local-lib5/lib/perl5/Moose/Cookbook/Meta/Recipe6.pod

   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
  97 create objects. Most Moose classes have a custom "inlined" constructor
  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
 129 interpreter does not private easy hooks into method declaration, the
 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