File Coverage

lib/Config/Simple/Extended.pm
Criterion Covered Total %
statement 77 80 96.2
branch 11 18 61.1
condition 3 5 60.0
subroutine 11 11 100.0
pod 3 3 100.0
total 105 117 89.7


line stmt bran cond sub pod time code
1             package Config::Simple::Extended;
2              
3 3     3   188190 use warnings;
  3         7  
  3         144  
4 3     3   15 use strict;
  3         5  
  3         98  
5 3     3   18 use base qw( Config::Simple );
  3         18  
  3         2407  
6 3     3   43393 use FindBin;
  3         3162  
  3         122  
7 3     3   3305 use Data::Dumper;
  3         26043  
  3         289  
8              
9 3     3   27 use lib "$FindBin::Bin/../../../local/lib/perl5";
  3         5  
  3         33  
10 3     3   9712 use File::PathInfo;
  3         10125  
  3         1081  
11              
12             our $VERSION = '0.15';
13              
14             =head1 NAME
15              
16             Config::Simple::Extended - Extend Config::Simple w/ Configuration Inheritance, chosen by URL
17              
18             =head1 VERSION
19              
20             Version 0.15
21              
22             =cut
23              
24             =head1 SYNOPSIS
25              
26             my $url = $cgi->url();
27             my $cfg_file_path = parse_url_for_config_path($url);
28             my $cfg_base_path = '/etc/app_name/sites';
29             my $cfg_path = "$cfg_base_path/$cfg_file_path";
30              
31             my $installation_cfg = Config::Simple->new(
32             file => '$cfg_path/app_name.ini' );
33              
34             my $client_cfg = Config::Simple::Extended->inherit(
35             base_config => $installation_cfg,
36             filename => '$cfg_path/client_name/app_name.ini',
37             );
38              
39             my $job_cfg = Config::Simple::Extended->inherit(
40             base_config => $client_cfg,
41             filename => '$cfg_path/client_name/app_job_id.ini',
42             );
43              
44             This is intended to provide, before this is complete
45             ->inherit() to inherit configurations, done;
46             ->parse_config_directory() choosing configuration by url;
47             ->heredoc() to parse heredoc configurations (still pending);
48             anything else?
49              
50             =head1 EXAMPLES
51              
52             For details on accessing configuration parameters, read perldoc
53             Config::Simple, which is well documented. In short, even if
54             you wanted to bypass the published methods, everything seems
55             to be found at: $cfg->{'_DATA'}->{$stanza}->{$key}, which then
56             takes an anonymous list of whatever you feed it. The notes
57             below focus on how to set up overloading configuration files
58             How to write a constructor which will use them, how to share
59             configuration hashes among modules in an application, etc.
60              
61             These configuration hashes can be shared around with other
62             objects which need them, like this:
63              
64             my $object = My::New::Module->new({ 'cfg' => $self->{'cfg'} });
65              
66             assuming that you are inside an object method whose constructor
67             stored the configuration hash at its own 'cfg' key, as I used
68             to do, or in a ->cfg attribute as I tend to do these days now
69             that Moose has come along.
70              
71             or to needlessly duplicate the object in your memory overhead,
72             as I did it when I was first digging around in the innards of
73             Config::Simple, and learning how to use it:
74              
75             my $new_object = My::New::Module->new({
76             'config_file' => $self->{'cfg'}->{'_FILE_NAME'} });
77              
78             But don't do that. It will make your dumpers needlessly confusing.
79              
80             Now I can write a constructor like this:
81              
82             =over
83              
84             package My::New::Module;
85            
86             sub new {
87             my $class = shift;
88             my $defaults = shift;
89             my $self = {};
90            
91             if(defined($defaults->{'config_file'})){
92             $self->{'cfg'} = Config::Simple->new(
93             $defaults->{'config_file'} );
94             } elsif(defined($defaults->{'config_files'})){
95             my $cfg;
96             undef($cfg);
97             foreach my $file (@{$defaults->{'config_files'}}){
98             $cfg = Config::Simple::Extended->inherit({
99             base_config => $cfg,
100             filename => $file });
101             }
102             $self->{'cfg'} = $cfg;
103             } else {
104             die "Constructor invoked with no Confirguration File."
105             }
106            
107             my $db = $self->{'cfg'}->get_block('db');
108             # print STDERR Dumper(\$db);
109             $self->{'dbh'} = My::New::Module::DB->connect($db);
110            
111             bless $self, $class;
112             return $self;
113             }
114              
115             =back
116              
117             or, with Moose, perhaps adapt that as a ->_build_cfg() method
118             to populate a ->cfg() attribute. That is how I've used this
119             module since I started using Moose.
120              
121             Making it possible to use it like so:
122              
123             my $new_object = My::New::Module->new({
124             'config_files' => [ '/etc/my_app/base_configuration.ini',
125             '/etc/my_app/client/client_configuration.ini',
126             '/etc/my_app/client/job_id.ini' ] });
127              
128             with the job config over-writing the client config, over-writing
129             the base config. If you let untrusted users write their
130             own job configuration files, you probably want to reverse
131             the order of the array, so that your base configuration file
132             ultimately overwrites the final object with your sanity checks
133             and security barriers in place.
134              
135             =cut
136              
137             =head1 METHODS
138              
139             =head2 $cfg_file_path = parse_url_for_config_path($url);
140              
141             This converts a url into a configuration file path, in a manner
142             similar to the way that drupal lays out its configuration files,
143             permitting a single code installation to host multiple instances
144             of the same application. Each url is aliased to the same code
145             installation, and this method sorts out which configuration
146             to provide it.
147              
148             =cut
149              
150             sub parse_url_for_config_path {
151 3     3 1 2597 my $self = shift;
152 3         6 my($url)=@_;
153 3         5 my $scriptpath = $0;
154 3         5 my $scriptname = $0;
155 3         5 my $default_domain = 'localhost.supporters';
156 3         6 $scriptname =~ s/^(.*)\///;
157 3         28 $scriptpath =~ s/$scriptname//;
158 3         6 $url =~ s/https:\/\///;
159 3         10 $url =~ s/http:\/\///;
160 3         10 $url =~ s/\//./g;
161             # print STDERR "The scriptname is: ",$scriptname,"\n";
162             # print STDERR "The scriptpath is: ",$scriptpath,"\n";
163 3         22 $url =~ s/$scriptname$//;
164 3         10 $url =~ s/\.$//;
165             # account for command line tests
166 3 50       11 if($url eq 'localhost'){
167 0         0 $url = $default_domain;
168 0         0 $scriptpath =~ s/t\///;
169             }
170 3         5 $url = $scriptpath."conf.d/".$url;
171             # print STDERR "The \$url is $url.\n";
172             # $self->{'conf_path'} = $url;
173             # print STDERR "The conf_path is $self->{'conf_path'}.\n";
174             # print STDERR Dumper(\$self);
175 3         11 return $url;
176             } # END parse_url_for_config_path
177              
178             =head2 ->Config::Simple::Extended->inherit();
179              
180             This is copied verbatim from ->Config::Simple::Inherit->inherit();
181             And this module's version number is taken from that module, as well.
182              
183             =head2 ->inherit()
184              
185             This module only offers this one method, but I trust you'll
186             find it useful. It returns a Config::Simple object, when given
187             a reference to a hash, of which it only recognizes two keys:
188             'base_config' and 'filename'. The 'base_config' ought to be
189             left undefined or set to a 'Config::Simple' object created
190             with either this method or the ->new() method provided by
191             Config::Simple. When 'base_config' is given a Config::Simple
192             object, it walks every configuration parameter defined in the
193             filename, and uses the new value to update the value for the
194             respective parameterin the 'base_config' object, inheriting
195             values from it, but overloading the configuration with the
196             new values.
197              
198             I envision essentially two ways this module might be used:
199              
200             (1) to provide a means for getting more specific with
201             a configuration by first creating an installation-wide
202             configuration, then a client specific configuration, then
203             job specific configuration, each overloading the more general
204             values provided by the configuration before it.
205              
206             (2) to enforce client, and installation security controls and
207             sanity checks on a configuration prepared by an untrusted user.
208             Say you had an application which permitted a local user to
209             create a configuration file for a job. By loading the user
210             created configuration first, then using the installation
211             default configuration to overwrite it, it would be possible
212             to prevent abuse and enforce system wide constraints.
213              
214             =cut
215              
216             sub inherit {
217 3     3 1 176347 my $class = shift;
218 3         9 my $args = shift;
219 3         31 my $f = new File::PathInfo;
220              
221             # print STDERR Dumper(\$args);
222 3     3   28 { no strict 'refs';
  3         6  
  3         1868  
  3         45  
223 3 100 66     87 unless(defined($args->{'base_config'}) &&
224             UNIVERSAL::isa($args->{'base_config'},'Config::Simple')) {
225 1 50       12 print "the base_config undef, return Config::Simple object \n"
226             if( $args->{'debug'} );
227 1         15 return Config::Simple->new( filename => $args->{'filename'} );
228             }
229             }
230 2         4 my @cfg_filenames;
231 2         6 my $cfg = $args->{'base_config'};
232 2 50 50     11 print "The base_config exists and includes this data: "
233             . Dumper( $cfg->{'_DATA'} ) if( $args->{'debug'} && 0 );
234 2 100       11 if(defined($cfg->{'_FILE_NAMES'})){
    50          
235 1         3 push @cfg_filenames, @{$cfg->{'_FILE_NAMES'}};
  1         6  
236 1         3 push @cfg_filenames, $args->{'filename'};
237             } elsif(defined($cfg->{'_FILE_NAME'})) {
238 1         4 push @cfg_filenames, $cfg->{'_FILE_NAME'};
239 1         2 push @cfg_filenames, $args->{'filename'};
240             } else {
241 0         0 die "We have a Config::Simple object, without an initial '_FILE_NAME' value.\n";
242             }
243 2         6 $cfg->{'_FILE_NAMES'} = \@cfg_filenames;
244 2 50       13 $f->set( $args->{'filename'} ) or die('file does not exist');
245 2         13641 my $cfg_file = $f->abs_path;
246 2         251 my $cfg_overload = Config::Simple->new( $cfg_file );
247 2 50       36479 print 'Our $cfg_overload applies this file: '
248             . $args->{'filename'}
249             . ' and looks like this: '
250             . Dumper( $cfg_overload )
251             if( $args->{'debug'} );
252              
253 2         26 my $stanzas = get_stanzas($cfg_overload);
254 2         5 foreach my $stanza ( @{$stanzas} ){
  2         13  
255 2         4 my %stanza = %{$cfg_overload->get_block( $stanza )};
  2         22  
256 2         196 foreach my $param_key (keys %stanza){
257 10 50       1426 print "\t$stanza.$param_key being overloaded with "
258             . $cfg_overload->param("$stanza.$param_key")
259             . "\n" if( $args->{'debug'} );
260 10         632 $cfg->param( "$stanza.$param_key", $cfg_overload->param("$stanza.$param_key") );
261             }
262             }
263              
264 2         199 return $cfg;
265             }
266              
267             =head2 my $array_ref = get_stanzas( $cfg );
268              
269             If you use a hierarchical configuration file structure, with values
270             assigned to keys inside of stanzas, you can use this method to
271             pull a reference to a list of the stanzas currently defined
272             in your configuration file. In an ini files this would be
273             denoted as [stanza_name], as if it were a one element arrayref.
274              
275             =cut
276              
277             sub get_stanzas {
278 2     2 1 4 my $cfg = shift;
279 2         10 my @stanzas;
280             my %stanza_keys;
281 2         86 my %config = $cfg->vars();
282 2         1706 foreach ( keys %config ){
283 10         40 $_ =~ s/\..*//;
284 10         27 $stanza_keys{$_} = 1;
285             }
286 2         12 @stanzas = keys %stanza_keys;
287 2         17 return \@stanzas;
288             }
289              
290             =head1 AUTHOR
291              
292             Hugh Esco, C<< >>
293              
294             =head1 BUGS
295              
296             On January 2nd, 2012 I resolved a long standing documentation bug which
297             I believe (but have in no way confirmed) was introduced by an interface
298             change to Config::Simple.
299              
300             On January 11th, 2013, I hardened this module by using the
301             interface, rather than the internals of Config::Simple.
302              
303             It seems that ->inherit will not overwrite a configuration
304             value for a key which does not already exist in the inherited
305             from ->cfg object. That is something which should be easy to
306             rectify but which seems barely outside the scope of this evening's
307             work when I'm supposed to be working on something else which
308             depends on these changes. I had not noticed this prior to these
309             revisions and this may represent regression. Hope this does not
310             break production installations for others. I will try to watch
311             the smoke tests and RT and respond if I see these recent enhancements
312             make problems for folks.
313              
314             Please report any bugs or feature requests to
315             C, or through the web interface at
316             L.
317             I will be notified, and then you'll automatically be notified of progress on
318             your bug as I make changes.
319              
320             =head1 SUPPORT
321              
322             You can find documentation for this module with the perldoc command.
323              
324             perldoc Config::Simple::Extended
325              
326             You can also look for information at:
327              
328             =over 4
329              
330             =item * AnnoCPAN: Annotated CPAN documentation
331              
332             L
333              
334             =item * CPAN Ratings
335              
336             L
337              
338             =item * RT: CPAN's request tracker
339              
340             L
341              
342             I also watch for bug reports at:
343              
344             L
345              
346             =item * Search CPAN
347              
348             L
349              
350             =back
351              
352             =head1 ACKNOWLEDGEMENTS
353              
354             Sherzod B. Ruzmetov, author of Config::Simple, which I've come
355             to rely on as the primary tool I use to manage configuration
356             for the applications I write.
357              
358             =head1 COPYRIGHT & LICENSE
359              
360             Copyright 2008-2013 Hugh Esco, all rights reserved.
361              
362             This program is released under the following license: Gnu
363             Public License.
364              
365             =head1 SEE ALSO
366              
367             Config::Simple which handles ini, html and simple formats.
368             Config::Simple::Extended returns a Config::Simple object, and
369             the accessors (and other methods) for its configuration are
370             documented by Mr. Ruzmetov in the perldoc for his module.
371              
372             If you need some combination of json, yaml, xml, perl, ini or
373             Config::General formats, take a look at: Config::Merge, which I
374             learned of after releasing version 0.03 of this module to cpan.
375              
376             =cut
377              
378             1; # End of Config::Simple::Extended
379