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 role_for_combination {
  87     my $self = shift;
  88     my $parameters = shift;
  89
  90     return $self->generate_role(
  91         parameters => $parameters,
  92     );
  93 }
  94
  95 sub apply {
  96     my $self     = shift;
  97     my $consumer = shift;
  98     my %args     = @_;
  99
 100     my $role = $self->generate_role(
 101         consumer   => $consumer,
 102         parameters => \%args,
 103     );
 104
 105     $role->apply($consumer, %args);
 106 }
 107
 108 sub apply_parameterizable_role {
 109     my $self = shift;
 110
 111     $self->SUPER::apply(@_);
 112 }
 113
 114 __PACKAGE__->meta->make_immutable;
 115 no Moose;
 116
 117 1;
 118
 119 __END__
 120
 121 =head1 NAME
 122
 123 MooseX::Role::Parameterized::Meta::Role::Parameterizable - metaclass for parameterizable roles
 124
 125 =head1 DESCRIPTION
 126
 127 This is the metaclass for parameteriz-able roles, roles that have their
 128 parameters currently unbound. These are the roles that you use L<Moose/with>,
 129 but instead of composing the parameteriz-able role, we construct a new
 130 parameteriz-ed role
 131 (L<MooseX::Role::Parameterized::Meta::Role::Parameterized>).
 132
 133 =cut
 134