Codebase list libconfig-merge-perl / upstream/1.01
[svn-inject] Installing original source of libconfig-merge-perl (1.01) Nicholas Bamber 13 years ago
79 changed file(s) with 4345 addition(s) and 0 deletion(s). Raw diff Collapse all Expand all
+36
-0
Build.PL less more
0 use strict;
1 use warnings;
2 use Module::Build;
3
4 my $builder = Module::Build->new(
5 module_name => 'Config::Merge',
6 license => 'perl',
7 dist_author => q{Clinton Gormley <drtech@cpan.org>},
8 dist_version_from => 'lib/Config/Merge.pm',
9 build_requires => { 'Test::More' => 0, },
10 create_makefile_pl => 'traditional',
11 requires => {
12 'File::Spec' => 0,
13 'Storable' => 0,
14 'Config::Any' => '0.07',
15 },
16 recommends => {
17 'YAML::Syck' => 0,
18 'YAML' => 0,
19 'JSON::XS' => 0,
20 'JSON' => 0,
21 'Config::Tiny' => 0,
22 'XML::Simple' => 0,
23 'Config::General' => 0
24 },
25 meta_merge => {
26 resources => {
27 bugtracker =>
28 'http://github.com/clintongormley/ConfigMerge/issues',
29 repository => 'http://github.com/clintongormley/ConfigMerge'
30 }
31 },
32 );
33
34 $builder->create_build_script();
35
+8
-0
Changes less more
0 1.01 12 Oct 2010 Removed dependency on Data::Alias - thanks to Graham Barr
1 for the patch.
2 Restructured the module to use the standard CPAN layout
3 with lib/, and switched to Module::Build
4
5 1.00 22 Oct 2007 First release of Config::Merge to CPAN.
6 Replaces Config::Loader
7
+80
-0
MANIFEST less more
0
1 Build.PL
2 Changes
3 examples/advanced.pl
4 examples/advanced/app-(dev1).yaml
5 examples/advanced/app-(dev2).yaml
6 examples/advanced/app.yaml
7 examples/browser.pl
8 examples/config_dev/app.yaml
9 examples/config_dev/app/db.yaml
10 examples/config_dev/app/html_filter.yaml
11 examples/config_dev/forms/search.yaml
12 examples/config_dev/forms/user/edit.yaml
13 examples/config_dev/forms/user/forgotten.yaml
14 examples/config_dev/forms/user/password.yaml
15 examples/config_dev/local.yaml
16 examples/config_prod/app.yaml
17 examples/config_prod/app/db.yaml
18 examples/config_prod/app/html_filter.yaml
19 examples/config_prod/forms/search.yaml
20 examples/config_prod/forms/user/edit.yaml
21 examples/config_prod/forms/user/forgotten.yaml
22 examples/config_prod/forms/user/password.yaml
23 examples/func.pl
24 examples/oo.pl
25 examples/README
26 lib/Config/Merge.pm
27 lib/Config/Merge/Perl.pm
28 Makefile.PL
29 MANIFEST This list of files
30 README
31 t/10_oo.t
32 t/20_functional.t
33 t/30_errors.t
34 t/40_advanced.t
35 t/80_pod.t
36 t/81_pod_coverage.t
37 t/data/array/local.pl
38 t/data/array/main.pl
39 t/data/bad/db.pl
40 t/data/empty/.dummy
41 t/data/errors/array_delete_int/local.pl
42 t/data/errors/array_delete_int/main.pl
43 t/data/errors/array_delete_ref/local.pl
44 t/data/errors/array_delete_ref/main.pl
45 t/data/errors/array_insert_int/local.pl
46 t/data/errors/array_insert_int/main.pl
47 t/data/errors/array_insert_ref/local.pl
48 t/data/errors/array_insert_ref/main.pl
49 t/data/errors/array_merge/local.pl
50 t/data/errors/array_merge/main.pl
51 t/data/load_as/dir-(local)/file.pl
52 t/data/load_as/dir/file.pl
53 t/data/load_as/file-(local).pl
54 t/data/load_as/file.pl
55 t/data/load_as/sub/dir-(aaa)/test.pl
56 t/data/load_as/sub/dir-(bbb)/test.pl
57 t/data/load_as/sub/dir/test.pl
58 t/data/load_as/sub/test-(aaa).pl
59 t/data/load_as/sub/test-(bbb).pl
60 t/data/load_as/sub/test.pl
61 t/data/local/email-(aaa).pl
62 t/data/local/email-(bbb).pl
63 t/data/local/email.pl
64 t/data/local/main.pl
65 t/data/local/override.pl
66 t/data/perl/global.perl
67 t/data/perlmulti/global.perl
68 t/data/perlmulti/global/db.pl
69 t/data/perlmulti/global/db2.pl
70 t/data/perlmulti/global/db3.pl
71 t/data/perlmulti/global/local.pl
72 t/data/perlmulti/local.perl
73 t/data/skip/main/skip_1.pl
74 t/data/skip/main/skip_2.pl
75 t/data/skip/main/skip_not.pl
76 t/data/skip/skip_1/test.pl
77 t/data/skip/skip_2/test.pl
78 t/data/skip/skip_not/test.pl
79 META.yml
+37
-0
META.yml less more
0 ---
1 abstract: "load a configuration directory tree containing\nYAML, JSON, XML, Perl, INI or Config::General files"
2 author:
3 - 'Clinton Gormley <drtech@cpan.org>'
4 build_requires:
5 Test::More: 0
6 configure_requires:
7 Module::Build: 0.36
8 generated_by: 'Module::Build version 0.3603'
9 license: perl
10 meta-spec:
11 url: http://module-build.sourceforge.net/META-spec-v1.4.html
12 version: 1.4
13 name: Config-Merge
14 provides:
15 Config::Merge:
16 file: lib/Config/Merge.pm
17 version: 1.01
18 Config::Merge::Perl:
19 file: lib/Config/Merge/Perl.pm
20 recommends:
21 Config::General: 0
22 Config::Tiny: 0
23 JSON: 0
24 JSON::XS: 0
25 XML::Simple: 0
26 YAML: 0
27 YAML::Syck: 0
28 requires:
29 Config::Any: 0.07
30 File::Spec: 0
31 Storable: 0
32 resources:
33 bugtracker: http://github.com/clintongormley/ConfigMerge/issues
34 license: http://dev.perl.org/licenses/
35 repository: http://github.com/clintongormley/ConfigMerge
36 version: 1.01
+17
-0
Makefile.PL less more
0 # Note: this file was auto-generated by Module::Build::Compat version 0.3603
1 use ExtUtils::MakeMaker;
2 WriteMakefile
3 (
4 'NAME' => 'Config::Merge',
5 'VERSION_FROM' => 'lib/Config/Merge.pm',
6 'PREREQ_PM' => {
7 'Config::Any' => '0.07',
8 'File::Spec' => 0,
9 'Storable' => 0,
10 'Test::More' => 0
11 },
12 'INSTALLDIRS' => 'site',
13 'EXE_FILES' => [],
14 'PL_FILES' => {}
15 )
16 ;
+761
-0
README less more
0 NAME
1 Config::Merge - load a configuration directory tree containing YAML,
2 JSON, XML, Perl, INI or Config::General files
3
4 SYNOPSIS
5 OO style
6 -------------------------------------------------------
7 use Config::Merge();
8
9 my $config = Config::Merge->new('/path/to/config');
10
11 @hosts = $config->('db.hosts.session');
12 $hosts_ref = $config->('db.hosts.session');
13 @cloned_hosts = $config->clone('db.hosts.session');
14 -------------------------------------------------------
15
16 OR
17
18 Functional style
19 -------------------------------------------------------
20 # On startup
21 use Config::Merge('My::Config' => '/path/to/config');
22
23 # Then, in any module where you want to use the config
24 package My::Module;
25 use My::Config;
26
27 @hosts = C('db.hosts.sesssion');
28 $hosts_ref = C('db.hosts.sesssion');
29 @cloned_hosts = My::Config::clone('db.hosts.session');
30 $config = My::Config::object;
31 -------------------------------------------------------
32
33 ADVANCED USAGE
34
35 OO style
36 -------------------------------------------------------
37 my $config = Config::Merge->new(
38 path => '/path/to/config',
39 skip => sub {} | regex | {} ,
40 is_local => sub {} | regex | {} ,
41 load_as => sub {} | regex ,
42 sort => sub {} ,
43 debug => 1 | 0
44 );
45 -------------------------------------------------------
46
47 Functional style
48 -------------------------------------------------------
49 use Config::Merge(
50 'My::Config' => '/path/to/config',
51 {
52 skip => sub {} | regex | {} ,
53 is_local => sub {} | regex | {} ,
54 load_as => sub {} | regex ,
55 sort => sub {} ,
56 debug => 1 | 0
57 }
58 );
59
60 # Also, you can subclass these:
61
62 package My::Config;
63 sub skip {
64 ...
65 }
66
67 -------------------------------------------------------
68
69 DESCRIPTION
70 Config::Merge is a configuration module which has six goals:
71
72 * Flexible storage
73 Store all configuration in your format(s) of choice (YAML, JSON,
74 INI, XML, Perl, Config::General / Apache-style config) broken down
75 into individual files in a configuration directory tree, for easy
76 maintenance. See "CONFIG TREE LAYOUT"
77
78 * Flexible access
79 Provide a simple, easy to read, concise way of accessing the
80 configuration values (similar to Template). See "ACCESSING CONFIG
81 DATA"
82
83 * Minimal maintenance
84 Specify the location of the configuration files only once per
85 application, so that it requires minimal effort to relocate. See
86 "USING Config::Merge"
87
88 * Easy to alter development environment
89 Provide a way for overriding configuration values on a development
90 machine, so that differences between the dev environment and the
91 live environment do not get copied over accidentally. See
92 "OVERRIDING CONFIG LOCALLY"
93
94 * Minimise memory use
95 Load all config at startup so that (eg in the mod_perl environment)
96 the data is shared between all child processes. See "MINIMISING
97 MEMORY USE"
98
99 * Flexible implementation
100 You may want to use a different schema for your configuration files,
101 so you can pass in (or subclass) methods for determining how your
102 files are merged. See "ADVANCED USAGE".
103
104 USING "Config::Merge"
105 There are two ways to use "Config::Merge":
106
107 OO STYLE
108 use Config::Merge();
109 my $config = Config::Merge->new('/path/to/config');
110
111 @hosts = $config->('db.hosts.session');
112 $hosts_ref = $config->('db.hosts.session');
113 @cloned_hosts = $config->clone('db.hosts.session');
114
115 Also, see "ADVANCED USAGE".
116
117 YOUR OWN CONFIG CLASS (functional style)
118 The following code:
119
120 # On startup
121 use Config::Merge('My::Config' => '/path/to/config');
122
123 * auto-generates the class "My::Config"
124
125 * loads the configuration data in '/path/to/config'
126
127 * creates the subs "My::Config::C", "My::Config::clone" and
128 "My::Config::object".
129
130 Then when you want your application to have access to your
131 configuration data, you add this (eg in your class "My::Module"):
132
133 package My::Module;
134 use My::Config; # Note, no ()
135
136 This exports the sub "C" into your current package, which allows you
137 to access your configuation data as follows:
138
139 @hosts = C('db.hosts.sesssion');
140 $hosts_ref = C('db.hosts.sesssion');
141 @cloned_hosts = My::Config::clone('db.hosts.session');
142 $config = My::Config::object;
143
144 CONFIG TREE LAYOUT
145 Config::Merge reads the data from any number (and type) of config files
146 stored in a directory tree. File names and directory names are used as
147 keys in the configuration hash.
148
149 It uses file extensions to decide what type of data the file contains,
150 so:
151
152 YAML : .yaml .yml
153 JSON : .json .jsn
154 XML : .xml
155 INI : .ini
156 Perl : .perl .pl
157 Config::General : .conf .cnf
158
159 When loading your config data, Config::Merge starts at the directory
160 specified at startup (see "USING Config::Merge") and looks through all
161 the sub-directories for files ending in one of the above extensions.
162
163 The name of the file or subdirectory is used as the first key. So:
164
165 global/
166 db.yaml:
167 username : admin
168 hosts:
169 - host1
170 - host2
171 password:
172 host1: password1
173 host2: password2
174
175 would be loaded as :
176
177 $Config = {
178 global => {
179 db => {
180 username => 'admin',
181 password => { host1 => 'password1', host2 => 'password2'},
182 hosts => ['host1','host2'],
183 }
184 }
185 }
186
187 Subdirectories are processed before the current directory, so you can
188 have a directory and a config file with the same name, and the values
189 will be merged into a single hash, so for instance, you can have:
190
191 confdir:
192 syndication/
193 --data_types/
194 --traffic.yaml
195 --headlines.yaml
196 --data_types.ini
197 syndication.conf
198
199 The config items in syndication.conf will be added to (or overwrite) the
200 items loaded into the syndication namespace via the subdirectory called
201 syndication.
202
203 OVERRIDING CONFIG LOCALLY
204 The situation often arises where it is necessary to specify different
205 config values on different machines. For instance, the database host on
206 a dev machine may be different from the host on the live application.
207 Also, see "ADVANCED USAGE" which provides you with other means to merge
208 local data.
209
210 Instead of changing this data during dev and then having to remember to
211 change it back before putting the new code live, we have a mechanism for
212 overriding config locally in a "local.*" file and then, as long as that
213 file never gets uploaded to live, you are protected.
214
215 You can put a file called "local.*" (where * is any of the recognised
216 extensions) in any sub-directory, and the data in this file will be
217 merged with the existing data.
218
219 Just make sure that the "local.*" files are never checked into your live
220 code.
221
222 For instance, if we have:
223
224 confdir:
225 db.yaml
226 local.yaml
227
228 and db.yaml has :
229
230 connections:
231 default_settings:
232 host: localhost
233 table: abc
234 password: 123
235
236 And in local.yaml:
237
238 db:
239 connections:
240 default_settings:
241 password: 456
242
243 the resulting configuration will look like this:
244
245 db:
246 connections:
247 default_settings:
248 host: localhost
249 table: abc
250 password: 456
251
252 ACCESSING CONFIG DATA
253 All configuration data is loaded into a single hash, eg:
254
255 $config = {
256 db => {
257 hosts => {
258 session => ['host1','host2','host3'],
259 images => ['host1','host2','host3'],
260 etc...
261 }
262 }
263 }
264
265 If you want to access it via standard Perl dereferences, you can just
266 ask for the hash:
267
268 OO:
269 $data_ref = $config->();
270 $hosts_ref = $data_ref->{db}{hosts}{session};
271 $host_1 = $data_ref->{db}{hosts}{session}[0];
272
273 Functional:
274 $data_ref = C();
275 $hosts_ref = $data_ref->{db}{hosts}{session};
276 $host_1 = $data_ref->{db}{hosts}{session}[0];
277
278 However, "Config::Merge" also provides an easy to read dot-notation in
279 the style of Template Toolkit: "('key1.key2.keyn')".
280
281 A key can be the key of a hash or the index of an array. The return
282 value is context sensitive, so if called in list context, a hash ref or
283 array ref will be dereferenced.
284
285 OO:
286 @hosts = $config->('db.hosts.session');
287 $hosts_ref = $config->('db.hosts.session');
288 $host_1 = $config->('db.hosts.session.0');
289
290 Functional:
291 @hosts = C('db.hosts.session');
292 $hosts_ref = C('db.hosts.session');
293 $host_1 = C('db.hosts.session.0');
294
295 These lookups are memo'ised, so lookups are fast.
296
297 If the specified key is not found, then an error is thrown.
298
299 MINIMISING MEMORY USE
300 The more configuration data you load, the more memory you use. In order
301 to keep the memory use as low as possible for mod_perl (or other forking
302 applications), the configuration data should be loaded at startup in the
303 parent process.
304
305 As long as the data is never changed by the children, the configuration
306 hash will be stored in shared memory, rather than there being a separate
307 copy in each child process.
308
309 (See
310 <http://search.cpan.org/~pgollucci/mod_perl-2.0.3/docs/user/performance/
311 mpm.pod>)
312
313 METHODS
314 "new()"
315 $conf = Config::Merge->new($config_dir);
316
317 new() instantiates a config object, loads the config from the
318 directory specified, and returns the object.
319
320 "C()"
321 $val = $config->C('key1.key2.keyn');
322 $val = $config->C('key1.key2.keyn',$hash_ref);
323
324 "Config::Merge" objects are overloaded so that this also works:
325
326 $val = $config->('key1.key2.keyn');
327 $val = $config->('key1.key2.keyn',$hash_ref);
328
329 Or, if used in the functional style (see "USING Config::Merge"):
330
331 $val = C('key1.key2.keyn');
332 $val = C('key1.key2.keyn',$hash_ref);
333
334 "key1" etc can be keys in a hash, or indexes of an array.
335
336 "C('key1.key2.keyn')" returns everything from "keyn" down, so you
337 can use the return value just as you would any normal Perl variable.
338
339 The return values are context-sensitive, so if called in list
340 context, an array ref or hash ref will be returned as lists. Scalar
341 values, code refs, regexes and blessed objects will always be
342 returned as themselves.
343
344 So for example:
345
346 $password = C('database.main.password');
347 $regex = C('database.main.password_regex');
348
349 @countries = C('lists.countries');
350 $countries_array_ref = C('lists.countries');
351
352 etc
353
354 If called with a hash ref as the second parameter, then that hash
355 ref will be examined, rather than the $config data.
356
357 "clone()"
358 This works exactly the same way as "C()" but it performs a deep
359 clone of the data before returning it.
360
361 This means that the returned data can be changed without affecting
362 the data stored in the $conf object;
363
364 The data is deep cloned, using Storable, so the bigger the data, the
365 more performance hit. That said, Storable's dclone is very fast.
366
367 "register_loader()"
368 Config::Merge->register_loader( 'Config::Merge::XYZ');
369
370 Config::Merge->register_loader( 'Config::Merge::XYZ' => 'xyz','xxx');
371
372 By default, "Config::Merge" uses the "Config::Any" plugins to
373 support YAML, JSON, INI, XML, Perl and Config::General configuration
374 files, using the standard file extensions to recognise the file
375 type. (See "CONFIG TREE LAYOUT").
376
377 If you would like to change the handler for an extension (eg, you
378 want ".conf" and ".cnf" files to be treated as YAML), do the
379 following:
380
381 Config::Merge->register_loader ('Config::Any::YAML' => 'conf', 'cnf');
382
383 If you would like to add a new config style, then your module should
384 have two methods: "extensions()" (which returns a list of the
385 extensions it handles), and "load()" which accepts the name of the
386 file to load, and returns a hash ref containing the data in the
387 file. See Config::Any for details.
388
389 Alternatively, you can specify the extensions when you load it:
390
391 Config::Merge->register_loader ('My::Merge' => 'conf', 'cnf');
392
393 "load_config()"
394 $config->load_config();
395
396 Will reload the config files located in the directory specified at
397 object creation (see "new()").
398
399 BEWARE : If you are using this in a mod_perl environment, you will
400 lose the benefit of shared memory by calling this in a child process
401 - each child will have its own copy of the data. See "MINIMISING
402 MEMORY USE".
403
404 Returns the config hash ref.
405
406 "clear_cache()"
407 $config->clear_cache();
408
409 Config data is generally not supposed to be changed at runtime.
410 However, if you do make changes, you may get inconsisten results,
411 because lookups are cached.
412
413 For instance:
414
415 print $config->C('db.hosts.session'); # Caches this lookup
416 > "host1 host2 host3"
417
418 $data = $config->C('db.hosts');
419 $data->{session} = 123;
420
421 print $config->C('db.hosts.session'); # uses cached value
422 > "host1 host2 host3"
423
424 $config->clear_cache();
425 print $config->C('db.hosts.session'); # uses actual value
426 > "123"
427
428 "import()"
429 "import()" will normally be called automatically when you "use
430 Config::Merge". However, you may want to do this:
431
432 use Config::Merge();
433 Config::Merge->register_loader('My::Plugin' => 'ext');
434 Config::Merge->import('My::Config' => '/path/to/config/dir');
435
436 If called with two params: $config_class and $config_dir, it
437 generates the new class (which inherits from Config::Merge)
438 specified in $config_class, creates a new object of that class and
439 creates 4 subs:
440
441 "C()"
442 As a function:
443 C('keys...')
444
445 is the equivalent of:
446 $config->C('keys...');
447
448 "clone()"
449 As a function:
450 clone('keys...')
451
452 is the equivalent of:
453 $config->clone('keys...');
454
455 "object()"
456 $config = My::Config->object();
457
458 Returns the $config object,
459
460 "import()"
461 When you use your generated config class, it exports the "C()"
462 sub into your package:
463
464 use My::Config;
465 $hosts = C('db.hosts.session');
466
467 ADVANCED USAGE
468 The items in the section allow you to customise how Config::Merge loads
469 your data. You may never need them.
470
471 You can:
472
473 * Override array values
474
475 * Skip the loading of parts of your config tree
476
477 * Specify which files / dirs are local
478
479 * Specify how to translate a file / dir name into a key
480
481 * Change order in which files are loaded
482
483 * See debug output
484
485 Overriding array values
486 Overriding hash values is easy, however arrays are more complex. it
487 may be simpler to copy and paste and edit the array you want to
488 change locally.
489
490 However, if your array is too long, and you want to make small
491 changes, then you can use the following:
492
493 In the main config:
494
495 {
496 cron => [qw( job1 job2 job3 job4)]
497 }
498
499 In the local file
500
501 {
502 cron => {
503 '3' => 'newjob4', # changes 'job4' -> 'newjob4'
504
505 '!' => { # signals an array override
506
507 '-' => [1], # deletes 'job2'
508
509 '+' => ['job5'], # appends 'job5'
510
511 OR '+' => { # inserts 'job3a' after 'job3'
512 2 => 'job3a'
513 }
514 }
515 }
516
517 * The override has to be a hash, with at least this structure "{
518 '!' => {} }" to signal an array override
519
520 * Any other keys with integers are treated as indexes and are used
521 to change the value at that index in the original array
522
523 * The '-' key should contain an array ref, with the indexes of the
524 elements to remove from the array.
525
526 * If the '+' key contains an array ref, then its contents are
527 appended to the original array.
528
529 * If the '+' key contains a hash ref, then each value is inserted
530 into the original array at the index given in the key
531
532 * Indexes are zero based, just as in Perl.
533
534 "skip()"
535 $c = Config::Merge->new(
536 path => '/path/to/config',
537 skip => qr/regex/,
538 | [ qr/regex1/, qr/regex2/...]
539 | { name1 => 1, name2 => 2}
540 | sub {}
541 );
542
543 "skip()" allows you to skip the loading of parts of your config
544 tree. For instance, if you don't need a list of cron jobs when
545 running your web server, you can skip it.
546
547 The decision is made based on the path to that value, eg
548 'app.db.hosts' rather than on filenames. Also, the check is only
549 performed for each new directory or filename - it doesn't check the
550 data within each file.
551
552 To use "skip()", you can either subclass it, or pass in a parameter
553 to new:
554
555 "qr/regex/" or "[qr/regex1/, qr/regex2]"
556 Each regex will be checked against the key path, and if it
557 matches then the loading of that tree will be skipped
558
559 "{key_path => 1}"
560 If the key path exists in the hash, then loading will be skipped
561
562 "sub {}" or subclassed "skip"
563 sub {
564 my ($self,$key_path) = @_;
565 ...make decision...
566 return 1 | 0;
567 }
568
569 "is_local()"
570 $c = Config::Merge->new(
571 path => '/path/to/config',
572 is_local => qr/regex/,
573 | [ qr/regex1/, qr/regex2/...]
574 | { name1 => 1, name2 => 2}
575 | sub {}
576 );
577
578 "is_local()" indicates whether a file or dir should be considered
579 part of the main config (and thus loaded normally) or part of the
580 local config (and thus merged into the main config).
581
582 The decision is made based on the name of the file / dir, without
583 any extension.
584
585 To use "is_local()", you can either subclass it, or pass in a
586 parameter to new:
587
588 "qr/regex/" or "[qr/regex1/, qr/regex2]"
589 Each regex will be checked against the file/dir name, and if it
590 matches then that tree will be merged
591
592 "{filename => 1, dirname => 1}"
593 If the file/dir name exists in the hash, then that tree will be
594 merged
595
596 "sub {}" or subclassed "is_local"
597 sub {
598 my ($self,$name) = @_;
599 ...make decision...
600 return 1 | 0;
601 }
602
603 See "EXAMPLE USING is_local() AND load_as()".
604
605 "load_as()"
606 $c = Config::Merge->new(
607 path => '/path/to/config',
608 load_as => qr/(regex)/,
609 | sub {}
610 );
611
612 "load_as()" returns the name of the key to use when loading the file
613 / dir. By default, it returns the $name for main config files, or ''
614 for local files.
615
616 The decision is made based on the name of the file / dir, without
617 any extension.
618
619 If "load_as()" returns an empty string, then each key in the
620 file/tree is merged separately. This is how the "local.*" files work
621 by default. See "OVERRIDING CONFIG LOCALLY".
622
623 For instance:
624
625 main.yaml:
626 key1: value
627 key2: value
628
629 db.yaml:
630 key3: value
631 key4: value
632
633 local.yaml:
634 main:
635 key1: new_value
636 db:
637 key4: new_value
638
639 To use "load_as()", you can either subclass it, or pass in a
640 parameter to new:
641
642 "qr/(regex)/"
643 The regex will be checked against the file/dir name, and if it
644 matches then it returns the string captured in the regex,
645 otherwise it returns the original name.
646
647 "sub {}" or subclassed "is_local"
648 sub {
649 my ($self,$name,$is_local) = @_;
650 ...make decision...
651 return 'string'; # string is used as the keyname
652 return ''; # acts like local.* (see above)
653 return undef; # don't load this file/dir
654 }
655
656 Also, see "EXAMPLE USING is_local() AND load_as()".
657
658 EXAMPLE USING "is_local()" AND "load_as()"
659 For instance, instead of using "local.*" files, you may want to keep
660 versioned copies of local configs for different machines, and so
661 use:
662
663 app.yaml
664 app-(dev1.domain.com).yaml
665 app-(dev2.domain.com).yaml
666
667 You would implement this as follows:
668
669 my $config = Config::Merge->new(
670 path => '/path/to/config',
671
672 # If matches 'xxx-(yyy)'
673 is_local => sub {
674 my ( $self, $name ) = @_;
675 return $name=~/- [(] .+ [)]/x ? 1 : 0;
676 },
677
678 # If local and matches 'xxx-(hostname)', return xxx
679 load_as => sub {
680 my ( $self, $name, $is_local ) = @_;
681 if ($is_local) {
682 if ( $name=~/(.*) - [(] ($hostname) [)] /x ) {
683 return $1;
684 }
685 return undef;
686 }
687 return $name;
688 }
689 );
690
691 See "examples/advanced.pl" for a working illustration.
692
693 "sort()"
694 $c = Config::Merge->new(
695 path => '/path/to/config',
696 sort => sub {}
697 );
698
699 By default, directory entries are sorted alphabetically, with
700 directories before filenames.
701
702 This would be the order for these directory entries:
703
704 api/
705 api-(dev1)/
706 api.yaml
707 api-(dev1).yaml
708
709 To override this, you can subclass "sort()" or pass it in as a
710 parameter to new:
711
712 sub {
713 my ($self,$names_array_ref) = @_
714 ...sort...
715 return $names_array_ref;
716 }
717
718 "debug()"
719 my $config = Config::Merge->new(
720 path => '/path/to/config',
721 debug => 1 | 0
722 );
723
724 If "debug" is true, then Config::Merge prints out an explanation of
725 what it is doing on STDERR.
726
727 SEE ALSO
728 Storable, Config::Any, Config::Any::YAML, Config::Any::JSON,
729 Config::Any::INI, Config::Any::XML, Config::Any::General
730
731 THANKS
732 Thanks to Hasanuddin Tamir [HASANT] for vacating the Config::Merge
733 namespace, which allowed me to rename Config::Loader to the more
734 meaningful Config::Merge.
735
736 His version of Config::Merge can be found in
737 <http://backpan.cpan.org/modules/by-authors/id/H/HA/HASANT/>.
738
739 Thanks to Joel Bernstein and Brian Cassidy for the interface to the
740 various configuration modules. Also to Ewan Edwards for his suggestions
741 about how to make Config::Merge more flexible.
742
743 BUGS
744 No bugs have been reported.
745
746 Please report any bugs or feature requests to
747 bug-config-loader@rt.cpan.org, or through the web interface at
748 <http://rt.cpan.org>.
749
750 AUTHOR
751 Clinton Gormley, <clinton@traveljury.com>
752
753 COPYRIGHT
754 Copyright (C) 2007 by Clinton Gormley
755
756 LICENSE
757 This library is free software; you can redistribute it and/or modify it
758 under the same terms as Perl itself, either Perl version 5.8.7 or, at
759 your option, any later version of Perl 5 you may have available.
760
+46
-0
examples/README less more
0 Examples for Config::Merge
1 ===========================
2
3 There are four examples of the usage of Config::Merge:
4
5 1) 'oo.pl' and 'func.pl' illustrate the two ways of using Config::Merge
6 They dump the config data corresponding to the path you type in.
7
8 To run them, try this:
9
10 perl oo.pl
11 perl oo.pl app.images
12 perl oo.pl app.html_filter.BanAllBut
13 perl oo.pl app.html_filter.BanAllBut.2
14
15 OR
16
17 perl func.pl
18 perl func.pl app.images
19 perl func.pl app.html_filter.BanAllBut
20 perl func.pl app.html_filter.BanAllBut.2
21
22 You need to have YAML::Syck or YAML installed to use these examples
23
24 2) 'browser.pl' allows you to compare the data between a production environment
25 and a development environment. The only difference between the data is
26 the 'local.yaml' file in 'config_dev/local.yaml'
27
28 To try it, type:
29 perl browser.pl
30 OR perl browser.pl debug
31
32 Then enter the path to the data you want (eg 'app.images.path')
33 or you can just press Enter to start.
34
35 You need to have Term::ReadLine and YAML::Syck or YAML installed to use
36 this example
37
38
39 3) 'advanced.pl' illustrates how to define your own methods for is_local()
40 and load_as(). It shows the same config data for the production server
41 and for the machines 'dev1' and 'dev2'
42
43 perl advanced.pl
44 OR perl advanced.pl debug
45
+14
-0
examples/advanced/app-(dev1).yaml less more
0 # Local overrides for machine 'dev1'
1
2 ---
3 root: /home/user/www/EXAMPLE
4 db:
5 host: DEV1.domain.com
6 utf8: ON
7 cron:
8 '!' :
9 '-' :
10 - 2
11 '+' :
12 - JOB5
13 1 : JOB1CHANGE
+10
-0
examples/advanced/app-(dev2).yaml less more
0 # Local overrides for machine 'dev2'
1 ---
2 db:
3 password: EASY
4
5 cron:
6 '!':
7 '+':
8 1 : JOB1NEW
9 5 : JOB5NEW
+14
-0
examples/advanced/app.yaml less more
0 # Global config file
1
2 ---
3 root: /srv/www/sites/example
4 db:
5 host: db.domain.com
6 username: prod
7 password: secret
8
9 cron:
10 - job1
11 - job2
12 - job3
13 - job4
+52
-0
examples/advanced.pl less more
0 #!/usr/bin/perl
1 use strict;
2 use warnings;
3 use blib;
4 use Config::Merge();
5 use File::Spec();
6
7 eval { require YAML::Syck; YAML::Syck->import(); 1 }
8 or eval { require YAML; YAML->import(); 1 }
9 or die "ERROR: "
10 . "YAML::Syck or YAML needs to be installed to use this example\n\n";
11
12 my $debug = shift @ARGV;
13
14 foreach my $hostname qw(main dev1 dev2) {
15 my $config = Config::Merge->new(
16 path => get_path('advanced'),
17 debug => $debug,
18
19 # If matches 'xxx-(yyy)'
20 is_local => sub {
21 my ($self,$name) = @_;
22 return $name=~/- [(] .+ [)]/x ? 1 : 0;
23 },
24
25 # If local and matches 'xxx-(hostname)', return xxx
26 load_as => sub {
27 my ($self,$name,$is_local) = @_;
28 if ($is_local) {
29 if ($name=~/(.*) - [(] ($hostname) [)] /x) {
30 return $1;
31 }
32 return undef;
33 }
34 return $name;
35 }
36 );
37 print "\nCONFIG FOR $hostname:\n".Dump(scalar $config->C());
38 }
39
40 #===================================
41 sub get_path {
42 #===================================
43 my ($vol,$path) = File::Spec->splitpath(
44 File::Spec->rel2abs($0)
45 );
46 $path = File::Spec->catdir(
47 File::Spec->splitdir($path),
48 ,@_
49 );
50 return File::Spec->catpath($vol,$path,'');
51 }
+93
-0
examples/browser.pl less more
0 #!/usr/bin/perl
1 use strict;
2 use warnings;
3 use blib;
4 use Config::Merge();
5 use File::Spec();
6
7 init();
8
9 my $debug = shift @ARGV;
10
11 my $prod = Config::Merge->new( path => get_path('config_prod') , debug => $debug);
12 my $dev = Config::Merge->new( path => get_path('config_dev') , debug => $debug);
13
14 my $term = Term::ReadLine->new('Browser');
15
16 while ( defined( my $path = $term->readline("Enter path:") ) ) {
17 last if $path eq 'q';
18 $term->addhistory($path);
19 print "\n";
20 dump_vals( 'Production Config', $prod, $path );
21 dump_vals( 'Dev Config', $dev, $path );
22 }
23
24 #===================================
25 sub dump_vals {
26 #===================================
27 my ( $title, $config, $path ) = @_;
28 print "$title\n" . ( '-' x length($title) ) . "\n ";
29 my $vals = eval { scalar $config->($path) };
30 if ($@) {
31 print " -- PATH NOT FOUND --";
32 }
33 else {
34 if ( my $ref = ref $vals ) {
35 if ( $ref eq 'ARRAY' ) {
36 print "ARRAY: " . join( ', ', @$vals );
37 }
38 elsif ( $ref eq 'HASH' ) {
39 print "HASH KEYS: " . join( ', ', keys %$vals );
40 }
41 else {
42 print "$ref";
43 }
44 }
45 else {
46 print "SCALAR: $vals";
47 }
48 }
49 print "\n\n";
50 }
51
52 #===================================
53 sub get_path {
54 #===================================
55 my ($vol,$path) = File::Spec->splitpath(
56 File::Spec->rel2abs($0)
57 );
58 $path = File::Spec->catdir(
59 File::Spec->splitdir($path),
60 ,@_
61 );
62 return File::Spec->catpath($vol,$path,'');
63 }
64
65 #===================================
66 sub init {
67 #===================================
68
69 print <<USAGE;
70
71 This browser allows you to compare an example configuration tree
72 for production and development environments. The only difference is
73 that development has a 'local.yaml' file.
74
75 Type in the path of the value you would like to see, eg: app.images.path
76 Try just pressing Enter to start.
77
78 'q' to quit
79
80 USAGE
81
82 eval { require Term::ReadLine }
83 or die "ERROR: "
84 . "Term::ReadLine needs to be installed to use this example browser\n\n";
85
86 eval { require YAML::Syck }
87 or eval { require YAML }
88 or die "ERROR: "
89 . "YAML::Syck or YAML needs to be installed to use this example browser\n\n"
90 ;
91
92 }
+20
-0
examples/config_dev/app/db.yaml less more
0 # Config file for database connections
1
2 ---
3 inactive_timeout: 30
4 connections:
5 default_settings:
6 driver: DBI:mysql
7 host: localhost
8 database: example
9 character_set: utf8
10 time_zone: +0:00
11 username: iannounce
12 password: SeCrEt
13 attributes:
14 RaiseError: 1
15 PrintError: 0
16 AutoCommit: 1
17 params:
18 mysql_connect_timeout: 5
19 mysql_client_found_rows: 1
+19
-0
examples/config_dev/app/html_filter.yaml less more
0 AllowHref: 0
1 AllowSrc: 1
2 AllowRelURL: 1
3 BanAllBut:
4 - blockquote
5 - br
6 - div
7 - em
8 - h1
9 - h2
10 - h3
11 - hr
12 - ol
13 - p
14 - span
15 - strong
16 - ul
17 - li
18 - img
+92
-0
examples/config_dev/app.yaml less more
0 # Global config file
1
2 ---
3 #=======================================================================
4 root: /srv/www/sites/example
5 #=======================================================================
6
7 #=======================================================================
8 webserver:
9 #=======================================================================
10 virtual_hosts:
11 - sites: example1 example2
12 http: *:80
13 https: *:443
14 aliases:
15 example1.co.uk: example1
16 example2.co.uk: examples
17 options:
18 name_virtual_host: 0
19 listen: 0
20
21 #=======================================================================
22 feed_parser:
23 #=======================================================================
24 incoming_dir: cron/feed/incoming
25 working_dir: cron/feed/working
26 archive_dir: cron/feed/archive
27 log_dir: cron/feed
28 send_user_emails: 0
29
30 #=======================================================================
31 images:
32 #=======================================================================
33 path: /var/images/
34 autolevels: 1
35 jpeg:
36 jpegquality: 80
37 large:
38 X: 600
39 Y: 600
40 medium:
41 X: 160
42 Y: 160
43 min_ratio: 0.5
44 small:
45 X: 100
46 Y: 100
47 min_ratio: 0.5
48
49 #=======================================================================
50 upload:
51 #=======================================================================
52 max_size:
53 total: 3500000
54 file: 2500000
55 types:
56 - image/bmp
57 - image/gif
58 - image/jpef
59 - image/jpeg
60 - image/pjpeg
61 - image/png
62 - image/pnm
63 - image/raw
64 - image/rgb
65 - image/tga
66 - image/tiff
67 path: /var/images/temp/
68 expiry: 900
69
70 #=======================================================================
71 search:
72 #=======================================================================
73 rows: 10
74 cache_pages: 3
75 show_pages: 9
76 expiry: 300
77
78 #=======================================================================
79 accounting:
80 #=======================================================================
81 vat_rate: 0.175
82 email:
83 to: john@example.com
84 from: jack@example.com
85 text: |
86 Please find attached this month's invoice for
87 hosting, plus a spreadsheet containing
88 a breakdown of your announcements.
89
90 temp_dir: cron/accounts/temp/
91 archive_dir: cron/accounts/archive/
+27
-0
examples/config_dev/forms/search.yaml less more
0 name: search
1 fields:
2 - keywords:
3 name:
4 en: Look for
5 type: text
6 min_length: 3
7 max_length: 150
8 - type:
9 name:
10 en: Search in
11 type: list
12 display: select
13 options: []
14 default: 'all_notices'
15 - source:
16 name:
17 en: Publication
18 type: list
19 display: select
20 options: ''
21 default: ''
22 - date_limit:
23 type: list
24 display: select
25 options: date_limit
26 default: 0
+24
-0
examples/config_dev/forms/user/edit.yaml less more
0 name: user_edit
1 fields:
2 - email:
3 name:
4 en: Email address
5 required: 1
6 default:
7 type: text
8 checks: email
9 max_length: 255
10 - firstname:
11 name:
12 en: First name
13 required: 1
14 type: text
15 checks: name
16 max_length: 100
17 - surname:
18 name:
19 en: Last name
20 required: 1
21 type: text
22 checks: name
23 max_length: 100
+10
-0
examples/config_dev/forms/user/forgotten.yaml less more
0 name: login
1 fields:
2 - email:
3 name:
4 en: Email address
5 required: 1
6 default:
7 type: text
8 checks: email
9 max_length: 255
+20
-0
examples/config_dev/forms/user/password.yaml less more
0 name: user_password
1 dependencies:
2 - equal: password password2
3 fields:
4 - password:
5 name:
6 en: Password
7 required: 1
8 type: password
9 checks:
10 min_length: 5
11 max_length: 25
12 - password2:
13 name:
14 en: Confirm password
15 required: 1
16 type: password
17 checks:
18 min_length: 5
19 max_length: 25
+23
-0
examples/config_dev/local.yaml less more
0 #=======================================================================
1 app:
2 #=======================================================================
3 webserver:
4 virtual_hosts:
5 - sites: example1
6 http: *:80
7 https: *:443
8 aliases:
9 localhost: example1
10 options:
11 name_virtual_host: 0
12 listen: 0
13 db:
14 connections:
15 default_settings:
16 host: localhost
17 password: LoCal
18
19 images:
20 path: /srv/www/sites/example/images/
21 upload:
22 path: /srv/www/sites/example/images/temp/
+20
-0
examples/config_prod/app/db.yaml less more
0 # Config file for database connections
1
2 ---
3 inactive_timeout: 30
4 connections:
5 default_settings:
6 driver: DBI:mysql
7 host: localhost
8 database: example
9 character_set: utf8
10 time_zone: +0:00
11 username: iannounce
12 password: SeCrEt
13 attributes:
14 RaiseError: 1
15 PrintError: 0
16 AutoCommit: 1
17 params:
18 mysql_connect_timeout: 5
19 mysql_client_found_rows: 1
+19
-0
examples/config_prod/app/html_filter.yaml less more
0 AllowHref: 0
1 AllowSrc: 1
2 AllowRelURL: 1
3 BanAllBut:
4 - blockquote
5 - br
6 - div
7 - em
8 - h1
9 - h2
10 - h3
11 - hr
12 - ol
13 - p
14 - span
15 - strong
16 - ul
17 - li
18 - img
+92
-0
examples/config_prod/app.yaml less more
0 # Global config file
1
2 ---
3 #=======================================================================
4 root: /srv/www/sites/example
5 #=======================================================================
6
7 #=======================================================================
8 webserver:
9 #=======================================================================
10 virtual_hosts:
11 - sites: example1 example2
12 http: *:80
13 https: *:443
14 aliases:
15 example1.co.uk: example1
16 example2.co.uk: examples
17 options:
18 name_virtual_host: 0
19 listen: 0
20
21 #=======================================================================
22 feed_parser:
23 #=======================================================================
24 incoming_dir: cron/feed/incoming
25 working_dir: cron/feed/working
26 archive_dir: cron/feed/archive
27 log_dir: cron/feed
28 send_user_emails: 0
29
30 #=======================================================================
31 images:
32 #=======================================================================
33 path: /var/images/
34 autolevels: 1
35 jpeg:
36 jpegquality: 80
37 large:
38 X: 600
39 Y: 600
40 medium:
41 X: 160
42 Y: 160
43 min_ratio: 0.5
44 small:
45 X: 100
46 Y: 100
47 min_ratio: 0.5
48
49 #=======================================================================
50 upload:
51 #=======================================================================
52 max_size:
53 total: 3500000
54 file: 2500000
55 types:
56 - image/bmp
57 - image/gif
58 - image/jpef
59 - image/jpeg
60 - image/pjpeg
61 - image/png
62 - image/pnm
63 - image/raw
64 - image/rgb
65 - image/tga
66 - image/tiff
67 path: /var/images/temp/
68 expiry: 900
69
70 #=======================================================================
71 search:
72 #=======================================================================
73 rows: 10
74 cache_pages: 3
75 show_pages: 9
76 expiry: 300
77
78 #=======================================================================
79 accounting:
80 #=======================================================================
81 vat_rate: 0.175
82 email:
83 to: john@example.com
84 from: jack@example.com
85 text: |
86 Please find attached this month's invoice for
87 hosting, plus a spreadsheet containing
88 a breakdown of your announcements.
89
90 temp_dir: cron/accounts/temp/
91 archive_dir: cron/accounts/archive/
+27
-0
examples/config_prod/forms/search.yaml less more
0 name: search
1 fields:
2 - keywords:
3 name:
4 en: Look for
5 type: text
6 min_length: 3
7 max_length: 150
8 - type:
9 name:
10 en: Search in
11 type: list
12 display: select
13 options: []
14 default: 'all_notices'
15 - source:
16 name:
17 en: Publication
18 type: list
19 display: select
20 options: ''
21 default: ''
22 - date_limit:
23 type: list
24 display: select
25 options: date_limit
26 default: 0
+24
-0
examples/config_prod/forms/user/edit.yaml less more
0 name: user_edit
1 fields:
2 - email:
3 name:
4 en: Email address
5 required: 1
6 default:
7 type: text
8 checks: email
9 max_length: 255
10 - firstname:
11 name:
12 en: First name
13 required: 1
14 type: text
15 checks: name
16 max_length: 100
17 - surname:
18 name:
19 en: Last name
20 required: 1
21 type: text
22 checks: name
23 max_length: 100
+10
-0
examples/config_prod/forms/user/forgotten.yaml less more
0 name: login
1 fields:
2 - email:
3 name:
4 en: Email address
5 required: 1
6 default:
7 type: text
8 checks: email
9 max_length: 255
+20
-0
examples/config_prod/forms/user/password.yaml less more
0 name: user_password
1 dependencies:
2 - equal: password password2
3 fields:
4 - password:
5 name:
6 en: Password
7 required: 1
8 type: password
9 checks:
10 min_length: 5
11 max_length: 25
12 - password2:
13 name:
14 en: Confirm password
15 required: 1
16 type: password
17 checks:
18 min_length: 5
19 max_length: 25
+38
-0
examples/func.pl less more
0 #!/usr/bin/perl
1 use strict;
2 use warnings;
3 use blib;
4 use File::Spec();
5 my $dir;
6
7 # Checks for YAML::Syck or YAML
8 # and finds the path for the config dir
9 BEGIN {
10 eval { require YAML::Syck; YAML::Syck->import(); 1 }
11 or eval { require YAML; YAML->import(); 1 }
12 or die "ERROR: "
13 . "YAML::Syck or YAML needs to be installed to use this example\n\n";
14
15 my ($vol,$path) = File::Spec->splitpath(
16 File::Spec->rel2abs($0)
17 );
18 $path = File::Spec->catdir(
19 File::Spec->splitdir($path),
20 ,'config_dev'
21 );
22 $dir = File::Spec->catpath($vol,$path,'');
23 }
24
25 # Set up the class My::Config
26 # Normally this would happen in a startup file
27 use Config::Merge( 'My::Config' => $dir );
28
29 # Import the sub My::Config::C
30 # You'd put this line into every module which needs access to the config data
31 use My::Config;
32
33 my $path = shift @ARGV || '';
34 my $data = C($path);
35
36 print Dump($data);
37
+31
-0
examples/oo.pl less more
0 #!/usr/bin/perl
1 use strict;
2 use warnings;
3 use blib;
4 use Config::Merge();
5 use File::Spec();
6
7 eval { require YAML::Syck; YAML::Syck->import(); 1 }
8 or eval { require YAML; YAML->import(); 1 }
9 or die "ERROR: "
10 . "YAML::Syck or YAML needs to be installed to use this example\n\n";
11
12 my $config = Config::Merge->new( get_path('config_dev') );
13 my $path = shift @ARGV || '';
14
15 my $data = $config->($path);
16
17 print Dump($data);
18
19 #===================================
20 sub get_path {
21 #===================================
22 my ($vol,$path) = File::Spec->splitpath(
23 File::Spec->rel2abs($0)
24 );
25 $path = File::Spec->catdir(
26 File::Spec->splitdir($path),
27 ,@_
28 );
29 return File::Spec->catpath($vol,$path,'');
30 }
+84
-0
lib/Config/Merge/Perl.pm less more
0 package Config::Merge::Perl;
1
2 use strict;
3 use warnings FATAL => 'all', NONFATAL => 'redefine';
4
5 =head1 NAME
6
7 Config::Merge::Perl - Load Perl config files
8
9 =head1 DESCRIPTION
10
11 Loads Perl files. Example:
12
13 {
14 name => 'TestApp',
15 'Controller::Foo' => {
16 foo => 'bar'
17 },
18 'Model::Baz' => {
19 qux => 'xyzzy'
20 }
21 }
22
23 Any error/warning in the file will throw a fatal error.
24
25 =head1 METHODS
26
27 =head2 extensions( )
28
29 return an array of valid extensions (C<pl>, C<perl>).
30
31 =cut
32
33 sub extensions {qw( pl perl );}
34
35 =head2 load( $file )
36
37 Attempts to load C<$file> as a Perl file.
38
39 =cut
40
41
42 sub load {
43 my $class = shift;
44 my $file = shift;
45 delete $INC{$file};
46 local ($^W) = 1;
47 local $SIG{__WARN__} = sub { die $_[0]};
48 require $file;
49 }
50
51 =head1 SEE ALSO
52
53 L<Config::Merge>
54
55 =head1 THANKS
56
57 Thanks to Joel Bernstein and Brian Cassidy for the original Config::Any::Perl
58 module
59
60 =head1 BUGS
61
62 None known
63
64 =head1 AUTHOR
65
66 Clinton Gormley, E<lt>clinton@traveljury.comE<gt>
67
68 =head1 COPYRIGHT
69
70 Copyright (C) 2007 by Clinton Gormley
71
72 =cut
73
74 =head1 LICENSE
75
76 This library is free software; you can redistribute it and/or modify
77 it under the same terms as Perl itself, either Perl version 5.8.7 or,
78 at your option, any later version of Perl 5 you may have available.
79
80
81 =cut
82
83 1;⏎
+1531
-0
lib/Config/Merge.pm less more
0 package Config::Merge;
1
2 use strict;
3 use warnings FATAL => 'all', NONFATAL => 'redefine';
4
5 use File::Spec();
6 use Storable();
7 use overload (
8 '&{}' => sub {
9 my $self = shift;
10 return sub { $self->C(@_) }
11 },
12 'fallback' => 1
13 );
14
15 use vars qw($VERSION);
16 $VERSION = '1.01';
17
18 =head1 NAME
19
20 Config::Merge - load a configuration directory tree containing
21 YAML, JSON, XML, Perl, INI or Config::General files
22
23 =head1 SYNOPSIS
24
25 OO style
26 -------------------------------------------------------
27 use Config::Merge();
28
29 my $config = Config::Merge->new('/path/to/config');
30
31 @hosts = $config->('db.hosts.session');
32 $hosts_ref = $config->('db.hosts.session');
33 @cloned_hosts = $config->clone('db.hosts.session');
34 -------------------------------------------------------
35
36 OR
37
38 Functional style
39 -------------------------------------------------------
40 # On startup
41 use Config::Merge('My::Config' => '/path/to/config');
42
43
44 # Then, in any module where you want to use the config
45 package My::Module;
46 use My::Config;
47
48 @hosts = C('db.hosts.sesssion');
49 $hosts_ref = C('db.hosts.sesssion');
50 @cloned_hosts = My::Config::clone('db.hosts.session');
51 $config = My::Config::object;
52 -------------------------------------------------------
53
54 ADVANCED USAGE
55
56 OO style
57 -------------------------------------------------------
58 my $config = Config::Merge->new(
59 path => '/path/to/config',
60 skip => sub {} | regex | {} ,
61 is_local => sub {} | regex | {} ,
62 load_as => sub {} | regex ,
63 sort => sub {} ,
64 debug => 1 | 0
65 );
66 -------------------------------------------------------
67
68 Functional style
69 -------------------------------------------------------
70 use Config::Merge(
71 'My::Config' => '/path/to/config',
72 {
73 skip => sub {} | regex | {} ,
74 is_local => sub {} | regex | {} ,
75 load_as => sub {} | regex ,
76 sort => sub {} ,
77 debug => 1 | 0
78 }
79 );
80
81 # Also, you can subclass these:
82
83 package My::Config;
84 sub skip {
85 ...
86 }
87
88 -------------------------------------------------------
89
90 =head1 DESCRIPTION
91
92 Config::Merge is a configuration module which has six goals:
93
94 =over
95
96 =item * Flexible storage
97
98 Store all configuration in your format(s) of choice (YAML, JSON, INI, XML, Perl,
99 Config::General / Apache-style config) broken down into individual files in
100 a configuration directory tree, for easy maintenance.
101 See L</"CONFIG TREE LAYOUT">
102
103 =item * Flexible access
104
105 Provide a simple, easy to read, concise way of accessing the configuration
106 values (similar to L<Template>). See L</"ACCESSING CONFIG DATA">
107
108 =item * Minimal maintenance
109
110 Specify the location of the configuration files only once per
111 application, so that it requires minimal effort to relocate.
112 See L</"USING Config::Merge">
113
114 =item * Easy to alter development environment
115
116 Provide a way for overriding configuration values on a development
117 machine, so that differences between the dev environment and
118 the live environment do not get copied over accidentally.
119 See L</"OVERRIDING CONFIG LOCALLY">
120
121 =item * Minimise memory use
122
123 Load all config at startup so that (eg in the mod_perl environment) the
124 data is shared between all child processes. See L</"MINIMISING MEMORY USE">
125
126 =item * Flexible implementation
127
128 You may want to use a different schema for your configuration files,
129 so you can pass in (or subclass) methods for determining how your
130 files are merged. See L</"ADVANCED USAGE">.
131
132 =back
133
134 =head1 USING C<Config::Merge>
135
136 There are two ways to use C<Config::Merge>:
137
138 =over
139
140 =item OO STYLE
141
142 use Config::Merge();
143 my $config = Config::Merge->new('/path/to/config');
144
145 @hosts = $config->('db.hosts.session');
146 $hosts_ref = $config->('db.hosts.session');
147 @cloned_hosts = $config->clone('db.hosts.session');
148
149 Also, see L</"ADVANCED USAGE">.
150
151 =item YOUR OWN CONFIG CLASS (functional style)
152
153 The following code:
154
155 # On startup
156 use Config::Merge('My::Config' => '/path/to/config');
157
158 =over
159
160 =item *
161
162 auto-generates the class C<My::Config>
163
164 =item *
165
166 loads the configuration data in C<'/path/to/config'>
167
168 =item *
169
170 creates the subs C<My::Config::C>, C<My::Config::clone>
171 and C<My::Config::object>.
172
173 =back
174
175 Then when you want your application to have access to your configuration data,
176 you add this (eg in your class C<My::Module>):
177
178 package My::Module;
179 use My::Config; # Note, no ()
180
181 This exports the sub C<C> into your current package, which allows you to
182 access your configuation data as follows:
183
184 @hosts = C('db.hosts.sesssion');
185 $hosts_ref = C('db.hosts.sesssion');
186 @cloned_hosts = My::Config::clone('db.hosts.session');
187 $config = My::Config::object;
188
189 =back
190
191 =head1 CONFIG TREE LAYOUT
192
193 Config::Merge reads the data from any number (and type) of config files
194 stored in a directory tree. File names and directory names are used as keys in
195 the configuration hash.
196
197 It uses file extensions to decide what type of data the file contains, so:
198
199 YAML : .yaml .yml
200 JSON : .json .jsn
201 XML : .xml
202 INI : .ini
203 Perl : .perl .pl
204 Config::General : .conf .cnf
205
206 When loading your config data, Config::Merge starts at the directory
207 specified at startup (see L</"USING Config::Merge">) and looks
208 through all the sub-directories for files ending in one of the above
209 extensions.
210
211 The name of the file or subdirectory is used as the first key. So:
212
213 global/
214 db.yaml:
215 username : admin
216 hosts:
217 - host1
218 - host2
219 password:
220 host1: password1
221 host2: password2
222
223 would be loaded as :
224
225 $Config = {
226 global => {
227 db => {
228 username => 'admin',
229 password => { host1 => 'password1', host2 => 'password2'},
230 hosts => ['host1','host2'],
231 }
232 }
233 }
234
235 Subdirectories are processed before the current directory, so
236 you can have a directory and a config file with the same name,
237 and the values will be merged into a single hash, so for
238 instance, you can have:
239
240 confdir:
241 syndication/
242 --data_types/
243 --traffic.yaml
244 --headlines.yaml
245 --data_types.ini
246 syndication.conf
247
248 The config items in syndication.conf will be added to (or overwrite)
249 the items loaded into the syndication namespace via the subdirectory
250 called syndication.
251
252 =head1 OVERRIDING CONFIG LOCALLY
253
254 The situation often arises where it is necessary to specify
255 different config values on different machines. For instance,
256 the database host on a dev machine may be different from the host
257 on the live application. Also, see L</"ADVANCED USAGE"> which
258 provides you with other means to merge local data.
259
260 Instead of changing this data during dev and then having to remember
261 to change it back before putting the new code live, we have a mechanism
262 for overriding config locally in a C<local.*> file and then, as long as
263 that file never gets uploaded to live, you are protected.
264
265 You can put a file called C<local.*> (where * is any of the recognised
266 extensions) in any sub-directory, and
267 the data in this file will be merged with the existing data.
268
269 Just make sure that the C<local.*> files are never checked into your live
270 code.
271
272 For instance, if we have:
273
274 confdir:
275 db.yaml
276 local.yaml
277
278 and db.yaml has :
279
280 connections:
281 default_settings:
282 host: localhost
283 table: abc
284 password: 123
285
286 And in local.yaml:
287
288 db:
289 connections:
290 default_settings:
291 password: 456
292
293 the resulting configuration will look like this:
294
295 db:
296 connections:
297 default_settings:
298 host: localhost
299 table: abc
300 password: 456
301
302 =head1 ACCESSING CONFIG DATA
303
304 All configuration data is loaded into a single hash, eg:
305
306 $config = {
307 db => {
308 hosts => {
309 session => ['host1','host2','host3'],
310 images => ['host1','host2','host3'],
311 etc...
312 }
313 }
314 }
315
316
317 If you want to access it via standard Perl dereferences, you can just ask
318 for the hash:
319
320 OO:
321 $data_ref = $config->();
322 $hosts_ref = $data_ref->{db}{hosts}{session};
323 $host_1 = $data_ref->{db}{hosts}{session}[0];
324
325 Functional:
326 $data_ref = C();
327 $hosts_ref = $data_ref->{db}{hosts}{session};
328 $host_1 = $data_ref->{db}{hosts}{session}[0];
329
330 However, C<Config::Merge> also provides an easy to read dot-notation in the
331 style of Template Toolkit: C<('key1.key2.keyn')>.
332
333 A key can be the key of a hash or the index of an array. The return value is
334 context sensitive, so if called in list context, a hash ref or array ref will
335 be dereferenced.
336
337 OO:
338 @hosts = $config->('db.hosts.session');
339 $hosts_ref = $config->('db.hosts.session');
340 $host_1 = $config->('db.hosts.session.0');
341
342 Functional:
343 @hosts = C('db.hosts.session');
344 $hosts_ref = C('db.hosts.session');
345 $host_1 = C('db.hosts.session.0');
346
347 These lookups are memo'ised, so lookups are fast.
348
349 If the specified key is not found, then an error is thrown.
350
351 =head1 MINIMISING MEMORY USE
352
353 The more configuration data you load, the more memory you use. In order to
354 keep the memory use as low as possible for mod_perl (or other forking
355 applications), the configuration data should be loaded at startup in the
356 parent process.
357
358 As long as the data is never changed by the children, the configuration hash
359 will be stored in shared memory, rather than there being a separate copy in each
360 child process.
361
362 (See L<http://search.cpan.org/~pgollucci/mod_perl-2.0.3/docs/user/performance/mpm.pod>)
363
364 =head1 METHODS
365
366 =over
367
368 =item C<new()>
369
370 $conf = Config::Merge->new($config_dir);
371
372 new() instantiates a config object, loads the config from
373 the directory specified, and returns the object.
374
375 =cut
376
377 #===================================
378 sub new {
379 #===================================
380 my $proto = shift;
381 my $class = ref $proto || $proto;
382
383 my $self = {};
384 bless( $self, $class );
385
386 my $params
387 = @_ > 1 ? {@_}
388 : ref $_[0] eq 'HASH' ? shift()
389 : { path => shift() };
390
391 # Emit debug messages
392 $self->{debug} = $params->{debug} ? 1 : 0;
393
394 die "Parameter 'sort' must be a coderef"
395 if exists $params->{sort} && ref $params->{sort} ne 'CODE';
396
397 # Setup callbacks
398 $self->_init_callback( $_, $params->{$_} )
399 foreach qw(skip is_local load_as sort);
400
401 my $path = $params->{path}
402 or die( "Configuration directory not specified when creating a new "
403 . "'$class' object" );
404
405 if ( $path && -d $path && -r _ ) {
406
407 $path =~ s|/?$|/|;
408 $self->{config_dir} = $path;
409 $self->load_config();
410
411 return $self;
412 }
413 else {
414 die("Configuration directory '$path' not readable when creating a new "
415 . "'$class' object" );
416 }
417 return $self;
418 }
419
420 =item C<C()>
421
422 $val = $config->C('key1.key2.keyn');
423 $val = $config->C('key1.key2.keyn',$hash_ref);
424
425 C<Config::Merge> objects are overloaded so that this also works:
426
427 $val = $config->('key1.key2.keyn');
428 $val = $config->('key1.key2.keyn',$hash_ref);
429
430 Or, if used in the functional style (see L</"USING Config::Merge">):
431
432 $val = C('key1.key2.keyn');
433 $val = C('key1.key2.keyn',$hash_ref);
434
435 C<key1> etc can be keys in a hash, or indexes of an array.
436
437 C<C('key1.key2.keyn')> returns everything from C<keyn> down,
438 so you can use the return value just as you would any normal Perl variable.
439
440 The return values are context-sensitive, so if called
441 in list context, an array ref or hash ref will be returned as lists.
442 Scalar values, code refs, regexes and blessed objects will always be returned
443 as themselves.
444
445 So for example:
446
447 $password = C('database.main.password');
448 $regex = C('database.main.password_regex');
449
450 @countries = C('lists.countries');
451 $countries_array_ref = C('lists.countries');
452
453 etc
454
455 If called with a hash ref as the second parameter, then that hash ref will be
456 examined, rather than the C<$config> data.
457
458 =cut
459
460 #===================================
461 sub C {
462 #===================================
463 my $self = shift;
464 my $path = shift;
465 $path = '' unless defined $path;
466
467 my ( $config, @keys );
468
469 # If a private hash is passed in use that
470 if (@_) {
471 $config = $_[0];
472 @keys = split( /\./, $path );
473 $config = $self->_walk_path( $config, 'PRIVATE', \@keys );
474 }
475
476 # Otherwise use the stored config data
477 else {
478
479 # Have we previously memoised this?
480 if ( exists $self->{_memo}->{$path} ) {
481 $config = ${ $self->{_memo}->{$path} };
482 }
483
484 # Not memoised, so get it manually
485 else {
486 $config = $self->{config};
487 (@keys) = split( /\./, $path );
488 $config = $self->_walk_path( $config, '', \@keys );
489 $self->{_memo}->{$path} = \$config;
490 }
491 }
492
493 return
494 wantarray && ref($config) eq 'HASH' ? %{$config}
495 : wantarray && ref($config) eq 'ARRAY' ? @{$config}
496 : $config;
497 }
498
499 #===================================
500 sub _walk_path {
501 #===================================
502 my $self = shift;
503 my ( $config, $key_path, $keys ) = @_;
504
505 foreach my $key (@$keys) {
506 next unless defined $key && length($key);
507 if ( ref $config eq 'ARRAY'
508 && $key =~ /^[0-9]+/
509 && exists $config->[$key] )
510 {
511 $config = $config->[$key];
512 $key_path .= '.' . $key;
513 next;
514 }
515 elsif ( ref $config eq 'HASH' && exists $config->{$key} ) {
516 $config = $config->{$key};
517 $key_path = $self->_join_key_path( $key_path, $key );
518 next;
519 }
520 die("Invalid key '$key' specified for '$key_path'\n");
521 }
522 return $config;
523 }
524
525 =item C<clone()>
526
527 This works exactly the same way as L</"C()"> but it performs a
528 deep clone of the data before returning it.
529
530 This means that the returned data can be changed without
531 affecting the data stored in the $conf object;
532
533 The data is deep cloned, using Storable, so the bigger the data, the more
534 performance hit. That said, Storable's dclone is very fast.
535
536 =cut
537
538 #===================================
539 sub clone {
540 #===================================
541 my $self = shift;
542 my $data = $self->Config::Merge::C(@_);
543 return Storable::dclone($data);
544 }
545
546 my @Builtin_Merges = qw(
547 Config::Any::YAML
548 Config::Any::General
549 Config::Any::XML
550 Config::Any::INI
551 Config::Any::JSON
552 Config::Merge::Perl
553 );
554
555 my %Module_For_Ext = ();
556 __PACKAGE__->register_loader($_) foreach @Builtin_Merges;
557
558 =item C<register_loader()>
559
560 Config::Merge->register_loader( 'Config::Merge::XYZ');
561
562 Config::Merge->register_loader( 'Config::Merge::XYZ' => 'xyz','xxx');
563
564 By default, C<Config::Merge> uses the C<Config::Any>
565 plugins to support YAML, JSON, INI, XML, Perl and Config::General configuration
566 files, using the standard file extensions to recognise the file type. (See
567 L</"CONFIG TREE LAYOUT">).
568
569 If you would like to change the handler for an extension (eg, you want C<.conf>
570 and C<.cnf> files to be treated as YAML), do the following:
571
572 Config::Merge->register_loader ('Config::Any::YAML' => 'conf', 'cnf');
573
574 If you would like to add a new config style, then your module should have two
575 methods: C<extensions()> (which returns a list of the extensions it handles),
576 and C<load()> which accepts the name of the file to load, and returns
577 a hash ref containing the data in the file. See L<Config::Any> for details.
578
579 Alternatively, you can specify the extensions when you load it:
580
581 Config::Merge->register_loader ('My::Merge' => 'conf', 'cnf');
582
583 =cut
584
585 #===================================
586 sub register_loader {
587 #===================================
588 my $class = shift;
589 my $loader = shift
590 or die "No loader class passed to register_loader()";
591 eval "require $loader"
592 or die $@;
593 my @extensions = @_ ? @_ : $loader->extensions;
594 foreach my $ext (@extensions) {
595 $Module_For_Ext{ lc($ext) } = $loader;
596 }
597 return;
598 }
599
600 =item C<load_config()>
601
602 $config->load_config();
603
604 Will reload the config files located in the directory specified at object
605 creation (see L</"new()">).
606
607 BEWARE : If you are using this in a mod_perl environment, you will lose the
608 benefit of shared memory by calling this in a child process
609 - each child will have its own copy of the data.
610 See L<MINIMISING MEMORY USE>.
611
612 Returns the config hash ref.
613
614 =cut
615
616 #===================================
617 sub load_config {
618 #===================================
619 my $self = shift;
620 $self->{_memo} = {};
621 $self->debug("Loading config data");
622 return $self->{config} = $self->_load_config() || {};
623 }
624
625 #===================================
626 sub _load_config {
627 #===================================
628 my $self = shift;
629 my $dir = shift || $self->{config_dir};
630 my $key_path = shift || '';
631 my $loading_local = shift;
632
633 my $config = {};
634
635 my @local;
636 my $config_files = $self->{sort}
637 ->( $self, [ glob( File::Spec->catfile( $dir, '*' ) ) ] );
638
639 my $is_local = $self->{is_local};
640 $self->debug( '', "Entering dir: $dir", '-' x ( length($dir) + 14 ) );
641
642 CONFIG_FILE:
643 foreach my $config_file (@$config_files) {
644 my ( $data, $name, $curr_key_path, $loader );
645
646 my $filename = ( File::Spec->splitpath($config_file) )[2];
647
648 # If it is a file
649 if ( -f $config_file ) {
650 $self->debug(" Found file : $config_file");
651
652 # Must have an extension
653 ( $name, my $ext ) = ( $filename =~ /(.+)[.]([^.]+)/ )
654 or $self->debug(" ... No extension") && next CONFIG_FILE;
655
656 # Must have an associated module
657 $loader = $Module_For_Ext{ lc $ext }
658 or $self->debug(" ... No loader") && next CONFIG_FILE;
659 }
660 elsif ( -d $config_file ) {
661 $self->debug(" Found dir : $config_file");
662 $name = $filename;
663 undef $loader;
664 }
665
666 # Anything else (eg symlink), skip
667 else {
668 next;
669 }
670
671 # If it is a local file/dir, process last
672 if ( !$loading_local && $is_local->( $self, $name ) ) {
673 $self->debug(" ... will merge later");
674 push @local, [ $loader, $config_file, $filename ];
675 next CONFIG_FILE;
676 }
677
678 # Find the key name from the filename
679 $name = $self->_load_as( $key_path, $name, $loading_local );
680 next CONFIG_FILE if not defined $name;
681
682 # loader = module name to load file, or undef for directory
683 $data
684 = $loader
685 ? $self->_load_config_file( $loader, $config_file )
686 : $self->_load_config( $config_file,
687 $self->_join_key_path( $key_path, $name ),
688 $loading_local );
689
690 next CONFIG_FILE unless defined $data;
691
692 # Merge keys if already exists
693 if ( exists $config->{$name}
694 && ref $config->{$name} eq 'HASH'
695 && ref $data eq 'HASH' )
696 {
697 $config->{$name}->{$_} = $data->{$_} foreach keys %$data;
698 }
699 else {
700 $config->{$name} = $data;
701 }
702 }
703
704 # Merge local config into main config
705 LOCAL_FILE:
706 foreach my $local_file (@local) {
707 my ( $loader, $config_file, $name ) = @$local_file;
708 $self->debug(" Merging file $config_file");
709 $name = $self->_load_as( $key_path, $name, 1 );
710 next LOCAL_FILE
711 unless defined $name;
712
713 my $data
714 = $loader
715 ? $self->_load_config_file( $loader, $config_file )
716 : $self->_load_config( $config_file, $key_path, 1 );
717
718 next LOCAL_FILE unless defined $data;
719
720 $config = $self->_merge_hash(
721 $config, $name
722 ? { $name => $data }
723 : $data
724 );
725 }
726
727 return keys %$config ? $config : undef;
728 }
729
730 #===================================
731 sub _load_as {
732 #===================================
733 my ( $self, $key_path, $name, $loading_local ) = @_;
734
735 # Find the key name from the filename
736 $name = $self->{load_as}->( $self, $name, $loading_local );
737 unless ( defined $name ) {
738 $self->debug(" ... Skipped by load_as()");
739 return;
740 }
741
742 die "load_as() cannot return '' when loading main config"
743 if !$loading_local && $name eq '';
744
745 my $curr_key_path = $self->_join_key_path( $key_path, $name );
746 $self->debug( " ... loading at : "
747 . ( length($curr_key_path) ? $curr_key_path : '.' ) );
748
749 if ( $self->{skip}->( $self, $curr_key_path ) ) {
750 $self->debug(" ... skipped by skip()");
751 return;
752 }
753 return $name;
754 }
755
756 #===================================
757 sub _join_key_path {
758 #===================================
759 my ( $self, $key_path, $name ) = @_;
760 return $key_path . '.' . $name if length($key_path);
761 return $name;
762 }
763
764 #===================================
765 sub _load_config_file {
766 #===================================
767 my $self = shift;
768 my ( $loader, $config_file ) = @_;
769 $self->debug(" ... with : $loader");
770 my $data;
771 eval {
772 my @data = $loader->load($config_file);
773 $data
774 = @data > 1
775 ? \@data
776 : $data[0];
777 };
778 if ($@) {
779 die( "Error loading config file $config_file:\n\n" . $@ );
780 }
781
782 return $data;
783 }
784
785 =item C<clear_cache()>
786
787 $config->clear_cache();
788
789 Config data is generally not supposed to be changed at runtime. However, if
790 you do make changes, you may get inconsistent results, because lookups are
791 cached.
792
793 For instance:
794
795 print $config->C('db.hosts.session'); # Caches this lookup
796 > "host1 host2 host3"
797
798 $data = $config->C('db.hosts');
799 $data->{session} = 123;
800
801 print $config->C('db.hosts.session'); # uses cached value
802 > "host1 host2 host3"
803
804 $config->clear_cache();
805 print $config->C('db.hosts.session'); # uses actual value
806 > "123"
807
808 =cut
809
810 #===================================
811 sub clear_cache {
812 #===================================
813 my $self = shift;
814 $self->{_memo} = {};
815 return;
816 }
817
818 =item C<import()>
819
820 C<import()> will normally be called automatically when you
821 C<use Config::Merge>. However, you may want to do this:
822
823 use Config::Merge();
824 Config::Merge->register_loader('My::Plugin' => 'ext');
825 Config::Merge->import('My::Config' => '/path/to/config/dir');
826
827 If called with two params: C<$config_class> and C<$config_dir>, it
828 generates the new class (which inherits from Config::Merge)
829 specified in C<$config_class>, creates a new
830 object of that class and creates 4 subs:
831
832 =over
833
834 =item C<C()>
835
836 As a function:
837 C('keys...')
838
839 is the equivalent of:
840 $config->C('keys...');
841
842 =item C<clone()>
843
844 As a function:
845 clone('keys...')
846
847 is the equivalent of:
848 $config->clone('keys...');
849
850 =item C<object()>
851
852 $config = My::Config->object();
853
854 Returns the C<$config> object,
855
856 =item C<import()>
857
858 When you use your generated config class, it exports the C<C()> sub into your
859 package:
860
861 use My::Config;
862 $hosts = C('db.hosts.session');
863
864 =back
865
866 =back
867
868 =cut
869
870 #===================================
871 sub import {
872 #===================================
873 my $caller_class = shift;
874 my ( $class, $dir ) = @_;
875 return
876 unless defined $class;
877
878 unless ( defined $dir ) {
879 $dir = $class;
880 $class = $caller_class;
881 }
882 if ( $class eq __PACKAGE__ ) {
883 die <<USAGE;
884
885 USAGE : use $class ('Your::Config' => '/path/to/config/dir' );
886
887 USAGE
888
889 }
890
891 my $inc_path = $class;
892 $inc_path =~ s{::}{/}g;
893 $inc_path .= '.pm';
894
895 no strict 'refs';
896 unless ( exists $INC{$inc_path} ) {
897 @{ $class . '::ISA' } = ($caller_class);
898 $INC{$inc_path} = 'Auto-inflated by ' . $caller_class;
899 }
900
901 my $params = @_ % 2 ? shift() : {@_};
902 $params->{path} = $dir;
903 my $config = $class->new(%$params);
904
905 # Export C, clone to the subclass
906 *{ $class . "::C" }
907 = sub { my $c = ref $_[0] ? shift : $config; return C( $c, @_ ) };
908 *{ $class . "::clone" } = sub {
909 my $c = ref $_[0] ? shift : $config;
910 return clone( $c, @_ );
911 };
912 *{ $class . "::object" } = sub { return $config };
913
914 # Create a new import sub in the subclass
915 *{ $class . "::import" } = eval '
916 sub {
917 my $callpkg = caller(0);
918 no strict \'refs\';
919 *{$callpkg."::C"} = \&' . $class . '::C;
920 }';
921
922 return;
923 }
924
925 #===================================
926 sub _merge_hash {
927 #===================================
928 my $self = shift;
929 my $config = shift;
930 my $local = shift;
931 KEY:
932 foreach my $key ( keys %$local ) {
933 if ( ref $local->{$key} eq 'HASH'
934 && exists $config->{$key} )
935 {
936 if ( ref $config->{$key} eq 'HASH' ) {
937 $self->debug(" ... entering hash : $key");
938 $config->{$key}
939 = $self->_merge_hash( $config->{$key}, $local->{$key} );
940 next KEY;
941 }
942 if ( ref $config->{$key} eq 'ARRAY'
943 && exists $local->{$key}{'!'}
944 && ref $local->{$key}{'!'} eq 'HASH' )
945 {
946 $self->_merge_array( $key, $config, $local );
947 next KEY;
948 }
949 }
950 $self->debug(" ... setting key : $key");
951 $config->{$key} = $local->{$key};
952 }
953 $self->debug(" ... leaving hash");
954 return $config;
955 }
956
957 =head1 ADVANCED USAGE
958
959 The items in the section allow you to customise how Config::Merge
960 loads your data. You may never need them.
961
962 You can:
963
964 =over
965
966 =item *
967
968 Override array values
969
970 =item *
971
972 Skip the loading of parts of your config tree
973
974 =item *
975
976 Specify which files / dirs are local
977
978 =item *
979
980 Specify how to translate a file / dir name into a key
981
982 =item *
983
984 Change order in which files are loaded
985
986 =item *
987
988 See debug output
989
990 =back
991
992 =over
993
994 =item Overriding array values
995
996 Overriding hash values is easy, however arrays are more complex.
997 it may be simpler to copy and paste and edit the array you want to
998 change locally.
999
1000 However, if your array is too long, and you want to make small changes,
1001 then you can use the following:
1002
1003 In the main config:
1004
1005 {
1006 cron => [qw( job1 job2 job3 job4)]
1007 }
1008
1009 In the local file
1010
1011 {
1012 cron => {
1013 '3' => 'newjob4', # changes 'job4' -> 'newjob4'
1014
1015 '!' => { # signals an array override
1016
1017 '-' => [1], # deletes 'job2'
1018
1019 '+' => ['job5'], # appends 'job5'
1020
1021 OR '+' => { # inserts 'job3a' after 'job3'
1022 2 => 'job3a'
1023 }
1024 }
1025 }
1026
1027 =over
1028
1029 =item *
1030
1031 The override has to be a hash, with at least this structure
1032 C<< { '!' => {} } >> to signal an array override
1033
1034 =item *
1035
1036 Any other keys with integers are treated as indexes and
1037 are used to change the value at that index in the original array
1038
1039 =item *
1040
1041 The C<'-'> key should contain an array ref, with the indexes of the
1042 elements to remove from the array.
1043
1044 =item *
1045
1046 If the C<'+'> key contains an array ref, then its contents are appended
1047 to the original array.
1048
1049 =item *
1050
1051 If the C<'+'> key contains a hash ref, then each value is inserted
1052 into the original array at the index given in the key
1053
1054 =item *
1055
1056 Indexes are zero based, just as in Perl.
1057
1058 =back
1059
1060 =cut
1061
1062 #===================================
1063 sub _merge_array {
1064 #===================================
1065 my ( $self, $key, $config, $local ) = @_;
1066 $self->debug(" ... merging array : $key");
1067 my $dest = $config->{$key};
1068 my $merge = $local->{$key};
1069 my $changes = delete $merge->{'!'};
1070
1071 # Changed elements
1072 foreach my $index ( keys %$merge ) {
1073 $index = '' if !defined $index;
1074 die "Array override for key '$key' : '$index' is not an integer"
1075 unless $index =~ /^\d+$/;
1076 $dest->[$index] = $merge->{$index};
1077 $self->debug(" ... changing index : $index");
1078 }
1079
1080 my %actions;
1081
1082 # Deleted elements
1083 my $remove = $changes->{'-'} || [];
1084 die "Index delete for key '$key' : '-' is not an array ref"
1085 unless ref $remove eq 'ARRAY';
1086
1087 foreach my $delete_index (@$remove) {
1088 next unless $delete_index =~ /^\d+/;
1089 $actions{$delete_index} = ['-']
1090 if $delete_index < @$dest;
1091 }
1092
1093 # Added elements
1094 my $add = $changes->{'+'} || [];
1095
1096 # Append
1097 if ( ref $add eq 'ARRAY' ) {
1098 if (@$add) {
1099 push @$dest, @$add;
1100 $self->debug(
1101 ' ... appending ' . ( scalar @$add ) . ' element(s)' );
1102 }
1103 }
1104
1105 # Insert
1106 elsif ( ref $add eq 'HASH' ) {
1107 foreach my $add_index ( keys %$add ) {
1108 next unless $add_index =~ /^\d+/;
1109 $actions{$add_index} = [
1110 ( exists $actions{$add_index} || $add_index >= @$dest )
1111 ? '~'
1112 : '+',
1113 $add->{$add_index}
1114 ];
1115 }
1116
1117 }
1118 else {
1119 die "Array add for key '$key' : '+' is not an array or hash ref";
1120 }
1121
1122 foreach my $index ( sort { $b <=> $a } keys %actions ) {
1123 my ( $action, $value ) = @{ $actions{$index} };
1124 if ( $action eq '-' ) {
1125 splice( @$dest, $index, 1 );
1126 $self->debug(" ... deleting index : $index");
1127 next;
1128 }
1129 if ( $action eq '~' ) {
1130 $dest->[$index] = $value;
1131 $self->debug(" ... changing index : $index");
1132 next;
1133 }
1134 splice( @$dest, $index, 0, $value );
1135 $self->debug(" ... inserting index : $index");
1136 }
1137 return;
1138 }
1139
1140 =item C<skip()>
1141
1142 $c = Config::Merge->new(
1143 path => '/path/to/config',
1144 skip => qr/regex/,
1145 | [ qr/regex1/, qr/regex2/...]
1146 | { name1 => 1, name2 => 2}
1147 | sub {}
1148 );
1149
1150 C<skip()> allows you to skip the loading of parts of your config
1151 tree. For instance, if you don't need a list of cron jobs when running
1152 your web server, you can skip it.
1153
1154 The decision is made based on the path to that value, eg 'app.db.hosts'
1155 rather than on filenames. Also, the check is only performed for each
1156 new directory or filename - it doesn't check the data within each file.
1157
1158 To use C<skip()>, you can either subclass it, or pass in a parameter
1159 to new:
1160
1161 =over
1162
1163 =item C<qr/regex/> or C<[qr/regex1/, qr/regex2]>
1164
1165 Each regex will be checked against the key path, and if it matches
1166 then the loading of that tree will be skipped
1167
1168 =item C<< {key_path => 1} >>
1169
1170 If the key path exists in the hash, then loading will be skipped
1171
1172 =item C<sub {}> or subclassed C<skip>
1173
1174 sub {
1175 my ($self,$key_path) = @_;
1176 ...make decision...
1177 return 1 | 0;
1178 }
1179
1180 =back
1181
1182 =cut
1183
1184 #===================================
1185 sub skip {
1186 #===================================
1187 return;
1188 }
1189
1190 =item C<is_local()>
1191
1192 $c = Config::Merge->new(
1193 path => '/path/to/config',
1194 is_local => qr/regex/,
1195 | [ qr/regex1/, qr/regex2/...]
1196 | { name1 => 1, name2 => 2}
1197 | sub {}
1198 );
1199
1200 C<is_local()> indicates whether a file or dir should be considered
1201 part of the main config (and thus loaded normally) or part of the
1202 local config (and thus merged into the main config).
1203
1204 The decision is made based on the name of the file / dir, without
1205 any extension.
1206
1207 To use C<is_local()>, you can either subclass it, or pass in a parameter
1208 to new:
1209
1210 =over
1211
1212 =item C<qr/regex/> or C<[qr/regex1/, qr/regex2]>
1213
1214 Each regex will be checked against the file/dir name, and if it matches
1215 then that tree will be merged
1216
1217 =item C<< {filename => 1, dirname => 1} >>
1218
1219 If the file/dir name exists in the hash, then that tree will be merged
1220
1221 =item C<sub {}> or subclassed C<is_local>
1222
1223 sub {
1224 my ($self,$name) = @_;
1225 ...make decision...
1226 return 1 | 0;
1227 }
1228
1229 =back
1230
1231 See L</"EXAMPLE USING is_local() AND load_as()">.
1232
1233 =cut
1234
1235 #===================================
1236 sub is_local {
1237 #===================================
1238 my ( $self, $filename ) = @_;
1239 return $filename =~ /^local\b/;
1240 }
1241
1242 =item C<load_as()>
1243
1244 $c = Config::Merge->new(
1245 path => '/path/to/config',
1246 load_as => qr/(regex)/,
1247 | sub {}
1248 );
1249
1250 C<load_as()> returns the name of the key to use when loading
1251 the file / dir. By default, it returns the C<$name> for main
1252 config files, or C<''> for local files.
1253
1254 The decision is made based on the name of the file / dir, without
1255 any extension.
1256
1257 If C<load_as()> returns an empty string, then each key in the file/tree
1258 is merged separately. This is how the C<local.*> files work by default.
1259 See L</"OVERRIDING CONFIG LOCALLY">.
1260
1261 For instance:
1262
1263 main.yaml:
1264 key1: value
1265 key2: value
1266
1267 db.yaml:
1268 key3: value
1269 key4: value
1270
1271 local.yaml:
1272 main:
1273 key1: new_value
1274 db:
1275 key4: new_value
1276
1277 To use C<load_as()>, you can either subclass it, or pass in a parameter
1278 to new:
1279
1280 =over
1281
1282 =item C<qr/(regex)/>
1283
1284 The regex will be checked against the file/dir name, and if it matches
1285 then it returns the string captured in the regex, otherwise it returns
1286 the original name.
1287
1288 =item C<sub {}> or subclassed C<is_local>
1289
1290 sub {
1291 my ($self,$name,$is_local) = @_;
1292 ...make decision...
1293 return 'string'; # string is used as the keyname
1294 return ''; # acts like local.* (see above)
1295 return undef; # don't load this file/dir
1296 }
1297
1298 =back
1299
1300 Also, see L</"EXAMPLE USING is_local() AND load_as()">.
1301
1302 =cut
1303
1304 #===================================
1305 sub load_as {
1306 #===================================
1307 my ( $self, $filename, $local ) = @_;
1308 return $local ? '' : $filename;
1309 }
1310
1311 my %callbacks = (
1312 CODE => \&_init_code_callback,
1313 HASH => \&_init_hash_callback,
1314 ARRAY => \&_init_array_callback,
1315 );
1316
1317 =item EXAMPLE USING C<is_local()> AND C<load_as()>
1318
1319 For instance, instead of using C<local.*> files, you may want to
1320 keep versioned copies of local configs for different machines, and so use:
1321
1322 app.yaml
1323 app-(dev1.domain.com).yaml
1324 app-(dev2.domain.com).yaml
1325
1326 You would implement this as follows:
1327
1328 my $config = Config::Merge->new(
1329 path => '/path/to/config',
1330
1331 # If matches 'xxx-(yyy)'
1332 is_local => sub {
1333 my ( $self, $name ) = @_;
1334 return $name=~/- [(] .+ [)]/x ? 1 : 0;
1335 },
1336
1337 # If local and matches 'xxx-(hostname)', return xxx
1338 load_as => sub {
1339 my ( $self, $name, $is_local ) = @_;
1340 if ($is_local) {
1341 if ( $name=~/(.*) - [(] ($hostname) [)] /x ) {
1342 return $1;
1343 }
1344 return undef;
1345 }
1346 return $name;
1347 }
1348 );
1349
1350 See C<examples/advanced.pl> for a working illustration.
1351
1352 =item C<sort()>
1353
1354 $c = Config::Merge->new(
1355 path => '/path/to/config',
1356 sort => sub {}
1357 );
1358
1359 By default, directory entries are sorted alphabetically, with
1360 directories before filenames.
1361
1362 This would be the order for these directory entries:
1363
1364 api/
1365 api-(dev1)/
1366 api.yaml
1367 api-(dev1).yaml
1368
1369 To override this, you can subclass C<sort()> or pass it in as a
1370 parameter to new:
1371
1372 sub {
1373 my ($self,$names_array_ref) = @_
1374 ...sort...
1375 return $names_array_ref;
1376 }
1377
1378 =cut
1379
1380 #===================================
1381 sub sort {
1382 #===================================
1383 my ( $self, $names ) = @_;
1384 s/[.]([^.]+$)/ .$1/ foreach @$names;
1385 $names = [ sort { $a cmp $b } @$names ];
1386 s/ [.]([^.]+$)/.$1/ foreach @$names;
1387 return $names;
1388 }
1389
1390 =item C<debug()>
1391
1392 my $config = Config::Merge->new(
1393 path => '/path/to/config',
1394 debug => 1 | 0
1395 );
1396
1397 If C<debug> is true, then Config::Merge prints out an explanation
1398 of what it is doing on STDERR.
1399
1400 =back
1401
1402 =cut
1403
1404 #===================================
1405 sub debug {
1406 #===================================
1407 my $self = shift;
1408 print STDERR ( join( "\n", @_, '' ) )
1409 if $self->{debug};
1410 return 1;
1411 }
1412
1413 #===================================
1414 sub _init_callback {
1415 #===================================
1416 my ( $self, $callback, $check ) = @_;
1417
1418 # If nothing set, use default or subclassed version
1419 unless ($check) {
1420 $self->{$callback} = $self->can($callback);
1421 $self->debug("Using default or subclassed $callback()");
1422 return;
1423 }
1424
1425 $check = [$check]
1426 unless exists $callbacks{ ref $check };
1427
1428 $self->debug( 'Using ' . ( ref $check ) . " handler for $callback()" );
1429
1430 $self->{$callback} = $callbacks{ ref $check }->( $check, $callback );
1431 return;
1432 }
1433
1434 #===================================
1435 sub _init_code_callback {
1436 #===================================
1437 return $_[0];
1438 }
1439
1440 #===================================
1441 sub _init_hash_callback {
1442 #===================================
1443 my ( $check, $callback ) = @_;
1444 die "load_as() cannot be a hashref"
1445 if $callback eq 'load_as';
1446 return sub {
1447 my $self = shift;
1448 my $param = shift;
1449 return exists $check->{$param};
1450 };
1451 }
1452
1453 #===================================
1454 sub _init_array_callback {
1455 #===================================
1456 my ( $check, $callback ) = @_;
1457 if ( $callback eq 'load_as' ) {
1458 die "load_as() must contain a single regex"
1459 unless @$check == 1;
1460 my $regex = $check->[0];
1461 return sub {
1462 my $self = shift;
1463 my $filename = shift;
1464 return $filename =~ m/$regex/
1465 ? $1
1466 : $filename;
1467 };
1468 }
1469
1470 foreach my $value (@$check) {
1471 $value ||= '';
1472 die "'$value' is not a regular expression"
1473 unless ref $value eq 'Regexp';
1474 }
1475 return sub {
1476 my $self = shift;
1477 my $value = shift;
1478 foreach my $regex (@$check) {
1479 return 1 if $value =~ m/$regex/;
1480 }
1481 return 0;
1482 };
1483 }
1484
1485 =head1 SEE ALSO
1486
1487 L<Storable>, L<Config::Any>, L<Config::Any::YAML>,
1488 L<Config::Any::JSON>, L<Config::Any::INI>, L<Config::Any::XML>,
1489 L<Config::Any::General>
1490
1491 =head1 THANKS
1492
1493 Thanks to Hasanuddin Tamir [HASANT] for vacating the Config::Merge namespace,
1494 which allowed me to rename Config::Loader to the more meaningful Config::Merge.
1495
1496 His version of Config::Merge can be found in
1497 L<http://backpan.cpan.org/modules/by-authors/id/H/HA/HASANT/>.
1498
1499 Thanks to Joel Bernstein and Brian Cassidy for the interface to the various
1500 configuration modules. Also to Ewan Edwards for his suggestions about how
1501 to make Config::Merge more flexible.
1502
1503 =head1 BUGS
1504
1505 No bugs have been reported.
1506
1507 Please report any bugs or feature requests to
1508 L<http://github.com/clintongormley/ConfigMerge/issues>.
1509
1510 =head1 AUTHOR
1511
1512 Clinton Gormley, E<lt>clinton@traveljury.comE<gt>
1513
1514 =head1 COPYRIGHT
1515
1516 Copyright (C) 2007-2010 by Clinton Gormley
1517
1518 =cut
1519
1520 =head1 LICENSE
1521
1522 This library is free software; you can redistribute it and/or modify
1523 it under the same terms as Perl itself, either Perl version 5.8.7 or,
1524 at your option, any later version of Perl 5 you may have available.
1525
1526
1527 =cut
1528
1529 1
1530
+136
-0
t/10_oo.t less more
0 use strict;
1 use warnings FATAL => 'all', NONFATAL => 'redefine';
2
3 use File::Spec;
4 use Test::More 'tests' => 30;
5
6 BEGIN { use_ok('Config::Merge'); }
7
8 my $config;
9 ok( $config = Config::Merge->new( get_path('empty') ),
10 'OO - Load empty dir' );
11
12 ok( $config = Config::Merge->new( get_path('perl') ),
13 'OO - Load perl dir' );
14
15 is( $config->C('global.domain'),
16 'www.test.com',
17 'OO - Simple lookup' );
18
19 is( $config->('global.domain'),
20 'www.test.com',
21 'OO - Overload lookup' );
22
23 is_deeply( scalar $config->C('global.db.hosts.session'),
24 [qw(host1 host2 host3)],
25 'OO - Array ref lookup' );
26
27 is_deeply( [ $config->C('global.db.hosts.session') ],
28 [qw(host1 host2 host3)],
29 'OO - Array lookup' );
30
31 is( $config->C('global.db.hosts.image.1'),
32 'host5',
33 'OO - Array element lookup' );
34
35 ok( $config = Config::Merge->new( get_path('perlmulti') ),
36 'OO - Load perl dir' );
37
38 my @list;
39 ok( @list = $config->C('global.testsub'),
40 'OO - Retrieve code');
41 is( scalar @list,
42 1,
43 'OO - CODE ref list context');
44
45 is( ref $list[0],
46 'CODE',
47 'OO - CODE ref');
48
49 is( ref scalar $config->C('global.testsub'),
50 'CODE',
51 'OO - CODE ref scalar context');
52
53 ok( @list = $config->C('global.testregex'),
54 'OO - Retrieve regepx');
55 is( scalar @list,
56 1,
57 'OO - Regexp ref list context');
58
59 is( ref $list[0],
60 'Regexp',
61 'OO - Regexp ref');
62
63 is( ref scalar $config->C('global.testregex'),
64 'Regexp',
65 'OO - Regexp ref scalar context');
66
67 ok( @list = $config->C('global.testobj'),
68 'OO - Retrieve object');
69 is( scalar @list,
70 1,
71 'OO - Object list context');
72
73 is( ref $list[0],
74 'ABC',
75 'OO - Object ref');
76
77 is( ref scalar $config->C('global.testobj'),
78 'ABC',
79 'OO - Object scalar context');
80
81 is( $config->C('global.db.hosts.image.1'),
82 'host5',
83 'OO - Directory lookup' );
84
85 is( $config->C('global.db.hosts.image.1'),
86 'host5',
87 'OO - Directory lookup' );
88
89 is( defined eval{$config->C('global.db3.hosts.image.1')} ? 1 : 0,
90 0,
91 'OO - Directory lookup - fail overwritten' );
92
93 is( $config->C('global.db3.different'),
94 'data',
95 'OO - Directory lookup - succeed overwritten' );
96
97 is( $config->C('global.engine'),
98 'Oracle',
99 'OO - Local override' );
100
101 is( $config->C('global.db2.hosts.session.0'),
102 'local1',
103 'OO - Local override deep' );
104
105 $config->clear_cache();
106 my $data = $config->C('global.db.hosts');
107 $data->{session} = '123';
108 is( $config->C('global.db.hosts.session'),
109 '123',
110 'OO - Overwrite original' );
111
112 $data = $config->clone('global.db.hosts');
113 $data->{image} = '123';
114 isnt( $config->C('global.db.hosts.image'),
115 '123',
116 'OO - Overwrite clone' );
117
118 $config->load_config();
119 isnt( $config->C('global.db.hosts.session'),
120 '123',
121 'OO - Reload data' );
122
123
124 #===================================
125 sub get_path {
126 #===================================
127 my ($vol,$path) = File::Spec->splitpath(
128 File::Spec->rel2abs($0)
129 );
130 $path = File::Spec->catdir(
131 File::Spec->splitdir($path),
132 'data',@_
133 );
134 return File::Spec->catpath($vol,$path,'');
135 }
+145
-0
t/20_functional.t less more
0 use strict;
1 use warnings;
2
3 use File::Spec;
4 use Test::More 'tests' => 31;
5
6 my $path;
7 BEGIN {
8 my $vol;
9 ($vol,$path) = File::Spec->splitpath(
10 File::Spec->rel2abs($0)
11 );
12 $path = File::Spec->catdir(
13 File::Spec->splitdir($path),
14 'data','perlmulti'
15 );
16 $path = File::Spec->catpath($vol,$path,'');
17 }
18
19 BEGIN { use_ok('Config::Merge', 'My' => $path); }
20 BEGIN { use_ok('My'); }
21
22 is( C('global.domain'),
23 'www.test.com',
24 'Func - Simple lookup' );
25
26 is_deeply( scalar C('global.db.hosts.session'),
27 [qw(host1 host2 host3)],
28 'Func - Array ref lookup' );
29
30 is_deeply( [ C('global.db.hosts.session') ],
31 [qw(host1 host2 host3)],
32 'Func - Array lookup' );
33
34 is( C('global.db.hosts.image.1'),
35 'host5',
36 'Func - Array element lookup' );
37
38 my @list;
39 ok( @list = C('global.testsub'),
40 'Func - Retrieve coderef');
41 is( scalar @list,
42 1,
43 'Func - CODE ref list context');
44
45 is( ref $list[0],
46 'CODE',
47 'Func - CODE ref');
48
49 is( ref scalar C('global.testsub'),
50 'CODE',
51 'Func - CODE ref scalar context');
52
53 ok( @list = C('global.testregex'),
54 'Func - Retrieve regexp');
55 is( scalar @list,
56 1,
57 'Func - Regexp ref list context');
58
59 is( ref $list[0],
60 'Regexp',
61 'Func - Regexp ref');
62
63 is( ref scalar C('global.testregex'),
64 'Regexp',
65 'Func - Regexp ref scalar context');
66
67 ok( @list = C('global.testobj'),
68 'Func - Retrieve object');
69 is( scalar @list,
70 1,
71 'Func - Object list context');
72
73 is( ref $list[0],
74 'ABC',
75 'Func - Object ref');
76
77 is( ref scalar C('global.testobj'),
78 'ABC',
79 'Func - Object scalar context');
80
81 is( C('global.db.hosts.image.1'),
82 'host5',
83 'Func - Directory lookup' );
84
85 is( defined eval{C('global.db3.hosts.image.1')} ? 1 : 0,
86 0,
87 'Func - Directory lookup - fail overwritten' );
88
89 is( C('global.db3.different'),
90 'data',
91 'Func - Directory lookup - succeed overwritten' );
92
93 is( C('global.engine'),
94 'Oracle',
95 'Func - Local override' );
96
97 is( C('global.db2.hosts.session.0'),
98 'local1',
99 'Func - Local override deep' );
100
101 my $config = My->object();
102 is( $config->C('global.domain'),
103 'www.test.com',
104 'Func - object->C lookup' );
105
106 is( $config->('global.domain'),
107 'www.test.com',
108 'Func - overload lookup' );
109
110 $config->clear_cache();
111
112 my $data = C('global.db.hosts');
113 $data->{session} = '123';
114 is( C('global.db.hosts.session'),
115 '123',
116 'Func - Overwrite original' );
117
118 $data = My::clone('global.db.hosts');
119 $data->{image} = '123';
120 isnt( C('global.db.hosts.image'),
121 '123',
122 'Func - Overwrite clone' );
123
124 My::object->load_config();
125 isnt( C('global.db.hosts.session'),
126 '123',
127 'Func - Reload data' );
128
129 is ($config,
130 My::object(),
131 'Func - reload object same');
132
133 $config->clear_cache();
134 $data = $config->C('global.db.hosts');
135 $data->{session} = '123';
136 is( $config->C('global.db.hosts.session'),
137 '123',
138 'Func - Object overwrite original' );
139
140 $data = $config->clone('global.db.hosts');
141 $data->{image} = '123';
142 isnt( $config->C('global.db.hosts.image'),
143 '123',
144 'Func - Object overwrite clone' );
+101
-0
t/30_errors.t less more
0 use strict;
1 use warnings;
2
3 use File::Spec;
4 use Test::More 'tests' => 17;
5
6 BEGIN { use_ok('Config::Merge'); }
7
8 my $config;
9
10 eval { $config = Config::Merge->new()};
11 like( $@,
12 qr/Configuration directory not specified/,
13 'New - no directory' );
14
15 eval { $config = Config::Merge->new(get_path('none'))};
16 like( $@,
17 qr/not readable/,
18 'New - directory not readable' );
19
20 eval { $config = Config::Merge->new(get_path('bad'))};
21 like( $@,
22 qr/Error loading config/,
23 'New - Error loading config' );
24
25 $config = Config::Merge->new(get_path('perl'));
26 eval { $config->('global.nonexistent')};
27 like( $@,
28 qr/Invalid key/,
29 'Invalid key' );
30
31 eval {Config::Merge->register_loader()};
32 like( $@,
33 qr/No loader class/,
34 'No loader class' );
35
36 eval {Config::Merge->register_loader('Config::Merge::None')};
37 like( $@,
38 qr{Can't locate Config/Merge/None.pm},
39 'Bad loader class' );
40
41 eval {Config::Merge->import(get_path('perl'))};
42 like( $@,
43 qr{USAGE},
44 'Bad import' );
45
46 eval { $config = Config::Merge->new(path => get_path('perl'), load_as => sub {return ''})};
47 like( $@,
48 qr/load_as\(\) cannot return ''/,
49 "New - main load_as '' " );
50
51 eval { $config = Config::Merge->new(path => get_path('errors','array_merge'))};
52 like( $@,
53 qr/Array override for key/,
54 "Array override" );
55
56 eval { $config = Config::Merge->new(path => get_path('errors','array_delete_ref'))};
57 like( $@,
58 qr/Index delete.*array ref/,
59 "Array delete ref" );
60
61 ok ($config = Config::Merge->new(path => get_path('errors','array_delete_int')),
62 'Array delete int'
63 );
64
65 eval { $config = Config::Merge->new(path => get_path('errors','array_insert_ref'))};
66 like( $@,
67 qr/Array add .*ref/,
68 "Array insert ref" );
69
70 ok ($config = Config::Merge->new(path => get_path('errors','array_insert_int')),
71 'Array insert int'
72 );
73
74 eval { $config = Config::Merge->new(path => get_path('empty'), load_as =>{})};
75 like( $@,
76 qr/load_as\(\) cannot be a hashref/,
77 "Load_as hash ref" );
78
79 eval { $config = Config::Merge->new(path => get_path('empty'), load_as => [])};
80 like( $@,
81 qr/single regex/,
82 "Load_as array ref" );
83
84 eval { $config = Config::Merge->new(path => get_path('empty'), is_local => 'abc')};
85 like( $@,
86 qr/not a regular expression/,
87 "Not regex" );
88
89 #===================================
90 sub get_path {
91 #===================================
92 my ($vol,$path) = File::Spec->splitpath(
93 File::Spec->rel2abs($0)
94 );
95 $path = File::Spec->catdir(
96 File::Spec->splitdir($path),
97 'data',@_
98 );
99 return File::Spec->catpath($vol,$path,'');
100 }
+434
-0
t/40_advanced.t less more
0 use strict;
1 use warnings;
2
3 use File::Spec;
4 use Test::More 'tests' => 80;
5
6 BEGIN { use_ok('Config::Merge'); }
7
8 my ($c,$C);
9
10 my $path = get_path('skip');
11
12 ## SKIP
13
14 ok($c = Config::Merge->new(path => $path, skip => qr{skip_\d}),
15 'new - skip - regex'
16 );
17 $C=$c->();
18
19 ok( exists $C->{skip_not},
20 'skip - dir - regex - 1'
21 );
22
23 ok( ! exists $C->{skip_1},
24 'skip - dir - regex - 2'
25 );
26
27 ok( exists $C->{main}{skip_not},
28 'skip - file - regex - 1'
29 );
30
31 ok(! exists $C->{main}{skip_1},
32 'skip - file - regex - 2'
33 );
34
35 ok($c = Config::Merge->new(path => $path, skip => [qr{skip_1}, qr{skip_2}]),
36 'new - skip - regexen'
37 );
38 $C=$c->();
39
40 ok( exists $C->{skip_not},
41 'skip - dir - regexen - 1'
42 );
43
44 ok( ! exists $C->{skip_1},
45 'skip - dir - regexen - 2'
46 );
47
48 ok( exists $C->{main}{skip_not},
49 'skip - file - regexen - 1'
50 );
51
52 ok(! exists $C->{main}{skip_1},
53 'skip - file - regexen - 2'
54 );
55
56 ok($c = Config::Merge->new(path => $path, skip => {'skip_1' => 1,'main.skip_1' => 1}),
57 'new - skip - hash'
58 );
59 $C=$c->();
60
61 ok( exists $C->{skip_not},
62 'skip - dir - hash - 1'
63 );
64
65 ok( ! exists $C->{skip_1},
66 'skip - dir - hash - 2'
67 );
68
69 ok( exists $C->{main}{skip_not},
70 'skip - file - hash - 1'
71 );
72
73 ok(! exists $C->{main}{skip_1},
74 'skip - file - hash - 2'
75 );
76
77 ok($c = Config::Merge->new(path => $path, skip => sub {
78 my ($self,$filename) = @_;
79 return 1 if $filename=~/skip_1/;
80 return 0;
81 }),
82 'new - skip - sub'
83 );
84 $C=$c->();
85
86 ok( exists $C->{skip_not},
87 'skip - dir - sub - 1'
88 );
89
90 ok( ! exists $C->{skip_1},
91 'skip - dir - sub - 2'
92 );
93
94 ok( exists $C->{main}{skip_not},
95 'skip - file - sub - 1'
96 );
97
98 ok(! exists $C->{main}{skip_1},
99 'skip - file - sub - 2'
100 );
101
102 ## LOAD_AS for main config
103 $path = get_path('load_as');
104
105 ok($c = Config::Merge->new(path => $path),
106 'new - main load_as - none'
107 );
108
109 is($c->C('file.a'),
110 1,
111 'main load_as - none - 1'
112 );
113
114 is($c->C('file-(local).a'),
115 4,
116 'main load_as - none - 2'
117 );
118
119 is($c->C('dir.file.a'),
120 1,
121 'main load_as - none - 3'
122 );
123
124 is($c->C('dir-(local).file.a'),
125 4,
126 'main load_as - none - 4'
127 );
128
129 is($c->C('sub.test.foo'),
130 'test',
131 'main load_as - none - 5'
132 );
133
134 is($c->C('sub.test.bar'),
135 'test',
136 'main load_as - none - 6'
137 );
138
139 is($c->C('sub.test-(aaa).foo'),
140 'test-(aaa)',
141 'main load_as - none - 7'
142 );
143
144 is($c->C('sub.test-(bbb).foo'),
145 'test-(bbb)',
146 'main load_as - none - 8'
147 );
148
149 is($c->C('sub.dir.test.foo'),
150 'test',
151 'main load_as - none - 9'
152 );
153
154 is($c->C('sub.dir.test.bar'),
155 'test',
156 'main load_as - none - 10'
157 );
158
159 is($c->C('sub.dir-(aaa).test.foo'),
160 'test-(aaa)',
161 'main load_as - none - 11'
162 );
163
164 is($c->C('sub.dir-(bbb).test.foo'),
165 'test-(bbb)',
166 'main load_as - none - 12'
167 );
168
169 ok($c = Config::Merge->new(path => $path, load_as => qr/(.*)-\(local\)/),
170 'new - load_as - regex'
171 );
172 $C=$c->();
173
174 is($c->C('file.a'),
175 '4',
176 'load_as - regex - 1'
177 );
178
179 is($c->C('file.d'),
180 '5',
181 'load_as - regex - 2'
182 );
183
184 is($c->C('file.b'),
185 '2',
186 'load_as - regex - 3'
187 );
188
189 is($c->C('dir.file.a'),
190 '4',
191 'load_as - regex - 4'
192 );
193
194 is($c->C('dir.file.d'),
195 '5',
196 'load_as - regex - 5'
197 );
198
199 ok (!exists $C->{dir}{file}{b},
200 'load_as - regex - 6'
201 );
202
203 ok($c = Config::Merge->new(path => $path,
204 load_as => sub {
205 my ($self,$name) = @_;
206 if ($name=~/(.*)-[(](\w+)[)]/) {
207 return $2 eq 'aaa' ? $1 : undef;
208 }
209 return $name;
210 }),
211 'new - load_as - sub'
212 );
213 $C=$c->();
214
215 is($c->C('sub.test.foo'),
216 'test-(aaa)',
217 'load_as - sub - 1'
218 );
219
220 is($c->C('sub.test.bar'),
221 'test',
222 'load_as - sub - 2'
223 );
224
225 is($c->C('sub.dir.test.foo'),
226 'test-(aaa)',
227 'load_as - sub - 3'
228 );
229
230 ok (!exists $C->{sub}{dir}{test}{bar},
231 'load_as - sub - 4'
232 );
233
234 ok (!exists $C->{sub}{'test-(aaa)'},
235 'load_as - sub - 5'
236 );
237
238 ok (!exists $C->{sub}{'test-(bbb)'},
239 'load_as - sub - 6'
240 );
241
242 ok (!exists $C->{sub}{'dir-(aaa)'},
243 'load_as - sub - 7'
244 );
245
246 ok (!exists $C->{sub}{'dir-(bbb)'},
247 'load_as - sub - 7'
248 );
249
250 ## SORT
251 ok($c = Config::Merge->new(path => $path,
252 load_as => qr/(.*)-\(local\)/,
253 sort => sub {return [sort @{$_[1]}]}),
254 'new - load_as - regex'
255 );
256
257 is($c->C('file.a'),
258 '1',
259 'sort'
260 );
261
262 ## IS_LOCAL
263 $path=get_path('local');
264 ok($c = Config::Merge->new(path => $path),
265 'new - is_local - none'
266 );
267
268 is ($c->C('main.db.servers.server1.host'),
269 'host1',
270 'is_local - none - 1'
271 );
272
273 is ($c->C('main.db.servers.list.0'),
274 'server1',
275 'is_local - none - 2'
276 );
277
278 ok($c = Config::Merge->new(path => $path, is_local => qr{override}),
279 'new - is_local - regex - ..'
280 );
281
282 is ($c->C('main.db.servers.server1.host'),
283 'host4',
284 'is_local - regex - .. - 1'
285 );
286
287 is ($c->C('main.db.servers.list.0'),
288 'server3',
289 'is_local - regex - .. - 2'
290 );
291
292 ok($c = Config::Merge->new(path => $path, is_local => {override => 1}),
293 'new - is_local - hash - ..'
294 );
295
296 is ($c->C('main.db.servers.server1.host'),
297 'host4',
298 'is_local - hash - .. - 1'
299 );
300
301 is ($c->C('main.db.servers.list.0'),
302 'server3',
303 'is_local - hash - .. - 2'
304 );
305
306 ok($c = Config::Merge->new(path => $path, is_local => sub { return $_[1] eq 'override'}),
307 'new - is_local - sub - ..'
308 );
309
310 is ($c->C('main.db.servers.server1.host'),
311 'host4',
312 'is_local - sub - .. - 1'
313 );
314
315 is ($c->C('main.db.servers.list.0'),
316 'server3',
317 'is_local - sub - .. - 2'
318 );
319
320 ok($c = Config::Merge->new(path => $path,
321 is_local => qr{-[(].+[)]},
322 load_as => qr{(.*)-[(].+[)]}),
323 'new - is_local - regex - key'
324 );
325
326 is ($c->C('email.address.sig'),
327 'Us',
328 'is_local - regex - key - 1'
329 );
330
331 is ($c->C('email.address.from'),
332 'dev@',
333 'is_local - regex - key - 2'
334 );
335
336 is ($c->C('email.address.headers.0'),
337 'ddd',
338 'is_local - regex - key - 3'
339 );
340
341 is ($c->C('email.address.subject'),
342 'DEV',
343 'is_local - regex - key - 4'
344 );
345
346
347 ok($c = Config::Merge->new(path => $path,
348 is_local => qr{-[(].+[)]},
349 load_as => sub {
350 my $name = $_[1];
351 if ($name=~/(.*)-[(](.*)[)]/) {
352 return $2 eq 'aaa' ? $1 : undef;
353 }
354 return $name;}
355 ),
356 'new - is_local - sub - key'
357 );
358
359 is ($c->C('email.address.sig'),
360 'Us',
361 'is_local - sub - key - 1'
362 );
363
364 is ($c->C('email.address.from'),
365 'dev@',
366 'is_local - sub - key - 2'
367 );
368
369 is ($c->C('email.address.headers.0'),
370 'ddd',
371 'is_local - sub - key - 3'
372 );
373
374 is ($c->C('email.address.subject'),
375 'HELP',
376 'is_local - sub - key - 4'
377 );
378
379 $path = get_path('array');
380
381 ok($c = Config::Merge->new(path => $path),
382 'new - array merge'
383 );
384
385 is_deeply(
386 scalar $c->C('main.foo'),
387 [qw(a b d f h i Z k l m)],
388 'array merge - 1'
389 );
390
391 is_deeply(
392 scalar $c->C('main.bar'),
393 [qw(a b Z d Y f h i j), undef, undef, 'X',undef, 'W'],
394 'array merge - 2'
395 );
396
397 is_deeply(
398 scalar $c->C('main.baz'),
399 [qw(x y z)],
400 'array merge - 3'
401 );
402
403
404 ## EXPLAIN
405 my ($debug, $olderr);
406 open $olderr, '>&', \*STDERR or die "Can't dup STDERR: $!";
407 close STDERR or die "Can't close STDERR : $!";
408 open STDERR, '>>', \$debug or die "Can't open STDERR to debug : $!";
409
410 ok($c = Config::Merge->new(path => $path, debug => 1),
411 'new - debug'
412 );
413
414 open STDERR, '>&', $olderr or die "Can't dup OLDERR: $!";
415 like($debug,
416 qr/Entering dir/,
417 'debug'
418 );
419
420 #===================================
421 sub get_path {
422 #===================================
423 my ($vol,$path) = File::Spec->splitpath(
424 File::Spec->rel2abs($0)
425 );
426 $path = File::Spec->catdir(
427 File::Spec->splitdir($path),
428 'data',@_
429 );
430 return File::Spec->catpath($vol,$path,'');
431 }
432
433 1;⏎
+4
-0
t/80_pod.t less more
0 use Test::More;
1 eval "use Test::Pod 1.00";
2 plan skip_all => "Test::Pod 1.00 required for testing POD" if $@;
3 all_pod_files_ok();
+6
-0
t/81_pod_coverage.t less more
0 use Test::More;
1 eval "use Test::Pod::Coverage tests=>1";
2 plan skip_all => "Test::Pod::Coverage required for testing POD coverage"
3 if $@;
4
5 pod_coverage_ok( "Config::Merge", "Config::Merge is covered" );
+23
-0
t/data/array/local.pl less more
0 {
1 main => {
2 foo => {
3 '!' => {
4 '-' => [2,4,6],
5 '+' => [qw(k l m)],
6 },
7 '9' => 'Z',
8 },
9 bar => {
10 '!' => {
11 '-' => [2,4,6,20],
12 '+' => {
13 2 => 'Z',
14 5 => 'Y',
15 12 => 'X',
16 14 => 'W',
17 },
18 },
19 },
20 baz => [qw( x y z )],
21 }
22 }
+5
-0
t/data/array/main.pl less more
0 {
1 foo => [qw( a b c d e f g h i j )],
2 bar => [qw( a b c d e f g h i j )],
3 baz => [qw( a b c d e f g h i j )],
4 }
+6
-0
t/data/bad/db.pl less more
0 hosts => {
1 session => [qw(host1 host2 host3)],
2 image => [qw(host4 host5 host6)],
3 ,
4
5
+0
-0
t/data/empty/.dummy less more
(New empty file)
+8
-0
t/data/errors/array_delete_int/local.pl less more
0 {main => {
1 foo => {
2 '!' => {
3 '-' => ['abc'],
4 },
5 }
6 }
7 }
+1
-0
t/data/errors/array_delete_int/main.pl less more
0 { foo => [ 1, 2, 3, 4 ] }
+8
-0
t/data/errors/array_delete_ref/local.pl less more
0 {main => {
1 foo => {
2 '!' => {
3 '-' => 'abc',
4 },
5 }
6 }
7 }
+1
-0
t/data/errors/array_delete_ref/main.pl less more
0 { foo => [ 1, 2, 3, 4 ] }
+8
-0
t/data/errors/array_insert_int/local.pl less more
0 {main => {
1 foo => {
2 '!' => {
3 '+' => {'abc' => 1},
4 },
5 }
6 }
7 }
+1
-0
t/data/errors/array_insert_int/main.pl less more
0 { foo => [ 1, 2, 3, 4 ] }
+8
-0
t/data/errors/array_insert_ref/local.pl less more
0 {main => {
1 foo => {
2 '!' => {
3 '+' => 'abc',
4 },
5 }
6 }
7 }
+1
-0
t/data/errors/array_insert_ref/main.pl less more
0 { foo => [ 1, 2, 3, 4 ] }
+7
-0
t/data/errors/array_merge/local.pl less more
0 {main => {
1 foo => {
2 '!' => {},
3 'abc' => 'bar',
4 }
5 }
6 }
+1
-0
t/data/errors/array_merge/main.pl less more
0 { foo => [ 1, 2, 3, 4 ] }
+5
-0
t/data/load_as/dir/file.pl less more
0 {
1 'a' => 1,
2 'b' => 2,
3 'c' => 3,
4 }
+4
-0
t/data/load_as/dir-(local)/file.pl less more
0 {
1 'a' => 4,
2 'd' => 5,
3 }
+4
-0
t/data/load_as/file-(local).pl less more
0 {
1 'a' => 4,
2 'd' => 5,
3 }
+5
-0
t/data/load_as/file.pl less more
0 {
1 'a' => 1,
2 'b' => 2,
3 'c' => 3,
4 }
+3
-0
t/data/load_as/sub/dir/test.pl less more
0 { foo => 'test',
1 bar => 'test'
2 }
+1
-0
t/data/load_as/sub/dir-(aaa)/test.pl less more
0 { foo => 'test-(aaa)' }
+1
-0
t/data/load_as/sub/dir-(bbb)/test.pl less more
0 { foo => 'test-(bbb)' }
+1
-0
t/data/load_as/sub/test-(aaa).pl less more
0 { foo => 'test-(aaa)' }
+1
-0
t/data/load_as/sub/test-(bbb).pl less more
0 { foo => 'test-(bbb)' }
+3
-0
t/data/load_as/sub/test.pl less more
0 { foo => 'test',
1 bar => 'test'
2 }
+6
-0
t/data/local/email-(aaa).pl less more
0 {
1 address => {
2 from => 'dev@',
3 headers => [qw(ddd )],
4 },
5 }
+5
-0
t/data/local/email-(bbb).pl less more
0 {
1 address => {
2 subject => 'DEV',
3 },
4 }
+8
-0
t/data/local/email.pl less more
0 {
1 address => {
2 sig => 'Us',
3 from => 'help@',
4 subject => 'HELP',
5 headers => [qw(aaa bbb ccc )],
6 },
7 }
+15
-0
t/data/local/main.pl less more
0 {
1 db => {
2 servers => {
3 server1 => {
4 host => 'host1',
5 user => 'user1',
6 },
7 server2 => {
8 host => 'host2',
9 user => 'user2',
10 },
11 list => [qw(server1 server2)],
12 }
13 }
14 }
+17
-0
t/data/local/override.pl less more
0 {
1 main => {
2 db => {
3 servers => {
4 server1 => {
5 host => 'host4',
6 user => 'user4',
7 },
8 server3 => {
9 host => 'host3',
10 user => 'user3',
11 },
12 list => [qw(server3)],
13 }
14 }
15 }
16 }
+12
-0
t/data/perl/global.perl less more
0 {
1 db => {
2 hosts => {
3 session => [qw(host1 host2 host3)],
4 image => [qw(host4 host5 host6)],
5 },
6 engine => 'MySQL',
7 },
8 domain => 'www.test.com',
9 }
10
11
+7
-0
t/data/perlmulti/global/db.pl less more
0 { hosts => {
1 session => [qw(host1 host2 host3)],
2 image => [qw(host4 host5 host6)],
3 },
4 },
5
6
+7
-0
t/data/perlmulti/global/db2.pl less more
0 { hosts => {
1 session => [qw(host1 host2 host3)],
2 image => [qw(host4 host5 host6)],
3 },
4 }
5
6
+7
-0
t/data/perlmulti/global/db3.pl less more
0 { hosts => {
1 session => [qw(host1 host2 host3)],
2 image => [qw(host4 host5 host6)],
3 },
4 }
5
6
+3
-0
t/data/perlmulti/global/local.pl less more
0 { db2 => { hosts => { session =>[qw(local1)]}}}
1
2
+14
-0
t/data/perlmulti/global.perl less more
0 {
1 domain => 'www.test.com',
2 db3 => {
3 different => 'data',
4 },
5 engine => 'MySQL',
6 testsub => sub {'test'},
7 testregex => qr/test/,
8 testobj => bless({},'ABC'),
9 list => { a => 'b'},
10 array => [1,2,3,4],
11 }
12
13
+7
-0
t/data/perlmulti/local.perl less more
0 { global => {
1 engine => 'Oracle',
2 array => { key => 'value' },
3 }
4 }
5
6
+1
-0
t/data/skip/main/skip_1.pl less more
0 'foo'
+1
-0
t/data/skip/main/skip_2.pl less more
0 'foo'
+1
-0
t/data/skip/main/skip_not.pl less more
0 'foo'
+1
-0
t/data/skip/skip_1/test.pl less more
0 'foo'
+1
-0
t/data/skip/skip_2/test.pl less more
0 'foo'
+1
-0
t/data/skip/skip_not/test.pl less more
0 'foo'