Commit | Line | Data |
32726d88 |
1 | package MooseX::StrictConstructor; |
2 | |
3 | use strict; |
4 | use warnings; |
5 | |
2a1fb9c7 |
6 | our $VERSION = '0.06_01'; |
c633cb7e |
7 | $VERSION = eval $VERSION; |
32726d88 |
8 | |
0cdff431 |
9 | use Class::MOP (); |
10 | use Moose (); |
11 | use Moose::Exporter; |
12 | use MooseX::StrictConstructor::Role::Object; |
13 | use MooseX::StrictConstructor::Role::Metaclass; |
32726d88 |
14 | |
0cdff431 |
15 | Moose::Exporter->setup_import_methods( also => 'Moose' ); |
32726d88 |
16 | |
0cdff431 |
17 | sub init_meta |
32726d88 |
18 | { |
0cdff431 |
19 | shift; |
20 | my %p = @_; |
21 | |
22 | Moose->init_meta(%p); |
23 | |
24 | my $caller = $p{for_class}; |
25 | |
8d7ba9ea |
26 | my $old_meta = $caller->meta(); |
27 | |
28 | my $metameta = $old_meta->meta(); |
0cdff431 |
29 | unless ( $metameta->can('does_role') |
30 | && $metameta->does_role( 'MooseX::StrictConstructor::Role::Metaclass' ) ) |
31 | { |
32 | my $new_meta = |
33 | Moose::Meta::Class->create_anon_class |
34 | ( superclasses => [ ref $caller->meta() ], |
35 | roles => [ 'MooseX::StrictConstructor::Role::Metaclass' ], |
36 | cache => 1, |
37 | ); |
38 | |
39 | Class::MOP::remove_metaclass_by_name($caller); |
40 | |
8d7ba9ea |
41 | $new_meta->name()->initialize( $caller, |
42 | map { $_ => $old_meta->$_() } |
43 | qw( attribute_metaclass |
44 | method_metaclass |
45 | instance_metaclass |
46 | ) |
47 | ); |
0cdff431 |
48 | } |
49 | |
50 | unless ( $caller->meta()->does_role('MooseX::StrictConstructor::Role::Object') ) |
51 | { |
52 | my $new_base = |
53 | Moose::Meta::Class->create_anon_class |
54 | ( superclasses => [ $caller->meta()->superclasses() ], |
55 | roles => [ 'MooseX::StrictConstructor::Role::Object' ], |
56 | cache => 1, |
57 | ); |
58 | |
59 | $caller->meta()->superclasses( $new_base->name() ); |
60 | } |
61 | |
62 | return $caller->meta(); |
32726d88 |
63 | } |
64 | |
32726d88 |
65 | 1; |
66 | |
67 | __END__ |
68 | |
69 | =pod |
70 | |
71 | =head1 NAME |
72 | |
2ffa7b60 |
73 | MooseX::StrictConstructor - Make your object constructors blow up on unknown attributes |
32726d88 |
74 | |
75 | =head1 SYNOPSIS |
76 | |
2ffa7b60 |
77 | package My::Class; |
32726d88 |
78 | |
2ffa7b60 |
79 | use MooseX::StrictConstructor; # instead of use Moose |
32726d88 |
80 | |
2ffa7b60 |
81 | has 'size' => ...; |
32726d88 |
82 | |
2ffa7b60 |
83 | # then later ... |
84 | |
85 | # this blows up because color is not a known attribute |
86 | My::Class->new( size => 5, color => 'blue' ); |
32726d88 |
87 | |
88 | =head1 DESCRIPTION |
89 | |
2ffa7b60 |
90 | Using this class to load Moose instead of just loading using Moose |
91 | itself makes your constructors "strict". If your constructor is called |
a83dec43 |
92 | with an attribute init argument that your class does not declare, then |
93 | it calls "Carp::confess()". This is a great way to catch small typos. |
2ffa7b60 |
94 | |
95 | =head2 Subverting Strictness |
96 | |
97 | You may find yourself wanting to accept a parameter to the constructor |
98 | that is not the name of an attribute. |
99 | |
100 | In that case, you'll probably be writing a C<BUILD()> method to deal |
101 | with it. Your C<BUILD()> method will receive two parameters, the new |
102 | object, and a hash reference of parameters passed to the constructor. |
103 | |
104 | If you delete keys from this hash reference, then they will not be |
105 | seen when this class does its checking. |
106 | |
107 | sub BUILD { |
108 | my $self = shift; |
109 | my $params = shift; |
32726d88 |
110 | |
2ffa7b60 |
111 | if ( delete $params->{do_something} ) { |
112 | ... |
113 | } |
114 | } |
32726d88 |
115 | |
c001451a |
116 | =head2 Caveats |
117 | |
118 | Using this class replaces the default Moose meta class, |
119 | C<Moose::Meta::Class>, with its own, |
120 | C<MooseX::StrictConstructor::Meta::Class>. If you have your own meta |
121 | class, this distro will probably not work for you. |
122 | |
32726d88 |
123 | =head1 AUTHOR |
124 | |
125 | Dave Rolsky, C<< <autarch@urth.org> >> |
126 | |
127 | =head1 BUGS |
128 | |
2ffa7b60 |
129 | Please report any bugs or feature requests to |
130 | C<bug-moosex-strictconstructor@rt.cpan.org>, or through the web |
131 | interface at L<http://rt.cpan.org>. I will be notified, and then |
132 | you'll automatically be notified of progress on your bug as I make |
133 | changes. |
32726d88 |
134 | |
135 | =head1 COPYRIGHT & LICENSE |
136 | |
137 | Copyright 2007 Dave Rolsky, All Rights Reserved. |
138 | |
139 | This program is free software; you can redistribute it and/or modify |
140 | it under the same terms as Perl itself. |
141 | |
142 | =cut |