Commit | Line | Data |
b1d7ad19 |
1 | |
2 | =pod |
3 | |
4 | =head1 NAME |
5 | |
6 | Moose::Cookbook::Meta::Recipe6 - A method metaclass for marking methods public or private |
7 | |
8 | =head1 SYNOPSIS |
9 | |
10 | package My::Meta::Method; |
11 | |
12 | use Moose; |
13 | use Moose::Util::TypeConstraints; |
14 | |
15 | extends 'Moose::Meta::Method'; |
16 | |
17 | has '_policy' => ( |
18 | is => 'ro', |
19 | isa => enum( [ qw( public private ) ] ), |
20 | default => 'public', |
21 | init_arg => 'policy', |
22 | ); |
23 | |
24 | sub new { |
25 | my $class = shift; |
26 | my %options = @_; |
27 | |
28 | my $self = $class->SUPER::wrap(%options); |
29 | |
30 | $self->{_policy} = $options{policy}; |
31 | |
32 | $self->_add_policy_wrapper; |
33 | |
34 | return $self; |
35 | } |
36 | |
37 | sub _add_policy_wrapper { |
38 | my $self = shift; |
39 | |
40 | return if $self->is_public; |
41 | |
42 | my $name = $self->name; |
43 | my $package = $self->package_name; |
44 | my $real_body = $self->body; |
45 | |
46 | my $body = sub { |
47 | die "The $package\::$name method is private" |
48 | unless ( scalar caller() ) eq $package; |
49 | |
50 | goto &{$real_body}; |
51 | }; |
52 | |
53 | $self->{body} = $body; |
54 | } |
55 | |
56 | sub is_public { $_[0]->_policy eq 'public' } |
57 | sub is_private { $_[0]->_policy eq 'private' } |
58 | |
59 | package MyApp::User; |
60 | |
61 | use Moose; |
62 | |
63 | has 'password' => ( is => 'rw' ); |
64 | |
65 | __PACKAGE__->meta()->add_method( |
66 | '_reset_password', |
67 | My::Meta::Method->new( |
68 | name => '_reset_password', |
69 | package_name => __PACKAGE__, |
70 | body => sub { $_[0]->password('reset') }, |
71 | policy => 'private', |
72 | ) |
73 | ); |
74 | |
75 | =head1 DESCRIPTION |
76 | |
77 | This example shows a custom method metaclass that models public versus |
78 | private methods. If a method is defined as private, it adds a wrapper |
79 | around the method which dies unless it is called from the class where |
80 | it was defined. |
81 | |
82 | The way the method is added to the class is rather ugly. If we wanted |
83 | to make this a real feature, we'd probably want to add some sort of |
84 | sugar to allow us to declare private methods, but that is beyond the |
85 | scope of this recipe. See the Extending recipes for more on this |
86 | topic. |
87 | |
88 | The core of our custom class is the C<policy> attribute, and |
89 | C<_add_policy_wrapper> method. |
90 | |
91 | You'll note that we have to explicitly set the C<policy> attribute in |
92 | our constructor: |
93 | |
94 | $self->{policy} = $options{policy}; |
95 | |
96 | That is necessary because Moose metaclasses do not use the meta API to |
66d68f76 |
97 | create objects. Most Moose classes have a custom "inlined" constructor |
b1d7ad19 |
98 | for speed. |
99 | |
100 | In this particular case, our parent class's constructor is the C<wrap> |
101 | method. We call that to build our object, but it does not include |
102 | subclass-specific attributes. |
103 | |
104 | The C<_add_policy_wrapper> method is where the real work is done. If |
105 | the method is private, we construct a wrapper around the real |
106 | subroutine which checks that the caller matches the package in which |
107 | the subroutine was created. |
108 | |
109 | If they don't match, it dies. If they do match, the real method is |
110 | called. We use C<goto> so that the wrapper does not show up in the |
111 | call stack. |
112 | |
113 | Finally, we replace the value of C<< $self->{body} >>. This is another |
114 | case where we have to do something a bit gross because Moose does not |
115 | use Moose for its own implementation. |
116 | |
117 | When we pass this method object to the metaclass's C<add_method> |
118 | method, it will take the method body and make it available in the |
119 | class. |
120 | |
121 | Finally, when we retrieve these methods via the introspection API, we |
122 | can call the C<is_public> and C<is_private> methods on them to get |
123 | more information about the method. |
124 | |
125 | =head1 SUMMARY |
126 | |
127 | A custom method metaclass lets us add both behavior and |
128 | meta-information to methods. Unfortunately, because the Perl |
2a67e654 |
129 | interpreter does not provide easy hooks into method declaration, the |
b1d7ad19 |
130 | API we have for adding these methods is not very pretty. |
131 | |
132 | That can be improved with custom Moose-like sugar, or even by using a |
133 | tool like L<Devel::Declare> to create full-blown new keywords in Perl. |
134 | |
135 | =head1 AUTHOR |
136 | |
137 | Dave Rolsky E<lt>autarch@urth.orgE<gt> |
138 | |
139 | =head1 COPYRIGHT AND LICENSE |
140 | |
141 | Copyright 2009 by Infinity Interactive, Inc. |
142 | |
143 | L<http://www.iinteractive.com> |
144 | |
145 | This library is free software; you can redistribute it and/or modify |
146 | it under the same terms as Perl itself. |
147 | |
148 | =begin testing |
149 | |
150 | package main; |
151 | |
152 | use Test::Exception; |
153 | |
154 | my $user = MyApp::User->new( password => 'foo!' ); |
155 | |
156 | throws_ok { $user->_reset_password } |
157 | qr/The MyApp::User::_reset_password method is private/, |
158 | '_reset_password method dies if called outside MyApp::User class'; |
159 | |
160 | { |
161 | package MyApp::User; |
162 | |
163 | sub run_reset { $_[0]->_reset_password } |
164 | } |
165 | |
166 | $user->run_reset; |
167 | |
168 | is( $user->password, 'reset', 'password has been reset' ); |
169 | |
170 | =end testing |
171 | |
172 | =cut |