Use Moose's new create_anon_role API
[gitmo/MooseX-Role-Parameterized.git] / lib / MooseX / Role / Parameterized / Meta / Role / Parameterizable.pm
CommitLineData
7b42fc96 1#!/usr/bin/env perl
d93bd54d 2package MooseX::Role::Parameterized::Meta::Role::Parameterizable;
7b42fc96 3use Moose;
4extends 'Moose::Meta::Role';
5
8f9a5c92 6use MooseX::Role::Parameterized::Meta::Role::Parameterized;
7b42fc96 7use MooseX::Role::Parameterized::Parameters;
8
533553a0 9use constant parameterized_role_metaclass => 'MooseX::Role::Parameterized::Meta::Role::Parameterized';
10
f563c3cd 11has parameter_metaclass => (
39d3d5d0 12 is => 'rw',
f563c3cd 13 isa => 'Moose::Meta::Class',
14 lazy => 1,
15 default => sub {
16 Moose::Meta::Class->create_anon_class(
17 superclasses => ['MooseX::Role::Parameterized::Parameters'],
18 );
19 },
20);
21
5b82ffb1 22has role_generator => (
23 is => 'rw',
24 isa => 'CodeRef',
25 predicate => 'has_role_generator',
26);
27
f563c3cd 28sub add_parameter {
29 my $self = shift;
30 $self->parameter_metaclass->add_attribute(@_);
31}
7b42fc96 32
f74750fb 33sub construct_parameters {
34 my $self = shift;
1adb2fea 35 $self->parameter_metaclass->new_object(@_);
f74750fb 36}
37
4534bdce 38sub generate_role {
39 my $self = shift;
40 my %args = @_;
41
42 confess "A role generator is required to generate roles"
43 unless $self->has_role_generator;
44
8f9a5c92 45 my $parameters = $self->construct_parameters(%args);
46
533553a0 47 my $role = $self->parameterized_role_metaclass->create_anon_role(parameters => $parameters);
4534bdce 48
884a2a3b 49 local $MooseX::Role::Parameterized::CURRENT_METACLASS = $role;
1e750b62 50 $self->role_generator->($parameters,
884a2a3b 51 operating_on => $role,
1e750b62 52 );
4534bdce 53
1e750b62 54 return $role;
4534bdce 55}
56
d872e120 57sub apply {
58 my $self = shift;
59 my $class = shift;
60 my %args = @_;
61
62 my $role = $self->generate_role(%args);
63 $role->apply($class, %args);
64}
65
7b42fc96 66__PACKAGE__->meta->make_immutable;
67no Moose;
68
691;
70