1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
|
# PODNAME: Moose::Cookbook::Meta::PrivateOrPublic_MethodMetaclass
# ABSTRACT: A method metaclass for marking methods public or private
__END__
=pod
=encoding UTF-8
=head1 NAME
Moose::Cookbook::Meta::PrivateOrPublic_MethodMetaclass - A method metaclass for marking methods public or private
=head1 VERSION
version 2.1405
=head1 SYNOPSIS
package MyApp::Meta::Method::PrivateOrPublic;
use Moose;
use Moose::Util::TypeConstraints;
extends 'Moose::Meta::Method';
has '_policy' => (
is => 'ro',
isa => enum( [ qw( public private ) ] ),
default => 'public',
init_arg => 'policy',
);
sub new {
my $class = shift;
my %options = @_;
my $self = $class->SUPER::wrap(%options);
$self->{_policy} = $options{policy};
$self->_add_policy_wrapper;
return $self;
}
sub _add_policy_wrapper {
my $self = shift;
return if $self->is_public;
my $name = $self->name;
my $package = $self->package_name;
my $real_body = $self->body;
my $body = sub {
die "The $package\::$name method is private"
unless ( scalar caller() ) eq $package;
goto &{$real_body};
};
$self->{body} = $body;
}
sub is_public { $_[0]->_policy eq 'public' }
sub is_private { $_[0]->_policy eq 'private' }
package MyApp::User;
use Moose;
has 'password' => ( is => 'rw' );
__PACKAGE__->meta()->add_method(
'_reset_password',
MyApp::Meta::Method::PrivateOrPublic->new(
name => '_reset_password',
package_name => __PACKAGE__,
body => sub { $_[0]->password('reset') },
policy => 'private',
)
);
=head1 DESCRIPTION
This example shows a custom method metaclass that models public versus
private methods. If a method is defined as private, it adds a wrapper
around the method which dies unless it is called from the class where
it was defined.
The way the method is added to the class is rather ugly. If we wanted
to make this a real feature, we'd probably want to add some sort of
sugar to allow us to declare private methods, but that is beyond the
scope of this recipe. See the Extending recipes for more on this
topic.
The core of our custom class is the C<policy> attribute, and
C<_add_policy_wrapper> method.
You'll note that we have to explicitly set the C<policy> attribute in
our constructor:
$self->{_policy} = $options{policy};
That is necessary because Moose metaclasses do not use the meta API to
create objects. Most Moose classes have a custom "inlined" constructor
for speed.
In this particular case, our parent class's constructor is the C<wrap>
method. We call that to build our object, but it does not include
subclass-specific attributes.
The C<_add_policy_wrapper> method is where the real work is done. If
the method is private, we construct a wrapper around the real
subroutine which checks that the caller matches the package in which
the subroutine was created.
If they don't match, it dies. If they do match, the real method is
called. We use C<goto> so that the wrapper does not show up in the
call stack.
Finally, we replace the value of C<< $self->{body} >>. This is another
case where we have to do something a bit gross because Moose does not
use Moose for its own implementation.
When we pass this method object to the metaclass's C<add_method>
method, it will take the method body and make it available in the
class.
Finally, when we retrieve these methods via the introspection API, we
can call the C<is_public> and C<is_private> methods on them to get
more information about the method.
=head1 SUMMARY
A custom method metaclass lets us add both behavior and
meta-information to methods. Unfortunately, because the Perl
interpreter does not provide easy hooks into method declaration, the
API we have for adding these methods is not very pretty.
That can be improved with custom Moose-like sugar, or even by using a
tool like L<Devel::Declare> to create full-blown new keywords in Perl.
=begin testing
package main;
use strict;
use warnings;
use Test::Fatal;
my $user = MyApp::User->new( password => 'foo!' );
like( exception { $user->_reset_password },
qr/The MyApp::User::_reset_password method is private/,
'_reset_password method dies if called outside MyApp::User class');
{
package MyApp::User;
sub run_reset { $_[0]->_reset_password }
}
$user->run_reset;
is( $user->password, 'reset', 'password has been reset' );
=end testing
=head1 AUTHORS
=over 4
=item *
Stevan Little <stevan.little@iinteractive.com>
=item *
Dave Rolsky <autarch@urth.org>
=item *
Jesse Luehrs <doy@tozt.net>
=item *
Shawn M Moore <code@sartak.org>
=item *
יובל קוג'מן (Yuval Kogman) <nothingmuch@woobling.org>
=item *
Karen Etheridge <ether@cpan.org>
=item *
Florian Ragwitz <rafl@debian.org>
=item *
Hans Dieter Pearcey <hdp@weftsoar.net>
=item *
Chris Prather <chris@prather.org>
=item *
Matt S Trout <mst@shadowcat.co.uk>
=back
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2006 by Infinity Interactive, Inc..
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut
|
