Commit | Line | Data |
d6ce838b |
1 | package MooseX::UndefTolerant::Class; |
02e25b00 |
2 | |
3 | # applied to metaclass, for Moose >= 1.9900 |
4 | |
5 | use strict; |
6 | use warnings; |
7 | |
d6ce838b |
8 | use Moose::Role; |
9 | |
dc3621bc |
10 | # TODO: this code should be in the attribute trait, in the inlined version of |
11 | # initialize_instance_slot, but this does not yet exist! |
12 | |
e5d1b642 |
13 | around _inline_init_attr_from_constructor => sub { |
14 | my $orig = shift; |
15 | my $self = shift; |
16 | my ($attr, $idx) = @_; |
d6ce838b |
17 | |
e5d1b642 |
18 | my @source = $self->$orig(@_); |
d6ce838b |
19 | |
e5d1b642 |
20 | my $init_arg = $attr->init_arg; |
f6bb95bd |
21 | my $type_constraint = $attr->type_constraint; |
22 | my $tc_says_clean = ($type_constraint && !$type_constraint->check(undef) ? 1 : 0); |
23 | |
72f76bd1 |
24 | # FIXME: not properly sanitizing field names - e.g. consider a field name "Z'ha'dum" |
f6bb95bd |
25 | return ($tc_says_clean ? ( |
26 | "if ( exists \$params->{'$init_arg'} && defined \$params->{'$init_arg'} ) {", |
27 | ) : (), |
28 | @source, |
29 | $tc_says_clean ? ( |
e5d1b642 |
30 | '} else {', |
f6bb95bd |
31 | "delete \$params->{'$init_arg'};", |
32 | '}', |
33 | ) : (), |
34 | ); |
e5d1b642 |
35 | }; |
d6ce838b |
36 | |
37 | no Moose::Role; |
d6ce838b |
38 | 1; |