Commit | Line | Data |
---|---|---|
1a4f7732 | 1 | package MooseX::StrictConstructor::Trait::Class; |
c001451a | 2 | |
d99e6f32 | 3 | use Moose::Role; |
4 | ||
5 | use namespace::autoclean; | |
c001451a | 6 | |
79b37c7d | 7 | use B (); |
c001451a | 8 | |
709eccb9 | 9 | around new_object => sub { |
eb63f59e | 10 | my $orig = shift; |
11 | my $self = shift; | |
12 | my $params = @_ == 1 ? $_[0] : {@_}; | |
709eccb9 | 13 | my $instance = $self->$orig(@_); |
14 | ||
15 | my %attrs = ( | |
16 | __INSTANCE__ => 1, | |
eb63f59e | 17 | ( |
18 | map { $_ => 1 } | |
19 | grep {defined} | |
20 | map { $_->init_arg() } $self->get_all_attributes() | |
21 | ) | |
709eccb9 | 22 | ); |
23 | ||
24 | my @bad = sort grep { !$attrs{$_} } keys %$params; | |
25 | ||
26 | if (@bad) { | |
27 | $self->throw_error( | |
eb63f59e | 28 | "Found unknown attribute(s) init_arg passed to the constructor: @bad" |
29 | ); | |
709eccb9 | 30 | } |
31 | ||
32 | return $instance; | |
33 | }; | |
34 | ||
0b60c40b | 35 | around _inline_BUILDALL => sub { |
64c958ef | 36 | my $orig = shift; |
c001451a | 37 | my $self = shift; |
38 | ||
01265e2a | 39 | my @source = $self->$orig(); |
c001451a | 40 | |
5a0d4921 | 41 | my @attrs = ( |
df9653e6 | 42 | '__INSTANCE__ => 1,', |
79b37c7d | 43 | map { B::perlstring($_) . ' => 1,' } |
5a0d4921 | 44 | grep {defined} |
01265e2a | 45 | map { $_->init_arg() } $self->get_all_attributes() |
5a0d4921 | 46 | ); |
c001451a | 47 | |
01265e2a | 48 | return ( |
49 | @source, | |
bb64c045 | 50 | 'my @bad = sort grep { !$allowed_attrs{$_} } keys %{ $params };', |
01265e2a | 51 | 'if (@bad) {', |
714128ef | 52 | 'Moose->throw_error("Found unknown attribute(s) passed to the constructor: @bad");', |
01265e2a | 53 | '}', |
54 | ); | |
0dc0aea2 | 55 | } if $Moose::VERSION >= 1.9900; |
c001451a | 56 | |
f00a034f | 57 | around _eval_environment => sub { |
58 | my $orig = shift; | |
59 | my $self = shift; | |
60 | ||
61 | my $env = $self->$orig(); | |
62 | ||
63 | my %attrs = map { $_ => 1 } | |
64 | grep { defined } | |
65 | map { $_->init_arg() } | |
66 | $self->get_all_attributes(); | |
67 | ||
68 | $attrs{__INSTANCE__} = 1; | |
69 | ||
70 | $env->{'%allowed_attrs'} = \%attrs; | |
71 | ||
72 | return $env; | |
73 | } if $Moose::VERSION >= 1.9900; | |
74 | ||
c001451a | 75 | 1; |
58370717 | 76 | |
0639c294 | 77 | # ABSTRACT: A role to make immutable constructors strict |
78 | ||
58370717 | 79 | __END__ |
80 | ||
81 | =pod | |
82 | ||
58370717 | 83 | =head1 DESCRIPTION |
84 | ||
01265e2a | 85 | This role simply wraps C<_inline_BUILDALL()> (from |
86 | C<Moose::Meta::Class>) so that immutable classes have a | |
fbfaa61f | 87 | strict constructor. |
58370717 | 88 | |
58370717 | 89 | =cut |