lib/Moose/Cookbook/Meta/Recipe6.pod

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