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