package MooseX::Role::Parameterized;
-
-# ABSTRACT: parameterized roles, at long last
-
use Moose (
extends => { -as => 'moose_extends' },
around => { -as => 'moose_around' },
qw/confess blessed/,
);
+moose_extends 'Moose::Exporter';
-use Carp 'croak';
use Moose::Role ();
-moose_extends 'Moose::Exporter';
use MooseX::Role::Parameterized::Meta::Role::Parameterizable;
our $CURRENT_METACLASS;
__PACKAGE__->setup_import_methods(
- with_caller => ['parameter', 'role', 'method'],
- as_is => [
- 'has', 'with', 'extends', 'requires', 'excludes', 'augment', 'inner',
- 'before', 'after', 'around', 'super', 'override', 'confess',
- 'blessed',
- ],
+ with_caller => ['parameter', 'role', 'method', 'has', 'with', 'extends',
+ 'requires', 'excludes', 'augment', 'inner', 'before',
+ 'after', 'around', 'super', 'override'],
+ as_is => [ 'confess', 'blessed' ],
);
sub parameter {
my $caller = shift;
- my $names = shift;
+ confess "'parameter' may not be used inside of the role block"
+ if $CURRENT_METACLASS;
+
+ my $meta = Class::MOP::Class->initialize($caller);
+
+ my $names = shift;
$names = [$names] if !ref($names);
for my $name (@$names) {
- Class::MOP::Class->initialize($caller)->add_parameter($name, @_);
+ $meta->add_parameter($name, @_);
}
}
-sub role {
+sub role (&) {
my $caller = shift;
my $role_generator = shift;
Class::MOP::Class->initialize($caller)->role_generator($role_generator);
);
}
-# give role a (&) prototype
-moose_around _make_wrapper => sub {
- my $orig = shift;
- my ($self, $caller, $sub, $fq_name) = @_;
-
- if ($fq_name =~ /::role$/) {
- return sub (&) { $sub->($caller, @_) };
- }
-
- return $orig->(@_);
-};
-
sub has {
- confess "has must be called within the role { ... } block."
- unless $CURRENT_METACLASS;
+ my $caller = shift;
+ my $meta = $CURRENT_METACLASS || Class::MOP::Class->initialize($caller);
my $names = shift;
$names = [$names] if !ref($names);
for my $name (@$names) {
- $CURRENT_METACLASS->add_attribute($name, @_);
+ $meta->add_attribute($name, @_);
}
}
sub method {
- confess "method must be called within the role { ... } block."
- unless $CURRENT_METACLASS;
-
my $caller = shift;
+ my $meta = $CURRENT_METACLASS || Class::MOP::Class->initialize($caller);
+
my $name = shift;
my $body = shift;
- my $method = $CURRENT_METACLASS->method_metaclass->wrap(
+ my $method = $meta->method_metaclass->wrap(
package_name => $caller,
name => $name,
body => $body,
);
- $CURRENT_METACLASS->add_method($name => $method);
+ $meta->add_method($name => $method);
}
sub before {
- confess "before must be called within the role { ... } block."
- unless $CURRENT_METACLASS;
+ my $caller = shift;
+ my $meta = $CURRENT_METACLASS || Class::MOP::Class->initialize($caller);
my $code = pop @_;
for (@_) {
- croak "Roles do not currently support "
+ Carp::croak "Roles do not currently support "
. ref($_)
. " references for before method modifiers"
if ref $_;
- $CURRENT_METACLASS->add_before_method_modifier($_, $code);
+ $meta->add_before_method_modifier($_, $code);
}
}
sub after {
- confess "after must be called within the role { ... } block."
- unless $CURRENT_METACLASS;
+ my $caller = shift;
+ my $meta = $CURRENT_METACLASS || Class::MOP::Class->initialize($caller);
my $code = pop @_;
for (@_) {
- croak "Roles do not currently support "
+ Carp::croak "Roles do not currently support "
. ref($_)
. " references for after method modifiers"
if ref $_;
- $CURRENT_METACLASS->add_after_method_modifier($_, $code);
+ $meta->add_after_method_modifier($_, $code);
}
}
sub around {
- confess "around must be called within the role { ... } block."
- unless $CURRENT_METACLASS;
+ my $caller = shift;
+ my $meta = $CURRENT_METACLASS || Class::MOP::Class->initialize($caller);
my $code = pop @_;
for (@_) {
- croak "Roles do not currently support "
+ Carp::croak "Roles do not currently support "
. ref($_)
. " references for around method modifiers"
if ref $_;
- $CURRENT_METACLASS->add_around_method_modifier($_, $code);
+ $meta->add_around_method_modifier($_, $code);
}
}
sub with {
- confess "with must be called within the role { ... } block."
- unless $CURRENT_METACLASS;
- Moose::Util::apply_all_roles($CURRENT_METACLASS, @_);
+ my $caller = shift;
+ my $meta = $CURRENT_METACLASS || Class::MOP::Class->initialize($caller);
+
+ Moose::Util::apply_all_roles($meta, @_);
}
sub requires {
- confess "requires must be called within the role { ... } block."
- unless $CURRENT_METACLASS;
- croak "Must specify at least one method" unless @_;
- $CURRENT_METACLASS->add_required_methods(@_);
+ my $caller = shift;
+ my $meta = $CURRENT_METACLASS || Class::MOP::Class->initialize($caller);
+
+ Carp::croak "Must specify at least one method" unless @_;
+ $meta->add_required_methods(@_);
}
sub excludes {
- confess "excludes must be called within the role { ... } block."
- unless $CURRENT_METACLASS;
- croak "Must specify at least one role" unless @_;
- $CURRENT_METACLASS->add_excluded_roles(@_);
+ my $caller = shift;
+ my $meta = $CURRENT_METACLASS || Class::MOP::Class->initialize($caller);
+
+ Carp::croak "Must specify at least one role" unless @_;
+ $meta->add_excluded_roles(@_);
}
# see Moose.pm for discussion
}
sub override {
- confess "override must be called within the role { ... } block."
- unless $CURRENT_METACLASS;
+ my $caller = shift;
+ my $meta = $CURRENT_METACLASS || Class::MOP::Class->initialize($caller);
my ($name, $code) = @_;
- $CURRENT_METACLASS->add_override_method_modifier($name, $code);
+ $meta->add_override_method_modifier($name, $code);
}
-sub extends { croak "Roles do not currently support 'extends'" }
+sub extends { Carp::croak "Roles do not currently support 'extends'" }
-sub inner { croak "Roles cannot support 'inner'" }
+sub inner { Carp::croak "Roles cannot support 'inner'" }
-sub augment { croak "Roles cannot support 'augment'" }
+sub augment { Carp::croak "Roles cannot support 'augment'" }
1;
__END__
+=head1 NAME
+
+MooseX::Role::Parameterized - parameterized roles
+
=head1 SYNOPSIS
package MyRole::Counter;
use MooseX::Role::Parameterized;
parameter name => (
- is => 'ro',
isa => 'Str',
required => 1,
);
C<role> block.
Parameters are declared using the L</parameter> keyword which very much
-resembles L<Moose/has>. You can use any option that L<Moose/has> accepts.
-These parameters will get their values when the consuming class (or role) uses
+resembles L<Moose/has>. You can use any option that L<Moose/has> accepts. The
+default value for the "is" option is "ro" as that's a very common case. These
+parameters will get their values when the consuming class (or role) uses
L<Moose/with>. A parameter object will be constructed with these values, and
passed to the C<role> block.
There are many paths to parameterized roles (hopefully with a consistent enough
API); I believe this to be the easiest and most flexible implementation.
-Coincidentally, Pugs has a very similar design (I'm not convinced that that is
-a good thing yet).
+Coincidentally, Pugs has a very similar design (I'm not yet convinced that that
+is a good thing).
=head1 CAVEATS
You must use this syntax to declare methods in the role block:
-C<method NAME => sub { ... };>. This is due to a limitation in Perl. In return
-though you can use parameters I<in your methods>!
+C<< method NAME => sub { ... }; >>. This is due to a limitation in Perl. In
+return though you can use parameters I<in your methods>!
-L<Moose::Role/alias> and L<Moose::Role/excludes> are not yet supported. Because
-I'm totally unsure of whether they should be handled by this module, both
-declaring and providing a parameter named C<alias> or C<excludes> is an error.
+L<Moose::Role/alias> and L<Moose::Role/excludes> are not yet supported. I'm
+completely unsure of whether they should be handled by this module. Until we
+figure out a plan, both declaring and providing a parameter named C<alias> or
+C<excludes> is an error.
=head1 AUTHOR
Shawn M Moore, C<< <sartak@bestpractical.com> >>
+=head1 EXAMPLES
+
+=over 4
+
+=item L<MooseX::Role::Matcher>
+
+=item L<MooseX::Role::XMLRPC::Client>
+
+=item L<MooseX::RelatedClassRoles>
+
+=item L<WWW::Mechanize::TreeBuilder>
+
+=item L<TAEB::Action::Role::Item>
+
+=item L<KiokuDB::Role::Scan>
+
+=item L<Fey::Role::MakesAliasObjects>
+
+=item L<Fey::Role::HasAliasName>
+
+=item L<Fey::Role::SetOperation>
+
+=back
+
=cut