File Coverage

blib/lib/Config/IniFiles.pm
Criterion Covered Total %
statement 576 707 81.5
branch 238 374 63.6
condition 42 66 63.6
subroutine 51 59 86.4
pod 31 32 96.9
total 938 1238 75.8


line stmt bran cond sub pod time code
1             package Config::IniFiles;
2             $Config::IniFiles::VERSION = (qw($Revision: 2.38 $))[1];
3             require 5.004;
4 8     8   234 use strict;
  8         77  
  8         150  
5 8     8   122 use Carp;
  8         73  
  8         142  
6 8     8   196 use Symbol 'gensym','qualify_to_ref'; # For the 'any data type' hack
  8         74  
  8         148  
7              
8             @Config::IniFiles::errors = ( );
9              
10             # $Header: /cvsroot/config-inifiles/config-inifiles/IniFiles.pm,v 2.38 2003/05/14 01:30:32 wadg Exp $
11              
12             =head1 NAME
13            
14             Config::IniFiles - A module for reading .ini-style configuration files.
15            
16             =head1 SYNOPSIS
17            
18             use Config::IniFiles;
19             my $cfg = new Config::IniFiles( -file => "/path/configfile.ini" );
20             print "The value is " . $cfg->val( 'Section', 'Parameter' ) . "."
21             if $cfg->val( 'Section', 'Parameter' );
22            
23             =head1 DESCRIPTION
24            
25             Config::IniFiles provides a way to have readable configuration files outside
26             your Perl script. Configurations can be imported (inherited, stacked,...),
27             sections can be grouped, and settings can be accessed from a tied hash.
28            
29             =head1 FILE FORMAT
30            
31             INI files consist of a number of sections, each preceded with the
32             section name in square brackets. The first non-blank character of
33             the line indicating a section must be a left bracket and the last
34             non-blank character of a line indicating a section must be a right
35             bracket. The characters making up the section name can be any
36             symbols at all. However section names must be unique.
37            
38             Parameters are specified in each section as Name=Value. Any spaces
39             around the equals sign will be ignored, and the value extends to the
40             end of the line. Parameter names are localized to the namespace of
41             the section, but must be unique within a section.
42            
43             [section]
44             Parameter=Value
45            
46             Both the hash mark (#) and the semicolon (;) are comment characters.
47             by default (this can be changed by configuration)
48             Lines that begin with either of these characters will be ignored. Any
49             amount of whitespace may precede the comment character.
50            
51             Multi-line or multi-valued parameters may also be defined ala UNIX
52             "here document" syntax:
53            
54             Parameter=<<EOT
55             value/line 1
56             value/line 2
57             EOT
58            
59             You may use any string you want in place of "EOT". Note that what
60             follows the "<<" and what appears at the end of the text MUST match
61             exactly, including any trailing whitespace.
62            
63             As a configuration option (default is off), continuation lines can
64             be allowed:
65            
66             [Section]
67             Parameter=this parameter \
68             spreads across \
69             a few lines
70            
71            
72             =head1 USAGE -- Object Interface
73            
74             Get a new Config::IniFiles object with the I<new> method:
75            
76             $cfg = Config::IniFiles->new( -file => "/path/configfile.ini" );
77             $cfg = new Config::IniFiles -file => "/path/configfile.ini";
78            
79             Optional named parameters may be specified after the configuration
80             file name. See the I<new> in the B<METHODS> section, below.
81            
82             Values from the config file are fetched with the val method:
83            
84             $value = $cfg->val('Section', 'Parameter');
85            
86             If you want a multi-line/value field returned as an array, just
87             specify an array as the receiver:
88            
89             @values = $cfg->val('Section', 'Parameter');
90            
91             =head1 METHODS
92            
93             =head2 new ( [-option=>value ...] )
94            
95             Returns a new configuration object (or "undef" if the configuration
96             file has an error). One Config::IniFiles object is required per configuration
97             file. The following named parameters are available:
98            
99             =over 10
100            
101             =item I<-file> filename
102            
103             Specifies a file to load the parameters from. This 'file' may actually be
104             any of the following things:
105            
106             1) a simple filehandle, such as STDIN
107             2) a filehandle glob, such as *CONFIG
108             3) a reference to a glob, such as \*CONFIG
109             4) an IO::File object
110             5) the pathname of a file
111            
112             If this option is not specified, (i.e. you are creating a config file from scratch)
113             you must specify a target file using SetFileName in order to save the parameters.
114            
115             =item I<-default> section
116            
117             Specifies a section to be used for default values. For example, if you
118             look up the "permissions" parameter in the "users" section, but there
119             is none, Config::IniFiles will look to your default section for a "permissions"
120             value before returning undef.
121            
122             =item I<-reloadwarn> 0|1
123            
124             Set -reloadwarn => 1 to enable a warning message (output to STDERR)
125             whenever the config file is reloaded. The reload message is of the
126             form:
127            
128             PID <PID> reloading config file <file> at YYYY.MM.DD HH:MM:SS
129            
130             Default behavior is to not warn (i.e. -reloadwarn => 0).
131            
132             =item I<-nocase> 0|1
133            
134             Set -nocase => 1 to handle the config file in a case-insensitive
135             manner (case in values is preserved, however). By default, config
136             files are case-sensitive (i.e., a section named 'Test' is not the same
137             as a section named 'test'). Note that there is an added overhead for
138             turning off case sensitivity.
139            
140             =item I<-allowcontinue> 0|1
141            
142             Set -allowcontinue => 1 to enable continuation lines in the config file.
143             i.e. if a line ends with a backslash C<\>, then the following line is
144             appended to the parameter value, dropping the backslash and the newline
145             character(s).
146            
147             Default behavior is to keep a trailing backslash C<\> as a parameter
148             value. Note that continuation cannot be mixed with the "here" value
149             syntax.
150            
151             =item I<-import> object
152            
153             This allows you to import or inherit existing setting from another
154             Config::IniFiles object. When importing settings from another object,
155             sections with the same name will be merged and parameters that are
156             defined in both the imported object and the I<-file> will take the
157             value of given in the I<-file>.
158            
159             If a I<-default> section is also given on this call, and it does not
160             coincide with the default of the imported object, the new default
161             section will be used instead. If no I<-default> section is given,
162             then the default of the imported object will be used.
163            
164             =item I<-commentchar> 'char'
165            
166             The default comment character is C<#>. You may change this by specifying
167             this option to an arbitrary character, except alphanumeric characters
168             and square brackets and the "equal" sign.
169            
170             =item I<-allowedcommentchars> 'chars'
171            
172             Allowed default comment characters are C<#> and C<;>. By specifying this
173             option you may enlarge or narrow this range to a set of characters
174             (concatenating them to a string). Note that the character specified by
175             B<-commentchar> (see above) is always part of the allowed comment
176             characters. Note: The given string is evaluated as a character class
177             (i.e.: like C</[chars]/>).
178            
179             =back
180            
181             =cut
182              
183             sub new {
184 30     30 1 4276   my $class = shift;
185 30         368   my %parms = @_;
186              
187 30         347   my $errs = 0;
188 30         366   my @groups = ( );
189              
190 30         304   my $self = {};
191             # Set config file to default value, which is nothing
192 30         320   $self->{cf} = undef;
193 30 100 66     463   if( ref($parms{-import}) && ($parms{-import}->isa('Config::IniFiles')) ) {
194             # Import from the import object by COPYing, so we
195             # don't clobber the old object
196 3         25     %{$self} = %{$parms{-import}};
  3         205  
  3         69  
197               } else {
198 27         400     $self->{firstload} = 1;
199 27         281     $self->{default} = '';
200 27         291     $self->{imported} = [];
201 27 50       386     if( defined $parms{-import} ) {
202 0         0       carp "Invalid -import value \"$parms{-import}\" was ignored.";
203 0         0       delete $parms{-import};
204                 } # end if
205               } # end if
206              
207             # Copy the original parameters so we
208             # can use them when we build new sections
209 30         376   %{$self->{startup_settings}} = %parms;
  30         390  
210              
211             # Parse options
212 30         363   my($k, $v);
213 30         286   local $_;
214 30         318   $self->{nocase} = 0;
215              
216             # Handle known parameters first in this order,
217             # because each() could return parameters in any order
218 30 100       361   if (defined ($v = delete $parms{'-import'})) {
219             # Store the imported object's file parameter for reload
220 3 100       31     if( $self->{cf} ) {
221 2         17         push( @{$self->{imported}}, $self->{cf} );
  2         22  
222                 } else {
223 1         9         push( @{$self->{imported}}, "<Un-named file>" );
  1         11  
224                 } # end if
225               }
226 30 100       368   if (defined ($v = delete $parms{'-file'})) {
227             # Should we be pedantic and check that the file exists?
228             # .. no, because now it could be a handle, IO:: object or something else
229 26         262     $self->{cf} = $v;
230               }
231 30 100       339   if (defined ($v = delete $parms{'-default'})) {
232 3         32     $self->{default} = $v;
233               }
234 30 100       324   if (defined ($v = delete $parms{'-nocase'})) {
235 3 50       35     $self->{nocase} = $v ? 1 : 0;
236               }
237 30 50       321   if (defined ($v = delete $parms{'-reloadwarn'})) {
238 0 0       0     $self->{reloadwarn} = $v ? 1 : 0;
239               }
240 30 100       320   if (defined ($v = delete $parms{'-allowcontinue'})) {
241 1 50       12     $self->{allowcontinue} = $v ? 1 : 0;
242               }
243 30 100       318   if (defined ($v = delete $parms{'-commentchar'})) {
244 1 50 33     20     if(!defined $v || length($v) != 1) {
    50          
245 0         0       carp "Comment character must be unique.";
246 0         0       $errs++;
247                 }
248                 elsif($v =~ /[\[\]=\w]/) {
249             # must not be square bracket, equal sign or alphanumeric
250 0         0       carp "Illegal comment character.";
251 0         0       $errs++;
252                 }
253                 else {
254 1         11       $self->{comment_char} = $v;
255                 }
256               }
257 30 50       323   if (defined ($v = delete $parms{'-allowedcommentchars'})) {
258             # must not be square bracket, equal sign or alphanumeric
259 0 0 0     0     if(!defined $v || $v =~ /[\[\]=\w]/) {
260 0         0       carp "Illegal value for -allowedcommentchars.";
261 0         0       $errs++;
262                 }
263                 else {
264 0         0       $self->{comment_char} = $v;
265                 }
266               }
267 30 100       523   $self->{comment_char} = '#' unless exists $self->{comment_char};
268 30 100       462   $self->{allowed_comment_char} = ';' unless exists $self->{allowed_comment_char};
269             # make sure that comment character is always allowed
270 30         303   $self->{allowed_comment_char} .= $self->{comment_char};
271              
272             # Any other parameters are unkown
273 30         392   while (($k, $v) = each %parms) {
274 0         0     carp "Unknown named parameter $k=>$v";
275 0         0     $errs++;
276               }
277              
278 30 50       327   return undef if $errs;
279              
280 30         406   bless $self, $class;
281              
282             # No config file specified, so everything's okay so far.
283 30 100       330   if (not defined $self->{cf}) {
284 4         55     return $self;
285               }
286               
287 26 100       295   if ($self->ReadConfig) {
288 23         612     return $self;
289               } else {
290 3         33     return undef;
291               }
292             }
293              
294             =head2 val ($section, $parameter [, $default] )
295            
296             Returns the value of the specified parameter (C<$parameter>) in section
297             C<$section>, returns undef (or C<$default> if specified) if no section or
298             no parameter for the given section section exists.
299            
300            
301             If you want a multi-line/value field returned as an array, just
302             specify an array as the receiver:
303            
304             @values = $cfg->val('Section', 'Parameter');
305            
306             A multi-line/value field that is returned in a scalar context will be
307             joined using $/ (input record separator, default is \n) if defined,
308             otherwise the values will be joined using \n.
309            
310             =cut
311              
312             sub val {
313 34     34 1 2271   my ($self, $sect, $parm, $def) = @_;
314              
315             # Always return undef on bad parameters
316 34 50       355   return undef if not defined $sect;
317 34 50       415   return undef if not defined $parm;
318               
319 34 100       340   if ($self->{nocase}) {
320 1         10     $sect = lc($sect);
321 1         10     $parm = lc($parm);
322               }
323               
324 34 100       5905   my $val = defined($self->{v}{$sect}{$parm}) ?
325                 $self->{v}{$sect}{$parm} :
326                 $self->{v}{$self->{default}}{$parm};
327               
328             # If the value is undef, make it $def instead (which could just be undef)
329 34 100       447   $val = $def unless defined $val;
330               
331             # Return the value in the desired context
332 34 100 100     455   if (wantarray and ref($val) eq "ARRAY") {
    100          
333 1         15     return @$val;
334               } elsif (ref($val) eq "ARRAY") {
335 3 50       36    if (defined ($/)) {
336 3         48 return join "$/", @$val;
337             } else {
338 0         0 return join "\n", @$val;
339             }
340               } else {
341 30         491     return $val;
342               }
343             }
344              
345             =head2 setval ($section, $parameter, $value, [ $value2, ... ])
346            
347             Sets the value of parameter C<$parameter> in section C<$section> to
348             C<$value> (or to a set of values). See below for methods to write
349             the new configuration back out to a file.
350            
351             You may not set a parameter that didn't exist in the original
352             configuration file. B<setval> will return I<undef> if this is
353             attempted. See B<newval> below to do this. Otherwise, it returns 1.
354            
355             =cut
356              
357             sub setval {
358 2     2 1 20   my $self = shift;
359 2         21   my $sect = shift;
360 2         19   my $parm = shift;
361 2         23   my @val = @_;
362              
363 2 50       25   return undef if not defined $sect;
364 2 50       24   return undef if not defined $parm;
365              
366             # tom@ytram.com +
367 2 100       26   if ($self->{nocase}) {
368 1         10     $sect = lc($sect);
369 1         10     $parm = lc($parm);
370               }
371             # tom@ytram.com -
372              
373 2 100       27   if (defined($self->{v}{$sect}{$parm})) {
374 1 50       17     if (@val > 1) {
375 0         0       $self->{v}{$sect}{$parm} = \@val;
376 0         0