File Coverage

blib/lib/CGI/Application/Plugin/ConfigAuto.pm
Criterion Covered Total %
statement 45 53 84.9
branch 13 22 59.0
condition n/a
subroutine 8 8 100.0
pod 3 3 100.0
total 69 86 80.2


line stmt bran cond sub pod time code
1             package CGI::Application::Plugin::ConfigAuto;
2 2     2   52119 use base 'Exporter';
  2         5  
  2         220  
3 2     2   10 use Carp;
  2         5  
  2         155  
4 2     2   9 use strict;
  2         8  
  2         140  
5              
6             our @EXPORT_OK = qw(
7             cfg_file
8             cfg
9             );
10              
11             # For compliance with CGI::App::Standard::Config
12             # we break the rule and export config and std_config by default.
13             sub import {
14 4     4   46907 my $app = caller;
15 2     2   14 no strict 'refs';
  2         4  
  2         1254  
16 4         17 my $full_name = $app . '::config';
17 4         24 *$full_name = \&cfg;
18              
19 4         10 my $std_config_name = $app.'::std_config';
20 4         17 *$std_config_name = \&std_config;
21 4         550 CGI::Application::Plugin::ConfigAuto->export_to_level(1,@_);
22             }
23              
24              
25             our $VERSION = '1.33';
26              
27             # required by C::A::Standard::Config;
28 1     1 1 6 sub std_config { return 1; }
29              
30             =pod
31              
32             =head1 NAME
33              
34             CGI::Application::Plugin::ConfigAuto - Easy config file management for CGI::Application
35              
36             =head1 SYNOPSIS
37              
38             use CGI::Application::Plugin::ConfigAuto (qw/cfg/);
39              
40             In your instance script:
41              
42             my $app = WebApp->new(PARAMS => { cfg_file => 'config.pl' });
43             $app->run();
44              
45             In your application module:
46              
47             sub my_run_mode {
48             my $self = shift;
49              
50             # Access a config hash key directly
51             $self->cfg('field');
52            
53             # Return config as hash
54             %CFG = $self->cfg;
55              
56             }
57              
58              
59             =head1 DESCRIPTION
60              
61             CGI::Application::Plugin::ConfigAuto adds easy access to config file variables
62             to your L modules. Lazy loading is used to
63             prevent the config file from being parsed if no configuration variables are
64             accessed during the request. In other words, the config file is not parsed
65             until it is actually needed. The L package provides
66             the framework for this plugin.
67              
68             =head1 RATIONALE
69              
70             C promotes re-usable applications by moving a maximal amount
71             of code into modules. For an application to be fully re-usable without code changes,
72             it is also necessary to store configuration variables in a separate file.
73              
74             This plugin supports multiple config files for a single application, allowing
75             config files to override each other in a particular order. This covers even
76             complex cases, where you have a global config file, and second local config
77             file which overrides a few variables.
78              
79             It is recommended that you to declare your config file locations in the
80             instance scripts, where it will have minimum impact on your application. This
81             technique is ideal when you intend to reuse your module to support multiple
82             configuration files. If you have an application with multiple instance scripts
83             which share a single config file, you may prefer to call the plugin from the
84             setup() method.
85              
86             =head1 DECLARING CONFIG FILE LOCATIONS
87              
88             # In your instance script
89             # value can also be an arrayref of config files
90             my $app = WebApp->new(PARAMS => { cfg_file => 'config.pl' })
91              
92             # OR ...
93              
94             # Pass in an array of config files, and they will be processed in order.
95             $app->cfg_file('../../config/config.pl');
96              
97             Your config files should be referenced using the syntax example above. Note
98             that the key C can be used as alternative to cfg_file.
99              
100              
101              
102              
103             The format is detected automatically using L. It it
104             known to support the following formats: colon separated, space separated,
105             equals separated, XML, Perl code, and Windows INI. See that modules
106             documentation for complete details.
107              
108             =head1 METHODS
109              
110             =head2 cfg()
111              
112             # Access a config hash key directly
113             $self->cfg('field');
114            
115             # Return config as hash
116             my %CFG = $self->cfg;
117              
118             # return as hashref
119             my $cfg_href = $self->cfg;
120            
121             A method to access project configuration variables. The config
122             file is parsed on the first call with a perl hash representation stored in memory.
123             Subsequent calls will use this version, rather than re-reading the file.
124              
125             In list context, it returns the configuration data as a hash.
126             In scalar context, it returns the configuration data as a hashref.
127              
128             =head2 config()
129              
130             L is provided as an alias to cfg() for compliance with
131             L. It always exported by default per the
132             standard.
133              
134             =head2 std_config()
135              
136             L is implemented to comply with L. It's
137             for developers. Users can ignore it.
138              
139             =cut
140              
141             sub cfg {
142 8     8 1 33131 my $self = shift;
143              
144 8 100       33 if (!$self->{__CFG}) {
145 4         3857 require Config::Auto;
146              
147 4 50       19574 unless ($self->{__CFG_FILES}) {
148 0         0 my @all_cfg_files;
149 0         0 for my $key (qw/cfg_file config_files/) {
150 0         0 my $cfg_file = $self->param($key);
151 0 0       0 if (defined $cfg_file) {
152 0 0       0 push @all_cfg_files, @$cfg_file if (ref $cfg_file eq 'ARRAY');
153 0 0       0 push @all_cfg_files, $cfg_file if (ref \$cfg_file eq 'SCALAR');
154             }
155             }
156            
157             # Non-standard call syntax for mix-in happiness.
158 0         0 cfg_file($self,@all_cfg_files);
159             }
160              
161             # Read in config files in the order the appear in this array.
162 4         8 my %combined_cfg;
163 4         9 for (my $i = 0; $i < scalar @{ $self->{__CFG_FILES} }; $i++) {
  8         37  
164 5         15 my $file = $self->{__CFG_FILES}[$i];
165 5         7 my %parms;
166 5 100       19 if (ref $self->{__CFG_FILES}[$i+1] eq 'HASH') {
167 2         3 %parms = %{ $self->{__CFG_FILES}[$i+1] };
  2         8  
168             # skip trying to process the hashref as a file name
169 2         4 $i++;
170             }
171 5         23 my $cfg = Config::Auto::parse($file, %parms);
172 4         11843 %combined_cfg = (%combined_cfg, %$cfg);
173             }
174 3 100       24 die "No configuration found. Check your config file(s) (check the syntax if this is a perl format)."
175             unless keys %combined_cfg;
176              
177 2         8 $self->{__CFG} = \%combined_cfg;
178             }
179              
180 6         10 my $cfg = $self->{__CFG};
181 6         7 my $field = shift;
182 6 100       22 return $cfg->{$field} if $field;
183 5 50       21 if (ref $cfg) {
184 5 100       23 return wantarray ? %$cfg : $cfg;
185             }
186             }
187              
188             =head2 cfg_file()
189              
190             # Usual
191             $self->cfg_file('my_config_file.pl');
192            
193             # Supply the first format, guess the second
194             $self->cfg_file('my_config_file.pl',{ format => 'perl' } );
195              
196             Supply an array of config files, and they will be processed in order. If a
197             hash reference if found it, will be used to supply the format for the previous
198             file in the array.
199              
200             =cut
201              
202             sub cfg_file {
203 5     5 1 2210 my $self = shift;
204 5         15 my @cfg_files = @_;
205 5 50       14 unless (scalar @cfg_files) { croak "cfg_file: must have at least one config file." }
  0         0  
206 5         22 $self->{__CFG_FILES} = \@cfg_files;
207             }
208              
209              
210             1;
211             __END__