Commit | Line | Data |
9f552252 |
1 | package DBIx::Class::DeploymentHandler::WithApplicatorDumple; |
2 | use MooseX::Role::Parameterized; |
3 | use Class::MOP; |
4 | use namespace::autoclean; |
5 | |
6 | parameter interface_role => ( |
7 | isa => 'Str', |
8 | required => 1, |
9 | ); |
10 | |
11 | parameter class_name => ( |
12 | isa => 'Str', |
13 | required => 1, |
14 | ); |
15 | |
16 | parameter delegate_name => ( |
17 | isa => 'Str', |
18 | required => 1, |
19 | ); |
20 | |
9f552252 |
21 | parameter attributes_to_copy => ( |
22 | isa => 'ArrayRef[Str]', |
23 | default => sub {[]}, |
24 | ); |
25 | |
26 | parameter attributes_to_assume => ( |
27 | isa => 'ArrayRef[Str]', |
28 | default => sub {[]}, |
29 | ); |
30 | |
31 | role { |
32 | my $p = shift; |
33 | |
34 | my $class_name = $p->class_name; |
35 | |
36 | Class::MOP::load_class($class_name); |
37 | |
38 | my $meta = Class::MOP::class_of($class_name); |
39 | |
4f73e4ac |
40 | has $_->name => %{ $_->clone } |
41 | for grep { $_ } map $meta->get_attribute($_), @{ $p->attributes_to_copy }; |
9f552252 |
42 | |
43 | has $p->delegate_name => ( |
44 | is => 'ro', |
45 | lazy_build => 1, |
46 | does => $p->interface_role, |
47 | handles => $p->interface_role, |
48 | ); |
49 | |
50 | method '_build_'.$p->delegate_name => sub { |
51 | my $self = shift; |
52 | |
53 | $class_name->new({ |
54 | map { $_ => $self->$_ } |
55 | @{ $p->attributes_to_assume }, |
56 | @{ $p->attributes_to_copy }, |
57 | }) |
58 | }; |
59 | }; |
60 | |
61 | 1; |
62 | |
63 | # vim: ts=2 sw=2 expandtab |
64 | |
65 | __END__ |