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