Commit | Line | Data |
---|---|---|
64c958ef | 1 | package MooseX::StrictConstructor::Role::Constructor; |
c001451a | 2 | |
3 | use strict; | |
4 | use warnings; | |
5 | ||
5c3f24ed | 6 | use Carp (); |
c001451a | 7 | |
64c958ef | 8 | use Moose::Role; |
c001451a | 9 | |
64c958ef | 10 | around '_generate_BUILDALL' => sub |
c001451a | 11 | { |
64c958ef | 12 | my $orig = shift; |
c001451a | 13 | my $self = shift; |
14 | ||
64c958ef | 15 | my $source = $self->$orig(); |
5c3f24ed | 16 | $source .= ";\n" if $source; |
c001451a | 17 | |
0f795b43 | 18 | my @attrs = |
19 | ( map { "$_ => 1," } | |
20 | grep { defined } | |
21 | map { $_->init_arg() } | |
22 | @{ $self->attributes() } | |
23 | ); | |
c001451a | 24 | |
5c3f24ed | 25 | $source .= <<"EOF"; |
26 | my \%attrs = (@attrs); | |
c001451a | 27 | |
5c40fb22 | 28 | my \@bad = sort grep { ! \$attrs{\$_} } keys \%{ \$params }; |
5c3f24ed | 29 | |
30 | if (\@bad) { | |
31 | Carp::confess "Found unknown attribute(s) passed to the constructor: \@bad"; | |
32 | } | |
c001451a | 33 | EOF |
34 | ||
5c3f24ed | 35 | return $source; |
c001451a | 36 | }; |
37 | ||
64c958ef | 38 | no Moose::Role; |
c001451a | 39 | |
40 | 1; | |
58370717 | 41 | |
42 | __END__ | |
43 | ||
44 | =pod | |
45 | ||
46 | =head1 NAME | |
47 | ||
48 | MooseX::StrictConstructor::Meta::Method::Constructor - A meta class to make immutable constructors strict | |
49 | ||
50 | =head1 SYNOPSIS | |
51 | ||
52 | use MooseX::StrictConstructor; | |
53 | ||
54 | =head1 DESCRIPTION | |
55 | ||
56 | This class simply overrides C<_generate_BUILDALL()> in | |
57 | C<Moose::Meta::Method::Constructor> so that classes that are made | |
58 | immutable have a strict constructor. | |
59 | ||
60 | You should never have to use this class directly. | |
61 | ||
62 | =head1 AUTHOR | |
63 | ||
64 | Dave Rolsky, C<< <autarch@urth.org> >> | |
65 | ||
66 | =head1 COPYRIGHT & LICENSE | |
67 | ||
68 | Copyright 2007 Dave Rolsky, All Rights Reserved. | |
69 | ||
70 | This program is free software; you can redistribute it and/or modify | |
71 | it under the same terms as Perl itself. | |
72 | ||
73 | =cut | |
74 |