1package MooseX::StrictConstructor::Trait::Class;
2
3use strict;
4use warnings;
5use namespace::autoclean;
6
7our $VERSION = '0.21';
8
9use Moose::Role;
10
11use B ();
12
13around new_object => sub {
14    my $orig     = shift;
15    my $self     = shift;
16    my $params   = @_ == 1 ? $_[0] : {@_};
17    my $instance = $self->$orig(@_);
18
19    my %attrs = (
20        __INSTANCE__ => 1,
21        __no_BUILD__ => 1,
22        (
23            map { $_ => 1 }
24            grep {defined}
25            map  { $_->init_arg() } $self->get_all_attributes()
26        ),
27    );
28
29    my @bad = sort grep { !$attrs{$_} } keys %$params;
30
31    if (@bad) {
32        $self->throw_error(
33            "Found unknown attribute(s) init_arg passed to the constructor: @bad"
34        );
35    }
36
37    return $instance;
38};
39
40around _inline_BUILDALL => sub {
41    my $orig = shift;
42    my $self = shift;
43
44    my @source = $self->$orig();
45
46    my @attrs = (
47        '__INSTANCE__ => 1,',
48        '__no_BUILD__ => 1,',
49        (
50            map  { B::perlstring($_) . ' => 1,' }
51            grep {defined}
52            map  { $_->init_arg() } $self->get_all_attributes()
53        ),
54    );
55
56    return (
57        @source,
58        'my @bad = sort grep { !$allowed_attrs{$_} } keys %{ $params };',
59        'if (@bad) {',
60        'Moose->throw_error("Found unknown attribute(s) passed to the constructor: @bad");',
61        '}',
62    );
63    }
64    if $Moose::VERSION >= 1.9900;
65
66around _eval_environment => sub {
67    my $orig = shift;
68    my $self = shift;
69
70    my $env = $self->$orig();
71
72    my %attrs = map { $_ => 1 }
73        grep {defined}
74        map  { $_->init_arg() } $self->get_all_attributes();
75
76    $attrs{__INSTANCE__} = 1;
77    $attrs{__no_BUILD__} = 1;
78
79    $env->{'%allowed_attrs'} = \%attrs;
80
81    return $env;
82    }
83    if $Moose::VERSION >= 1.9900;
84
851;
86
87# ABSTRACT: A role to make immutable constructors strict
88
89__END__
90
91=pod
92
93=encoding UTF-8
94
95=head1 NAME
96
97MooseX::StrictConstructor::Trait::Class - A role to make immutable constructors strict
98
99=head1 VERSION
100
101version 0.21
102
103=head1 DESCRIPTION
104
105This role simply wraps C<_inline_BUILDALL()> (from
106C<Moose::Meta::Class>) so that immutable classes have a
107strict constructor.
108
109=head1 SUPPORT
110
111Bugs may be submitted at L<https://github.com/moose/MooseX-StrictConstructor/issues>.
112
113I am also usually active on IRC as 'autarch' on C<irc://irc.perl.org>.
114
115=head1 SOURCE
116
117The source code repository for MooseX-StrictConstructor can be found at L<https://github.com/moose/MooseX-StrictConstructor>.
118
119=head1 AUTHOR
120
121Dave Rolsky <autarch@urth.org>
122
123=head1 COPYRIGHT AND LICENSE
124
125This software is Copyright (c) 2007 - 2017 by Dave Rolsky.
126
127This is free software, licensed under:
128
129  The Artistic License 2.0 (GPL Compatible)
130
131The full text of the license can be found in the
132F<LICENSE> file included with this distribution.
133
134=cut
135