Commit | Line | Data |
9f552252 |
1 | package DBIx::Class::DeploymentHandler::WithApplicatorDumple; |
2 | use MooseX::Role::Parameterized; |
7cd51078 |
3 | use Module::Runtime 'use_module'; |
9f552252 |
4 | use namespace::autoclean; |
5 | |
1b7ebcbf |
6 | # this is at least a little ghetto and not super well |
7 | # thought out. Take a look at the following at some |
8 | # point to clean it all up: |
9 | # |
10 | # http://search.cpan.org/~jjnapiork/MooseX-Role-BuildInstanceOf-0.06/lib/MooseX/Role/BuildInstanceOf.pm |
11 | # http://github.com/rjbs/role-subsystem/blob/master/lib/Role/Subsystem.pm |
12 | |
9f552252 |
13 | parameter interface_role => ( |
14 | isa => 'Str', |
15 | required => 1, |
16 | ); |
17 | |
18 | parameter class_name => ( |
19 | isa => 'Str', |
20 | required => 1, |
21 | ); |
22 | |
23 | parameter delegate_name => ( |
24 | isa => 'Str', |
25 | required => 1, |
26 | ); |
27 | |
9f552252 |
28 | parameter attributes_to_copy => ( |
29 | isa => 'ArrayRef[Str]', |
30 | default => sub {[]}, |
31 | ); |
32 | |
33 | parameter attributes_to_assume => ( |
34 | isa => 'ArrayRef[Str]', |
35 | default => sub {[]}, |
36 | ); |
37 | |
38 | role { |
39 | my $p = shift; |
40 | |
41 | my $class_name = $p->class_name; |
42 | |
7cd51078 |
43 | use_module($class_name); |
9f552252 |
44 | |
45 | my $meta = Class::MOP::class_of($class_name); |
46 | |
4f73e4ac |
47 | has $_->name => %{ $_->clone } |
1b7ebcbf |
48 | for grep { $_ } map $meta->find_attribute_by_name($_), @{ $p->attributes_to_copy }; |
9f552252 |
49 | |
50 | has $p->delegate_name => ( |
51 | is => 'ro', |
52 | lazy_build => 1, |
53 | does => $p->interface_role, |
54 | handles => $p->interface_role, |
55 | ); |
56 | |
57 | method '_build_'.$p->delegate_name => sub { |
58 | my $self = shift; |
59 | |
60 | $class_name->new({ |
61 | map { $_ => $self->$_ } |
62 | @{ $p->attributes_to_assume }, |
63 | @{ $p->attributes_to_copy }, |
64 | }) |
65 | }; |
66 | }; |
67 | |
68 | 1; |
69 | |
70 | # vim: ts=2 sw=2 expandtab |
71 | |
72 | __END__ |