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

   1 #!/usr/bin/env perl
   2 package MooseX::Role::Parameterized::Meta::Role;
   3 use Moose;
   4 extends 'Moose::Meta::Role';
   5
   6 use MooseX::Role::Parameterized::Parameters;
   7
   8 has parameter_metaclass => (
   9     is      => 'rw',
  10     isa     => 'Moose::Meta::Class',
  11     lazy    => 1,
  12     default => sub {
  13         Moose::Meta::Class->create_anon_class(
  14             superclasses => ['MooseX::Role::Parameterized::Parameters'],
  15         );
  16     },
  17 );
  18
  19 has role_generator => (
  20     is        => 'rw',
  21     isa       => 'CodeRef',
  22     predicate => 'has_role_generator',
  23 );
  24
  25 sub add_parameter {
  26     my $self = shift;
  27     $self->parameter_metaclass->add_attribute(@_);
  28 }
  29
  30 sub construct_parameters {
  31     my $self = shift;
  32     $self->parameter_metaclass->construct_instance(@_);
  33 }
  34
  35 sub generate_role {
  36     my $self = shift;
  37     my %args = @_;
  38
  39     confess "A role generator is required to generate roles"
  40         unless $self->has_role_generator;
  41
  42     my $role = Moose::Meta::Class->create_anon_class(
  43         superclasses => ['Moose::Meta::Role'],
  44     );
  45
  46     my $parameters = $self->construct_parameters(%args);
  47
  48     local $MooseX::Role::Parameterized::CURRENT_ROLE = $role;
  49     $self->role_generator->($parameters, $role);
  50
  51     return $role->construct_instance;
  52 }
  53
  54 __PACKAGE__->meta->make_immutable;
  55 no Moose;
  56
  57 1;
  58