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 has parameter_metaclass => (
  10     is      => 'rw',
  11     isa     => 'Moose::Meta::Class',
  12     lazy    => 1,
  13     default => sub {
  14         Moose::Meta::Class->create_anon_class(
  15             superclasses => ['MooseX::Role::Parameterized::Parameters'],
  16         );
  17     },
  18 );
  19
  20 has role_generator => (
  21     is        => 'rw',
  22     isa       => 'CodeRef',
  23     predicate => 'has_role_generator',
  24 );
  25
  26 sub add_parameter {
  27     my $self = shift;
  28     $self->parameter_metaclass->add_attribute(@_);
  29 }
  30
  31 sub construct_parameters {
  32     my $self = shift;
  33     $self->parameter_metaclass->new_object(@_);
  34 }
  35
  36 sub generate_role {
  37     my $self = shift;
  38     my %args = @_;
  39
  40     confess "A role generator is required to generate roles"
  41         unless $self->has_role_generator;
  42
  43     my $parameters = $self->construct_parameters(%args);
  44
  45     my $metaclass = Moose::Meta::Class->create_anon_class(
  46         superclasses => ['MooseX::Role::Parameterized::Meta::Role::Parameterized'],
  47     );
  48     my $role = $metaclass->new_object(
  49         parameters => $parameters,
  50     );
  51
  52     local $MooseX::Role::Parameterized::CURRENT_METACLASS = $role;
  53     $self->role_generator->($parameters,
  54         operating_on => $role,
  55     );
  56
  57     return $role;
  58 }
  59
  60 sub apply {
  61     my $self  = shift;
  62     my $class = shift;
  63     my %args  = @_;
  64
  65     my $role = $self->generate_role(%args);
  66     $role->apply($class, %args);
  67 }
  68
  69 __PACKAGE__->meta->make_immutable;
  70 no Moose;
  71
  72 1;
  73