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

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