--- /dev/null
+
+=pod
+
+=head1 NAME
+
+Moose::Cookbook::Meta::Recipe6 - A method metaclass for marking methods public or private
+
+=head1 SYNOPSIS
+
+ package My::Meta::Method;
+
+ 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',
+ My::Meta::Method->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 classe 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 private 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.
+
+=head1 AUTHOR
+
+Dave Rolsky E<lt>autarch@urth.orgE<gt>
+
+=head1 COPYRIGHT AND LICENSE
+
+Copyright 2009 by Infinity Interactive, Inc.
+
+L<http://www.iinteractive.com>
+
+This library is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself.
+
+=begin testing
+
+package main;
+
+use Test::Exception;
+
+my $user = MyApp::User->new( password => 'foo!' );
+
+throws_ok { $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
+
+=cut
projects / gitmo/Moose.git / commitdiff