File Coverage

blib/lib/CGI/Application/Plugin/Config/General.pm
Criterion Covered Total %
statement 141 145 97.2
branch 54 64 84.3
condition 1 3 33.3
subroutine 24 24 100.0
pod 5 6 83.3
total 225 242 92.9


line stmt bran cond sub pod time code
1              
2             package CGI::Application::Plugin::Config::General;
3              
4 13     13   494435 use warnings;
  13         36  
  13         496  
5 13     13   79 use strict;
  13         26  
  13         649  
6             require 5.006;
7              
8 13     13   74 use base 'Exporter';
  13         26  
  13         1371  
9 13     13   1319 use CGI::Application;
  13         9414  
  13         353  
10 13     13   13832 use Config::General::Match;
  13         609721  
  13         858  
11              
12 13     13   126 use Carp;
  13         31  
  13         866  
13 13     13   77 use File::Spec;
  13         26  
  13         461  
14 13     13   69 use Scalar::Util qw(weaken isweak);
  13         23  
  13         1762  
15 13     13   80 use Cwd;
  13         33  
  13         825  
16              
17 13     13   173 use vars '@EXPORT';
  13         26  
  13         33936  
18             @EXPORT = qw(conf);
19              
20             our $CGIAPP_Namespace = '__CONFIG_GENERAL';
21              
22             =head1 NAME
23              
24             CGI::Application::Plugin::Config::General - Add Config::General Support to CGI::Application
25              
26             =head1 VERSION
27              
28             Version 0.08
29              
30             =cut
31              
32             our $VERSION = '0.08';
33              
34             =head1 NOTE
35              
36             This module is obsolete and has now been superceded by
37             L.
38              
39             =head1 SYNOPSIS
40              
41             =head2 Simple Access to Configuration
42              
43             In your L-based module:
44              
45             use base 'CGI::Application';
46             use CGI::Application::Plugin::Config::General;
47              
48             sub cgiapp_init {
49             my $self = shift;
50              
51             # Set config file and other options
52             $self->conf->init(
53             -ConfigFile => 'app.conf',
54             );
55             }
56              
57             sub my_run_mode {
58             my $self = shift;
59              
60             # get entire configuration
61             my %conf = $self->conf->getall;
62              
63             # get entire configuration (as a reference)
64             my $conf = $self->conf->getall;
65              
66             # get single config parameter
67             my $value = $self->conf->param('some_value');
68              
69             # get underlying Config::General::Match object
70             my $obj = $self->conf->obj;
71             }
72              
73             =head2 Configuration Based on URL or Module
74              
75             You can match a configuration section to the request URL, or to the
76             module name. For instance, given the following configuration file:
77              
78             admin_area = 0
79              
80            
81             admin_area = 1
82             title = Admin Area
83            
84              
85            
86             title = Feedback Form
87            
88              
89             The configuration will depend on how the script is called:
90              
91              
92             # URL: /cgi-bin/feedback.cgi?rm=add
93             # Module: MyApp::Feedback
94              
95             print $self->conf->param('admin_area'); # 0
96             print $self->conf->param('title'); # 'Feedback Form'
97              
98             # URL: /cgi-bin/admin/users.cgi
99             # Module: MyApp::Admin::Users
100              
101             print $self->conf->param('admin_area'); # 1
102             print $self->conf->param('title'); # 'Admin Area'
103              
104             =head2 Matching Configuration based on a Virtual Host
105              
106             This module can also pick a configuration section based on the current
107             virtual-host:
108              
109             # httpd.conf
110            
111             SetEnv SITE_NAME REDSITE
112            
113              
114             # in app.conf
115            
116             background = blue
117             foreground = white
118            
119              
120            
121             background = red
122             foreground = pink
123            
124              
125            
126             background = darkgreen
127             foreground = lightgreen
128            
129              
130             =head1 DESCRIPTION
131              
132             This module allows you to easily access configuration data stored in
133             L (i.e. Apache-style) config files.
134              
135             You can also automatically match configuration sections to the request
136             URL, or to the module name. This is similar to how Apache dynamically
137             selects a configuration by matching the request URL to e.g.
138             C<< >> and C<< >> sections.
139              
140             You can also select configuration sections based on Virtual Host or by a
141             variable you set in an C<.htaccess> file. This allows you to share a
142             single application between many virtual hosts, each with its own
143             unique configuration. This could be useful, for instance, in providing
144             multiple themes for a single application.
145              
146             =head2 Simple access to Configuration
147              
148             This module provides a C method to your L
149             object. First, you initialize the configuration system (typically in
150             your C method):
151              
152             $self->conf->init(
153             -ConfigFile => 'app.conf',
154             );
155              
156             The configuration file is parsed at this point and is available from
157             this point on.
158              
159             Then, within your run-modes you can retrieve configuration data:
160              
161             # get entire configuration
162             my %conf = $self->conf->getall;
163             my $value = $conf{'some_value'};
164              
165             # get entire configuration (as a reference)
166             my $conf = $self->conf->getall;
167             my $value = $conf->{'some_value'};
168              
169             # get single config parameter
170             my $value = $self->conf->param('some_value');
171              
172             =head2 Multiple named Configurations
173              
174             You can use more than one configuration by providing a name to the
175             C method:
176              
177             $self->conf('database')->init(
178             -ConfigFile => 'app.conf',
179             );
180             $self->conf('application')->init(
181             -ConfigFile => 'app.conf',
182             );
183              
184             ...
185              
186             my %db_config = $self->conf('database')->getall;
187             my %app_config = $self->conf('application')->getall;
188              
189             =head2 Configuration based on URL or Module
190              
191             Within your configuration file, you can provide different configurations
192             depending on the current URL, or on the package name of your
193             application.
194              
195             =over 4
196              
197             =item
198              
199             Matches against the C environment variable, using an I
200             match.
201              
202             # httpd.conf
203            
204             SetEnv SITE_NAME REDSITE
205            
206              
207             # in app.conf
208            
209             background = blue
210             foreground = white
211            
212              
213            
214             background = red
215             foreground = pink
216            
217              
218            
219             background = darkgreen
220             foreground = lightgreen
221            
222              
223             You can use name your sections something other than C<< >>, and
224             you can use a different environment variable than C. See
225             L, below.
226              
227             =item
228              
229             Matches the Package name of your application module, for instance:
230              
231            
232             ...
233            
234              
235             The match is performed hierachically, like a filesystem path, except
236             using C<::> as a delimiter, instead of C. The match is tied to the
237             beginning of the package name, just like absolute paths. For instance,
238             given the section:
239              
240            
241             ...
242            
243              
244             the packages C and C would match, but
245             the packages C and C would not.
246              
247             =item
248              
249             Matches the package name of your application module, using a regular
250             expression. The expression is not tied to the start of the string. For
251             instance, given the section:
252              
253            
254             ...
255            
256              
257             The following packages would all match: C, C,
258             C, C, C.
259              
260             =item
261              
262             Matches hierarchically against the request URI, including the path and
263             the C components, but I the scheme, host, port and
264             query string.
265              
266             So, for instance with the following URL:
267              
268             http://bookstore.example.com/cgi-bin/category.cgi/fiction/?rm=list
269              
270             The Location would be:
271              
272             /cgi-bin/category.cgi/fiction/
273              
274             Internally, the location is obtained by calling the C method of the
275             query object (which is usually either a L or L
276             object):
277              
278             $path = $webapp->query->url('-absolute' => 1, '-path_info' => 1);
279              
280             =item
281              
282             Matches against the request URI, using a regular expression.
283              
284             =back
285              
286             =head2 Section Merge Order
287              
288             The sections are matched in the following order:
289              
290             Site:
291             Package Name: and
292             URL: and
293              
294             When there is more than one matching section at the same level of
295             priority (e.g. two C<< >> sections, or both an C<< >>
296             and an C<< >> section), then the sections are merged in the
297             order of shortest match first.
298              
299             Values in sections matched later override the values in sections matched
300             earlier.
301              
302             The idea is that the longer matches are more specific and should have
303             priority, and that URIs are more specific than Module names.
304              
305             =head2 Section Nesting
306              
307             The sections can be nested inside each other. For instance:
308              
309            
310            
311             admin_books = 1
312            
313            
314              
315            
316            
317             admin_records = 1
318            
319            
320              
321            
322            
323            
324            
325              
326              
327             By default, the sections can be nested up to two levels deep. You can
328             change this by setting the L<-NestingDepth> parameter to L.
329              
330             =head2 Merging Configuration Values into your Template
331              
332             You can easily pass values from your configuration files directly to
333             your templates. This allows you to associate HTML titles with URLs,
334             or keep text like copyright notices in your config file instead of your
335             templates:
336              
337             copyright_notice = Copyright (C) 1492 Christopher Columbus
338              
339            
340             title = "Manifest Destiny, Inc. - About Us"
341            
342              
343            
344             title = "Manifest Destiny, Inc. - Contact Us"
345            
346              
347             If you use L, you use the associate method when you load
348             the template:
349              
350             $self->load_template(
351             'template.tmpl',
352             'associate' => $self->conf,
353             );
354              
355             If you use L (via the L
356             module), you can accomplish the same thing by providing a custom
357             tt_pre_process method:
358              
359             sub tt_pre_process {
360             my $self = shift;
361             my $template = shift;
362             my $template_params = shift;
363              
364             my $config = $self->conf->getall
365             foreach (keys %$config) {
366             unless (exists $template_params->{$_}) {
367             $template_params->{$_} = $config->{$_};
368             }
369             }
370             }
371              
372              
373             I
374             I
375             I
376             I
377              
378              
379             =head1 METHODS
380              
381             =cut
382              
383             # The 'conf' method is the only sub exported into the cgiapp namespace all
384             # other methods are called through the object returned by this method.
385             #
386             # 'conf' checks to see if an object of the requested name (or the default,
387             # unnamed object) already exists in the webapp object.
388             #
389             # If it exists it returns a reference to it
390             #
391             # If it doesn't exist, it creates it and returns a reference to it
392             #
393             #
394             # Note that at the moment, subclasses of this plugin are probably not
395             # possible because of the call to __PACKAGE__->new.
396              
397             sub conf {
398 101     101 0 3052933 my ($self, $conf_name) = @_;
399              
400 101 100       301 if (defined $conf_name) {
401             # Named config
402 75 100       370 if (not exists $self->{$CGIAPP_Namespace}->{'__NAMED_CONFIGS'}->{$conf_name}) {
403 27         253 $self->{$CGIAPP_Namespace}->{'__NAMED_CONFIGS'}->{$conf_name} = __PACKAGE__->_new($self, $conf_name);
404 27 50       205 if ($self->can('add_callback')) {
405 27         142 $self->add_callback('teardown', \&_clear_all_current_configs, 'LAST');
406             }
407              
408             }
409 75         799 return $self->{$CGIAPP_Namespace}->{'__NAMED_CONFIGS'}->{$conf_name};
410             }
411             else {
412             # Default config
413 26 100       152 if (not exists $self->{$CGIAPP_Namespace}->{'__DEFAULT_CONFIG'}) {
414 11         101 $self->{$CGIAPP_Namespace}->{'__DEFAULT_CONFIG'} = __PACKAGE__->_new($self);
415 11 50       207 if ($self->can('add_callback')) {
416 11         62 $self->add_callback('teardown', \&_clear_all_current_configs, 'LAST');
417             }
418             }
419 26         375 return $self->{$CGIAPP_Namespace}->{'__DEFAULT_CONFIG'};
420             }
421             }
422              
423             sub _new {
424 38     38   82 my ($proto, $webapp, $conf_name) = @_;
425              
426 38   33     246 my $class = ref $proto || $proto;
427              
428 38         206 my ($package) = ref $webapp;
429              
430 38         283 my $self = {
431             '__CONFIG_NAME' => $conf_name,
432             '__CALLERS_PACKAGE' => $package,
433             '__CGIAPP_OBJ' => $webapp,
434             '__CONFIG' => undef,
435             '__CONFIG_OBJ' => undef,
436             '__CONFIG_OBJ_CREATED' => undef,
437             '__CONFIG' => undef,
438             };
439              
440             # Force reference to CGI::Applcation object to be weak to avoid
441             # circular references
442 38         206 weaken($self->{'__CGIAPP_OBJ'});
443              
444 38         276 return bless $self, $class;
445             }
446              
447             =head2 init
448              
449             Initializes the plugin. The only required parameter is a config file:
450              
451             $self->conf->init(
452             -ConfigFile => 'app.conf',
453             );
454              
455             The other paramters are described below:
456              
457             =over 4
458              
459             =item -ConfigFile
460              
461             The path to the configuration file to be parsed.
462              
463             =item -Options
464              
465             Any additional L options. See the documentation
466             to L and L for more details.
467              
468             =item -CacheConfigFiles
469              
470             Whether or not to cache configuration files. Enabled, by default.
471             This option is only really useful in a persistent environment such as
472             C. See L under L,
473             below.
474              
475             =item -StatConfig
476              
477             If config file caching is enabled, this option controls how often the
478             config files are checked to see if they have changed. The default is 60
479             seconds. This option is only really useful in a persistent environment
480             such as C. See L under
481             C, below.
482              
483             =item -SiteSectionName
484              
485             Change the name of the C<< >> section to something else. For
486             instance, to use sections named C<< >>, use:
487              
488             -SiteSectionName => 'VirtualHost'
489              
490             =item -SiteVar
491              
492             Change the name of the C environment variable used to match
493             against C<< >> sections. For instance To change this name to
494             C, use:
495              
496             -SiteVar => 'HTTP_HOST',
497              
498             =item -NestingDepth
499              
500             The number of levels deep that sections can be nested. The default is
501             two levels deep.
502              
503             See L
, above.
504              
505             =back
506              
507             You can initialize the plugin from within your instance CGI script:
508              
509             my $app = WebApp->new();
510             $app->conf->init(-ConfigFile => '../../config/app.conf');
511             $app->run();
512              
513             Or you can do so from within your C method within the
514             application:
515              
516             sub cgiapp_init {
517             my $self = shift;
518             $self->conf->init(
519             -ConfigFile => "$ENV{DOCUMENT_ROOT}/../config/app.conf"
520             );
521             }
522              
523              
524             =cut
525              
526             sub init {
527 36     36 1 93 my $self = shift;
528              
529 36         129 my %args = @_;
530 36 50       170 my $config_file = delete $args{'-ConfigFile'} or croak "CAP::CG->init: -ConfigFile is a required parameter\n";
531              
532 36 100       136 my $cache_config_files = exists $args{'-CacheConfigFiles'} ? delete $args{'-CacheConfigFiles'} : 1;
533 36 100       123 my $stat_config = exists $args{'-StatConfig'} ? delete $args{'-StatConfig'} : 60;
534 36 100       198 my $options = exists $args{'-Options'} ? delete $args{'-Options'} : {};
535 36 100       123 my $site_var = exists $args{'-SiteVar'} ? delete $args{'-SiteVar'} : 'SITE_NAME';
536 36 100       340 my $site_section_name = exists $args{'-SiteSectionName'} ? delete $args{'-SiteSectionName'} : 'Site';
537 36 50       114 my $nesting_depth = exists $args{'-NestingDepth'} ? delete $args{'-NestingDepth'} : 2;
538              
539 36 50       121 if (keys %args) {
540 0         0 croak "CAP::CG: unrecognized args to init: " .(join ', ', keys %args). "\n";
541             }
542              
543 36         83 my $cg_obj;
544              
545             # If file caching is enabled then attempt to retrieve the
546             # Config::General object from the cache
547              
548 36 100       99 if ($cache_config_files) {
549 22 100       117 if ($self->_cgm_cache_check_valid($config_file, $stat_config)) {
550              
551             # we don't need to reread the files
552 8         23 $cg_obj = $self->_cgm_cache_retrieve($config_file);
553              
554             }
555             }
556              
557             # Build the C::G::M object if we haven't retrieved it from the cache
558 36 100       116 if (!$cg_obj) {
559             # print STDERR "$self->{'__CALLERS_PACKAGE'} did not retrieve from cache\n";
560              
561             # Add -MatchSections if not provided
562 28 100       85 unless ($options->{'-MatchSections'}) {
563              
564             # Override 'Site' with -SiteSectionName if desired
565 27         228 $options->{'-MatchSections'} = $self->_default_matchsections(
566             $site_section_name
567             );
568             }
569              
570 28         73 $options->{'-ConfigFile'} = $config_file;
571              
572 28         346 $cg_obj = Config::General::Match->new(%$options);
573              
574 27         54321 $self->{'__CONFIG_OBJ_CREATED'} = time;
575              
576             # If file caching is enabled then store the object in the cache
577 27 100       102 if ($cache_config_files) {
578              
579 14         34 my @config_files = ($config_file);
580              
581 14         69 $self->_cgm_cache_store($config_file, $cg_obj, $self->{'__CONFIG_OBJ_CREATED'});
582             }
583             }
584              
585 35         99 $self->{'__CONFIG_OBJ'} = $cg_obj;
586              
587 35         75 my $cgiapp = $self->{'__CGIAPP_OBJ'};
588              
589 35         130 my $config = $cg_obj->getall_matching_nested(
590             $nesting_depth,
591             'env' => $self->_get_server_var($site_var),
592             'module' => $self->{'__CALLERS_PACKAGE'},
593             'path' => $cgiapp->query->url('-absolute' => 1, '-path_info' => 1),
594             );
595              
596 35         331736 $self->{'__CONFIG'} = $config;
597              
598 35         172 $self->_set_current_config($self->{'__CONFIG_NAME'}, $config);
599              
600             }
601              
602             our %CGM_Cache;
603              
604             # Cache format:
605             # %CGM_Cache = (
606             # $absolute_filename1 => {
607             # __OBJ => $cg_obj,
608             # __CREATION_TIME => $creation_time, # time object was constructed
609             #
610             # __FILES => [ # array of fileinfo hashrefs,
611             # # one per config file included
612             # # by the primary config file
613             # {
614             # __FILENAME => $filename1, # name of file
615             # __MTIME => $mtime1, # last modified time, in epoch seconds
616             # __SIZE => $size1, # size, in bytes
617             # __LASTCHECK => $time1, # last time we checked this file, in epoch seconds
618             # },
619             # {
620             # __FILENAME => $filename2,
621             # __MTIME => $mtime2,
622             # __SIZE => $size2,
623             # __LASTCHECK => $time2,
624             # },
625             # ]
626             # }
627              
628              
629             # _cgm_cache_retrieve($filename) # returns object
630             sub _cgm_cache_retrieve {
631 8     8   73 my ($self, $config_file) = @_;
632              
633 8         279 my $abs_path = Cwd::abs_path($config_file);
634              
635 8         24 return $CGM_Cache{$abs_path}->{'__OBJ'};
636             }
637              
638              
639             # _cgm_cache_store($filename, $cg_obj, $creation_time) # stores object
640             sub _cgm_cache_store {
641 14     14   37 my ($self, $config_file, $cg_obj, $creation_time) = @_;
642              
643 14         35 my @config_files = ($config_file);
644 14         834 my $abs_path = Cwd::abs_path($config_file);
645              
646             # Config::General 2.28 and higher can give a list of files it has read,
647             # including included files
648 14 50       131 if ($cg_obj->can('files')) {
649 14         57 @config_files = $cg_obj->files;
650             }
651              
652 14         261 my @filedata;
653              
654 14         35 foreach my $config_file (@config_files) {
655 16         29 my $time = time;
656 16         243 my ($size, $mtime) = (stat $config_file)[7,9];
657 16         97 my %fileinfo = (
658             '__FILENAME' => $config_file,
659             '__LASTCHECK' => $time,
660             '__MTIME' => $mtime,
661             '__SIZE' => $size,
662             );
663 16         57 push @filedata, \%fileinfo;
664             }
665              
666 14         110 $CGM_Cache{$abs_path} = {
667             '__OBJ' => $cg_obj,
668             '__CREATION_TIME' => $creation_time,
669             '__FILES' => \@filedata,
670             };
671             }
672              
673             # _cgm_cache_check_valid($config_file, $cg_obj, $stat_config)
674             # - returns true if all config files associated with this file
675             # are still valid.
676             # - returns false if any of the configuration files have changed
677             #
678             # if a file was checked less than stat_seconds ago, then it is not even
679             # checked, but assumed to be valid.
680             # Otherwise it is checked again. If its mtime or size have changed
681             # then it is assumed to be invalid.
682             #
683             # if any file has changed then the configuration is determined to
684             # be invalid
685              
686             sub _cgm_cache_check_valid {
687 22     22   52 my ($self, $config_file, $stat_config) = @_;
688              
689 22         69 my @config_files = ($config_file);
690 22         1526 my $abs_path = Cwd::abs_path($config_file);
691              
692 22 100       132 return unless exists $CGM_Cache{$abs_path};
693 12 50       57 return unless ref $CGM_Cache{$abs_path}{'__FILES'} eq 'ARRAY';
694              
695 12         26 foreach my $fileinfo (@{ $CGM_Cache{$abs_path}{'__FILES'} }) {
  12         48  
696 13         22 my $time = time;
697              
698             # Don't stat the file unless our last check was more recent than
699             # $stat_config seconds ago
700              
701 13 100       116 next if ($fileinfo->{'__MTIME'} + $stat_config >= $time);
702              
703 5         67 my ($size, $mtime) = (stat $config_file)[7,9];
704              
705             # return false if any differences
706 5 100       33 return if $size != $fileinfo->{'__SIZE'};
707 2 100       12 return if $mtime != $fileinfo->{'__MTIME'};
708              
709             # no change, so save the new stat info in the cache
710 1         2 $fileinfo->{'__SIZE'} = $size;
711 1         2 $fileinfo->{'__MTIME'} = $mtime;
712 1         3 $fileinfo->{'__LASTCHECK'} = $time;
713              
714             }
715 8         36 return 1;
716             }
717              
718             # _get_apache_var($varname)
719             # - retrieve the variable $varname from dirconfig or from %ENV
720              
721             sub _get_server_var {
722 35     35   80 my ($self, $varname) = @_;
723              
724 35         48 my $value;
725 35 50       141 if ($ENV{'MOD_PERL'}) {
726 0         0 require Apache;
727 0         0 $value = Apache->request->dir_config($varname);
728             }
729 35 50       104 if (!$value) {
730 35         73 $value = $ENV{$varname};
731             }
732 35         282 return $value;
733             }
734              
735             =head2 getall
736              
737             Gets the entire configuration as a hash or hashref:
738              
739             my %config = $self->conf->getall; # as hash
740             my $config = $self->conf->getall; # as hashref
741              
742             Note that the following two method calls will return different results:
743              
744             my %config = $self->conf->getall; # parsed config
745             my %config = $self->conf->obj->getall; # raw config
746              
747             In the first case, the matching based on URI, Module, etc. has already
748             been performed. In the second case, you get the raw config with all of
749             the C<< >>, C<< >>, etc. sections intact.
750              
751             =cut
752              
753             sub getall {
754 26     26 1 47 my $self = shift;
755 26 100       79 return %{ $self->{'__CONFIG'} } if wantarray;
  2         14  
756 24         82 return $self->{'__CONFIG'};
757             }
758              
759             =head2 param
760              
761             Allows you to retrieve individual values from the configuration.
762              
763             It behvaves like the C method in other classes, such as L,
764             L and L:
765              
766             $value = $self->conf->param('some_key');
767             @all_keys = $self->conf->param();
768              
769             =cut
770              
771             sub param {
772 14     14 1 26 my $self = shift;
773 14         25 my $config = $self->{'__CONFIG'};
774              
775 14 100       28 if (@_) {
776 13         74 return $config->{$_[0]};
777             }
778             else {
779 1         29 return keys %$config;
780             }
781             }
782              
783             =head2 obj
784              
785             Provides access to the underlying L object.
786              
787             You can access the raw unparsed configuration data by calling
788              
789             my $config = $self->conf->obj->getall; # raw config
790              
791             See the note under L, above.
792              
793             In future versions of this module, certain caching strategies may
794             prevent you from accessing the underlying L
795             object in certain situations.
796              
797             =cut
798              
799             sub obj {
800 21     21 1 35 my $self = shift;
801 21         162 return $self->{'__CONFIG_OBJ'};
802             }
803              
804             =head2 get_current_config ($name)
805              
806             This is a class method which returns the current configuration object.
807              
808             my $conf = CGI::Application::Plugin::Config::General->get_current_config;
809             print $conf->{'title'};
810              
811             my %db_conf = CGI::Application::Plugin::Config::General->get_current_config('db');
812             print $db_conf{'username'};
813              
814             This method is most useful in situations where you don't have access to
815             the L object, such within a L class. See
816             L for an example.
817              
818             Note that L returns the configuration hash (or
819             hashref) directly, and does not give you access to the object itself.
820             It is the equivalent of calling C<< $self->conf->getall >>.
821              
822             =cut
823              
824             # Sets the "current config" for a given name
825             # _set_current_config($name, \%config);
826              
827             our $Default_Current_Config;
828             our %Current_Config;
829              
830             sub _set_current_config {
831 35     35   70 my ($class, $name, $config) = @_;
832              
833 35 100       117 if (defined $name) {
834 25         175 $Current_Config{$name} = $config;
835             }
836             else {
837 10         81 $Default_Current_Config = $config;
838             }
839             }
840              
841             # Clears all "current configs"
842             # _clear_all_current_configs();
843             sub _clear_all_current_configs {
844 14     14   33350 %Current_Config = ();
845 14         90 $Default_Current_Config = {};
846             }
847              
848             sub get_current_config {
849 4     4 1 5755 my ($class, $name) = @_;
850              
851 4         9 my $config = {};
852              
853 4 100       11 if (defined $name) {
854 1 50       5 if (exists $Current_Config{$name}) {
855 1         3 $config = $Current_Config{$name};
856             }
857             else {
858 0         0 croak "CAP::CG: requested config named '$name' does not exist\n";
859             }
860             }
861             else {
862 3         5 $config = $Default_Current_Config;
863             }
864              
865 4 100       19 return %$config if wantarray;
866 3         7 return $config;
867             }
868              
869             =head1 ADVANCED USAGE
870              
871             =head2 Usage in a Persistent Environment such as mod_perl
872              
873             The following sections describe some notes about running this module
874             under mod_perl:
875              
876             =head3 Config File Caching
877              
878             By default each config file is read only once when the conf object is
879             first initialized. Thereafter, on each init, the cached config is used.
880              
881             This means that in a persistent environment like mod_perl, the config
882             file is parsed on the first request, but not on subsequent requests.
883              
884             If enough time has passed (sixty seconds by default) the config file is
885             checked to see if it has changed. If it has changed, then the file is
886             reread.
887              
888             If you are using L version 2.28 or greater, then you
889             can safely use the C feature of L and all
890             included files will be checked for changes along with the main file.
891              
892             To disable caching of config files pass a false value to the
893             L<-CacheConfigFiles> parameter to L, e.g:
894              
895             $self->conf->init(
896             -ConfigFile => 'app.conf',
897             -CacheConfigFiles => 0,
898             );
899              
900             To change how often config files are checked for changes, change the
901             value of the L<-StatConfig> paramter to L, e.g.:
902              
903             $self->conf->init(
904             -ConfigFile => 'app.conf',
905             -StatConfig => 1, # check the config file every second
906             );
907              
908              
909             Internally the configuration cache is implemented by a hash, keyed by
910             the absolute path of the configuration file. This means that if you have
911             two web applications that use the same configuration file, they will use
912             the same cache.
913              
914             This would only matter if you wanted to use different C
915             or C options for different applications running
916             in the same process that use the same config file.
917              
918              
919             =head3 PerlSetVar instead of SetEnv
920              
921             For a (slight) performance improvement, you can use C
922             instead of C within a C<< >>:
923              
924             # httpd.conf
925            
926             PerlSetVar SITE_NAME REDSITE
927            
928              
929             =head2 Notes on Site Matching
930              
931             =head3 Renaming C<< >> or C
932              
933             Normally, the environment variable C is matched to
934             C<< >> section.
935              
936             You can change these with the L<-SiteSectionName> and L<-SiteVar>
937             parameters to L:
938              
939             $self->conf->init(
940             -ConfigFile => 'app.conf',
941             -SiteSectionName => 'Host',
942             -SiteVar => 'MY_HOST',
943             );
944              
945             This will match the environment variable C to the C<< >>
946             section.
947              
948             =head3 Setting C from an C<.htaccess> file or the CGI script
949              
950             Since C is just an environment variable, you can set it
951             anywhere you can set environment variables. For instance in an C<.htaccess> file:
952              
953             # .htaccess
954             SetEnv SITE_NAME bookshop
955              
956             Or even the calling CGI script:
957              
958             #!/usr/bin/perl
959              
960             use MySite::WebApp;
961              
962             $ENV{'SITE_NAME'} = 'recordshop';
963             my $app = MySite::WebApp->new();
964             $app->run();
965              
966              
967             =head2 Access to Configuration information from another Class
968              
969             You can also get at the current configuration settings from a completely
970             unrelated Perl module. This can be useful for instance if you need to
971             configure a set of L classes, and you want them to be able
972             to pick up their configuration on their own. For instance:
973              
974             # app.conf
975              
976            
977             connect_string = dbi:Pg:dbname=example
978             username = test
979             password = test
980              
981            
982             RaiseError = 1
983             AutoCommit = 1
984            
985            
986              
987              
988             # In your Class::DBI subclass
989             package My::Class::DBI::Base;
990             use base 'Class::DBI';
991              
992             sub db_Main {
993              
994             my $conf = CGI::Application::Plugin::Config::General->get_current_config;
995              
996             my $dsn = $conf->{'database'}{'connect_string'};
997             my $user = $conf->{'database'}{'username'};
998             my $pass = $conf->{'database'}{'password'};
999             my $opts = $conf->{'database'}{'options'};
1000              
1001             return DBI->connect_cached($dsn, $user, $pass, $opts);
1002             }
1003              
1004             For this example to work, you need to make sure you call
1005             C<< $self->conf->init >> before you access the database through any of your
1006             L objects.
1007              
1008             Note that L returns the configuration hash (or
1009             hashref) directly, and does not give you access to the object itself.
1010             It is the equivalent of calling C<< $self->conf->getall >>.
1011              
1012             =head2 Changing Parsing Behaviour Using Custom L<-MatchSections>
1013              
1014             Internally, this module uses L and
1015             L to parse its config files. If you want to
1016             change the parsing behaviour, you can pass your own L<-MatchSections>
1017             list to L. For instance, if you want to allow only sections named
1018             C<< >>, with no nesting, and have these matched exactly to the
1019             complete request path, you could do the following:
1020              
1021             # app.conf
1022              
1023             admin_area = 0
1024             user_area = 0
1025              
1026            
1027             admin_area = 1
1028            
1029              
1030            
1031             user_area = 1
1032            
1033              
1034              
1035             # in your cgiapp_init:
1036             $self->conf->init(
1037             -ConfigFile => 'app.conf',
1038             -NestingDepth => 1,
1039             -Options => {
1040             -MatchSections => [
1041             {
1042             -Name => 'URL',
1043             -MatchType => 'exact',
1044             -MergePriority => 0,
1045             -SectionType => 'path',
1046             },
1047             ]
1048             }
1049             );
1050              
1051              
1052             For reference, here is the default L<-MatchSections>:
1053              
1054             -MatchSections => [
1055             {
1056             -Name => 'Site', # overridden by -SiteSectionName
1057             -MatchType => 'exact',
1058             -MergePriority => 0,
1059             -SectionType => 'env',
1060             },
1061             {
1062             -Name => 'AppMatch',
1063             -MatchType => 'regex',
1064             -SectionType => 'module',
1065             -MergePriority => 1,
1066             },
1067             {
1068             -Name => 'App',
1069             -MatchType => 'path',
1070             -PathPathSeparator => '::',
1071             -SectionType => 'module',
1072             -MergePriority => 1,
1073             },
1074             {
1075             -Name => 'LocationMatch',
1076             -MatchType => 'regex',
1077             -SectionType => 'path',
1078             -MergePriority => 3,
1079             },
1080             {
1081             -Name => 'Location',
1082             -MatchType => 'path',
1083             -SectionType => 'path',
1084             -MergePriority => 3,
1085             },
1086             ],
1087              
1088             =cut
1089              
1090             sub _default_matchsections {
1091 27     27   56 my $self = shift;
1092 27         46 my $site_var_name = shift;
1093              
1094             return
1095             [
1096             {
1097 27         648 -Name => $site_var_name,
1098             -MatchType => 'exact',
1099             -MergePriority => 0,
1100             -SectionType => 'env',
1101             },
1102             {
1103             -Name => 'AppMatch',
1104             -MatchType => 'regex',
1105             -SectionType => 'module',
1106             -MergePriority => 1,
1107             },
1108             {
1109             -Name => 'App',
1110             -MatchType => 'path',
1111             -PathSeparator => '::',
1112             -SectionType => 'module',
1113             -MergePriority => 1,
1114             },
1115             {
1116             -Name => 'LocationMatch',
1117             -MatchType => 'regex',
1118             -SectionType => 'path',
1119             -MergePriority => 3,
1120             },
1121             {
1122             -Name => 'Location',
1123             -MatchType => 'path',
1124             -SectionType => 'path',
1125             -MergePriority => 3,
1126             },
1127             ];
1128             }
1129              
1130              
1131              
1132              
1133             =pod
1134              
1135             For each section, the L<-SectionType> param indicates what runtime
1136             variable the section will be matched against. Here are the allowed values
1137              
1138             env: matched to the environment variable SITE_NAME (overridden by -SiteNameVar)
1139             module: name of the Perl Module handling this request (e.g. MyApp::Users)
1140             path: path of the request, including path_info (e.g. /cgi-bin/myapp/users.cgi/some/path)
1141              
1142             You can use the above L<-SectionType> values in your own custom
1143             L<-MatchSections>.
1144              
1145             For more information on the syntax of L<-MatchSections>, see the docs
1146             for L.
1147              
1148             =head1 AUTHOR
1149              
1150             Michael Graham, C<< >>
1151              
1152             =head1 BUGS
1153              
1154             Please report any bugs or feature requests to
1155             C, or through the web interface at
1156             L. I will be notified, and then you'll automatically
1157             be notified of progress on your bug as I make changes.
1158              
1159             =head1 ACKNOWLEDGEMENTS
1160              
1161             This module would not be possible without Thomas Linden's excellent
1162             L module.
1163              
1164             Thanks to the excellent examples provided by the other
1165             L plugin authors: Mark Stosberg, Michael Peters, Cees
1166             Hek and others.
1167              
1168             =head1 SOURCE
1169              
1170             The source code repository for this module can be found at http://github.com/mgraham/CAP-Config-General
1171              
1172             =head1 SEE ALSO
1173              
1174             CGI::Application
1175             Config::General
1176             Config::General::Match
1177             CGI::Application::Plugin::Config::Simple
1178             CGI::Application::Plugin::ConfigAuto
1179              
1180             CGI::Application::Plugin::TT
1181             Template::Toolkit
1182             HTML::Template
1183              
1184             =head1 COPYRIGHT & LICENSE
1185              
1186             Copyright 2005 Michael Graham, All Rights Reserved.
1187              
1188             This program is free software; you can redistribute it and/or modify it
1189             under the same terms as Perl itself.
1190              
1191             =cut
1192              
1193             1;