local-lib5/lib/perl5/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 our $VERSION = '0.10';
   6
   7 use MooseX::Role::Parameterized::Meta::Role::Parameterized;
   8 use MooseX::Role::Parameterized::Meta::Parameter;
   9 use MooseX::Role::Parameterized::Parameters;
  10
  11 use constant parameterized_role_metaclass => 'MooseX::Role::Parameterized::Meta::Role::Parameterized';
  12 use constant parameter_metaclass => 'MooseX::Role::Parameterized::Meta::Parameter';
  13
  14 has parameters_class => (
  15     is      => 'ro',
  16     isa     => 'ClassName',
  17     default => 'MooseX::Role::Parameterized::Parameters',
  18 );
  19
  20 has parameters_metaclass => (
  21     is      => 'rw',
  22     isa     => 'Moose::Meta::Class',
  23     lazy    => 1,
  24     default => sub {
  25         my $self = shift;
  26
  27         $self->parameters_class->meta->create_anon_class(
  28             superclasses        => [$self->parameters_class],
  29             attribute_metaclass => $self->parameter_metaclass,
  30         );
  31     },
  32     handles => {
  33         has_parameter => 'has_attribute',
  34     },
  35 );
  36
  37 has role_generator => (
  38     is        => 'rw',
  39     isa       => 'CodeRef',
  40     predicate => 'has_role_generator',
  41 );
  42
  43 sub add_parameter {
  44     my $self = shift;
  45     my $name = shift;
  46
  47     confess "You must provide a name for the parameter"
  48         if !defined($name);
  49
  50     # need to figure out a plan for these guys..
  51     confess "The parameter name ($name) is currently forbidden"
  52         if $name eq 'alias'
  53         || $name eq 'excludes';
  54
  55     $self->parameters_metaclass->add_attribute($name => @_);
  56 }
  57
  58 sub construct_parameters {
  59     my $self = shift;
  60     my %args = @_;
  61
  62     # need to figure out a plan for these guys..
  63     for my $name ('alias', 'excludes') {
  64         confess "The parameter name ($name) is currently forbidden"
  65             if exists $args{$name};
  66     }
  67
  68     $self->parameters_metaclass->new_object(\%args);
  69 }
  70
  71 sub generate_role {
  72     my $self     = shift;
  73     my %args     = @_;
  74
  75     my $parameters = blessed($args{parameters})
  76                    ? $args{parameters}
  77                    : $self->construct_parameters(%{ $args{parameters} });
  78
  79     confess "A role generator is required to generate roles"
  80         unless $self->has_role_generator;
  81
  82     my $role = $self->parameterized_role_metaclass->create_anon_role(
  83         genitor    => $self,
  84         parameters => $parameters,
  85     );
  86
  87     local $MooseX::Role::Parameterized::CURRENT_METACLASS = $role;
  88
  89     $self->apply_parameterizable_role($role);
  90
  91     $self->role_generator->($parameters,
  92         operating_on => $role,
  93         consumer     => $args{consumer},
  94     );
  95
  96     return $role;
  97 }
  98
  99 sub _role_for_combination {
 100     my $self = shift;
 101     my $parameters = shift;
 102
 103     return $self->generate_role(
 104         parameters => $parameters,
 105     );
 106 }
 107
 108 sub apply {
 109     my $self     = shift;
 110     my $consumer = shift;
 111     my %args     = @_;
 112
 113     my $role = $self->generate_role(
 114         consumer   => $consumer,
 115         parameters => \%args,
 116     );
 117
 118     $role->apply($consumer, %args);
 119 }
 120
 121 sub apply_parameterizable_role {
 122     my $self = shift;
 123
 124     $self->SUPER::apply(@_);
 125 }
 126
 127 __PACKAGE__->meta->make_immutable;
 128 no Moose;
 129
 130 1;
 131
 132 __END__
 133
 134 =head1 NAME
 135
 136 MooseX::Role::Parameterized::Meta::Role::Parameterizable - metaclass for parameterizable roles
 137
 138 =head1 DESCRIPTION
 139
 140 This is the metaclass for parameterizable roles, roles that have their
 141 parameters currently unbound. These are the roles that you use L<Moose/with>,
 142 but instead of composing the parameterizable role, we construct a new
 143 parameterized role
 144 (L<MooseX::Role::Parameterized::Meta::Role::Parameterized>).
 145
 146 =head1 ATTRIBUTES
 147
 148 =head2 parameters_class
 149
 150 The name of the class that will be used to construct the parameters object.
 151
 152 =head2 parameters_metaclass
 153
 154 A metaclass representing this roles's parameters. It will be an anonymous
 155 subclass of L</parameters_class>. Each call to
 156 L<MooseX::Role::Parameters/parameter> adds an attribute to this metaclass.
 157
 158 When this role is consumed, the parameters object will be instantiated using
 159 this metaclass.
 160
 161 =head2 role_generator
 162
 163 A code reference that is used to generate a role based on the parameters
 164 provided by the consumer. The user usually specifies it using the
 165 L<MooseX::Role::Parameterized/role> keyword.
 166
 167 =head1 METHODS
 168
 169 =head2 add_parameter $name, %options
 170
 171 Basically delegates to L<Moose::Meta::Class/add_attribute> on the
 172 L</parameters_metaclass> but with error messages that refer to a "parameter"
 173 not an "attribute".
 174
 175 =head2 construct_parameters %arguments
 176
 177 Creates a new L<MooseX::Role::Parameterized::Parameters> object using metaclass
 178 L</parameters_metaclass>.
 179
 180 The arguments are those specified by the consumer as parameter values.
 181
 182 =head2 generate_role %arguments
 183
 184 Returns a new instance of
 185 L<MooseX::Role::Parameterized::Meta::Role::Parameterized> based on the
 186 arguments. The arguments are a hash reference of C<parameters> and, if
 187 available, a C<consumer> metaobject.
 188
 189 =head2 apply
 190
 191 Overrides L<Moose::Meta::Role/apply> to automatically generate the
 192 parameterized role.
 193
 194 =cut
 195