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->initialize($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->initialize($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->initialize($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->initialize($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 before {
  81     my $caller = shift;
  82     my $meta   = $CURRENT_METACLASS || Class::MOP::Class->initialize($caller);
  83
  84     my $code = pop @_;
  85
  86     for (@_) {
  87         Carp::croak "Roles do not currently support "
  88             . ref($_)
  89             . " references for before method modifiers"
  90             if ref $_;
  91         $meta->add_before_method_modifier($_, $code);
  92     }
  93 }
  94
  95 sub after {
  96     my $caller = shift;
  97     my $meta   = $CURRENT_METACLASS || Class::MOP::Class->initialize($caller);
  98
  99     my $code = pop @_;
 100
 101     for (@_) {
 102         Carp::croak "Roles do not currently support "
 103             . ref($_)
 104             . " references for after method modifiers"
 105             if ref $_;
 106         $meta->add_after_method_modifier($_, $code);
 107     }
 108 }
 109
 110 sub around {
 111     my $caller = shift;
 112     my $meta   = $CURRENT_METACLASS || Class::MOP::Class->initialize($caller);
 113
 114     my $code = pop @_;
 115
 116     for (@_) {
 117         Carp::croak "Roles do not currently support "
 118             . ref($_)
 119             . " references for around method modifiers"
 120             if ref $_;
 121         $meta->add_around_method_modifier($_, $code);
 122     }
 123 }
 124
 125 sub with {
 126     my $caller = shift;
 127     my $meta   = $CURRENT_METACLASS || Class::MOP::Class->initialize($caller);
 128
 129     Moose::Util::apply_all_roles($meta, @_);
 130 }
 131
 132 sub requires {
 133     my $caller = shift;
 134     my $meta   = $CURRENT_METACLASS || Class::MOP::Class->initialize($caller);
 135
 136     Carp::croak "Must specify at least one method" unless @_;
 137     $meta->add_required_methods(@_);
 138 }
 139
 140 sub excludes {
 141     my $caller = shift;
 142     my $meta   = $CURRENT_METACLASS || Class::MOP::Class->initialize($caller);
 143
 144     Carp::croak "Must specify at least one role" unless @_;
 145     $meta->add_excluded_roles(@_);
 146 }
 147
 148 # see Moose.pm for discussion
 149 sub super {
 150     return unless $Moose::SUPER_BODY;
 151     $Moose::SUPER_BODY->(@Moose::SUPER_ARGS);
 152 }
 153
 154 sub override {
 155     my $caller = shift;
 156     my $meta   = $CURRENT_METACLASS || Class::MOP::Class->initialize($caller);
 157
 158     my ($name, $code) = @_;
 159     $meta->add_override_method_modifier($name, $code);
 160 }
 161
 162 sub extends { Carp::croak "Roles do not currently support 'extends'" }
 163
 164 sub inner { Carp::croak "Roles cannot support 'inner'" }
 165
 166 sub augment { Carp::croak "Roles cannot support 'augment'" }
 167
 168 1;
 169
 170 __END__
 171
 172 =head1 NAME
 173
 174 MooseX::Role::Parameterized - parameterized roles
 175
 176 =head1 SYNOPSIS
 177
 178     package MyRole::Counter;
 179     use MooseX::Role::Parameterized;
 180
 181     parameter name => (
 182         isa      => 'Str',
 183         required => 1,
 184     );
 185
 186     role {
 187         my $p = shift;
 188
 189         my $name = $p->name;
 190
 191         has $name => (
 192             is      => 'rw',
 193             isa     => 'Int',
 194             default => 0,
 195         );
 196
 197         method "increment_$name" => sub {
 198             my $self = shift;
 199             $self->$name($self->$name + 1);
 200         };
 201
 202         method "decrement_$name" => sub {
 203             my $self = shift;
 204             $self->$name($self->$name - 1);
 205         };
 206     };
 207
 208     package MyGame::Tile;
 209     use Moose;
 210
 211     with 'MyRole::Counter' => { name => 'stepped_on' };
 212
 213 =head1 L<MooseX::Role::Parameterized::Tutorial>
 214
 215 B<Stop!> If you're new here, please read
 216 L<MooseX::Role::Parameterized::Tutorial>.
 217
 218 =head1 DESCRIPTION
 219
 220 Your parameterized role consists of two things: parameter declarations and a
 221 C<role> block.
 222
 223 Parameters are declared using the L</parameter> keyword which very much
 224 resembles L<Moose/has>. You can use any option that L<Moose/has> accepts. The
 225 default value for the "is" option is "ro" as that's a very common case. These
 226 parameters will get their values when the consuming class (or role) uses
 227 L<Moose/with>. A parameter object will be constructed with these values, and
 228 passed to the C<role> block.
 229
 230 The C<role> block then uses the usual L<Moose::Role> keywords to build up a
 231 role. You can shift off the parameter object to inspect what the consuming
 232 class provided as parameters. You can use the parameters to make your role
 233 customizable!
 234
 235 There are many paths to parameterized roles (hopefully with a consistent enough
 236 API); I believe this to be the easiest and most flexible implementation.
 237 Coincidentally, Pugs has a very similar design (I'm not yet convinced that that
 238 is a good thing).
 239
 240 =head1 CAVEATS
 241
 242 You must use this syntax to declare methods in the role block:
 243 C<< method NAME => sub { ... }; >>. This is due to a limitation in Perl. In
 244 return though you can use parameters I<in your methods>!
 245
 246 L<Moose::Role/alias> and L<Moose::Role/excludes> are not yet supported. I'm
 247 completely unsure of whether they should be handled by this module. Until we
 248 figure out a plan, both declaring and providing a parameter named C<alias> or
 249 C<excludes> is an error.
 250
 251 =head1 AUTHOR
 252
 253 Shawn M Moore, C<< <sartak@bestpractical.com> >>
 254
 255 =head1 EXAMPLES
 256
 257 =over 4
 258
 259 =item L<MooseX::Role::Matcher>
 260
 261 =item L<MooseX::Role::RelatedClassRoles>
 262
 263 =item L<MooseX::Role::XMLRPC::Client>
 264
 265 =item L<WWW::Mechanize::TreeBuilder>
 266
 267 =item L<TAEB::Action::Role::Item>
 268
 269 =item L<KiokuDB::Role::Scan>
 270
 271 =item L<Fey::Role::MakesAliasObjects>
 272
 273 =item L<Fey::Role::HasAliasName>
 274
 275 =item L<Fey::Role::SetOperation>
 276
 277 =back
 278
 279 =cut
 280