File Coverage

blib/lib/Catmandu/Env.pm
Criterion Covered Total %
statement 93 104 89.4
branch 26 38 68.4
condition 20 29 68.9
subroutine 18 19 94.7
pod 0 9 0.0
total 157 199 78.8


line stmt bran cond sub pod time code
1              
2             use Catmandu::Sane;
3 147     147   95529  
  147         287  
  147         810  
4             our $VERSION = '1.2018';
5              
6             use Catmandu::Util qw(require_package use_lib read_yaml read_json :is :check);
7 147     147   1033 use Catmandu::Fix;
  147         375  
  147         57441  
8 147     147   21208 use Config::Onion;
  147         387  
  147         4592  
9 147     147   60263 use File::Spec;
  147         1936497  
  147         5129  
10 147     147   1168 use Moo;
  147         368  
  147         3434  
11 147     147   822 require Catmandu;
  147         320  
  147         740  
12             use namespace::clean;
13 147     147   70216  
  147         320  
  147         1145  
14             with 'Catmandu::Logger';
15              
16             my $dir = $_[0];
17             my @dirs = grep length, File::Spec->splitdir(Catmandu->default_load_path);
18 0     0   0 for (; @dirs; pop @dirs) {
19 0         0 my $path = File::Spec->catdir(File::Spec->rootdir, @dirs);
20 0         0 opendir my $dh, $path or last;
21 0         0 return $path
22 0 0       0 if grep {-r File::Spec->catfile($path, $_)}
23             grep /^catmandu.+(?:yaml|yml|json|pl)$/, readdir $dh;
24 0 0       0 }
  0         0  
25             Catmandu->default_load_path;
26             }
27 0         0  
28             has load_paths => (
29             is => 'ro',
30             default => sub {[]},
31             coerce => sub {
32             [
33             map {File::Spec->canonpath($_)}
34             map {$_ eq ':up' ? _search_up($_) : $_} split /,/,
35             join ',',
36             ref $_[0] ? @{$_[0]} : $_[0]
37             ];
38             },
39             );
40              
41             has config => (is => 'rwp', default => sub {+{}});
42              
43             has stores => (is => 'ro', default => sub {+{}});
44             has validators => (is => 'ro', default => sub {+{}});
45             has fixers => (is => 'ro', default => sub {+{}});
46              
47             has default_store => (is => 'ro', default => sub {'default'});
48             has default_importer => (is => 'ro', default => sub {'default'});
49             has default_exporter => (is => 'ro', default => sub {'default'});
50             has default_validator => (is => 'ro', default => sub {'default'});
51             has default_fixer => (is => 'ro', default => sub {'default'});
52              
53             has default_store_package => (is => 'ro');
54             has default_importer_package => (is => 'ro', default => sub {'JSON'});
55             has default_exporter_package => (is => 'ro', default => sub {'JSON'});
56             has default_validator_package => (is => 'ro');
57              
58             has store_namespace => (is => 'ro', default => sub {'Catmandu::Store'});
59             has importer_namespace => (is => 'ro', default => sub {'Catmandu::Importer'});
60             has exporter_namespace => (is => 'ro', default => sub {'Catmandu::Exporter'});
61             has validator_namespace =>
62             (is => 'ro', default => sub {'Catmandu::Validator'});
63              
64             my ($self) = @_;
65              
66             my @config_dirs = @{$self->load_paths};
67 65     65 0 385 my @lib_dirs;
68              
69 65         135 for my $dir (@config_dirs) {
  65         340  
70 65         145 if (!-d $dir) {
71             Catmandu::Error->throw("load path $dir doesn't exist");
72 65         198 }
73 65 50       1661  
74 0         0 my $lib_dir = File::Spec->catdir($dir, 'lib');
75              
76             if (-d $lib_dir && -r $lib_dir) {
77 65         684 push @lib_dirs, $lib_dir;
78             }
79 65 50 33     1745 }
80 65         283  
81             if (@config_dirs) {
82             my @globs = map {
83             my $dir = $_;
84 65 50       197 map {File::Spec->catfile($dir, "catmandu*.$_")}
85             qw(yaml yml json pl)
86 65         181 } reverse @config_dirs;
  65         179  
87 65         144  
  260         1898  
88             my $config = Config::Onion->new(prefix_key => '_prefix');
89             $config->load_glob(@globs);
90              
91 65         1196 if ($self->log->is_debug) {
92 65         48591 use Data::Dumper;
93             $self->log->debug(Dumper($config->get));
94 65 100       927844 }
95 147     147   267773 $self->_set_config($config->get);
  147         493  
  147         134712  
96 13         703 }
97              
98 65         61066 if (@lib_dirs) {
99             lib->import(@lib_dirs);
100             }
101 65 50       13924 }
102 65         469  
103             $_[0]->load_paths->[0];
104             }
105              
106             goto &load_paths;
107 2     2 0 23 }
108              
109             goto &load_path;
110             }
111 5     5 0 142  
112             my $self = shift;
113              
114             # it's already a fixer
115 2     2 0 423 if (is_instance($_[0], 'Catmandu::Fix')) {
116             return $_[0];
117             }
118              
119 11     11 0 2472 # an array ref of fixes
120             if (is_array_ref($_[0])) {
121             return Catmandu::Fix->new(fixes => $_[0]);
122 11 50       49 }
123 0         0  
124             # a single fix
125             if (is_able($_[0], 'fix')) {
126             return Catmandu::Fix->new(fixes => [$_[0]]);
127 11 100       53 }
128 2         25  
129             # try to load from config
130             my $key = $_[0] || $self->default_fixer;
131              
132 9 50       35 my $fixers = $self->fixers;
133 0         0  
134             $fixers->{$key} || do {
135             if (my $fixes = $self->config->{fixer}{$key}) {
136             return $fixers->{$key} = Catmandu::Fix->new(fixes => $fixes);
137 9   66     45 }
138             return Catmandu::Fix->new(fixes => [@_]);
139 9         28 };
140             }
141 9 50       54  
142 9 100       41 my $self = shift;
143 3         36 $self->_named_package('store', $self->store_namespace,
144             $self->default_store, $self->default_store_package,
145 6         91 $self->stores, @_);
146             }
147              
148             my $self = shift;
149             $self->_named_package('importer', $self->importer_namespace,
150 29     29 0 197 $self->default_importer, $self->default_importer_package,
151 29         263 undef, @_);
152             }
153              
154             my $self = shift;
155             $self->_named_package('exporter', $self->exporter_namespace,
156             $self->default_exporter, $self->default_exporter_package,
157 41     41 0 674 undef, @_);
158 41         394 }
159              
160             my $self = shift;
161             $self->_named_package(
162             'validator', $self->validator_namespace,
163             $self->default_validator, $self->default_validator_package,
164 55     55 0 470 $self->validators, @_
165 55         367 );
166             }
167              
168             my $self = shift;
169             my $type = shift;
170             my $ns = shift;
171 2     2 0 6 my $default_name = shift;
172 2         18 my $default_package = shift;
173             my $cache = shift;
174             my $name = shift;
175             my $key = $name || $default_name;
176              
177             return $name if is_instance($name) && index(ref($name), $ns) == 0;
178              
179             # return cached instance if no arguments are given
180 127     127   297 if ($cache && !@_ and my $instance = $cache->{$key}) {
181 127         211 return $instance;
182 127         198 }
183 127         181  
184 127         199 if (exists $self->config->{$type}) {
185 127         189 if (my $c = $self->config->{$type}{$key}) {
186 127         213 check_hash_ref($c);
187 127   66     330 check_string(my $package = $c->{package} || $default_package);
188             my $opts = check_hash_ref($c->{options} || {});
189 127 100 66     472 if (@_ > 1) {
190             $opts = {%$opts, @_};
191             }
192 126 100 100     698 elsif (@_ == 1) {
      100        
193 12         64 $opts = {%$opts, %{$_[0]}};
194             }
195             my $instance = require_package($package, $ns)->new($opts);
196 114 50       473  
197 114 100       507 # cache this instance if no arguments are given
198 25         94 if ($cache && !@_) {
199 25   33     4429 $cache->{$key} = $instance;
200 25   100     3667 }
201 25 100       651  
    100          
202 1         7 return $instance;
203             }
204             }
205 6         19  
  6         16  
206             check_string(my $package = $name || $default_package);
207 25         97 require_package($package, $ns)->new(@_);
208             }
209              
210 25 100 100     205 1;
211 10         35  
212              
213             =pod
214 25         314  
215             =head1 NAME
216              
217             Catmandu::Env - A catmandu configuration file loader
218 89   33     483  
219 89         8122 =head1 SYNOPSIS
220              
221             use Catmandu::Env;
222              
223             my $env = Catmandu::Env->new(load_paths => [ '/etc/catmandu '] );
224             my $env = Catmandu::Env->new(load_paths => [ ':up'] );
225              
226             my $store = $env->store('mongodb');
227             my $importer = $env->importer('loc');
228             my $exporter = $env->exporter('europeana');
229             my $fixer = $env->fixer('my_fixes');
230             my $conf = $env->config;
231              
232             =head1 DESCRIPTION
233              
234             This class loads the catmandu.*.pl, catmandu.*.json, catmandu.*.yml and catmandu.*.yaml file from
235             all provided load_paths. Programmers are advised I<not> to use this class directly
236             but use the equivalent functionality provided in the Catmandu package:
237              
238             Catmandu->load('/etc/catmandu');
239             Catmandu->load(':up');
240              
241             my $store = Catmandu->store('mongodb');
242             my $importer = Catmandu->importer('loc');
243             my $exporter = Catmandu->exporter('europeana');
244             my $fixer = Catmandu->fixer('my_fixes');
245             my $conf = Catmandu->config;
246              
247             =head1 SEE ALSO
248              
249             L<Catmandu>
250              
251             =cut