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.002000';
3             # ABSTRACT: Load configs from files and the environment
4              
5 1     1   887154 use Moo;
  1         1180372  
  1         7  
6 1     1   1579 use warnings NONFATAL => 'all';
  1         2  
  1         44  
7              
8 1     1   713 use JSON::MaybeXS;
  1         14602  
  1         106  
9 1     1   1566 use IO::All;
  1         12799  
  1         8  
10 1     1   1785 use Try::Tiny;
  1         1438  
  1         51  
11 1     1   5 use Module::Runtime 'use_module';
  1         2  
  1         8  
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   1728 builder => sub { \&decode_json },
70             );
71              
72             has _encode_via => (
73             is => 'ro',
74             init_arg => 'encode_via',
75             lazy => 1,
76 1     1   477 builder => sub { \&encode_json },
77             );
78              
79 7     7   23 sub _io { io->file(shift->_location) }
80              
81             sub _debug_log {
82 9     9   14 my ($self, $line, $ret) = @_;
83              
84 9 50       172 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         167 }
95              
96             sub _read_config_from_file {
97 6     6   10 my $self = shift;
98              
99             my $ret = try {
100 6     6   185 $self->_debug_log(FILE => $self->_decode_via->($self->_io->all));
101             } catch {
102 3 50   3   13118 if ($self->_debug) {
103 0         0 warn "CONFIGSTATION FROM FILE: $_\n"
104             }
105             {}
106 6         45 };
  3         31  
107              
108             }
109              
110             sub _read_config_from_env {
111 6     6   8 my $self = shift;
112              
113 6         16 my $k_re = '^' . quotemeta($self->_env_key) . '_(.+)';
114              
115             my $ret = +{
116 6         88 map {; m/$k_re/; lc $1 => $ENV{$self->_env_key . "_$1"} }
  7         25  
  7         40  
117             grep m/$k_re/,
118             keys %ENV
119             };
120              
121 6         22 $self->_debug_log(ENV => $ret);
122             }
123              
124             sub _read_config {
125 6     6   171 my $self = shift;
126              
127             {
128 6         9 %{$self->_read_config_from_file},
  6         15  
129 6         7 %{$self->_read_config_from_env},
  6         85  
130             }
131             }
132              
133             sub load {
134 6     6 0 7287 my $self = shift;
135              
136 6         29 use_module($self->_config_class)->new($self->_read_config)
137             }
138              
139             # eat my data
140             sub store {
141 1     1 0 624 my ($self, $obj) = @_;
142              
143 1         4 $self->_io->print($self->_encode_via->($obj->serialize))
144             }
145              
146             1;
147              
148             __END__