MooseX::Role::Parameterized - roles with composition parameters

    package Counter;
    use MooseX::Role::Parameterized;

    parameter name => (
        isa      => 'Str',
        required => 1,
    );

    role {
        my $p = shift;

        my $name = $p->name;

        has $name => (
            is      => 'rw',
            isa     => 'Int',
            default => 0,
        );

        method "increment_$name" => sub {
            my $self = shift;
            $self->$name($self->$name + 1);
        };

        method "reset_$name" => sub {
            my $self = shift;
            $self->$name(0);
        };
    };

    package MyGame::Weapon;
    use Moose;

    with Counter => { name => 'enchantment' };

    package MyGame::Wand;
    use Moose;

    with Counter => { name => 'zapped' };

package MooseX::Role::Parameterized;
use 5.008001;
use Moose::Role ();
use Moose::Exporter;
use Carp 'confess';
use Scalar::Util 'blessed';

use MooseX::Role::Parameterized::Meta::Role::Parameterizable;

our $VERSION = '0.26';
our $CURRENT_METACLASS;

Moose::Exporter->setup_import_methods(
    with_caller => ['parameter', 'role', 'method', 'has', 'with', 'extends',
                    'requires', 'excludes', 'augment', 'inner', 'before',
                    'after', 'around', 'super', 'override'],
    as_is => [ 'confess', 'blessed' ],
);

sub current_metaclass { $CURRENT_METACLASS }

sub parameter {
    my $caller = shift;

    confess "'parameter' may not be used inside of the role block"
        if $CURRENT_METACLASS && $CURRENT_METACLASS->genitor->name eq $caller;

    my $meta   = Class::MOP::class_of($caller);

    my $names = shift;
    $names = [$names] if !ref($names);

    for my $name (@$names) {
        $meta->add_parameter($name, @_);
    }
}

sub role (&) {
    my $caller         = shift;
    my $role_generator = shift;
    Class::MOP::class_of($caller)->role_generator($role_generator);
}

sub init_meta {
    my $self = shift;
    my %options = @_;
    $options{metaclass} ||= 'MooseX::Role::Parameterized::Meta::Role::Parameterizable';

    return Moose::Role->init_meta(%options);
}

sub has {
    my $caller = shift;
    my $meta   = $CURRENT_METACLASS || Class::MOP::class_of($caller);

    my $names = shift;
    $names = [$names] if !ref($names);

    for my $name (@$names) {
        $meta->add_attribute($name, @_);
    }
}

sub method {
    my $caller = shift;
    my $meta   = $CURRENT_METACLASS || Class::MOP::class_of($caller);

    my $name   = shift;
    my $body   = shift;

    my $method = $meta->method_metaclass->wrap(
        package_name => $caller,
        name         => $name,
        body         => $body,
    );

    $meta->add_method($name => $method);
}

sub _add_method_modifier {
    my $type   = shift;
    my $caller = shift;
    my $meta   = $CURRENT_METACLASS || Class::MOP::class_of($caller);

    my $code = pop @_;

    for (@_) {
        Carp::croak "Roles do not currently support "
            . ref($_)
            . " references for $type method modifiers"
            if ref $_;

        my $add_method = "add_${type}_method_modifier";
        $meta->$add_method($_, $code);
    }
}

sub before {
    _add_method_modifier('before', @_);
}

sub after {
    _add_method_modifier('after', @_);
}

sub around {
    _add_method_modifier('around', @_);
}

sub with {
    my $caller = shift;
    my $meta   = $CURRENT_METACLASS || Class::MOP::class_of($caller);

    Moose::Util::apply_all_roles($meta, @_);
}

sub requires {
    my $caller = shift;
    my $meta   = $CURRENT_METACLASS || Class::MOP::class_of($caller);

    Carp::croak "Must specify at least one method" unless @_;
    $meta->add_required_methods(@_);
}

sub excludes {
    my $caller = shift;
    my $meta   = $CURRENT_METACLASS || Class::MOP::class_of($caller);

    Carp::croak "Must specify at least one role" unless @_;
    $meta->add_excluded_roles(@_);
}

# see Moose.pm for discussion
sub super {
    return unless $Moose::SUPER_BODY;
    $Moose::SUPER_BODY->(@Moose::SUPER_ARGS);
}

sub override {
    my $caller = shift;
    my $meta   = $CURRENT_METACLASS || Class::MOP::class_of($caller);

    my ($name, $code) = @_;
    $meta->add_override_method_modifier($name, $code);
}

sub extends { Carp::croak "Roles do not currently support 'extends'" }

sub inner { Carp::croak "Roles cannot support 'inner'" }

sub augment { Carp::croak "Roles cannot support 'augment'" }

1;

__END__