lib/MooseX/Role/Parameterized.pm

   1 package MooseX::Role::Parameterized;
   2 use Moose (
   3     extends => { -as => 'moose_extends' },
   4     around  => { -as => 'moose_around' },
   5     qw/confess blessed/,
   6 );
   7 moose_extends 'Moose::Exporter';
   8
   9 use Moose::Role ();
  10
  11 use MooseX::Role::Parameterized::Meta::Role::Parameterizable;
  12
  13 our $CURRENT_METACLASS;
  14
  15 __PACKAGE__->setup_import_methods(
  16     with_caller => ['parameter', 'role', 'method', 'has', 'with', 'extends',
  17                     'requires', 'excludes', 'augment', 'inner', 'before',
  18                     'after', 'around', 'super', 'override'],
  19     as_is => [ 'confess', 'blessed' ],
  20 );
  21
  22 sub parameter {
  23     my $caller = shift;
  24
  25     confess "'parameter' may not be used inside of the role block"
  26         if $CURRENT_METACLASS;
  27
  28     my $meta   = Class::MOP::class_of($caller);
  29
  30     my $names = shift;
  31     $names = [$names] if !ref($names);
  32
  33     for my $name (@$names) {
  34         $meta->add_parameter($name, @_);
  35     }
  36 }
  37
  38 sub role (&) {
  39     my $caller         = shift;
  40     my $role_generator = shift;
  41     Class::MOP::class_of($caller)->role_generator($role_generator);
  42 }
  43
  44 sub init_meta {
  45     my $self = shift;
  46
  47     return Moose::Role->init_meta(@_,
  48         metaclass => 'MooseX::Role::Parameterized::Meta::Role::Parameterizable',
  49     );
  50 }
  51
  52 sub has {
  53     my $caller = shift;
  54     my $meta   = $CURRENT_METACLASS || Class::MOP::class_of($caller);
  55
  56     my $names = shift;
  57     $names = [$names] if !ref($names);
  58
  59     for my $name (@$names) {
  60         $meta->add_attribute($name, @_);
  61     }
  62 }
  63
  64 sub method {
  65     my $caller = shift;
  66     my $meta   = $CURRENT_METACLASS || Class::MOP::class_of($caller);
  67
  68     my $name   = shift;
  69     my $body   = shift;
  70
  71     my $method = $meta->method_metaclass->wrap(
  72         package_name => $caller,
  73         name         => $name,
  74         body         => $body,
  75     );
  76
  77     $meta->add_method($name => $method);
  78 }
  79
  80 sub _add_method_modifier {
  81     my $type   = shift;
  82     my $caller = shift;
  83     my $meta   = $CURRENT_METACLASS || Class::MOP::class_of($caller);
  84
  85     my $code = pop @_;
  86
  87     for (@_) {
  88         Carp::croak "Roles do not currently support "
  89             . ref($_)
  90             . " references for $type method modifiers"
  91             if ref $_;
  92
  93         my $add_method = "add_${type}_method_modifier";
  94         $meta->$add_method($_, $code);
  95     }
  96 }
  97
  98 sub before {
  99     _add_method_modifier('before', @_);
 100 }
 101
 102 sub after {
 103     _add_method_modifier('after', @_);
 104 }
 105
 106 sub around {
 107     _add_method_modifier('around', @_);
 108 }
 109
 110 sub with {
 111     my $caller = shift;
 112     my $meta   = $CURRENT_METACLASS || Class::MOP::class_of($caller);
 113
 114     Moose::Util::apply_all_roles($meta, @_);
 115 }
 116
 117 sub requires {
 118     my $caller = shift;
 119     my $meta   = $CURRENT_METACLASS || Class::MOP::class_of($caller);
 120
 121     Carp::croak "Must specify at least one method" unless @_;
 122     $meta->add_required_methods(@_);
 123 }
 124
 125 sub excludes {
 126     my $caller = shift;
 127     my $meta   = $CURRENT_METACLASS || Class::MOP::class_of($caller);
 128
 129     Carp::croak "Must specify at least one role" unless @_;
 130     $meta->add_excluded_roles(@_);
 131 }
 132
 133 # see Moose.pm for discussion
 134 sub super {
 135     return unless $Moose::SUPER_BODY;
 136     $Moose::SUPER_BODY->(@Moose::SUPER_ARGS);
 137 }
 138
 139 sub override {
 140     my $caller = shift;
 141     my $meta   = $CURRENT_METACLASS || Class::MOP::class_of($caller);
 142
 143     my ($name, $code) = @_;
 144     $meta->add_override_method_modifier($name, $code);
 145 }
 146
 147 sub extends { Carp::croak "Roles do not currently support 'extends'" }
 148
 149 sub inner { Carp::croak "Roles cannot support 'inner'" }
 150
 151 sub augment { Carp::croak "Roles cannot support 'augment'" }
 152
 153 1;
 154
 155 __END__
 156
 157 =head1 NAME
 158
 159 MooseX::Role::Parameterized - parameterized roles
 160
 161 =head1 SYNOPSIS
 162
 163     package MyRole::Counter;
 164     use MooseX::Role::Parameterized;
 165
 166     parameter name => (
 167         isa      => 'Str',
 168         required => 1,
 169     );
 170
 171     role {
 172         my $p = shift;
 173
 174         my $name = $p->name;
 175
 176         has $name => (
 177             is      => 'rw',
 178             isa     => 'Int',
 179             default => 0,
 180         );
 181
 182         method "increment_$name" => sub {
 183             my $self = shift;
 184             $self->$name($self->$name + 1);
 185         };
 186
 187         method "decrement_$name" => sub {
 188             my $self = shift;
 189             $self->$name($self->$name - 1);
 190         };
 191     };
 192
 193     package MyGame::Tile;
 194     use Moose;
 195
 196     with 'MyRole::Counter' => { name => 'stepped_on' };
 197
 198 =head1 L<MooseX::Role::Parameterized::Tutorial>
 199
 200 B<Stop!> If you're new here, please read
 201 L<MooseX::Role::Parameterized::Tutorial> for a much gentler introduction.
 202
 203 =head1 DESCRIPTION
 204
 205 Your parameterized role consists of two new things: parameter declarations
 206 and a C<role> block.
 207
 208 Parameters are declared using the L</parameter> keyword which very much
 209 resembles L<Moose/has>. You can use any option that L<Moose/has> accepts. The
 210 default value for the C<is> option is C<ro> as that's a very common case. These
 211 parameters will get their values when the consuming class (or role) uses
 212 L<Moose/with>. A parameter object will be constructed with these values, and
 213 passed to the C<role> block.
 214
 215 The C<role> block then uses the usual L<Moose::Role> keywords to build up a
 216 role. You can shift off the parameter object to inspect what the consuming
 217 class provided as parameters. You use the parameters to customize your
 218 role however you wish.
 219
 220 There are many possible implementations for parameterized roles (hopefully with
 221 a consistent enough API); I believe this to be the easiest and most flexible
 222 design. Coincidentally, Pugs originally had an eerily similar design.
 223
 224 =head2 Why a parameters object?
 225
 226 I've been asked several times "Why use a parameter I<object> and not just a
 227 parameter I<hashref>? That would eliminate the need to explicitly declare your
 228 parameters."
 229
 230 The benefits of using an object are similar to the benefits of using Moose. You
 231 get an easy way to specify lazy defaults, type constraint, delegation, and so
 232 on. You get to use MooseX modules.
 233
 234 You also get the usual introspective and intercessory abilities that come
 235 standard with the metaobject protocol. Ambitious users should be able to add
 236 traits to the parameters metaclass to further customize behavior. Please let
 237 me know if you're doing anything viciously complicated with this extension. :)
 238
 239 =head1 CAVEATS
 240
 241 You must use this syntax to declare methods in the role block:
 242 C<< method NAME => sub { ... }; >>. This is due to a limitation in Perl. In
 243 return though you can use parameters I<in your methods>!
 244
 245 L<Moose::Role/alias> and L<Moose::Role/excludes> are not yet supported. I'm
 246 completely unsure of whether they should be handled by this module. Until we
 247 figure out a plan, either declaring or providing a parameter named C<alias> or
 248 C<excludes> is an error.
 249
 250 =head1 AUTHOR
 251
 252 Shawn M Moore, C<< <sartak@bestpractical.com> >>
 253
 254 =head1 EXAMPLES
 255
 256 =over 4
 257
 258 =item L<MooseX::Role::Matcher>
 259
 260 =item L<MooseX::Role::XMLRPC::Client>
 261
 262 =item L<MooseX::RelatedClassRoles>
 263
 264 =item L<WWW::Mechanize::TreeBuilder>
 265
 266 =item L<TAEB::Action::Role::Item>
 267
 268 =item L<KiokuDB::Role::Scan>
 269
 270 =item L<Fey::Role::MakesAliasObjects>
 271
 272 =item L<Fey::Role::HasAliasName>
 273
 274 =item L<Fey::Role::SetOperation>
 275
 276 =back
 277
 278 =cut
 279