lib/MooseX/Role/Parameterized/Meta/Role/Parameterizable.pm

   1 package MooseX::Role::Parameterized::Meta::Role::Parameterizable;
   2 use Moose;
   3 extends 'Moose::Meta::Role';
   4
   5 use MooseX::Role::Parameterized::Meta::Role::Parameterized;
   6 use MooseX::Role::Parameterized::Parameters;
   7
   8 use constant parameterized_role_metaclass => 'MooseX::Role::Parameterized::Meta::Role::Parameterized';
   9
  10 has parameters_metaclass => (
  11     is      => 'rw',
  12     isa     => 'Moose::Meta::Class',
  13     lazy    => 1,
  14     default => sub {
  15         Moose::Meta::Class->create_anon_class(
  16             superclasses => ['MooseX::Role::Parameterized::Parameters'],
  17         );
  18     },
  19 );
  20
  21 has role_generator => (
  22     is        => 'rw',
  23     isa       => 'CodeRef',
  24     predicate => 'has_role_generator',
  25 );
  26
  27 sub add_parameter {
  28     my $self = shift;
  29     my $name = shift;
  30
  31     confess "You must provide a name for the parameter"
  32         if !defined($name);
  33
  34     # need to figure out a plan for these guys..
  35     confess "The parameter name ($name) is currently forbidden"
  36         if $name eq 'alias'
  37         || $name eq 'excludes';
  38
  39     $self->parameters_metaclass->add_attribute($name => @_);
  40 }
  41
  42 sub construct_parameters {
  43     my $self = shift;
  44     my %args = @_;
  45
  46     # need to figure out a plan for these guys..
  47     for my $name ('alias', 'excludes') {
  48         confess "The parameter name ($name) is currently forbidden"
  49             if exists $args{$name};
  50     }
  51
  52     $self->parameters_metaclass->new_object(\%args);
  53 }
  54
  55 sub generate_role {
  56     my $self = shift;
  57
  58     my $parameters = @_ == 1 ? shift
  59                              : $self->construct_parameters(@_);
  60
  61     confess "A role generator is required to generate roles"
  62         unless $self->has_role_generator;
  63
  64     my $role = $self->parameterized_role_metaclass->create_anon_role(parameters => $parameters);
  65
  66     local $MooseX::Role::Parameterized::CURRENT_METACLASS = $role;
  67
  68     $self->apply_parameterizable_role($role);
  69
  70     $self->role_generator->($parameters,
  71         operating_on => $role,
  72     );
  73
  74     return $role;
  75 }
  76
  77 sub apply {
  78     my $self  = shift;
  79     my $class = shift;
  80     my %args  = @_;
  81
  82     my $role = $self->generate_role(%args);
  83     $role->apply($class, %args);
  84 }
  85
  86 sub apply_parameterizable_role {
  87     my $self = shift;
  88
  89     $self->SUPER::apply(@_);
  90 }
  91
  92 __PACKAGE__->meta->make_immutable;
  93 no Moose;
  94
  95 1;
  96
  97 __END__
  98
  99 =head1 NAME
 100
 101 MooseX::Role::Parameterized::Meta::Role::Parameterizable - metaclass for parameterizable roles
 102
 103 =head1 DESCRIPTION
 104
 105 This is the metaclass for parameteriz-able roles, roles that have their
 106 parameters currently unbound. These are the roles that you use L<Moose/with>,
 107 but instead of composing the parameteriz-able role, we construct a new
 108 parameteriz-ed role
 109 (L<MooseX::Role::Parameterized::Meta::Role::Parameterized>).
 110
 111 =cut
 112