File Coverage

blib/lib/Config/General.pm

Criterion	Covered	Total	%
statement	415	541	76.7
branch	203	306	66.3
condition	40	72	55.6
subroutine	28	32	87.5
pod	8	10	80.0
total	694	961	72.2

line	stmt	bran	cond	sub	pod	time	code
1							#
2							# Config::General.pm - Generic Config Module
3							#
4							# Purpose: Provide a convenient way for loading
5							# config values from a given file and
6							# return it as hash structure
7							#
8							# Copyright (c) 2000-2007 Thomas Linden <tlinden \|AT\| cpan.org>.
9							# All Rights Reserved. Std. disclaimer applies.
10							# Artificial License, same as perl itself. Have fun.
11							#
12							# namespace
13							package Config::General;
14
15	1			1		17	use strict;
	1					10
	1					16
16	1			1		15	use warnings;
	1					9
	1					17
17	1			1		31	use English '-no_match_vars';
	1					10
	1					16
18
19	1			1		35	use IO::File;
	1					10
	1					23
20	1			1		63	use FileHandle;
	1					9
	1					16
21	1			1		84	use File::Spec::Functions qw(splitpath file_name_is_absolute catfile catpath);
	1					37
	1					24
22	1			1		19	use File::Glob qw/:glob/;
	1					9
	1					18
23
24
25							# on debian with perl > 5.8.4 croak() doesn't work anymore without this.
26							# There is some require statement which dies 'cause it can't find Carp::Heavy,
27							# I really don't understand, what the hell they made, but the debian perl
28							# installation is definetly bullshit, damn!
29	1			1		38	use Carp::Heavy;
	1					10
	1					22
30
31
32	1			1		16	use Carp;
	1					9
	1					17
33	1			1		15	use Exporter;
	1					9
	1					14
34
35							$Config::General::VERSION = 2.32;
36
37	1			1		17	use vars qw(@ISA @EXPORT_OK);
	1					9
	1					16
38	1			1		15	use base qw(Exporter);
	1					12
	1					18
39							@EXPORT_OK = qw(ParseConfig SaveConfig SaveConfigString);
40
41							sub new {
42							#
43							# create new Config::General object
44							#
45	40			40	1	728	my($this, @param ) = @_;
46	40		66			566	my $class = ref($this) \|\| $this;
47
48							# define default options
49	40					1864	my $self = {
50							SlashIsDirectory => 0,
51
52							AllowMultiOptions => 1,
53
54							MergeDuplicateOptions => 0,
55							MergeDuplicateBlocks => 0,
56
57							LowerCaseNames => 0,
58
59							UseApacheInclude => 0,
60							IncludeRelative => 0,
61							IncludeDirectories => 0,
62							IncludeGlob => 0,
63
64							AutoLaunder => 0,
65
66							AutoTrue => 0,
67
68							AutoTrueFlags => {
69							true => '^(on\|yes\|true\|1)$',
70							false => '^(off\|no\|false\|0)$',
71							},
72
73							DefaultConfig => {},
74
75							level => 1,
76
77							InterPolateVars => 0,
78
79							InterPolateEnv => 0,
80
81							ExtendedAccess => 0,
82
83							SplitPolicy => 'guess', # also possible: whitespace, equalsign and custom
84
85							SplitDelimiter => 0, # must be set by the user if SplitPolicy is 'custom'
86
87							StoreDelimiter => 0, # will be set by me unless user uses 'custom' policy
88
89							CComments => 1, # by default turned on
90
91							BackslashEscape => 0, # by default turned off, allows escaping anything using the backslash
92
93							StrictObjects => 1, # be strict on non-existent keys in OOP mode
94
95							StrictVars => 1, # be strict on undefined variables in Interpolate mode
96
97							Tie => q(), # could be set to a perl module for tie'ing new hashes
98
99							parsed => 0, # internal state stuff for variable interpolation
100							upperkey => q(),
101							upperkeys => [],
102							lastkey => q(),
103							prevkey => q( ),
104							files => {}, # which files we have read, if any
105							};
106
107							# create the class instance
108	40					595	bless $self, $class;
109
110
111	40	100				612	if ($#param >= 1) {
		50
112							# use of the new hash interface!
113	32					428	my %conf = @param;
114
115							# save the parameter list for ::Extended's new() calls
116	32					512	$self->{Params} = \%conf;
117
118							# be backwards compatible
119	32	100				377	if (exists $conf{-file}) {
120	6					80	$self->{ConfigFile} = delete $conf{-file};
121							}
122	32	50				377	if (exists $conf{-hash}) {
123	0					0	$self->{ConfigHash} = delete $conf{-hash};
124							}
125
126							# store input, file, handle, or array
127	32	100				331	if (exists $conf{-ConfigFile}) {
128	8					99	$self->{ConfigFile} = delete $conf{-ConfigFile};
129							}
130	32	100				376	if (exists $conf{-ConfigHash}) {
131	11					128	$self->{ConfigHash} = delete $conf{-ConfigHash};
132							}
133
134							# store search path for relative configs, if any
135	32	50				327	if (exists $conf{-ConfigPath}) {
136	0					0	my $configpath = delete $conf{-ConfigPath};
137	0	0				0	$self->{ConfigPath} = ref $configpath eq 'ARRAY' ? $configpath : [$configpath];
138							}
139
140							# handle options which contains values we are needing (strings, hashrefs or the like)
141	32	100				330	if (exists $conf{-String} ) {
142	7	100				87	if (ref(\$conf{-String}) eq 'SCALAR') {
143	6	50				67	if ( $conf{-String}) {
144	6					158	$self->{StringContent} = $conf{-String};
145							}
146	6					65	delete $conf{-String};
147							}
148							else {
149	1					14	croak "Parameter -String must be a SCALAR!\n";
150							}
151							}
152
153	31	50				342	if (exists $conf{-Tie}) {
154	0	0				0	if ($conf{-Tie}) {
155	0					0	$self->{Tie} = delete $conf{-Tie};
156	0					0	$self->{DefaultConfig} = $self->_hashref();
157							}
158							}
159
160	31	100				315	if (exists $conf{-FlagBits}) {
161	1	50	33			26	if ($conf{-FlagBits} && ref($conf{-FlagBits}) eq 'HASH') {
162	1					12	$self->{FlagBits} = 1;
163	1					12	$self->{FlagBitsFlags} = $conf{-FlagBits};
164							}
165	1					261	delete $conf{-FlagBits};
166							}
167
168	31	100				385	if (exists $conf{-DefaultConfig}) {
169	2	100	66			92	if ($conf{-DefaultConfig} && ref($conf{-DefaultConfig}) eq 'HASH') {
		50	33
170	1					13	$self->{DefaultConfig} = $conf{-DefaultConfig};
171							}
172							elsif ($conf{-DefaultConfig} && ref($conf{-DefaultConfig}) eq q()) {
173	1					16	$self->_read($conf{-DefaultConfig}, 'SCALAR');
174	1					12	$self->{DefaultConfig} = $self->_parse($self->_hashref(), $self->{content});
175	1					11	$self->{content} = ();
176							}
177	2					90	delete $conf{-DefaultConfig};
178							}
179
180							# handle options which may either be true or false
181							# allowing "human" logic about what is true and what is not
182	31					383	foreach my $entry (keys %conf) {
183	28					337	my $key = $entry;
184	28					372	$key =~ s/^\-//;
185	28	50				366	if (! exists $self->{$key}) {
186	0					0	croak "Unknown parameter: $entry => \"$conf{$entry}\" (key: <$key>)\n";
187							}
188	28	100				453	if ($conf{$entry} =~ /$self->{AutoTrueFlags}->{true}/io) {
		100
189	25					303	$self->{$key} = 1;
190							}
191							elsif ($conf{$entry} =~ /$self->{AutoTrueFlags}->{false}/io) {
192	1					12	$self->{$key} = 0;
193							}
194							else {
195							# keep it untouched
196	2					24	$self->{$key} = $conf{$entry};
197							}
198							}
199
200	31	100				383	if ($self->{MergeDuplicateOptions}) {
201							# override if not set by user
202	5	50				58	if (! exists $conf{-AllowMultiOptions}) {
203	5					75	$self->{AllowMultiOptions} = 0;
204							}
205							}
206							}
207							elsif ($#param == 0) {
208							# use of the old style
209	8					107	$self->{ConfigFile} = $param[0];
210	8	50				99	if (ref($self->{ConfigFile}) eq 'HASH') {
211	0					0	$self->{ConfigHash} = delete $self->{ConfigFile};
212							}
213							}
214							else {
215							# this happens if $#param == -1,1 thus no param was given to new!
216	0					0	$self->{config} = $self->_hashref();
217	0					0	$self->{parsed} = 1;
218							}
219
220							# prepare the split delimiter if needed
221	39	100				527	if ($self->{SplitPolicy} ne 'guess') {
222	1	50				18	if ($self->{SplitPolicy} eq 'whitespace') {
		50
		50
223	0					0	$self->{SplitDelimiter} = '\s+';
224	0	0				0	if (!$self->{StoreDelimiter}) {
225	0					0	$self->{StoreDelimiter} = q( );
226							}
227							}
228							elsif ($self->{SplitPolicy} eq 'equalsign') {
229	0					0	$self->{SplitDelimiter} = '\s=\s';
230	0	0				0	if (!$self->{StoreDelimiter}) {
231	0					0	$self->{StoreDelimiter} = ' = ';
232							}
233							}
234							elsif ($self->{SplitPolicy} eq 'custom') {
235	1	50				13	if (! $self->{SplitDelimiter} ) {
236	0					0	croak "SplitPolicy set to 'custom' but no SplitDelimiter set.\n";
237							}
238							}
239							else {
240	0					0	croak "Unsupported SplitPolicy: $self->{SplitPolicy}.\n";
241							}
242							}
243							else {
244	38	50				496	if (!$self->{StoreDelimiter}) {
245	38					418	$self->{StoreDelimiter} = q( );
246							}
247							}
248
249	39	100	66			677	if ($self->{InterPolateVars} \|\| $self->{InterPolateEnv}) {
250							# InterPolateEnv implies InterPolateVars
251	1					10	$self->{InterPolateVars} = 1;
252
253							# we are blessing here again, to get into the ::InterPolated namespace
254							# for inheriting the methods available overthere, which we doesn't have.
255							#
256	1					13	bless $self, 'Config::General::Interpolated';
257	1					9	eval {
258	1					33	require Config::General::Interpolated;
259							};
260	1	50				15	if ($EVAL_ERROR) {
261	0					0	croak $EVAL_ERROR;
262							}
263							# pre-compile the variable regexp
264	1					15	$self->{regex} = $self->_set_regex();
265							}
266
267							# process as usual
268	39	50				407	if (!$self->{parsed}) {
269	39	100	66			540	if ($self->{DefaultConfig} && $self->{InterPolateVars}) {
270	1					14	$self->{DefaultConfig} = $self->_interpolate_hash($self->{DefaultConfig}); # FIXME: _hashref() ?
271							}
272	39	100	33			580	if (exists $self->{StringContent}) {
		100
		50
273							# consider the supplied string as config file
274	6					79	$self->_read($self->{StringContent}, 'SCALAR');
275	6					81	$self->{config} = $self->_parse($self->{DefaultConfig}, $self->{content});
276							}
277							elsif (exists $self->{ConfigHash}) {
278	11	100				114	if (ref($self->{ConfigHash}) eq 'HASH') {
279							# initialize with given hash
280	10					94	$self->{config} = $self->{ConfigHash};
281	10					89	$self->{parsed} = 1;
282							}
283							else {
284	1					13	croak "Parameter -ConfigHash must be a hash reference!\n";
285							}
286							}
287							elsif (ref($self->{ConfigFile}) eq 'GLOB' \|\| ref($self->{ConfigFile}) eq 'FileHandle') {
288							# use the file the glob points to
289	0					0	$self->_read($self->{ConfigFile});
290	0					0	$self->{config} = $self->_parse($self->{DefaultConfig}, $self->{content});
291							}
292							else {
293	22	50				212	if ($self->{ConfigFile}) {
294							# open the file and read the contents in
295	22					223	$self->{configfile} = $self->{ConfigFile};
296	22	50				279	if ( file_name_is_absolute($self->{ConfigFile}) ) {
297							# look if is is an absolute path and save the basename if it is absolute
298	0					0	my ($volume, $path, undef) = splitpath($self->{ConfigFile});
299	0					0	$path =~ s#/$##; # remove eventually existing trailing slash
300	0	0				0	if (! $self->{ConfigPath}) {
301	0					0	$self->{ConfigPath} = [];
302							}
303	0					0	unshift @{$self->{ConfigPath}}, catpath($volume, $path, q());
	0					0
304							}
305	22					899	$self->_open($self->{configfile});
306							# now, we parse immdediately, getall simply returns the whole hash
307	19					731	$self->{config} = $self->_hashref();
308	19					247	$self->{config} = $self->_parse($self->{DefaultConfig}, $self->{content});
309							}
310							else {
311							# hm, no valid config file given, so try it as an empty object
312	0					0	$self->{config} = $self->_hashref();
313	0					0	$self->{parsed} = 1;
314							}
315							}
316							}
317
318							#
319							# Submodule handling. Parsing is already done at this point.
320							#
321	35	100				382	if ($self->{ExtendedAccess}) {
322							#
323							# we are blessing here again, to get into the ::Extended namespace
324							# for inheriting the methods available overthere, which we doesn't have.
325							#
326	11					173	bless $self, 'Config::General::Extended';
327	11					91	eval {
328	11					175	require Config::General::Extended;
329							};
330	11	50				113	if ($EVAL_ERROR) {
331	0					0	croak $EVAL_ERROR;
332							}
333							}
334
335	35					467	return $self;
336							}
337
338
339
340							sub getall {
341							#
342							# just return the whole config hash
343							#
344	23			23	1	209	my($this) = @_;
345	23	50				230	return (exists $this->{config} ? %{$this->{config}} : () );
	23					629
346							}
347
348
349							sub files {
350							#
351							# return a list of files opened so far
352							#
353	1			1	1	11	my($this) = @_;
354	1	50				12	return (exists $this->{files} ? keys %{$this->{files}} : () );
	1					14
355							}
356
357
358							sub _open {
359							#
360							# open the config file, or expand a directory or glob
361							#
362	34			34		330	my($this, $configfile) = @_;
363	34					277	my $fh;
364
365	34	100	66			388	if ($this->{IncludeGlob} and $configfile =~ /[*?\[\{\\]/) {
366							# Something like: .conf (or maybe dir/.conf) was included; expand it and
367							# pass each expansion through this method again.
368	1					13	my @include = grep { -f $_ } bsd_glob($configfile, GLOB_BRACE \| GLOB_QUOTE);
	3					491
369	1	50				16	if (@include == 1) {
370	0					0	$configfile = $include[0];
371							}
372							else {
373							# Multiple results or no expansion results (which is fine,
374							# include foo/* shouldn't fail if there isn't anything matching)
375	1					11	local $this->{IncludeGlob};
376	1					11	for (@include) {
377	3					88	$this->_open($_);
378							}
379	1					29	return;
380							}
381							}
382
383	33	100				895	if (!-e $configfile) {
384	3					26	my $found;
385	3	50				35	if (defined $this->{ConfigPath}) {
386							# try to find the file within ConfigPath
387	0					0	foreach my $dir (@{$this->{ConfigPath}}) {
	0					0
388	0	0				0	if( -e catfile($dir, $configfile) ) {
389	0					0	$configfile = catfile($dir, $configfile);
390	0					0	$found = 1;
391	0					0	last; # found it
392							}
393							}
394							}
395	3	50				32	if (!$found) {
396	3	50				34	my $path_message = defined $this->{ConfigPath} ? q( within ConfigPath: ) . join(q(.), @{$this->{ConfigPath}}) : q();
	0					0
397	3					47	croak qq{The file "$configfile" does not exist$path_message!};
398							}
399							}
400
401	30					389	local ($RS) = $RS;
402	30	50				299	if (! $RS) {
403	0					0	carp(q(\$RS (INPUT_RECORD_SEPARATOR) is undefined. Guessing you want a line feed character));
404	0					0	$RS = "\n";
405							}
406
407	30	100	66			799	if (-d $configfile and $this->{IncludeDirectories}) {
		50
408							# A directory was included; include all the files inside that directory in ASCII order
409	1					10	local *INCLUDEDIR;
410	1	50				97	opendir INCLUDEDIR, $configfile or croak "Could not open directory $configfile!($!)\n";
411	1					73	my @files = sort grep { -f "$configfile/$_" } "$configfile/$_", readdir INCLUDEDIR;
	9					183
412	1					21	closedir INCLUDEDIR;
413	1					12	local $this->{CurrentConfigFilePath} = $configfile;
414	1					10	for (@files) {
415	5	50				68	if (! $this->{files}->{"$configfile/$_"}) {
416	5	50				99	$fh = IO::File->new( "$configfile/$_", 'r') or croak "Could not open $configfile/$_!($!)\n";
417	5					307	$this->{files}->{"$configfile/$_"} = 1;
418	5					141	$this->_read($fh);
419							}
420							}
421							}
422							elsif (-e _) {
423	29	50				324	if (exists $this->{files}->{$configfile} ) {
424							# do not read the same file twice, just return
425							# FIXME: should we croak here, when some "debugging" is enabled?
426	0					0	return;
427							}
428							else {
429	29	50				661	$fh = IO::File->new( "$configfile", 'r') or croak "Could not open $configfile!($!)\n";
430
431	29					6578	$this->{files}->{$configfile} = 1;
432
433	29					345	my ($volume, $path, undef) = splitpath($configfile);
434	29					1611	local $this->{CurrentConfigFilePath} = catpath($volume, $path, q());
435
436	29					1211	$this->_read($fh);
437							}
438							}
439	29					614	return;
440							}
441
442
443							sub _read {
444							#
445							# store the config contents in @content
446							# and prepare it somewhat for easier parsing later
447							# (comments, continuing lines, and stuff)
448							#
449	41			41		476	my($this, $fh, $flag) = @_;
450	41					357	my(@stuff, @content, $c_comment, $longline, $hier, $hierend, @hierdoc);
451	41					371	local $_ = q();
452
453	41	100	66			553	if ($flag && $flag eq 'SCALAR') {
454	7	50				72	if (ref($fh) eq 'ARRAY') {
455	0					0	@stuff = @{$fh};
	0					0
456							}
457							else {
458	7					101	@stuff = split /\n/, $fh;
459							}
460							}
461							else {
462	34					15353	@stuff = <$fh>;
463							}
464
465	41					1902	foreach (@stuff) {
466	529	50				5835	if ($this->{AutoLaunder}) {
467	0	0				0	if (m/^(.*)$/) {
468	0					0	$_ = $1;
469							}
470							}
471
472	529					4970	chomp;
473
474	529	50				6868	if ($this->{CComments}) {
475							# look for C-Style comments, if activated
476	529	100				6401	if (/(\s\/\.\\/\s*)/) {
		100
		100
477							# single c-comment on one line
478	1					20	s/\s\/\.\\/\s*//;
479							}
480							elsif (/^\s\/\/) {
481							# the beginning of a C-comment ("/*"), from now on ignore everything.
482	13	50				133	if (/\\/\s$/) {
483							# C-comment end is already there, so just ignore this line!
484	0					0	$c_comment = 0;
485							}
486							else {
487	13					114	$c_comment = 1;
488							}
489							}
490							elsif (/\*\//) {
491	13	50				131	if (!$c_comment) {
492	0					0	warn "invalid syntax: found end of C-comment without previous start!\n";
493							}
494	13					107	$c_comment = 0; # the current C-comment ends here, go on
495	13					147	s/^.\\///; # if there is still stuff, it will be read
496							}
497	529	100				5282	next if($c_comment); # ignore EVERYTHING from now on, IF it IS a C-Comment
498							}
499
500
501	380	100				3773	if ($hier) {
502							# inside here-doc, only look for $hierend marker
503	15	100				225	if (/^(\s)\Q$hierend\E\s$/) {
504	4					38	my $indent = $1; # preserve indentation
505	4					38	$hier .= ' ' . chr 182; # append a "�" to the here-doc-name, so
506							# _parse will also preserver indentation
507	4	50				36	if ($indent) {
508	0					0	foreach (@hierdoc) {
509	0					0	s/^$indent//; # i.e. the end was: " EOF" then we remove " " from every here-doc line
510	0					0	$hier .= $_ . "\n"; # and store it in $hier
511							}
512							}
513							else {
514	4					46	$hier .= join "\n", @hierdoc; # there was no indentation of the end-string, so join it 1:1
515							}
516	4					33	push @{$this->{content}}, $hier; # push it onto the content stack
	4					45
517	4					39	@hierdoc = ();
518	4					32	undef $hier;
519	4					34	undef $hierend;
520							}
521							else {
522							# everything else onto the stack
523	11					100	push @hierdoc, $_;
524							}
525	15					135	next;
526							}
527
528							###
529							### non-heredoc entries from now on
530							##
531
532							# Remove comments and empty lines
533	365					3359	s/(?<!\\)#.+$//;
534	365	100				3862	next if /^\s*#/;
535	363	100				4093	next if /^\s*$/;
536
537
538							# look for multiline option, indicated by a trailing backslash
539	257	50				2586	my $extra = $this->{BackslashEscape} ? '(?<!\\\\)' : q();
540	257	100				3605	if (/$extra\\$/) {
541	6					50	chop;
542	6					57	s/^\s*//;
543	6					55	$longline .= $_;
544	6					52	next;
545							}
546
547							# remove the \ from all characters if BackslashEscape is turned on
548	251	50				3196	if ($this->{BackslashEscape}) {
549	0					0	s/\\(.)/$1/g;
550							}
551							else {
552							# remove the \ char in front of masked "#", if any
553	251					2219	s/\\#/#/g;
554							}
555
556
557							# transform explicit-empty blocks to conforming blocks
558	251	100				4492	if (/\s<([^\/]+?.?)\/>$/) {
559	1					16	my $block = $1;
560	1	50				51	if ($block !~ /\"/) {
561	1	50				15	if ($block !~ /\s[^\s]/) {
562							# fix of bug 7957, add quotation to pure slash at the
563							# end of a block so that it will be considered as directory
564							# unless the block is already quoted or contains whitespaces
565							# and no quotes.
566	1	50				11	if ($this->{SlashIsDirectory}) {
567	1					62	push @{$this->{content}}, '<' . $block . '"/">';
	1					30
568	1					14	next;
569							}
570							}
571							}
572	0					0	my $orig = $_;
573	0					0	$orig =~ s/\/>$/>/;
574	0					0	$block =~ s/\s\s.$//;
575	0					0	push @{$this->{content}}, $orig, "</${block}>";
	0					0
576	0					0	next;
577							}
578
579
580							# look for here-doc identifier
581	250	100				2595	if ($this->{SplitPolicy} eq 'guess') {
582	247	100				2521	if (/^\s(\S+?)(\s=\s\|\s+)<<\s(.+?)\s*$/) {
583	5					84	$hier = $1; # the actual here-doc variable name
584	5					54	$hierend = $3; # the here-doc identifier, i.e. "EOF"
585	5					46	next;
586							}
587							}
588							else {
589							# no guess, use one of the configured strict split policies
590	3	50				78	if (/^\s(\S+?)($this->{SplitDelimiter})<<\s(.+?)\s*$/) {
591	0					0	$hier = $1; # the actual here-doc variable name
592	0					0	$hierend = $3; # the here-doc identifier, i.e. "EOF"
593	0					0	next;
594							}
595							}
596
597
598
599							###
600							### any "normal" config lines from now on
601							###
602
603	245	100				2261	if ($longline) {
604							# previous stuff was a longline and this is the last line of the longline
605	2					19	s/^\s*//;
606	2					20	$longline .= $_;
607	2					19	push @{$this->{content}}, $longline; # push it onto the content stack
	2					93
608	2					18	undef $longline;
609	2					21	next;
610							}
611							else {
612							# look for include statement(s)
613	243					2806	my $incl_file;
614	243					2445	my $path = '';
615	243	100	66			3103	if ( $this->{IncludeRelative} and defined $this->{CurrentConfigFilePath}) {
		50
616	12					117	$path = $this->{CurrentConfigFilePath};
617							}
618							elsif (defined $this->{ConfigPath}) {
619							# fetch pathname of base config file, assuming the 1st one is the path of it
620	0					0	$path = $this->{ConfigPath}->[0];
621							}
622	243	100	33			3709	if (/^\s<<include\s+(.+?)>>\s$/i \|\| (/^\sinclude\s+(.+?)\s$/i && $this->{UseApacheInclude})) {
			66
623	9					107	$incl_file = $1;
624	9	100	66			162	if ( $this->{IncludeRelative} && $path && !file_name_is_absolute($incl_file) ) {
			66
625							# include the file from within location of $this->{configfile}
626	4					2207	$this->_open( catfile($path, $incl_file) );
627							}
628							else {
629							# include the file from within pwd, or absolute
630	5					108	$this->_open($incl_file);
631							}
632							}
633							else {
634							# standard entry, (option = value)
635	234					2103	push @{$this->{content}}, $_;
	234					9221
636							}
637							}
638
639							}
640	40					1109	return 1;
641							}
642
643
644
645
646
647							sub _parse {
648							#
649							# parse the contents of the file
650							#
651	73			73		652	my($this, $config, $content) = @_;
652	73					623	my(@newcontent, $block, $blockname, $chunk,$block_level);
653	73					627	local $_;
654	73					668	my $indichar = chr 182; # �, inserted by _open, our here-doc indicator
655
656	73					672	foreach (@{$content}) { # loop over content stack
	73					764
657	369					4191	chomp;
658	369					7001	$chunk++;
659	369					4233	$_ =~ s/^\s*//; # strip spaces @ end and begin
660	369					4424	$_ =~ s/\s*$//;
661
662							#
663							# build option value assignment, split current input
664							# using whitespace, equal sign or optionally here-doc
665							# separator (ascii 182).
666	369					8431	my ($option,$value);
667	369	100				4517	if (/$indichar/) {
668	4					95	($option,$value) = split /\s$indichar\s/, $_, 2; # separated by heredoc-finding in _open()
669							}
670							else {
671	365	100				6915	if ($this->{SplitPolicy} eq 'guess') {
672							# again the old regex. use equalsign SplitPolicy to get the
673							# 2.00 behavior. the new regexes were too odd.
674	362					5077	($option,$value) = split /\s=\s\|\s+/, $_, 2;
675							}
676							else {
677							# no guess, use one of the configured strict split policies
678	3					67	($option,$value) = split /$this->{SplitDelimiter}/, $_, 2;
679							}
680							}
681
682	369	100	100			5379	if ($value && $value =~ /^"/ && $value =~ /"$/) {
			100
683	4					38	$value =~ s/^"//; # remove leading and trailing "
684	4					40	$value =~ s/"$//;
685							}
686	369	100				4308	if (! defined $block) { # not inside a block @ the moment
		100
		100
687	192	100				2391	if (/^<([^\/]+?.*?)>$/) { # look if it is a block
		50
688	47					565	$block = $1; # store block name
689	47	100				579	if ($block =~ /^"([^"]+)"$/) {
690							# quoted block, unquote it and do not split
691	1					14	$block =~ s/"//g;
692							}
693							else {
694							# If it is a named block store the name separately; allow the block and name to each be quoted
695	46	50				801	if ($block =~ /^(?:"([^"]+)"\|(\S+))(?:\s+(?:"([^"]+)"\|(.*)))?$/) {
696	46		66			654	$block = $1 \|\| $2;
697	46		100			694	$blockname = $3 \|\| $4;
698							}
699							}
700	47	100				467	if ($this->{InterPolateVars}) {
701							# interpolate block(name), add "<" and ">" to the key, because
702							# it is sure that such keys does not exist otherwise.
703	7					89	$block = $this->_interpolate("<$block>", $block);
704	7	100				69	if (defined $blockname) {
705	3					39	$blockname = $this->_interpolate("<$blockname>", "$blockname");
706							}
707							}
708	47	50				544	if ($this->{LowerCaseNames}) {
709	0					0	$block = lc $block; # only for blocks lc(), if configured via new()
710							}
711	47					482	$this->{level} += 1;
712	47					448	undef @newcontent;
713	47					456	next;
714							}
715							elsif (/^<\/(.+?)>$/) { # it is an end block, but we don't have a matching block!
716	0					0	croak "EndBlock \"<\/$1>\" has no StartBlock statement (level: $this->{level}, chunk $chunk)!\n";
717							}
718							else { # insert key/value pair into actual node
719	145	50				1765	if ($this->{LowerCaseNames}) {
720	0					0	$option = lc $option;
721							}
722	145	100				1341	if (exists $config->{$option}) {
723	22	100				246	if ($this->{MergeDuplicateOptions}) {
724	4					44	$config->{$option} = $this->_parse_value($option, $value);
725							}
726							else {
727	18	50				167	if (! $this->{AllowMultiOptions} ) {
728							# no, duplicates not allowed
729	0					0	croak "Option \"$option\" occurs more than once (level: $this->{level}, chunk $chunk)!\n";
730							}
731							else {
732							# yes, duplicates allowed
733	18	100				283	if (ref($config->{$option}) ne 'ARRAY') { # convert scalar to array
734	11					107	my $savevalue = $config->{$option};
735	11					111	delete $config->{$option};
736	11					131	push @{$config->{$option}}, $savevalue;
	11					134
737							}
738	18					162	eval {
739							# check if arrays are supported by the underlying hash
740	18					144	my $i = scalar @{$config->{$option}};
	18					203
741							};
742	18	50				160	if ($EVAL_ERROR) {
743	0					0	$config->{$option} = $this->_parse_value($option, $value);
744							}
745							else {
746							# it's already an array, just push
747	18					146	push @{$config->{$option}}, $this->_parse_value($option, $value);
	18					199
748							}
749							}
750							}
751							}
752							else {
753							# standard config option, insert key/value pair into node
754	123					1313	$config->{$option} = $this->_parse_value($option, $value);
755							}
756							}
757							}
758							elsif (/^<([^\/]+?.*?)>$/) { # found a start block inside a block, don't forget it
759	13					104	$block_level++; # $block_level indicates wether we are still inside a node
760	13					129	push @newcontent, $_; # push onto new content stack for later recursive call of _parse()
761							}
762							elsif (/^<\/(.+?)>$/) {
763	60	100				589	if ($block_level) { # this endblock is not the one we are searching for, decrement and push
764	13					105	$block_level--; # if it is 0, then the endblock was the one we searched for, see below
765	13					131	push @newcontent, $_; # push onto new content stack
766							}
767							else { # calling myself recursively, end of $block reached, $block_level is 0
768	47	100				542	if (defined $blockname) { # a named block, make it a hashref inside a hash within the current node
769	18					197	$this->_savelast($blockname);
770
771	18	100				242	if (! exists $config->{$block}) {
772	14					205	$config->{$block} = $this->_hashref(); # Make sure that the hash is not created implicitely
773							}
774
775	18	50				291	if (exists $config->{$block}->{$blockname}) { # the named block already exists, make it an array
		50
776	0	0				0	if ($this->{MergeDuplicateBlocks}) {
777							# just merge the new block with the same name as an existing one into
778							# this one.
779	0					0	$config->{$block}->{$blockname} = $this->_parse($config->{$block}->{$blockname}, \@newcontent);
780							}
781							else {
782	0	0				0	if (! $this->{AllowMultiOptions}) {
783	0					0	croak "Named block \"<$block $blockname>\" occurs more than once (level: $this->{level}, chunk $chunk)!\n";
784							}
785							else { # preserve existing data
786	0					0	my $savevalue = $config->{$block}->{$blockname};
787	0					0	delete $config->{$block}->{$blockname};
788	0					0	my @ar;
789	0	0				0	if (ref $savevalue eq 'ARRAY') {
790	0					0	push @ar, @{$savevalue}; # preserve array if any
	0					0
791							}
792							else {
793	0					0	push @ar, $savevalue;
794							}
795	0					0	push @ar, $this->_parse( $this->_hashref(), \@newcontent); # append it
796	0					0	$config->{$block}->{$blockname} = \@ar;
797							}
798							}
799							}
800							elsif (ref($config->{$block}) eq 'ARRAY') {
801	0					0	croak "Cannot add named block <$block $blockname> to hash! Block <$block> occurs more than once.\n"
802							."Turn on -MergeDuplicateBlocks or make sure <$block> occurs only once in the config.\n";
803							}
804							else {
805							# the first occurence of this particular named block
806	18					181	$config->{$block}->{$blockname} = $this->_parse($this->_hashref(), \@newcontent);
807							}
808	18					197	$this->_backlast($blockname);
809							}
810							else { # standard block
811	29					326	$this->_savelast($block);
812	29	100				272	if (exists $config->{$block}) { # the block already exists, make it an array
813	2	50				24	if ($this->{MergeDuplicateBlocks}) {
814							# just merge the new block with the same name as an existing one into
815							# this one.
816	0					0	$config->{$block} = $this->_parse($config->{$block}, \@newcontent);
817							}
818							else {
819	2	50				21	if (! $this->{AllowMultiOptions}) {
820	0					0	croak "Block \"<$block>\" occurs more than once (level: $this->{level}, chunk $chunk)!\n";
821							}
822							else {
823	2					19	my $savevalue = $config->{$block};
824	2					22	delete $config->{$block};
825	2					38	my @ar;
826	2	50				22	if (ref $savevalue eq "ARRAY") {
827	0					0	push @ar, @{$savevalue};
	0					0
828							}
829							else {
830	2					19	push @ar, $savevalue;
831							}
832	2					21	push @ar, $this->_parse( $this->_hashref(), \@newcontent);
833	2					22	$config->{$block} = \@ar;
834							}
835							}
836							}
837							else {
838							# the first occurence of this particular block
839							#### $config->{$block} = $this->_parse($config->{$block}, \@newcontent);
840	27					279	$config->{$block} = $this->_parse($this->_hashref(), \@newcontent);
841							}
842	29					307	$this->_backlast($block);
843							}
844	47					392	undef $blockname;
845	47					378	undef $block;
846	47					471	$this->{level} -= 1;
847	47					445	next;
848							}
849							}
850							else { # inside $block, just push onto new content stack
851	104					1134	push @newcontent, $_;
852							}
853							}
854	73	50				746	if ($block) {
855							# $block is still defined, which means, that it had
856							# no matching endblock!
857	0					0	croak "Block \"<$block>\" has no EndBlock statement (level: $this->{level}, chunk $chunk)!\n";
858							}
859	73					901	return $config;
860							}
861
862
863							sub _savelast {
864	47			47		442	my($this, $key) = @_;
865	47					382	push @{$this->{upperkeys}}, $this->{lastkey};
	47					503
866	47					451	$this->{lastkey} = $this->{prevkey};
867	47					437	$this->{prevkey} = $key;
868	47					412	return;
869							}
870
871							sub _backlast {
872	47			47		431	my($this, $key) = @_;
873	47					432	$this->{prevkey} = $this->{lastkey};
874	47					367	$this->{lastkey} = pop @{$this->{upperkeys}};
	47					458
875	47					443	return;
876							}
877
878							sub _parse_value {
879							#
880							# parse the value if value parsing is turned on
881							# by either -AutoTrue and/or -FlagBits
882							# otherwise just return the given value unchanged
883							#
884	145			145		3522	my($this, $option, $value) =@_;
885
886							# avoid "Use of uninitialized value"
887	145	100				1313	if (! defined $value) {
888	2					20	$value = q();
889							}
890
891	145	100				1526	if ($this->{InterPolateVars}) {
892	14					156	$value = $this->_interpolate($option, $value);
893							}
894
895							# make true/false values to 1 or 0 (-AutoTrue)
896	145	100				2086	if ($this->{AutoTrue}) {
897	12	100				183	if ($value =~ /$this->{AutoTrueFlags}->{true}/io) {
		50
898	6					53	$value = 1;
899							}
900							elsif ($value =~ /$this->{AutoTrueFlags}->{false}/io) {
901	6					54	$value = 0;
902							}
903							}
904
905							# assign predefined flags or undef for every flag \| flag ... (-FlagBits)
906	145	100				1458	if ($this->{FlagBits}) {
907	1	50				14	if (exists $this->{FlagBitsFlags}->{$option}) {
908	1					16	my %__flags = map { $_ => 1 } split /\s\\|\s/, $value;
	2					24
909	1					11	foreach my $flag (keys %{$this->{FlagBitsFlags}->{$option}}) {
	1					14
910	3	100				30	if (exists $__flags{$flag}) {
911	2					22	$__flags{$flag} = $this->{FlagBitsFlags}->{$option}->{$flag};
912							}
913							else {
914	1					11	$__flags{$flag} = undef;
915							}
916							}
917	1					11	$value = \%__flags;
918							}
919							}
920	145					2142	return $value;
921							}
922
923
924
925
926
927
928							sub NoMultiOptions {
929							#
930							# turn AllowMultiOptions off, still exists for backward compatibility.
931							# Since we do parsing from within new(), we must
932							# call it again if one turns NoMultiOptions on!
933							#
934	0			0	0	0	croak q(The NoMultiOptions() method is deprecated. Set 'AllowMultiOptions' to 'no' instead!);
935							}
936
937
938							sub save {
939							#
940							# this is the old version of save() whose API interface
941							# has been changed. I'm very sorry 'bout this.
942							#
943							# I'll try to figure out, if it has been called correctly
944							# and if yes, feed the call to Save(), otherwise croak.
945							#
946	0			0	0	0	my($this, $one, @two) = @_;
947
948	0	0	0			0	if ( (@two && $one) && ( (scalar @two) % 2 == 0) ) {
			0
949							# @two seems to be a hash
950	0					0	my %h = @two;
951	0					0	$this->save_file($one, \%h);
952							}
953							else {
954	0					0	croak q(The save() method is deprecated. Use the new save_file() method instead!);
955							}
956	0					0	return;
957							}
958
959
960							sub save_file {
961							#
962							# save the config back to disk
963							#
964	3			3	1	33	my($this, $file, $config) = @_;
965	3					24	my $fh;
966	3					25	my $config_string;
967
968	3	50				30	if (!$file) {
969	0					0	croak "Filename is required!";
970							}
971							else {
972	3	50				59	$fh = IO::File->new( "$file", 'w') or croak "Could not open $file!($!)\n";
973
974	3	50				1064	if (!$config) {
975	3	50				33	if (exists $this->{config}) {
976	3					27	$config_string = $this->_store(0, %{$this->{config}});
	3					52
977							}
978							else {
979	0					0	croak "No config hash supplied which could be saved to disk!\n";
980							}
981							}
982							else {
983	0					0	$config_string = $this->_store(0,%{$config});
	0					0
984							}
985
986	3	50				36	if ($config_string) {
987	3					25	print {$fh} $config_string;
	3					136
988							}
989							else {
990							# empty config for whatever reason, I don't care
991	0					0	print {$fh} q();
	0					0
992							}
993
994	3					305	close $fh;
995							}
996	3					55	return;
997							}
998
999
1000
1001							sub save_string {
1002							#
1003							# return the saved config as a string
1004							#
1005	0			0	1	0	my($this, $config) = @_;
1006
1007	0	0	0			0	if (!$config \|\| ref($config) ne 'HASH') {
1008	0	0				0	if (exists $this->{config}) {
1009	0					0	return $this->_store(0, %{$this->{config}});
	0					0
1010							}
1011							else {
1012	0					0	croak "No config hash supplied which could be saved to disk!\n";
1013							}
1014							}
1015							else {
1016	0					0	return $this->_store(0, %{$config});
	0					0
1017							}
1018	0					0	return;
1019							}
1020
1021
1022
1023							sub _store {
1024							#
1025							# internal sub for saving a block
1026							#
1027	15			15		174	my($this, $level, %config) = @_;
1028	15					164	local $_;
1029	15					165	my $indent = q( ) x $level;
1030
1031	15					125	my $config_string = q();
1032
1033	15					246	foreach my $entry (sort keys %config) {
1034	31	100				368	if (ref($config{$entry}) eq 'ARRAY') {
		100
1035	4					77	foreach my $line (@{$config{$entry}}) {
	4					52
1036	10	100				98	if (ref($line) eq 'HASH') {
1037	2					25	$config_string .= $this->_write_hash($level, $entry, $line);
1038							}
1039							else {
1040	8					77	$config_string .= $this->_write_scalar($level, $entry, $line);
1041							}
1042							}
1043							}
1044							elsif (ref($config{$entry}) eq 'HASH') {
1045	10					153	$config_string .= $this->_write_hash($level, $entry, $config{$entry});
1046							}
1047							else {
1048	17					173	$config_string .= $this->_write_scalar($level, $entry, $config{$entry});
1049							}
1050							}
1051
1052	15					204	return $config_string;
1053							}
1054
1055
1056							sub _write_scalar {
1057							#
1058							# internal sub, which writes a scalar
1059							# it returns it, in fact
1060							#
1061	25			25		233	my($this, $level, $entry, $line) = @_;
1062
1063	25					214	my $indent = q( ) x $level;
1064
1065	25					194	my $config_string;
1066
1067	25	100	66			316	if ($line =~ /\n/ \|\| $line =~ /\\$/) {
1068							# it is a here doc
1069	1					8	my $delimiter;
1070	1					10	my $tmplimiter = 'EOF';
1071	1					13	while (!$delimiter) {
1072							# create a unique here-doc identifier
1073	1	50				25	if ($line =~ /$tmplimiter/s) {
1074	0					0	$tmplimiter .= q(%);
1075							}
1076							else {
1077	1					12	$delimiter = $tmplimiter;
1078							}
1079							}
1080	1					16	my @lines = split /\n/, $line;
1081	1					14	$config_string .= $indent . $entry . $this->{StoreDelimiter} . "<<$delimiter\n";
1082	1					10	foreach (@lines) {
1083	3					31	$config_string .= $indent . $_ . "\n";
1084							}
1085	1					13	$config_string .= $indent . "$delimiter\n";
1086							}
1087							else {
1088							# a simple stupid scalar entry
1089	24					253	$line =~ s/#/\\#/g;
1090	24					257	$config_string .= $indent . $entry . $this->{StoreDelimiter} . $line . "\n";
1091							}
1092
1093	25					413	return $config_string;
1094							}
1095
1096							sub _write_hash {
1097							#
1098							# internal sub, which writes a hash (block)
1099							# it returns it, in fact
1100							#
1101	12			12		111	my($this, $level, $entry, $line) = @_;
1102
1103	12					149	my $indent = q( ) x $level;
1104	12					94	my $config_string;
1105
1106	12	50				123	if ($entry =~ /\s/) {
1107							# quote the entry if it contains whitespaces
1108	0					0	$entry = q(") . $entry . q(");
1109							}
1110
1111	12					210	$config_string .= $indent . q(<) . $entry . ">\n";
1112	12					2117	$config_string .= $this->_store($level + 1, %{$line});
	12					190
1113	12					127	$config_string .= $indent . q(</) . $entry . ">\n";
1114
1115	12					138	return $config_string
1116							}
1117
1118
1119							sub _hashref {
1120							#
1121							# return a probably tied new empty hash ref
1122							#
1123	81			81		813	my($this) = @_;
1124	81					1671	my ($package, $filename, $line, $subroutine, $hasargs,
1125							$wantarray, $evaltext, $is_require, $hints, $bitmask) = caller 0;
1126	81	50				891	if ($this->{Tie}) {
1127	0					0	eval {
1128	0					0	eval {require $this->{Tie}};
	0					0
1129							};
1130	0	0				0	if ($EVAL_ERROR) {
1131	0					0	croak q(Could not create a tied hash of type: ) . $this->{Tie} . q(: ) . $EVAL_ERROR;
1132							}
1133	0					0	my %hash;
1134	0					0	tie %hash, $this->{Tie};
1135	0					0	return \%hash;
1136							}
1137							else {
1138	81					1153	return {};
1139							}
1140							}
1141
1142
1143
1144							#
1145							# Procedural interface
1146							#
1147							sub ParseConfig {
1148							#
1149							# @_ may contain everything which is allowed for new()
1150							#
1151	3			3	1	51	return (new Config::General(@_))->getall();
1152							}
1153
1154							sub SaveConfig {
1155							#
1156							# 2 parameters are required, filename and hash ref
1157							#
1158	1			1	1	11	my ($file, $hash) = @_;
1159
1160	1	50	33			17	if (!$file \|\| !$hash) {
1161	0					0	croak q{SaveConfig(): filename and hash argument required.};
1162							}
1163							else {
1164	1	50				40	if (ref($hash) ne 'HASH') {
1165	0					0	croak q(The second parameter must be a reference to a hash!);
1166							}
1167							else {
1168	1					20	(new Config::General(-ConfigHash => $hash))->save_file($file);
1169							}
1170							}
1171	1					89	return;
1172							}
1173
1174							sub SaveConfigString {
1175							#
1176							# same as SaveConfig, but return the config,
1177							# instead of saving it
1178							#
1179	0			0	1		my ($hash) = @_;
1180
1181	0	0					if (!$hash) {
1182	0						croak q{SaveConfigString(): Hash argument required.};
1183							}
1184							else {
1185	0	0					if (ref($hash) ne 'HASH') {
1186	0						croak q(The parameter must be a reference to a hash!);
1187							}
1188							else {
1189	0						return (new Config::General(-ConfigHash => $hash))->save_string();
1190							}
1191							}
1192	0						return;
1193							}
1194
1195
1196
1197							# keep this one
1198							1;
1199							__END__
1200
1201
1202
1203
1204
1205							=head1 NAME
1206
1207							Config::General - Generic Config Module
1208
1209							=head1 SYNOPSIS
1210
1211							#
1212							# the OOP way
1213							use Config::General;
1214							$conf = new Config::General("rcfile");
1215							my %config = $conf->getall;
1216
1217							#
1218							# the procedural way
1219							use Config::General;
1220							my %config = ParseConfig("rcfile");
1221
1222							=head1 DESCRIPTION
1223
1224							This module opens a config file and parses it's contents for you. The B<new> method
1225							requires one parameter which needs to be a filename. The method B<getall> returns a hash
1226							which contains all options and it's associated values of your config file.
1227
1228							The format of config files supported by B<Config::General> is inspired by the well known apache config
1229							format, in fact, this module is 100% compatible to apache configs, but you can also just use simple
1230							name/value pairs in your config files.
1231
1232							In addition to the capabilities of an apache config file it supports some enhancements such as here-documents,
1233							C-style comments or multiline options.
1234
1235
1236							=head1 SUBROUTINES/METHODS
1237
1238							=over
1239
1240							=item new()
1241
1242							Possible ways to call B<new()>:
1243
1244							$conf = new Config::General("rcfile");
1245
1246							$conf = new Config::General(\%somehash);
1247
1248							$conf = new Config::General( %options ); # see below for description of possible options
1249
1250
1251							This method returns a B<Config::General> object (a hash blessed into "Config::General" namespace.
1252							All further methods must be used from that returned object. see below.
1253
1254							You can use the new style with hash parameters or the old style which is of course
1255							still supported. Possible parameters to B<new()> are:
1256
1257							* a filename of a configfile, which will be opened and parsed by the parser
1258
1259							or
1260
1261							* a hash reference, which will be used as the config.
1262
1263							An alternative way to call B<new()> is supplying an option- hash with one or more of
1264							the following keys set:
1265
1266							=over
1267
1268							=item B<-ConfigFile>
1269
1270							A filename or a filehandle, i.e.:
1271
1272							-ConfigFile => "rcfile" or -ConfigFile => \$FileHandle
1273
1274
1275
1276							=item B<-ConfigHash>
1277
1278							A hash reference, which will be used as the config, i.e.:
1279
1280							-ConfigHash => \%somehash
1281
1282
1283
1284							=item B<-String>
1285
1286							A string which contains a whole config, or an arrayref
1287							containing the whole config line by line.
1288							The parser will parse the contents of the string instead
1289							of a file. i.e:
1290
1291							-String => $complete_config
1292
1293							it is also possible to feed an array reference to -String:
1294
1295							-String => \@config_lines
1296
1297
1298
1299							=item B<-AllowMultiOptions>
1300
1301							If the value is "no", then multiple identical options are disallowed.
1302							The default is "yes".
1303							i.e.:
1304
1305							-AllowMultiOptions => "no"
1306
1307							see B<IDENTICAL OPTIONS> for details.
1308
1309							=item B<-LowerCaseNames>
1310
1311							If set to a true value, then all options found in the config will be converted
1312							to lowercase. This allows you to provide case-in-sensitive configs. The
1313							values of the options will B<not> lowercased.
1314
1315
1316
1317							=item B<-UseApacheInclude>
1318
1319							If set to a true value, the parser will consider "include ..." as valid include
1320							statement (just like the well known apache include statement).
1321
1322
1323
1324							=item B<-IncludeRelative>
1325
1326							If set to a true value, included files with a relative path (i.e. "cfg/blah.conf")
1327							will be opened from within the location of the configfile instead from within the
1328							location of the script($0). This works only if the configfile has a absolute pathname
1329							(i.e. "/etc/main.conf").
1330
1331							If the variable B<-ConfigPath> has been set and if the file to be included could
1332							not be found in the location relative to the current config file, the module
1333							will search within B<-ConfigPath> for the file. See the description of B<-ConfigPath>
1334							for more details.
1335
1336
1337							=item B<-IncludeDirectories>
1338
1339							If set to a true value, you may specify include a directory, in which case all
1340							files inside the directory will be loaded in ASCII order. Directory includes
1341							will not recurse into subdirectories. This is comparable to including a
1342							directory in Apache-style config files.
1343
1344
1345							=item B<-IncludeGlob>
1346
1347							If set to a true value, you may specify a glob pattern for an include to
1348							include all matching files (e.g. <<include conf.d/*.conf>>). Also note that as
1349							with standard file patterns, * will not match dot-files, so <<include dir/*>>
1350							is often more desirable than including a directory with B<-IncludeDirectories>.
1351
1352
1353							=item B<-ConfigPath>
1354
1355							As mentioned above, you can use this variable to specify a search path for relative
1356							config files which have to be included. Config::General will search within this
1357							path for the file if it cannot find the file at the location relative to the
1358							current config file.
1359
1360							To provide multiple search paths you can specify an array reference for the
1361							path. For example:
1362
1363							@path = qw(/usr/lib/perl /nfs/apps/lib /home/lib);
1364							..
1365							-ConfigPath => \@path
1366
1367
1368
1369							=item B<-MergeDuplicateBlocks>
1370
1371							If set to a true value, then duplicate blocks, that means blocks and named blocks,
1372							will be merged into a single one (see below for more details on this).
1373							The default behavior of Config::General is to create an array if some junk in a
1374							config appears more than once.
1375
1376
1377							=item B<-MergeDuplicateOptions>
1378
1379							If set to a true value, then duplicate options will be merged. That means, if the