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     my %args     = @_;
  64
  65     my $parameters = blessed($args{parameters})
  66                    ? $args{parameters}
  67                    : $self->construct_parameters(%{ $args{parameters} });
  68
  69     confess "A role generator is required to generate roles"
  70         unless $self->has_role_generator;
  71
  72     my $role = $self->parameterized_role_metaclass->create_anon_role(parameters => $parameters);
  73
  74     local $MooseX::Role::Parameterized::CURRENT_METACLASS = $role;
  75
  76     $self->apply_parameterizable_role($role);
  77
  78     $self->role_generator->($parameters,
  79         operating_on => $role,
  80         consumer     => $args{consumer},
  81     );
  82
  83     return $role;
  84 }
  85
  86 sub apply {
  87     my $self     = shift;
  88     my $consumer = shift;
  89     my %args     = @_;
  90
  91     my $role = $self->generate_role(
  92         consumer   => $consumer,
  93         parameters => \%args,
  94     );
  95
  96     $role->apply($consumer, %args);
  97 }
  98
  99 sub apply_parameterizable_role {
 100     my $self = shift;
 101
 102     $self->SUPER::apply(@_);
 103 }
 104
 105 __PACKAGE__->meta->make_immutable;
 106 no Moose;
 107
 108 1;
 109
 110 __END__
 111
 112 =head1 NAME
 113
 114 MooseX::Role::Parameterized::Meta::Role::Parameterizable - metaclass for parameterizable roles
 115
 116 =head1 DESCRIPTION
 117
 118 This is the metaclass for parameteriz-able roles, roles that have their
 119 parameters currently unbound. These are the roles that you use L<Moose/with>,
 120 but instead of composing the parameteriz-able role, we construct a new
 121 parameteriz-ed role
 122 (L<MooseX::Role::Parameterized::Meta::Role::Parameterized>).
 123
 124 =cut
 125