blob: 1ed42654a5fa996b3b031e0756aafc035667f056 (
plain) (
blame)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
|
package Bread::Board::Declare::Role::Service;
use Moose::Role;
# ABSTRACT: role for Bread::Board::Service objects
=head1 DESCRIPTION
This role modifies L<Bread::Board::Service> objects for use in
L<Bread::Board::Declare>. It holds a reference to the attribute object that the
service is associated with, and overrides the C<get> method to prefer to return
the value in the attribute, if it exists.
=cut
=attr associated_attribute
The attribute metaobject that this service is associated with.
=cut
has associated_attribute => (
is => 'ro',
isa => 'Class::MOP::Attribute',
required => 1,
weak_ref => 1,
);
around get => sub {
my $orig = shift;
my $self = shift;
my $container = $self->parent_container;
my $attr = $self->associated_attribute;
if ($attr->has_value($container)) {
return $attr->get_value($container);
}
my $val = $self->$orig(@_);
if ($attr->has_type_constraint) {
$val = $attr->type_constraint->coerce($val)
if $attr->should_coerce;
$attr->verify_against_type_constraint($val, instance => $container);
}
return $val;
};
=method parent_container
Returns the Bread::Board::Declare container object that this service is
contained in.
=cut
sub parent_container {
my $self = shift;
my $container = $self;
until (!defined($container)
|| ($container->isa('Bread::Board::Container')
&& $container->does('Bread::Board::Declare::Role::Object'))) {
$container = $container->parent;
}
die "Couldn't find associated object!" unless defined $container;
return $container;
}
no Moose::Role;
1;
|
