blob: 90d027dc3f3df2e2cd34bd7449b6040aa67da4e5 (
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
74
75
|
package Bread::Board::Declare::Meta::Role::Attribute::Container;
use Moose::Role;
Moose::Util::meta_attribute_alias('Container');
use Class::Load 'load_class';
has dependencies => (
is => 'ro',
isa => 'Bread::Board::Service::Dependencies',
coerce => 1,
predicate => 'has_dependencies',
);
after attach_to_class => sub {
my $self = shift;
my $tc = $self->type_constraint;
if ($tc && $tc->isa('Moose::Meta::TypeConstraint::Class')) {
load_class($tc->class);
confess "Subcontainers must inherit from Bread::Board::Container"
unless $tc->class->isa('Bread::Board::Container');
}
else {
confess "Attributes for subcontainers must specify a class type constraint";
}
};
around get_value => sub {
my $orig = shift;
my $self = shift;
my ($instance) = @_;
return $self->$orig($instance)
if $self->has_value($instance)
|| $self->has_default
|| $self->has_builder;
my $val = $instance->get_sub_container($self->name);
if ($self->has_type_constraint) {
$val = $self->type_constraint->coerce($val)
if $self->should_coerce;
$self->verify_against_type_constraint($val, instance => $instance);
}
return $val;
};
around _inline_instance_get => sub {
my $orig = shift;
my $self = shift;
my ($instance) = @_;
return 'do {' . "\n"
. 'my $val;' . "\n"
. 'if (' . $self->_inline_instance_has($instance) . ') {' . "\n"
. '$val = ' . $self->$orig($instance) . ';' . "\n"
. '}' . "\n"
. 'else {' . "\n"
. '$val = ' . $instance . '->get_sub_container(\'' . $self->name . '\');' . "\n"
. join("\n", $self->_inline_check_constraint(
'$val',
'$type_constraint',
(Moose->VERSION >= 2.0100
? '$type_message'
: '$type_constraint_obj'),
)) . "\n"
. '}' . "\n"
. '$val' . "\n"
. '}';
};
no Moose::Role;
1;
|