File Coverage

blib/lib/Config/Singleton.pm

Criterion	Covered	Total	%
statement	91	97	93.8
branch	26	26	100.0
condition	13	23	56.5
subroutine	25	27	92.5
pod			n/a
total	155	173	89.6

line	stmt	bran	cond	sub	time	code
1	10			10	241762	use warnings;
	10				45
	10				323
2	10			10	47	use strict;
	10				18
	10				285
3						package Config::Singleton 0.006;
4						# ABSTRACT: one place for your app's configuration
5
6	10			10	41	use Cwd ();
	10				19
	10				130
7	10			10	52	use File::Basename ();
	10				17
	10				144
8	10			10	4401	use File::HomeDir ();
	10				48760
	10				202
9	10			10	65	use File::Spec ();
	10				18
	10				120
10	10			10	3732	use YAML::XS ();
	10				24707
	10				335
11
12	10				72	use Sub::Exporter -setup => {
13						groups => [ setup => \'_build_config_methods' ],
14	10			10	6211	};
	10				110401
15
16						#pod =head1 SYNOPSIS
17						#pod
18						#pod package YourApplication::Config;
19						#pod
20						#pod use Config::Singleton -setup => {
21						#pod filename => 'something.yaml',
22						#pod template => {
23						#pod foo => undef,
24						#pod bar => 1024,
25						#pod qux => [ 1, 2, 3],
26						#pod },
27						#pod };
28						#pod
29						#pod Elsewhere...
30						#pod
31						#pod use YourApplication::Config 'my_instance_config.yml';
32						#pod
33						#pod my $foo = YourApplication::Config->foo;
34						#pod
35						#pod =head1 DESCRIPTION
36						#pod
37						#pod Config::Singleton provides a base class for access to configuration data for
38						#pod your app. The basic implementation stores its configuration in YAML in a text
39						#pod file found in all the usual places. By default, Config::Singleton looks for
40						#pod myapp.yml, but an alternate filename may be passed when using the module.
41						#pod
42						#pod This module was derived from L.
43						#pod
44						#pod =head1 USING APP::CONFIG
45						#pod
46						#pod The L section, above, demonstrates an example of almost every
47						#pod feature of Config::Singleton It's a very simple module with a very small
48						#pod interface.
49						#pod
50						#pod It is not a base class. It is a utility for setting up a class that stores
51						#pod loaded configuration data. You just need to C the module like this:
52						#pod
53						#pod package Your::Config;
54						#pod
55						#pod use Config::Singleton -setup => {
56						#pod filename => 'your_program.yaml',
57						#pod template => {
58						#pod username => undef,
59						#pod hostname => undef,
60						#pod logfile => undef,
61						#pod facility => 'local1',
62						#pod path => [ qw(/var/spool /tmp/jobs) ],
63						#pod },
64						#pod };
65						#pod
66						#pod When another module uses Your::Config, F will be loaded and
67						#pod its contents will be merged over the defaults given by the C
68						#pod argument. Each entry in the template hashref becomes a method on
69						#pod YourProgram::Config, which returns either the value from the config file or the
70						#pod value from the template, if no entry exists in the config file.
71						#pod
72						#pod So, assuming that F looks like this:
73						#pod
74						#pod ---
75						#pod username: rjbs
76						#pod hostname: fulfill.example.com
77						#pod
78						#pod path:
79						#pod - /var/spool/jobs
80						#pod - /home/rjbs/spool/jobs
81						#pod
82						#pod Then these are the results of method calls on Your::Config:
83						#pod
84						#pod Your::Config->username; # 'rjbs'
85						#pod
86						#pod Your::Config->logfile; # undef
87						#pod
88						#pod Your::Config->facility; # 'local0'
89						#pod
90						#pod Your::Config->path; # qw(/var/spool/jobs /home/rjbs/spool/jobs)
91						#pod
92						#pod =head2 Specifying a Config File
93						#pod
94						#pod Config::Singleton finds a config file via a series of DWIM-my steps that are
95						#pod probably
96						#pod more complicated to explain than they are to understand.
97						#pod
98						#pod The F argument given when using Config::Singleton is the name of the
99						#pod file that will, by default, be loaded to find configuration. It may be
100						#pod absolute or relative. If not given, it's computed as follows: the "module
101						#pod base name" is made by dropping the last part of the class name, if it's
102						#pod multi-part, and double colons become underscores. In other words
103						#pod "Your::Thing::Config" becomes "Your_Thing." If the environment variable
104						#pod YOUR_THING_CONFIG_FILE is set, that will be used as the default. If not,
105						#pod F will be used.
106						#pod
107						#pod The named file will be the source of configuration for the global (class
108						#pod method) configuration. It can be overridden, however, when using the config
109						#pod module. For example, after using the following code:
110						#pod
111						#pod use Your::Thing::Config 'special.yaml';
112						#pod
113						#pod ...the default name will have been replaced with F. If the
114						#pod previous default file has already been loaded, this will throw an exception.
115						#pod Using the module without specifying a filename will defer loading of the
116						#pod configuration file until it's needed. To force it to be loaded without setting
117						#pod an explicit filename, pass C<-load> as the filename. (All names beginning
118						#pod with a dash are reserved.)
119						#pod
120						#pod If the filename is relative, the configuration file is found by looking for the
121						#pod file name in the following paths (F is the location of the program being
122						#pod run, found via C<$0>):
123						#pod
124						#pod ./
125						#pod ../
126						#pod LOC/
127						#pod LOC/../etc/
128						#pod ~/
129						#pod /etc/
130						#pod
131						#pod You can change the paths checked by providing a F argument, as an
132						#pod arrayref, in the setup arguments.
133						#pod
134						#pod =head2 Alternate Configuration Objects
135						#pod
136						#pod Although it's generally preferable to begin your program by forcing the loading
137						#pod of a configuration file and then using the global configuration, it's possible
138						#pod to have multiple Your::Thing::Config configurations loaded by instantiating
139						#pod objects of that class, like this:
140						#pod
141						#pod my $config_obj = Your::Thing::Config->new($filename);
142						#pod
143						#pod The named file is found via the same path resolution (if it's relative) as
144						#pod described above.
145						#pod
146						#pod =head1 METHODS
147						#pod
148						#pod Config::Singleton doesn't actually have any real public methods of its own.
149						#pod Its methods are all private, and serve to power its C routine. These
150						#pod will probably be exposed in the future to allow for subclassing of
151						#pod Config::Singleton, but in the meantime, don't rely on them.
152						#pod
153						#pod =cut
154
155						# Initialize all the methods for our new class.
156						# this is a Sub::Exporter group generator
157						sub _build_config_methods {
158	9			9	2259	my ($self, $name, $arg) = @_;
159
160						# XXX: validate $arg here -- rjbs
161
162						# This is the set of subs we're going to install in config classes.
163						my %sub = (
164						$self->_build_default_filename_methods($arg),
165						$self->_build_default_object_methods($arg),
166	8			8	35	_template => sub { $arg->{template} },
167	16			16	35	_config => sub { shift->_self->{config} },
168	9				31	import => $self->_build_import($arg),
169						new => $self->_build_new($arg),
170						);
171
172	9				19	for my $attr (keys %{ $arg->{template} }) {
	9				29
173						Carp::croak "can't use reserved name $attr as config entry"
174	30	100			231	if exists $sub{ $attr };
175
176						$sub{ $attr } = sub {
177	16			16	1980	my $value = shift->_self->_config->{$attr};
178	16	100	100		109	return @$value if (ref $value \|\| q{}) eq 'ARRAY'; # XXX: use _ARRAYLIKE
179	13				67	return $value;
180	29				77	};
181						}
182
183	8				26	return \%sub;
184						}
185
186						## METHODS THAT BUILD METHODS TO INSTALL
187
188						sub _build_new {
189	9			9	17	my ($app_config, $arg) = @_;
190
191						sub {
192	10			10	1506	my ($class, $filename) = @_;
193
194	10				22	my $self = bless { } => $class;
195
196	10		33		67	$self->{basename} = $filename \|\| $class->default_filename;
197
198						$filename = $app_config->_find_file_in_path(
199						$self->{basename},
200						$arg->{path},
201	10				48	);
202
203	8				33	$self->{filename} = $filename;
204
205						$self->{config} = $app_config->_merge_data(
206						$self->_template,
207						$app_config->_load_file(
208						$app_config->_find_file_in_path(
209						$self->{filename},
210						$arg->{path},
211	8				27	),
212						),
213						);
214
215	8				63	return $self;
216	9				50	};
217						}
218
219						sub _build_default_filename_methods {
220	9			9	19	my ($app_config, $arg) = @_;
221
222	9				14	my $set_default;
223
224						my $get_default_filename = sub {
225	6			6	14	my ($self) = @_;
226						return $set_default \|\|= $arg->{filename}
227	6		33		40	\|\| $app_config->_default_filename_for_class($self);
			66
228	9				31	};
229
230						my $set_default_filename = sub {
231	7			7	16	my ($class, $filename) = @_;
232	7	100	100		471	Carp::croak "can't change default filename, config already loaded!"
233						if $set_default
234						and $set_default ne $filename;
235	4				10	$set_default = $filename;
236	9				28	};
237
238						return (
239	9				34	_get_default_filename => $get_default_filename,
240						_set_default_filename => $set_default_filename,
241						);
242						}
243
244						sub _build_default_object_methods {
245	9			9	17	my ($app_config) = @_;
246
247	9				14	my $default;
248
249						my $_self = sub {
250	37			37	64	my ($self) = @_;
251	37	100			122	return $self if ref $self;
252	17		66		108	return $default \|\|= $self->new($self->_get_default_filename);
253	9				24	};
254
255						return (
256						_self => $_self,
257	0			0	0	_default_object => sub { $default },
258	9				132	);
259						}
260
261						sub _build_import {
262	9			9	21	my ($app_config, $arg) = @_;
263
264						return sub {
265	16			16	11820	my ($class, $filename) = @_;
266
267	16	100			239	Carp::confess sprintf('import called on %s object', ref $class)
268						if ref $class;
269
270	15	100	66		78	return unless defined $filename and length $filename;
271
272	9	100			38	if ($filename =~ /^-/) {
273	2	100			6	if ($filename eq '-load') {
274	1				4	return $class->_self;
275						}
276	1				136	Carp::croak "unknown directive for $class: $filename";
277						} else {
278	7				21	$class->_set_default_filename($filename);
279						}
280
281	4				8	$class->_self;
282						}
283	9				63	}
284
285						# METHODS FOR THINGS TO CALL ON APP::CONFIG
286
287						sub _default_filename_for_class {
288	0			0	0	my ($app_config, $class) = @_;
289
290						# remove final part (A::Config -> A)
291	0				0	(my $module_base = $class) =~ s/::\w+\z//;
292
293	0				0	$module_base =~ s/::/_/g;
294	0		0		0	my $filename = $ENV{uc($module_base) . '_CONFIG_FILE'}
295						\|\| lc($module_base) . '.yaml';
296
297	0				0	return $filename;
298						}
299
300	8			8	43	sub _load_file { YAML::XS::LoadFile($_[1]); }
301
302						sub _find_file_in_path {
303	18			18	75	my ($self, $filename, $path) = @_;
304
305	18	100			151	if (File::Spec->file_name_is_absolute( $filename )) {
306	4	100			172	Carp::croak "config file $filename not found\n" unless -e $filename;
307	3				21	return $filename;
308						}
309
310	14	100			56	$path = $self->_default_path unless defined $path;
311
312	14				37	for my $dir (@$path) {
313	36				307	my $this_file = File::Spec->catfile($dir, $filename);
314	36	100			1149	return $this_file if -e $this_file;
315						};
316
317	1				179	Carp::croak "config file $filename not found in path (@$path)\n";
318						}
319
320						sub _default_path {
321	13			13	64	my $home = File::HomeDir->my_home;
322	13				1502	my $path = File::Basename::dirname(Cwd::realpath($0));
323
324						return [
325	13				90	q{},
326						q{./},
327						q{../},
328						qq{$path/},
329						qq{$path/../etc/},
330						qq{$home/.},
331						q{/etc/},
332						];
333						}
334
335						# In the future, using Clone here might be a good idea to avoid issues with
336						# stupid references.
337						sub _merge_data {
338	8			8	1406	my ($self, $template, $override) = @_;
339
340	8				21	my $merged = {};
341
342	8				30	for (keys %$template) {
343						# Should we be preventing the config file's entry from having a different
344						# data type than the template value? -- rjbs, 2007-08-18
345	32	100			98	$merged->{$_} = defined $override->{$_} ? $override->{$_} : $template->{$_};
346						}
347
348	8				24	return $merged;
349						}
350
351						#pod =head1 TODO
352						#pod
353						#pod =for :list
354						#pod * a ->new method to allow loading different configs
355						#pod * a way to tell Your::Config, with no explicit filename, to die unless a filename was specified by an earlier use
356						#pod
357						#pod =head1 ACKNOWLEDGEMENTS
358						#pod
359						#pod Ricardo SIGNES not only wrote the inspiration for this in Rubric::Config, but
360						#pod he also basically wrote the majority of the implementation here, and even
361						#pod provided extensions of what he knew I wanted it to do, even when I said I
362						#pod didn't need that yet. In the end it ended up being extremely elegant, which I
363						#pod can say without being boastful, because he wrote the elegant bits.
364						#pod
365						#pod =cut
366
367						1;
368
369						__END__