Do not recreate hash on every construction
[gitmo/MooseX-StrictConstructor.git] / lib / MooseX / StrictConstructor / Trait / Class.pm
1 package MooseX::StrictConstructor::Trait::Class;
2
3 use Moose::Role;
4
5 use namespace::autoclean;
6
7 use B ();
8
9 my %pkg_attrs;
10
11 around new_object => sub {
12     my $orig     = shift;
13     my $self     = shift;
14     my $params   = @_ == 1 ? $_[0] : {@_};
15     my $instance = $self->$orig(@_);
16
17     my $attrs =
18       $pkg_attrs{ref($instance)} ||= {
19           __INSTANCE__ => 1,
20           map { $_ => 1 }
21           grep {defined}
22           map  { $_->init_arg() } $self->get_all_attributes()
23       };
24
25     if (my @bad = sort grep { !$attrs->{$_} } keys %$params) {
26         $self->throw_error(
27             "Found unknown attribute(s) init_arg passed to the constructor: @bad"
28         );
29     }
30
31     return $instance;
32 };
33
34 around '_inline_BUILDALL' => sub {
35     my $orig = shift;
36     my $self = shift;
37
38     my @source = $self->$orig();
39
40     my @attrs = (
41         '__INSTANCE__ => 1,',
42         map { B::perlstring($_) . ' => 1,' }
43         grep {defined}
44         map  { $_->init_arg() } $self->get_all_attributes()
45     );
46
47     my $MY = 'my';
48     if ($] >= 5.009004) {
49         push @source, "use feature 'state';";
50         $MY = 'state';
51     }
52
53     return (
54         @source,
55         $MY.' $attrs = {' . ( join ' ', @attrs ) . '};',
56         'if (my @bad = sort grep { !$attrs->{$_} } keys %$params) {',
57             'Moose->throw_error("Found unknown attribute(s) passed to the constructor: @bad");',
58         '}',
59     );
60 } if $Moose::VERSION >= 1.9900;
61
62 1;
63
64 # ABSTRACT: A role to make immutable constructors strict
65
66 __END__
67
68 =pod
69
70 =head1 DESCRIPTION
71
72 This role simply wraps C<_inline_BUILDALL()> (from
73 C<Moose::Meta::Class>) so that immutable classes have a
74 strict constructor.
75
76 =cut