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 # ABSTRACT: metaclass for parameterizable roles
   6
   7 use MooseX::Role::Parameterized::Meta::Role::Parameterized;
   8 use MooseX::Role::Parameterized::Parameters;
   9
  10 use constant parameterized_role_metaclass => 'MooseX::Role::Parameterized::Meta::Role::Parameterized';
  11
  12 has parameter_metaclass => (
  13     is      => 'rw',
  14     isa     => 'Moose::Meta::Class',
  15     lazy    => 1,
  16     default => sub {
  17         Moose::Meta::Class->create_anon_class(
  18             superclasses => ['MooseX::Role::Parameterized::Parameters'],
  19         );
  20     },
  21 );
  22
  23 has role_generator => (
  24     is        => 'rw',
  25     isa       => 'CodeRef',
  26     predicate => 'has_role_generator',
  27 );
  28
  29 sub add_parameter {
  30     my $self = shift;
  31     my $name = shift;
  32
  33     # need to figure out a plan for these guys..
  34     confess "The parameter name ($name) is currently forbidden."
  35         if $name eq 'alias'
  36         || $name eq 'excludes';
  37
  38     $self->parameter_metaclass->add_attribute($name => @_);
  39 }
  40
  41 sub construct_parameters {
  42     my $self = shift;
  43     my %args = @_;
  44
  45     # need to figure out a plan for these guys..
  46     for my $name ('alias', 'excludes') {
  47         confess "The parameter name ($name) is currently forbidden."
  48             if exists $args{$name};
  49     }
  50
  51     $self->parameter_metaclass->new_object(\%args);
  52 }
  53
  54 sub generate_role {
  55     my $self = shift;
  56
  57     my $parameters = @_ == 1 ? shift
  58                              : $self->construct_parameters(@_);
  59
  60     confess "A role generator is required to generate roles"
  61         unless $self->has_role_generator;
  62
  63     my $role = $self->parameterized_role_metaclass->create_anon_role(parameters => $parameters);
  64
  65     local $MooseX::Role::Parameterized::CURRENT_METACLASS = $role;
  66     $self->role_generator->($parameters,
  67         operating_on => $role,
  68     );
  69
  70     return $role;
  71 }
  72
  73 sub apply {
  74     my $self  = shift;
  75     my $class = shift;
  76     my %args  = @_;
  77
  78     my $role = $self->generate_role(%args);
  79     $role->apply($class, %args);
  80 }
  81
  82 __PACKAGE__->meta->make_immutable;
  83 no Moose;
  84
  85 1;
  86