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