X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FMooseX%2FRole%2FParameterized%2FMeta%2FRole%2FParameterizable.pm;h=c9f15538418cbe6011de1134ee2aa653d53f1c57;hb=563f6b7c1d36e1c1efdc79330f95c034ec9bc0d1;hp=9fd9b76e2c5e40dbe426ba76d5550b64259fb237;hpb=8f9a5c92edf885c6598110b9729cc51edc4d8097;p=gitmo%2FMooseX-Role-Parameterized.git diff --git a/lib/MooseX/Role/Parameterized/Meta/Role/Parameterizable.pm b/lib/MooseX/Role/Parameterized/Meta/Role/Parameterizable.pm index 9fd9b76..c9f1553 100644 --- a/lib/MooseX/Role/Parameterized/Meta/Role/Parameterizable.pm +++ b/lib/MooseX/Role/Parameterized/Meta/Role/Parameterizable.pm @@ -1,4 +1,3 @@ -#!/usr/bin/env perl package MooseX::Role::Parameterized::Meta::Role::Parameterizable; use Moose; extends 'Moose::Meta::Role'; @@ -6,6 +5,8 @@ extends 'Moose::Meta::Role'; use MooseX::Role::Parameterized::Meta::Role::Parameterized; use MooseX::Role::Parameterized::Parameters; +use constant parameterized_role_metaclass => 'MooseX::Role::Parameterized::Meta::Role::Parameterized'; + has parameter_metaclass => ( is => 'rw', isa => 'Moose::Meta::Class', @@ -25,31 +26,44 @@ has role_generator => ( sub add_parameter { my $self = shift; - $self->parameter_metaclass->add_attribute(@_); + my $name = shift; + + # need to figure out a plan for these guys.. + confess "The parameter name ($name) is currently forbidden." + if $name eq 'alias' + || $name eq 'excludes'; + + $self->parameter_metaclass->add_attribute($name => @_); } sub construct_parameters { my $self = shift; - $self->parameter_metaclass->construct_instance(@_); + my %args = @_; + + # need to figure out a plan for these guys.. + for my $name ('alias', 'excludes') { + confess "The parameter name ($name) is currently forbidden." + if exists $args{$name}; + } + + $self->parameter_metaclass->new_object(\%args); } sub generate_role { my $self = shift; - my %args = @_; + + my $parameters = @_ == 1 ? shift + : $self->construct_parameters(@_); confess "A role generator is required to generate roles" unless $self->has_role_generator; - my $parameters = $self->construct_parameters(%args); - - my $metaclass = Moose::Meta::Class->create_anon_class( - superclasses => ['MooseX::Role::Parameterized::Meta::Role::Parameterized'], - ); - my $role = $metaclass->construct_instance( - parameters => $parameters, - ); + my $role = $self->parameterized_role_metaclass->create_anon_role(parameters => $parameters); local $MooseX::Role::Parameterized::CURRENT_METACLASS = $role; + + $self->apply_parameterized_role($role); + $self->role_generator->($parameters, operating_on => $role, ); @@ -57,8 +71,39 @@ sub generate_role { return $role; } +sub apply { + my $self = shift; + my $class = shift; + my %args = @_; + + my $role = $self->generate_role(%args); + $role->apply($class, %args); +} + +sub apply_parameterized_role { + my $self = shift; + + $self->SUPER::apply(@_); +} + __PACKAGE__->meta->make_immutable; no Moose; 1; +__END__ + +=head1 NAME + +MooseX::Role::Parameterized::Meta::Role::Parameterizable - metaclass for parameterizable roles + +=head1 DESCRIPTION + +This is the metaclass for parameteriz-able roles, roles that have their +parameters currently unbound. These are the roles that you use L, +but instead of composing the parameteriz-able role, we construct a new +parameteriz-ed role +(L). + +=cut +