File Coverage

blib/lib/App/Config/Chronicle/Attribute.pm
Criterion Covered Total %
statement 10 12 83.3
branch n/a
condition n/a
subroutine 4 4 100.0
pod n/a
total 14 16 87.5


line stmt bran cond sub pod time code
1             package App::Config::Chronicle::Attribute;
2              
3 1     1   401 use Moose;
  1         1  
  1         4  
4             extends 'App::Config::Chronicle::Node';
5 1     1   3781 use namespace::autoclean;
  1         1  
  1         5  
6 1     1   649 use JSON::XS qw( decode_json );
  1         3834  
  1         56  
7              
8 1     1   153 use MooseX::Types -declare => ['LongStr'];
  0            
  0            
9             use Moose::Util::TypeConstraints;
10             use Try::Tiny;
11              
12             subtype 'LongStr', as 'Str';
13              
14             =head1 NAME
15              
16             App::Config::Chronicle::Attribute
17              
18             =head1 ATTRIBUTES
19              
20             =cut
21              
22             has 'version' => (
23             is => 'rw',
24             );
25              
26             sub _check_type {
27             my ($self, $value) = @_;
28             my $def = $self->{definition};
29             $self->{_json_string} //= $def->{isa} eq 'json_string' ? 1 : 0;
30             if ($self->{_json_string}) {
31             try { $value = decode_json($value) } catch { die "Couldn't decode JSON attribute $value: $_" };
32             } else {
33             $self->{_type_constraint} //= find_type_constraint($def->{isa});
34             unless ($self->{_type_constraint}) {
35             die "Couldn't find type constraint for " . $def->{isa} . " for " . $self->name;
36             }
37             $self->{_type_constraint}->check($value) or die $self->name . " expecting a value of type " . $def->{isa};
38             }
39             return;
40             }
41              
42             =head2 value
43              
44             =cut
45              
46             sub value {
47             my ($self, $value) = @_;
48              
49             if (defined $value) {
50             $self->_check_type($value);
51             $self->{_value} = $value;
52             $self->_set_value($value);
53             $self->version($self->data_set->{version}); #Avoids building after set unless version changed.
54             } else {
55             if (not $self->version or $self->version ne $self->data_set->{version}) {
56             my $val = $self->_build_value;
57             if (defined $val) {
58             $self->value($val);
59             $self->version($self->data_set->{version});
60             }
61             }
62             }
63              
64             return $self->{_value};
65             }
66              
67             =head2 build
68              
69             =cut
70              
71             sub build {
72             my $self = shift;
73             my $default = $self->definition->{default};
74             $self->_check_type($default);
75             $self->{_value} = $default;
76             return $self;
77             }
78              
79             sub _build_value {
80             my $self = shift;
81             my $value;
82             $value //= $self->data_set->{app_config}->get($self->path) if ($self->data_set->{app_config});
83             $value //= $self->definition->{default} if ($self->definition);
84              
85             return $value;
86             }
87              
88             sub _set_value {
89             return;
90             }
91              
92             __PACKAGE__->meta->make_immutable;
93              
94             1;