local-lib5/man/man3/Moose::Cookbook::Meta::Recipe6.3pm

   1 .\" Automatically generated by Pod::Man v1.37, Pod::Parser v1.3
   2 .\"
   3 .\" Standard preamble:
   4 .\" ========================================================================
   5 .de Sh \" Subsection heading
   6 .br
   7 .if t .Sp
   8 .ne 5
   9 .PP
  10 \fB\\$1\fR
  11 .PP
  12 ..
  13 .de Sp \" Vertical space (when we can't use .PP)
  14 .if t .sp .5v
  15 .if n .sp
  16 ..
  17 .de Vb \" Begin verbatim text
  18 .ft CW
  19 .nf
  20 .ne \\$1
  21 ..
  22 .de Ve \" End verbatim text
  23 .ft R
  24 .fi
  25 ..
  26 .\" Set up some character translations and predefined strings.  \*(-- will
  27 .\" give an unbreakable dash, \*(PI will give pi, \*(L" will give a left
  28 .\" double quote, and \*(R" will give a right double quote.  | will give a
  29 .\" real vertical bar.  \*(C+ will give a nicer C++.  Capital omega is used to
  30 .\" do unbreakable dashes and therefore won't be available.  \*(C` and \*(C'
  31 .\" expand to `' in nroff, nothing in troff, for use with C<>.
  32 .tr \(*W-|\(bv\*(Tr
  33 .ds C+ C\v'-.1v'\h'-1p'\s-2+\h'-1p'+\s0\v'.1v'\h'-1p'
  34 .ie n \{\
  35 .    ds -- \(*W-
  36 .    ds PI pi
  37 .    if (\n(.H=4u)&(1m=24u) .ds -- \(*W\h'-12u'\(*W\h'-12u'-\" diablo 10 pitch
  38 .    if (\n(.H=4u)&(1m=20u) .ds -- \(*W\h'-12u'\(*W\h'-8u'-\"  diablo 12 pitch
  39 .    ds L" ""
  40 .    ds R" ""
  41 .    ds C` ""
  42 .    ds C' ""
  43 'br\}
  44 .el\{\
  45 .    ds -- \|\(em\|
  46 .    ds PI \(*p
  47 .    ds L" ``
  48 .    ds R" ''
  49 'br\}
  50 .\"
  51 .\" If the F register is turned on, we'll generate index entries on stderr for
  52 .\" titles (.TH), headers (.SH), subsections (.Sh), items (.Ip), and index
  53 .\" entries marked with X<> in POD.  Of course, you'll have to process the
  54 .\" output yourself in some meaningful fashion.
  55 .if \nF \{\
  56 .    de IX
  57 .    tm Index:\\$1\t\\n%\t"\\$2"
  58 ..
  59 .    nr % 0
  60 .    rr F
  61 .\}
  62 .\"
  63 .\" For nroff, turn off justification.  Always turn off hyphenation; it makes
  64 .\" way too many mistakes in technical documents.
  65 .hy 0
  66 .if n .na
  67 .\"
  68 .\" Accent mark definitions (@(#)ms.acc 1.5 88/02/08 SMI; from UCB 4.2).
  69 .\" Fear.  Run.  Save yourself.  No user-serviceable parts.
  70 .    \" fudge factors for nroff and troff
  71 .if n \{\
  72 .    ds #H 0
  73 .    ds #V .8m
  74 .    ds #F .3m
  75 .    ds #[ \f1
  76 .    ds #] \fP
  77 .\}
  78 .if t \{\
  79 .    ds #H ((1u-(\\\\n(.fu%2u))*.13m)
  80 .    ds #V .6m
  81 .    ds #F 0
  82 .    ds #[ \&
  83 .    ds #] \&
  84 .\}
  85 .    \" simple accents for nroff and troff
  86 .if n \{\
  87 .    ds ' \&
  88 .    ds ` \&
  89 .    ds ^ \&
  90 .    ds , \&
  91 .    ds ~ ~
  92 .    ds /
  93 .\}
  94 .if t \{\
  95 .    ds ' \\k:\h'-(\\n(.wu*8/10-\*(#H)'\'\h"|\\n:u"
  96 .    ds ` \\k:\h'-(\\n(.wu*8/10-\*(#H)'\`\h'|\\n:u'
  97 .    ds ^ \\k:\h'-(\\n(.wu*10/11-\*(#H)'^\h'|\\n:u'
  98 .    ds , \\k:\h'-(\\n(.wu*8/10)',\h'|\\n:u'
  99 .    ds ~ \\k:\h'-(\\n(.wu-\*(#H-.1m)'~\h'|\\n:u'
 100 .    ds / \\k:\h'-(\\n(.wu*8/10-\*(#H)'\z\(sl\h'|\\n:u'
 101 .\}
 102 .    \" troff and (daisy-wheel) nroff accents
 103 .ds : \\k:\h'-(\\n(.wu*8/10-\*(#H+.1m+\*(#F)'\v'-\*(#V'\z.\h'.2m+\*(#F'.\h'|\\n:u'\v'\*(#V'
 104 .ds 8 \h'\*(#H'\(*b\h'-\*(#H'
 105 .ds o \\k:\h'-(\\n(.wu+\w'\(de'u-\*(#H)/2u'\v'-.3n'\*(#[\z\(de\v'.3n'\h'|\\n:u'\*(#]
 106 .ds d- \h'\*(#H'\(pd\h'-\w'~'u'\v'-.25m'\f2\(hy\fP\v'.25m'\h'-\*(#H'
 107 .ds D- D\\k:\h'-\w'D'u'\v'-.11m'\z\(hy\v'.11m'\h'|\\n:u'
 108 .ds th \*(#[\v'.3m'\s+1I\s-1\v'-.3m'\h'-(\w'I'u*2/3)'\s-1o\s+1\*(#]
 109 .ds Th \*(#[\s+2I\s-2\h'-\w'I'u*3/5'\v'-.3m'o\v'.3m'\*(#]
 110 .ds ae a\h'-(\w'a'u*4/10)'e
 111 .ds Ae A\h'-(\w'A'u*4/10)'E
 112 .    \" corrections for vroff
 113 .if v .ds ~ \\k:\h'-(\\n(.wu*9/10-\*(#H)'\s-2\u~\d\s+2\h'|\\n:u'
 114 .if v .ds ^ \\k:\h'-(\\n(.wu*10/11-\*(#H)'\v'-.4m'^\v'.4m'\h'|\\n:u'
 115 .    \" for low resolution devices (crt and lpr)
 116 .if \n(.H>23 .if \n(.V>19 \
 117 \{\
 118 .    ds : e
 119 .    ds 8 ss
 120 .    ds o a
 121 .    ds d- d\h'-1'\(ga
 122 .    ds D- D\h'-1'\(hy
 123 .    ds th \o'bp'
 124 .    ds Th \o'LP'
 125 .    ds ae ae
 126 .    ds Ae AE
 127 .\}
 128 .rm #[ #] #H #V #F C
 129 .\" ========================================================================
 130 .\"
 131 .IX Title "Moose::Cookbook::Meta::Recipe6 3"
 132 .TH Moose::Cookbook::Meta::Recipe6 3 "2009-04-07" "perl v5.8.7" "User Contributed Perl Documentation"
 133 .SH "NAME"
 134 Moose::Cookbook::Meta::Recipe6 \- A method metaclass for marking methods public or private
 135 .SH "SYNOPSIS"
 136 .IX Header "SYNOPSIS"
 137 .Vb 1
 138 \&  package My::Meta::Method;
 139 .Ve
 140 .PP
 141 .Vb 2
 142 \&  use Moose;
 143 \&  use Moose::Util::TypeConstraints;
 144 .Ve
 145 .PP
 146 .Vb 1
 147 \&  extends 'Moose::Meta::Method';
 148 .Ve
 149 .PP
 150 .Vb 6
 151 \&  has '_policy' => (
 152 \&      is       => 'ro',
 153 \&      isa      => enum( [ qw( public private ) ] ),
 154 \&      default  => 'public',
 155 \&      init_arg => 'policy',
 156 \&  );
 157 .Ve
 158 .PP
 159 .Vb 3
 160 \&  sub new {
 161 \&      my $class   = shift;
 162 \&      my %options = @_;
 163 .Ve
 164 .PP
 165 .Vb 1
 166 \&      my $self = $class\->SUPER::wrap(%options);
 167 .Ve
 168 .PP
 169 .Vb 1
 170 \&      $self\->{_policy} = $options{policy};
 171 .Ve
 172 .PP
 173 .Vb 1
 174 \&      $self\->_add_policy_wrapper;
 175 .Ve
 176 .PP
 177 .Vb 2
 178 \&      return $self;
 179 \&  }
 180 .Ve
 181 .PP
 182 .Vb 2
 183 \&  sub _add_policy_wrapper {
 184 \&      my $self = shift;
 185 .Ve
 186 .PP
 187 .Vb 1
 188 \&      return if $self\->is_public;
 189 .Ve
 190 .PP
 191 .Vb 3
 192 \&      my $name      = $self\->name;
 193 \&      my $package   = $self\->package_name;
 194 \&      my $real_body = $self\->body;
 195 .Ve
 196 .PP
 197 .Vb 3
 198 \&      my $body = sub {
 199 \&          die "The $package\e::$name method is private"
 200 \&              unless ( scalar caller() ) eq $package;
 201 .Ve
 202 .PP
 203 .Vb 2
 204 \&          goto &{$real_body};
 205 \&      };
 206 .Ve
 207 .PP
 208 .Vb 2
 209 \&      $self\->{body} = $body;
 210 \&  }
 211 .Ve
 212 .PP
 213 .Vb 2
 214 \&  sub is_public  { $_[0]\->_policy eq 'public' }
 215 \&  sub is_private { $_[0]\->_policy eq 'private' }
 216 .Ve
 217 .PP
 218 .Vb 1
 219 \&  package MyApp::User;
 220 .Ve
 221 .PP
 222 .Vb 1
 223 \&  use Moose;
 224 .Ve
 225 .PP
 226 .Vb 1
 227 \&  has 'password' => ( is => 'rw' );
 228 .Ve
 229 .PP
 230 .Vb 9
 231 \&  __PACKAGE__\->meta()\->add_method(
 232 \&      '_reset_password',
 233 \&      My::Meta::Method\->new(
 234 \&          name         => '_reset_password',
 235 \&          package_name => __PACKAGE__,
 236 \&          body         => sub { $_[0]\->password('reset') },
 237 \&          policy       => 'private',
 238 \&      )
 239 \&  );
 240 .Ve
 241 .SH "DESCRIPTION"
 242 .IX Header "DESCRIPTION"
 243 This example shows a custom method metaclass that models public versus
 244 private methods. If a method is defined as private, it adds a wrapper
 245 around the method which dies unless it is called from the class where
 246 it was defined.
 247 .PP
 248 The way the method is added to the class is rather ugly. If we wanted
 249 to make this a real feature, we'd probably want to add some sort of
 250 sugar to allow us to declare private methods, but that is beyond the
 251 scope of this recipe. See the Extending recipes for more on this
 252 topic.
 253 .PP
 254 The core of our custom class is the \f(CW\*(C`policy\*(C'\fR attribute, and
 255 \&\f(CW\*(C`_add_policy_wrapper\*(C'\fR method.
 256 .PP
 257 You'll note that we have to explicitly set the \f(CW\*(C`policy\*(C'\fR attribute in
 258 our constructor:
 259 .PP
 260 .Vb 1
 261 \&      $self\->{policy} = $options{policy};
 262 .Ve
 263 .PP
 264 That is necessary because Moose metaclasses do not use the meta \s-1API\s0 to
 265 create objects. Most Moose classes have a custom \*(L"inlined\*(R" constructor
 266 for speed.
 267 .PP
 268 In this particular case, our parent class's constructor is the \f(CW\*(C`wrap\*(C'\fR
 269 method. We call that to build our object, but it does not include
 270 subclass-specific attributes.
 271 .PP
 272 The \f(CW\*(C`_add_policy_wrapper\*(C'\fR method is where the real work is done. If
 273 the method is private, we construct a wrapper around the real
 274 subroutine which checks that the caller matches the package in which
 275 the subroutine was created.
 276 .PP
 277 If they don't match, it dies. If they do match, the real method is
 278 called. We use \f(CW\*(C`goto\*(C'\fR so that the wrapper does not show up in the
 279 call stack.
 280 .PP
 281 Finally, we replace the value of \f(CW\*(C`$self\->{body}\*(C'\fR. This is another
 282 case where we have to do something a bit gross because Moose does not
 283 use Moose for its own implementation.
 284 .PP
 285 When we pass this method object to the metaclass's \f(CW\*(C`add_method\*(C'\fR
 286 method, it will take the method body and make it available in the
 287 class.
 288 .PP
 289 Finally, when we retrieve these methods via the introspection \s-1API\s0, we
 290 can call the \f(CW\*(C`is_public\*(C'\fR and \f(CW\*(C`is_private\*(C'\fR methods on them to get
 291 more information about the method.
 292 .SH "SUMMARY"
 293 .IX Header "SUMMARY"
 294 A custom method metaclass lets us add both behavior and
 295 meta-information to methods. Unfortunately, because the Perl
 296 interpreter does not private easy hooks into method declaration, the
 297 \&\s-1API\s0 we have for adding these methods is not very pretty.
 298 .PP
 299 That can be improved with custom Moose-like sugar, or even by using a
 300 tool like Devel::Declare to create full-blown new keywords in Perl.
 301 .SH "AUTHOR"
 302 .IX Header "AUTHOR"
 303 Dave Rolsky <autarch@urth.org>
 304 .SH "COPYRIGHT AND LICENSE"
 305 .IX Header "COPYRIGHT AND LICENSE"
 306 Copyright 2009 by Infinity Interactive, Inc.
 307 .PP
 308 <http://www.iinteractive.com>
 309 .PP
 310 This library is free software; you can redistribute it and/or modify
 311 it under the same terms as Perl itself.