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 before {
  81     my $caller = shift;
  82     my $meta   = $CURRENT_METACLASS || Class::MOP::class_of($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_of($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_of($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_of($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_of($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_of($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_of($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 new things: parameter declarations
 221 and a 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 C<is> option is C<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 use the parameters to customize your
 233 role however you wish.
 234
 235 There are many possible implementations for parameterized roles (hopefully with
 236 a consistent enough API); I believe this to be the easiest and most flexible
 237 design. Coincidentally, Pugs originally had an eerily similar design.
 238
 239 =head2 Why a parameters object?
 240
 241 I've been asked several times "Why use a parameter I<object> and not just a
 242 parameter I<hashref>? That would eliminate the need to explicitly declare your
 243 parameters."
 244
 245 The benefits of using an object are similar to the benefits of using Moose. You
 246 get an easy way to specify lazy defaults, type constraint, delegation, and so
 247 on. You get to use MooseX modules.
 248
 249 You also get the usual introspective and intercessory abilities that come
 250 standard with the metaobject protocol. Ambitious users should be able to add
 251 traits to the parameters metaclass to further customize behavior. Please let
 252 me know if you're doing anything viciously complicated with this extension. :)
 253
 254 =head1 CAVEATS
 255
 256 You must use this syntax to declare methods in the role block:
 257 C<< method NAME => sub { ... }; >>. This is due to a limitation in Perl. In
 258 return though you can use parameters I<in your methods>!
 259
 260 L<Moose::Role/alias> and L<Moose::Role/excludes> are not yet supported. I'm
 261 completely unsure of whether they should be handled by this module. Until we
 262 figure out a plan, either declaring or providing a parameter named C<alias> or
 263 C<excludes> is an error.
 264
 265 =head1 AUTHOR
 266
 267 Shawn M Moore, C<< <sartak@bestpractical.com> >>
 268
 269 =head1 EXAMPLES
 270
 271 =over 4
 272
 273 =item L<MooseX::Role::Matcher>
 274
 275 =item L<MooseX::Role::XMLRPC::Client>
 276
 277 =item L<MooseX::RelatedClassRoles>
 278
 279 =item L<WWW::Mechanize::TreeBuilder>
 280
 281 =item L<TAEB::Action::Role::Item>
 282
 283 =item L<KiokuDB::Role::Scan>
 284
 285 =item L<Fey::Role::MakesAliasObjects>
 286
 287 =item L<Fey::Role::HasAliasName>
 288
 289 =item L<Fey::Role::SetOperation>
 290
 291 =back
 292
 293 =cut
 294