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 | |
21 | parameter interface_role => ( |
22 | isa => 'Str', |
23 | required => 1, |
24 | ); |
25 | |
26 | parameter attributes_to_copy => ( |
27 | isa => 'ArrayRef[Str]', |
28 | default => sub {[]}, |
29 | ); |
30 | |
31 | parameter attributes_to_assume => ( |
32 | isa => 'ArrayRef[Str]', |
33 | default => sub {[]}, |
34 | ); |
35 | |
36 | role { |
37 | my $p = shift; |
38 | |
39 | my $class_name = $p->class_name; |
40 | |
41 | Class::MOP::load_class($class_name); |
42 | |
43 | my $meta = Class::MOP::class_of($class_name); |
44 | |
45 | has [map %{$_->clone}, map $meta->get_attribute($_), @{ $p->attributes_to_copy }]; |
46 | |
47 | has $p->delegate_name => ( |
48 | is => 'ro', |
49 | lazy_build => 1, |
50 | does => $p->interface_role, |
51 | handles => $p->interface_role, |
52 | ); |
53 | |
54 | method '_build_'.$p->delegate_name => sub { |
55 | my $self = shift; |
56 | |
57 | $class_name->new({ |
58 | map { $_ => $self->$_ } |
59 | @{ $p->attributes_to_assume }, |
60 | @{ $p->attributes_to_copy }, |
61 | }) |
62 | }; |
63 | }; |
64 | |
65 | 1; |
66 | |
67 | # vim: ts=2 sw=2 expandtab |
68 | |
69 | __END__ |