File Coverage

blib/lib/Config/Singleton.pm

Criterion	Covered	Total	%
statement	94	100	94.0
branch	26	26	100.0
condition	13	23	56.5
subroutine	26	28	92.8
pod			n/a
total	159	177	89.8

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