File Coverage

blib/lib/Config/Station.pm
Criterion Covered Total %
statement 44 49 89.8
branch 2 6 33.3
condition n/a
subroutine 17 17 100.0
pod 0 2 0.0
total 63 74 85.1


line stmt bran cond sub pod time code
1             package Config::Station;
2             $Config::Station::VERSION = '0.002001';
3             # ABSTRACT: Load configs from files and the environment
4              
5 1     1   46575 use Moo;
  1         15610  
  1         5  
6 1     1   1577 use warnings NONFATAL => 'all';
  1         2  
  1         103  
7              
8 1     1   726 use JSON::MaybeXS;
  1         2440839  
  1         100  
9 1     1   1293 use IO::All;
  1         13651  
  1         7  
10 1     1   900 use Try::Tiny;
  1         1365  
  1         56  
11 1     1   6 use Module::Runtime 'use_module';
  1         1  
  1         9  
12              
13             has _debug => (
14             is => 'ro',
15             init_arg => undef,
16             lazy => 1,
17             default => sub {
18             my $self = shift;
19              
20             exists $ENV{'DEBUG_' . $self->_env_key}
21             ? $ENV{'DEBUG_' . $self->_env_key}
22             : $self->__debug
23             },
24             );
25              
26             has __debug => (
27             is => 'ro',
28             init_arg => 'debug',
29             );
30              
31             has _env_key => (
32             is => 'ro',
33             init_arg => 'env_key',
34             required => 1,
35             );
36              
37             has _location => (
38             is => 'ro',
39             init_arg => undef,
40             lazy => 1,
41             default => sub {
42             my $self = shift;
43              
44             my $path = $ENV{'FILE_' . $self->_env_key} ||
45             $self->__location;
46              
47             warn "No path specified to load config from\n"
48             if !$path && $self->_debug;
49              
50             return $path
51             },
52             );
53              
54             has __location => (
55             is => 'ro',
56             init_arg => 'location',
57             );
58              
59             has _config_class => (
60             is => 'ro',
61             init_arg => 'config_class',
62             required => 1,
63             );
64              
65             has _decode_via => (
66             is => 'ro',
67             init_arg => 'decode_via',
68             lazy => 1,
69 3     3   1865 builder => sub { \&decode_json },
70             );
71              
72             has _encode_via => (
73             is => 'ro',
74             init_arg => 'encode_via',
75             lazy => 1,
76 1     1   512 builder => sub { \&encode_json },
77             );
78              
79 7     7   25 sub _io { io->file(shift->_location) }
80              
81             sub _debug_log {
82 9     9   18 my ($self, $line, $ret) = @_;
83              
84 9 50       194 if ($self->_debug) {
85 0 0       0 if (my @keys = keys %$ret) {
86 0         0 warn "CONFIGSTATION FROM $line:\n";
87 0         0 warn " $_: $ret->{$_}\n" for @keys;
88             } else {
89 0         0 warn "CONFIGSTATION FROM $line: EMPTY\n";
90             }
91             }
92              
93             $ret
94 9         184 }
95              
96             sub _read_config_from_file {
97 6     6   8 my $self = shift;
98              
99             my $ret = try {
100 6     6   194 $self->_debug_log(FILE => $self->_decode_via->($self->_io->all));
101             } catch {
102 3 50   3   12482 if ($self->_debug) {
103 0         0 warn "CONFIGSTATION FROM FILE: $_\n"
104             }
105             {}
106 6         45 };
  3         33  
107              
108             }
109              
110             sub _read_config_from_env {
111 6     6   10 my $self = shift;
112              
113 6         18 my $k_re = '^' . quotemeta($self->_env_key) . '_(.+)';
114              
115             my $ret = +{
116 6         98 map {; m/$k_re/; lc $1 => $ENV{$self->_env_key . "_$1"} }
  7         28  
  7         42  
117             grep m/$k_re/,
118             keys %ENV
119             };
120              
121 6         25 $self->_debug_log(ENV => $ret);
122             }
123              
124             sub _read_config {
125 6     6   175 my $self = shift;
126              
127             {
128 6         10 %{$self->_read_config_from_file},
  6         17  
129 6         7 %{$self->_read_config_from_env},
  6         93  
130             }
131             }
132              
133             sub load {
134 6     6 0 7273 my $self = shift;
135              
136 6         32 use_module($self->_config_class)->new($self->_read_config)
137             }
138              
139             # eat my data
140             sub store {
141 1     1 0 745 my ($self, $obj) = @_;
142              
143 1         3 $self->_io->print($self->_encode_via->($obj->serialize))
144             }
145              
146             1;
147              
148             __END__