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	$self->{EOT}{$sect}{$parm} = 'EOT';
377							} else {
378	1					13	$self->{v}{$sect}{$parm} = shift @val;
379							}
380	1					15	return 1;
381							} else {
382	1					11	return undef;
383							}
384							}
385
386							=head2 newval($section, $parameter, $value [, $value2, ...])
387
388							Assignes a new value, C<$value> (or set of values) to the
389							parameter C<$parameter> in section C<$section> in the configuration
390							file.
391
392							=cut
393
394							sub newval {
395	7			7	1	69	my $self = shift;
396	7					87	my $sect = shift;
397	7					63	my $parm = shift;
398	7					72	my @val = @_;
399
400	7	50				75	return undef if not defined $sect;
401	7	50				73	return undef if not defined $parm;
402
403							# tom@ytram.com +
404	7	50				76	if ($self->{nocase}) {
405	0					0	$sect = lc($sect);
406	0					0	$parm = lc($parm);
407							}
408							# tom@ytram.com -
409	7					108	$self->AddSection($sect);
410
411	7					80	push(@{$self->{parms}{$sect}}, $parm)
	10					150
412	7	50				67	unless (grep {/^\Q$parm\E$/} @{$self->{parms}{$sect}} );
	7					86
413
414	7	100				82	if (@val > 1) {
415	1					13	$self->{v}{$sect}{$parm} = \@val;
416	1	50				20	$self->{EOT}{$sect}{$parm} = 'EOT' unless defined
417							$self->{EOT}{$sect}{$parm};
418							} else {
419	6					73	$self->{v}{$sect}{$parm} = shift @val;
420							}
421	7					77	return 1
422							}
423
424							=head2 delval($section, $parameter)
425
426							Deletes the specified parameter from the configuration file
427
428							=cut
429
430							sub delval {
431	1			1	1	10	my $self = shift;
432	1					9	my $sect = shift;
433	1					10	my $parm = shift;
434
435	1	50				13	return undef if not defined $sect;
436	1	50				11	return undef if not defined $parm;
437
438							# tom@ytram.com +
439	1	50				12	if ($self->{nocase}) {
440	0					0	$sect = lc($sect);
441	0					0	$parm = lc($parm);
442							}
443							# tom@ytram.com -
444
445	1					10	@{$self->{parms}{$sect}} = grep !/^\Q$parm\E$/, @{$self->{parms}{$sect}};
	1					15
	1					38
446	1					31	delete $self->{v}{$sect}{$parm};
447	1					14	return 1
448							}
449
450							=head2 ReadConfig
451
452							Forces the configuration file to be re-read. Returns undef if the
453							file can not be opened, no filename was defined (with the C<-file>
454							option) when the object was constructed, or an error occurred while
455							reading.
456
457							If an error occurs while parsing the INI file the @Config::IniFiles::errors
458							array will contain messages that might help you figure out where the
459							problem is in the file.
460
461							=cut
462
463							sub ReadConfig {
464	39			39	1	465	my $self = shift;
465
466	39					321	my($lineno, $sect);
467	39					323	my($group, $groupmem);
468	39					340	my($parm, $val);
469	39					673	my @cmts;
470	39					344	my %loaded_params = (); # A has to remember which params are loaded vs. imported
471	39					346	@Config::IniFiles::errors = ( );
472
473							# Initialize (and clear out) storage hashes
474							# unless we imported them from another file [JW]
475	39	100				320	if( @{$self->{imported}} ) {
	39					559
476							#
477							# Run up the import tree to the top, then reload coming
478							# back down, maintaining the imported file names and our
479							# file name.
480							# This is only needed on a re-load though
481	4	100				41	unless( $self->{firstload} ) {
482	3					29	my $cf = $self->{cf};
483	3					24	$self->{cf} = pop @{$self->{imported}};
	3					30
484	3					107	$self->ReadConfig;
485	3					25	push @{$self->{imported}}, $self->{cf};
	3					37
486	3					32	$self->{cf} = $cf;
487							} # end unless
488							} else {
489	35					473	$self->{sects} = []; # Sections
490	35					421	$self->{group} = {}; # Subsection lists
491	35					389	$self->{v} = {}; # Parameter values
492	35					400	$self->{sCMT} = {}; # Comments above section
493							} # end if
494
495							return undef if (
496	39	50	33			1031	(not exists $self->{cf}) or
			33
497							(not defined $self->{cf}) or
498							($self->{cf} eq '')
499							);
500
501	39					375	my $nocase = $self->{nocase};
502
503							# If this is a reload and we want warnings then send one to the STDERR log
504	39	50	66			493	unless( $self->{firstload} \|\| !$self->{reloadwarn} ) {
505	0					0	my ($ss, $mm, $hh, $DD, $MM, $YY) = (localtime(time))[0..5];
506	0					0	printf STDERR
507							"PID %d reloading config file %s at %d.%02d.%02d %02d:%02d:%02d\n",
508							$$, $self->{cf}, $YY+1900, $MM+1, $DD, $hh, $mm, $ss;
509							}
510
511							# Turn off. Future loads are reloads
512	39					380	$self->{firstload} = 0;
513
514							# Get a filehandle, allowing almost any type of 'file' parameter
515	39					447	my $fh = $self->_make_filehandle( $self->{cf} );
516	39	50				408	if (!$fh) {
517	0					0	carp "Failed to open $self->{cf}: $!";
518	0					0	return undef;
519							}
520
521							# Get mod time of file so we can retain it (if not from STDIN)
522	39					1035	my @stats = stat $fh;
523	39	50				644	$self->{file_mode} = sprintf("%04o", $stats[2]) if defined $stats[2];
524
525							# Get the entire file into memory (let's hope it's small!)
526	39					333	local $_;
527	39					45665	my @lines = split /\015\012?\|\012\|\025\|\n/, join( '', <$fh>);
528
529							# Only close if this is a filename, if it's
530							# an open handle, then just roll back to the start
531	39	100				895	if( !ref($fh) ) {
532	1					57	close($fh);
533							} else {
534							# But we can't roll back STDIN so skip that one
535	38	50				501	if( $fh != 0 ) {
536	38					986	seek( $fh, 0, 0 );
537							} # end if
538							} # end if
539
540							# If there's a UTF BOM (Byte-Order-Mark) in the first character of the first line
541							# then remove it before processing (http://www.unicode.org/unicode/faq/utf_bom.html#22)
542	39					399	($lines[0] =~ s/^//);
543							# Disabled the utf8 one for now (JW) because it doesn't work on all perl distros
544							# e.g. 5.6.1 works with or w/o 'use utf8' 5.6.0 fails w/o it. 5.005_03
545							# says "invalid hex value", etc. If anyone has a clue how to make this work
546							# please let me know!
547							# ($lines[0] =~ s/^//) \|\| (eval('use utf8; $lines[0] =~ s/^\x{FEFF}//;'));
548							# $@ = ''; $! = undef; # Clear any error messages
549
550
551
552							# The first lines of the file must be blank, comments or start with [
553	39					358	my $first = '';
554	39					383	my $allCmt = $self->{allowed_comment_char};
555	39					395	foreach ( @lines ) {
556	78	100				1190	next if /^\s*$/; # ignore blank lines
557	77	100				1450	next if /^\s*[$allCmt]/; # ignore comments
558	38					349	$first = $_;
559	38					457	last;
560							}
561	39	100				847	unless( $first =~ /^\s*\[/ ) {
562	2					25	return undef;
563							}
564
565							# Store what our line ending char was for output
566	37					462	($self->{line_ends}) = $lines[0] =~ /([\015\012\025\n]+)/;
567	37					392	while ( @lines ) {
568	1173					27657	$_ = shift @lines;
569
570	1173					14743	s/(\015\012?\|\012\|\025\|\n)$//; # remove line ending char(s)
571	1173					13952	$lineno++;
572	1173	100				24223	if (/^\s*$/) { # ignore blank lines
		100
		100
		100
573	232					2241	next;
574							}
575							elsif (/^\s*[$allCmt]/) { # collect comments
576	90					1186	push(@cmts, $_);
577	90					1118	next;
578							}
579							elsif (/^\s\[\s(\S\|\S.\S)\s\]\s*$/) { # New Section
580	264					3741	$sect = $1;
581	264	100				3156	if ($self->{nocase}) {
582	68					607	$sect = lc($sect);
583							}
584	264					2817	$self->AddSection($sect);
585	264					3143	$self->SetSectionComment($sect, @cmts);
586	264					3013	@cmts = ();
587							}
588							elsif (($parm, $val) = /^\s([^=]?[^=\s])\s=\s(.*)$/) { # new parameter
589	586	100				8971	$parm = lc($parm) if $nocase;
590	586					7003	$self->{pCMT}{$sect}{$parm} = [@cmts];
591	586					5391	@cmts = ( );
592	586	100				6015	if ($val =~ /^<<(.*)$/) { # "here" value
593	111					1220	my $eotmark = $1;
594	111					1075	my $foundeot = 0;
595	111					946	my $startline = $lineno;
596	111					1045	my @val = ( );
597	111					4871	while ( @lines ) {
598	435					4163	$_ = shift @lines;
599	435					5342	s/(\015\012?\|\012\|\025\|\n)$//; # remove line ending char(s)
600	435					5516	$lineno++;
601	435	100				4026	if ($_ eq $eotmark) {
602	111					1075	$foundeot = 1;
603	111					1113	last;
604							} else {
605	324					4452	push(@val, $_);
606							}
607							}
608	111	50				1297	if ($foundeot) {
609	111	100	66			1724	if (exists $self->{v}{$sect}{$parm} &&
	21		100			477
610							exists $loaded_params{$sect} &&
611							grep( /^\Q$parm\E$/, @{$loaded_params{$sect}}) ) {
612	15	50				186	if (ref($self->{v}{$sect}{$parm}) eq "ARRAY") {
613							# Add to the array
614	0					0	push @{$self->{v}{$sect}{$parm}}, @val;
	0					0
615							} else {
616							# Create array
617	15					268	my $old_value = $self->{v}{$sect}{$parm};
618	15					167	my @new_value = ($old_value, @val);
619	15					225	$self->{v}{$sect}{$parm} = \@new_value;
620							}
621							} else {
622	96					5217	$self->{v}{$sect}{$parm} = \@val;
623	96	100				5002	$loaded_params{$sect} = [] unless $loaded_params{$sect};
624	96					887	push @{$loaded_params{$sect}}, $parm;
	96					1181
625							}
626	111					1782	$self->{EOT}{$sect}{$parm} = $eotmark;
627							} else {
628	0					0	push(@Config::IniFiles::errors, sprintf('%d: %s', $startline,
629							qq#no end marker ("$eotmark") found#));
630							}
631							} else { # no here value
632
633							# process continuation lines, if any
634	475		100			14610	while($self->{allowcontinue} && $val =~ s/\\$//) {
635	2					17	$_ = shift @lines;
636	2					22	s/(\015\012?\|\012\|\025\|\n)$//; # remove line ending char(s)
637	2					16	$lineno++;
638	2					31	$val .= $_;
639							}
640
641							# Now load value
642	475	100	100			6557	if (exists $self->{v}{$sect}{$parm} &&
	70		100			1933
643							exists $loaded_params{$sect} &&
644							grep( /^\Q$parm\E$/, @{$loaded_params{$sect}}) ) {
645	60	100				862	if (ref($self->{v}{$sect}{$parm}) eq "ARRAY") {
646							# Add to the array
647	30					296	push @{$self->{v}{$sect}{$parm}}, $val;
	30					342
648							} else {
649							# Create array
650	30					881	my $old_value = $self->{v}{$sect}{$parm};
651	30					313	my @new_value = ($old_value, $val);
652	30					339	$self->{v}{$sect}{$parm} = \@new_value;
653							}
654							} else {
655	415					4854	$self->{v}{$sect}{$parm} = $val;
656	415	100				4863	$loaded_params{$sect} = [] unless $loaded_params{$sect};
657	415					3892	push @{$loaded_params{$sect}}, $parm;
	415					4590
658							}
659							}
660	586	100				4966	push(@{$self->{parms}{$sect}}, $parm) unless grep(/^\Q$parm\E$/, @{$self->{parms}{$sect}});
	488					20657
	586					16746
661							}
662							else {
663	1					21	push(@Config::IniFiles::errors, sprintf("Line \%d in file " . $self->{cf} . " is mal-formed:\n\t\%s", $lineno, $_));
664							}
665							}
666
667							#
668							# Now convert all the parameter hashes into tied hashes.
669							# This is in all uses, because it must be part of ReadConfig.
670							#
671	37					483	my %parms = %{$self->{startup_settings}};
	37					739
672	37	100				549	if( defined $parms{-default} ) {
673							# If the default section doesn't exists, create it.
674	7	100				88	unless( defined $self->{v}{$parms{-default}} ) {
675	1					13	$self->{v}{$parms{-default}} = {};
676	1	50				11	push(@{$self->{sects}}, $parms{-default}) unless (grep /^\Q$parms{-default}\E$/, @{$self->{sects}});
	1					13
	1					40
677	1					13	$self->{parms}{$parms{-default}} = [];
678							} # end unless
679	7					86	$parms{-default} = $self->{v}{$parms{-default}};
680							} # end if
681	37					350	foreach( keys %{$self->{v}} ) {
	37					527
682	266					3754	$parms{-_current_value} = $self->{v}{$_};
683	266					2745	$parms{-parms} = $self->{parms}{$_};
684	266					5898	$self->{v}{$_} = {};
685							# Add a reference to our {parms} hash for each section
686	266					2782	tie %{$self->{v}{$_}}, 'Config::IniFiles::_section', %parms
	266					4022
687							} # end foreach
688
689	37	100				1994	@Config::IniFiles::errors ? undef : 1;
690							}
691
692
693							=head2 Sections
694
695							Returns an array containing section names in the configuration file.
696							If the I<nocase> option was turned on when the config object was
697							created, the section names will be returned in lowercase.
698
699							=cut
700
701							sub Sections {
702	2			2	1	20	my $self = shift;
703	2	50				31	return @{$self->{sects}} if ref $self->{sects} eq 'ARRAY';
	2					38
704	0					0	return ();
705							}
706
707							=head2 SectionExists ( $sect_name )
708
709							Returns 1 if the specified section exists in the INI file, 0 otherwise (undefined if section_name is not defined).
710
711							=cut
712
713							sub SectionExists {
714	273			273	1	3487	my $self = shift;
715	273					2603	my $sect = shift;
716
717	273	50				4693	return undef if not defined $sect;
718
719	273	100				3393	if ($self->{nocase}) {
720	68					708	$sect = lc($sect);
721							}
722
723	273	50				3584	return undef() if not defined $sect;
724	273	100				2801	return 1 if (grep {/^\Q$sect\E$/} @{$self->{sects}});
	1135					17195
	273					8261
725	261					3072	return 0;
726							}
727
728							=head2 AddSection ( $sect_name )
729
730							Ensures that the named section exists in the INI file. If the section already
731							exists, nothing is done. In this case, the "new" section will possibly contain
732							data already.
733
734							If you really need to have a new section with no parameters in it, check that
735							the name that you're adding isn't in the list of sections already.
736
737							=cut
738
739							sub AddSection {
740	273			273	1	6839	my $self = shift;
741	273					2754	my $sect = shift;
742
743	273	50				2756	return undef if not defined $sect;
744
745	273	100				3258	if ($self->{nocase}) {
746	68					611	$sect = lc($sect);
747							}
748
749	273	100				3088	return if $self->SectionExists($sect);
750	261					2373	push @{$self->{sects}}, $sect;
	261					2905
751	261					3327	$self->SetGroupMember($sect);
752
753							# Set up the parameter names and values lists
754	261	100				3999	$self->{parms}{$sect} = [] unless ref $self->{parms}{$sect} eq 'ARRAY';
755	261	50				3723	if (!defined($self->{v}{$sect})) {
756	261					2846	$self->{sCMT}{$sect} = [];
757	261					3061	$self->{pCMT}{$sect} = {}; # Comments above parameters
758	261					2971	$self->{parms}{$sect} = [];
759	261					3174	$self->{v}{$sect} = {};
760							}
761							}
762
763							=head2 DeleteSection ( $sect_name )
764
765							Completely removes the entire section from the configuration.
766
767							=cut
768
769							sub DeleteSection {
770	1			1	1	10	my $self = shift;
771	1					10	my $sect = shift;
772
773	1	50				11	return undef if not defined $sect;
774
775	1	50				12	if ($self->{nocase}) {
776	0					0	$sect = lc($sect);
777							}
778
779							# This is done, the fast way, change if delval changes!!
780	1					11	delete $self->{v}{$sect};
781	1					10	delete $self->{sCMT}{$sect};
782	1					10	delete $self->{pCMT}{$sect};
783	1					10	delete $self->{EOT}{$sect};
784	1					11	delete $self->{parms}{$sect};
785
786	1					10	@{$self->{sects}} = grep !/^\Q$sect\E$/, @{$self->{sects}};
	1					11
	1					26
787
788	1	50				15	if( $sect =~ /^(\S+)\s+\S+/ ) {
789	0					0	my $group = $1;
790	0	0				0	if( defined($self->{group}{$group}) ) {
791	0					0	@{$self->{group}{$group}} = grep !/^\Q$sect\E$/, @{$self->{group}{$group}};
	0					0
	0					0
792							} # end if
793							} # end if
794
795	1					10	return 1;
796							} # end DeleteSection
797
798							=head2 Parameters ($sect_name)
799
800							Returns an array containing the parameters contained in the specified
801							section.
802
803							=cut
804
805							sub Parameters {
806	2			2	1	20	my $self = shift;
807	2					21	my $sect = shift;
808
809	2	50				23	return undef if not defined $sect;
810
811	2	50				67	if ($self->{nocase}) {
812	0					0	$sect = lc($sect);
813							}
814
815	2	100				29	return @{$self->{parms}{$sect}} if ref $self->{parms}{$sect} eq 'ARRAY';
	1					20
816	1					14	return ();
817							}
818
819							=head2 Groups
820
821							Returns an array containing the names of available groups.
822
823							Groups are specified in the config file as new sections of the form
824
825							[GroupName MemberName]
826
827							This is useful for building up lists. Note that parameters within a
828							"member" section are referenced normally (i.e., the section name is
829							still "Groupname Membername", including the space) - the concept of
830							Groups is to aid people building more complex configuration files.
831
832							=cut
833
834							sub Groups {
835	1			1	1	11	my $self = shift;
836	1	50				14	return keys %{$self->{group}} if ref $self->{group} eq 'HASH';
	1					50
837	0					0	return ();
838							}
839
840							=head2 SetGroupMember ( $sect )
841
842							Makes sure that the specified section is a member of the appropriate group.
843
844							Only intended for use in newval.
845
846							=cut
847
848							sub SetGroupMember {
849	261			261	1	2664	my $self = shift;
850	261					2293	my $sect = shift;
851
852	261	50				2479	return undef if not defined $sect;
853
854	261	100				3713	return(1) unless $sect =~ /^(\S+)\s+\S+/;
855
856	98					1253	my $group = $1;
857	98	100				1528	if (not exists($self->{group}{$group})) {
858	49					545	$self->{group}{$group} = [];
859							}
860	98	50				844	if (not grep {/^\Q$sect\E$/} @{$self->{group}{$group}}) {
	73					1407
	98					1051
861	98					877	push @{$self->{group}{$group}}, $sect;
	98					1301
862							}
863							}
864
865							=head2 RemoveGroupMember ( $sect )
866
867							Makes sure that the specified section is no longer a member of the
868							appropriate group. Only intended for use in DeleteSection.
869
870							=cut
871
872							sub RemoveGroupMember {
873	0			0	1	0	my $self = shift;
874	0					0	my $sect = shift;
875
876	0	0				0	return undef if not defined $sect;
877
878	0	0				0	return(1) unless $sect =~ /^(\S+)\s+\S+/;
879
880	0					0	my $group = $1;
881	0	0				0	return unless exists $self->{group}{$group};
882	0					0	@{$self->{group}{$group}} = grep {!/^\Q$sect\E$/} @{$self->{group}{$group}};
	0					0
	0					0
	0					0
883							}
884
885							=head2 GroupMembers ($group)
886
887							Returns an array containing the members of specified $group. Each element
888							of the array is a section name. For example, given the sections
889
890							[Group Element 1]
891							...
892
893							[Group Element 2]
894							...
895
896							GroupMembers would return ("Group Element 1", "Group Element 2").
897
898							=cut
899
900							sub GroupMembers {
901	0			0	1	0	my $self = shift;
902	0					0	my $group = shift;
903
904	0	0				0	return undef if not defined $group;
905
906	0	0				0	if ($self->{nocase}) {
907	0					0	$group = lc($group);
908							}
909
910	0	0				0	return @{$self->{group}{$group}} if ref $self->{group}{$group} eq 'ARRAY';
	0					0
911	0					0	return ();
912							}
913
914							=head2 SetWriteMode ($mode)
915
916							Sets the mode (permissions) to use when writing the INI file.
917
918							$mode must be a string representation of the octal mode.
919
920							=cut
921
922							sub SetWriteMode
923							{
924	5			5	1	46	my $self = shift;
925	5					51	my $mode = shift;
926	5	50				96	return undef if not defined ($mode);
927	5	50				73	return undef if not ($mode =~ m/[0-7]{3,3}/);
928	5					51	$self->{file_mode} = $mode;
929	5					51	return $mode;
930							}
931
932							=head2 GetWriteMode ($mode)
933
934							Gets the current mode (permissions) to use when writing the INI file.
935
936							$mode is a string representation of the octal mode.
937
938							=cut
939
940							sub GetWriteMode
941							{
942	0			0	1	0	my $self = shift;
943	0	0				0	return undef if not exists $self->{file_mode};
944	0					0	return $self->{file_mode};
945							}
946
947							=head2 WriteConfig ($filename)
948
949							Writes out a new copy of the configuration file. A temporary file
950							(ending in '-new') is written out and then renamed to the specified
951							filename. Also see B<BUGS> below.
952
953							Returns true on success, C<undef> on failure.
954
955							=cut
956
957							sub WriteConfig {
958	14			14	1	128	my $self = shift;
959	14					130	my $file = shift;
960
961	14	50				148	return undef unless defined $file;
962
963							# If we are using a filename, then do mode checks and write to a
964							# temporary file to avoid a race condition
965	14	100				310	if( !ref($file) ) {
966	13	100	100			645	if (-e $file) {
		100
967	6	100				103	if (not (-w $file))
968							{
969							#carp "File $file is not writable. Refusing to write config";
970	1					12	return undef;
971							}
972	5					82	my $mode = (stat $file)[2];
973	5					84	$self->{file_mode} = sprintf "%04o", ($mode & 0777);
974							#carp "Using mode $self->{file_mode} for file $file";
975							} elsif (defined($self->{file_mode}) and not (oct($self->{file_mode}) & 0222)) {
976							#carp "Store mode $self->{file_mode} prohibits writing config";
977							}
978
979	12					174	my $new_file = $file . "-new";
980	12					133	local(*F);
981	12	50				5625	open(F, "> $new_file") \|\| do {
982	0					0	carp "Unable to write temp config file $new_file: $!";
983	0					0	return undef;
984							};
985	12					606	my $oldfh = select(F);
986	12					360	$self->OutputConfig;
987	12					1084	close(F);
988	12					577	select($oldfh);
989	12	50				949	rename( $new_file, $file ) \|\| do {
990	0					0	carp "Unable to rename temp config file ($new_file) to $file: $!";
991	0					0	return undef;
992							};
993	12	100				175	if (exists $self->{file_mode}) {
994	11					316	chmod oct($self->{file_mode}), $file;
995							}
996
997							} # Otherwise, reset to the start of the file and write, unless we are using STDIN
998							else {
999							# Get a filehandle, allowing almost any type of 'file' parameter
1000							## NB: If this were a filename, this would fail because _make_file
1001							## opens a read-only handle, but we have already checked that case
1002							## so re-using the logic is ok [JW/WADG]
1003	1					13	my $fh = $self->_make_filehandle( $file );
1004	1	50				14	if (!$fh) {
1005	0					0	carp "Could not find a filehandle for the input stream ($file): $!";
1006	0					0	return undef;
1007							}
1008
1009
1010							# Only roll back if it's not STDIN (if it is, Carp)
1011	1	50				13	if( $fh == 0 ) {
1012	0					0	carp "Cannot write configuration file to STDIN.";
1013							} else {
1014	1					20	seek( $fh, 0, 0 );
1015	1					14	my $oldfh = select($fh);
1016	1					45	$self->OutputConfig;
1017	1					31	seek( $fh, 0, 0 );
1018	1					19	select($oldfh);
1019							} # end if
1020
1021							} # end if (filehandle/name)
1022
1023	13					224	return 1;
1024
1025							}
1026
1027							=head2 RewriteConfig
1028
1029							Same as WriteConfig, but specifies that the original configuration
1030							file should be rewritten.
1031
1032							=cut
1033
1034							sub RewriteConfig {
1035	12			12	1	171	my $self = shift;
1036
1037							return undef if (
1038	12	50	33			270	(not exists $self->{cf}) or
			33
1039							(not defined $self->{cf}) or
1040							($self->{cf} eq '')
1041							);
1042
1043							# Return whatever WriteConfig returns :)
1044	12					201	$self->WriteConfig($self->{cf});
1045							}
1046
1047							=head2 GetFileName
1048
1049							Returns the filename associated with this INI file.
1050
1051							If no filename has been specified, returns undef.
1052
1053							=cut
1054
1055							sub GetFileName
1056							{
1057	2			2	1	42	my $self = shift;
1058	2					17	my $filename;
1059	2	50				22	if (exists $self->{cf}) {
1060	2					18	$filename = $self->{cf};
1061							} else {
1062	0					0	undef $filename;
1063							}
1064	2					22	return $filename;
1065							}
1066
1067							=head2 SetFileName ($filename)
1068
1069							If you created the Config::IniFiles object without initialising from
1070							a file, or if you just want to change the name of the file to use for
1071							ReadConfig/RewriteConfig from now on, use this method.
1072
1073							Returns $filename if that was a valid name, undef otherwise.
1074
1075							=cut
1076
1077							sub SetFileName {
1078	10			10	1	311	my $self = shift;
1079	10					98	my $newfile = shift;
1080
1081	10	50				112	return undef if not defined $newfile;
1082
1083	10	50				140	if ($newfile ne "") {
1084	10					95	$self->{cf} = $newfile;
1085	10					112	return $self->{cf};
1086							}
1087	0					0	return undef;
1088							}
1089
1090							# OutputConfig
1091							#
1092							# Writes OutputConfig to STDOUT. Use select() to redirect STDOUT to
1093							# the output target before calling this function
1094
1095							sub OutputConfig {
1096	13			13	0	261	my $self = shift;
1097
1098	13					207	my($sect, $parm, @cmts);
1099	13		33			392	my $ors = $self->{line_ends} \|\| $\ \|\| "\n"; # $\ is normally unset, but use input by default
			50
1100	13					319	my $notfirst = 0;
1101	13					137	local $_;
1102	13					126	foreach $sect (@{$self->{sects}}) {
	13					157
1103	111	50				1529	next unless defined $self->{v}{$sect};
1104	111	100				4842	print $ors if $notfirst;
1105	111					933	$notfirst = 1;
1106	111	100	100			1338	if ((ref($self->{sCMT}{$sect}) eq 'ARRAY') &&
	109					2833
1107							(@cmts = @{$self->{sCMT}{$sect}})) {
1108	22					194	foreach (@cmts) {
1109	22					1731	print "$_$ors";
1110							}
1111							}
1112	111					6177	print "[$sect]$ors";
1113	111	50				1412	next unless ref $self->{v}{$sect} eq 'HASH';
1114
1115	111					1031	foreach $parm (@{$self->{parms}{$sect}}) {
	111					1190
1116	180	100	100			2370	if ((ref($self->{pCMT}{$sect}{$parm}) eq 'ARRAY') &&
	170					2377
1117							(@cmts = @{$self->{pCMT}{$sect}{$parm}})) {
1118	9					87	foreach (@cmts) {
1119	9					610	print "$_$ors";
1120							}
1121							}
1122
1123	180					2393	my $val = $self->{v}{$sect}{$parm};
1124	180	100				2593	next if ! defined ($val); # No parameter exists !!
1125	179	100				5190	if (ref($val) eq 'ARRAY') {
		50
1126	58		100			784	my $eotmark = $self->{EOT}{$sect}{$parm} \|\| 'EOT';
1127	58					5876	print "$parm= <<$eotmark$ors";
1128	58					539	foreach (@{$val}) {
	58					681
1129	173					9731	print "$_$ors";
1130							}
1131	58					3171	print "$eotmark$ors";
1132							} elsif( $val =~ /[$ors]/ ) {
1133							# The FETCH of a tied hash is never called in
1134							# an array context, so generate a EOT multiline
1135							# entry if the entry looks to be multiline
1136	0					0	my @val = split /[$ors]/, $val;
1137	0	0				0	if( @val > 1 ) {
1138	0		0			0	my $eotmark = $self->{EOT}{$sect}{$parm} \|\| 'EOT';
1139	0					0	print "$parm= <<$eotmark$ors";
1140	0					0	print map "$_$ors", @val;
1141	0					0	print "$eotmark$ors";
1142							} else {
1143	0					0	print "$parm=$val[0]$ors";
1144							} # end if
1145							} else {
1146	121					7334	print "$parm=$val$ors";
1147							}
1148							}
1149							}
1150	13					184	return 1;
1151							}
1152
1153							=head2 SetSectionComment($section, @comment)
1154
1155							Sets the comment for section $section to the lines contained in @comment.
1156
1157							Each comment line will be prepended with the comment charcter (default
1158							is C<#>) if it doesn't already have a comment character (ie: if the
1159							line does not start with whitespace followed by an allowed comment
1160							character, default is C<#> and C<;>).
1161
1162							To clear a section comment, use DeleteSectionComment ($section)
1163
1164							=cut
1165
1166							sub SetSectionComment
1167							{
1168	266			266	1	4733	my $self = shift;
1169	266					2364	my $sect = shift;
1170	266					3605	my @comment = @_;
1171
1172	266	50				2809	return undef if not defined $sect;
1173	266	100				4098	return undef unless @comment;
1174
1175	54	100				713	if ($self->{nocase}) {
1176	14					127	$sect = lc($sect);
1177							}
1178
1179	54					675	$self->{sCMT}{$sect} = [];
1180							# At this point it's possible to have a comment for a section that
1181							# doesn't exist. This comment will not get written to the INI file.
1182
1183	54					477	push @{$self->{sCMT}{$sect}}, $self->_markup_comments(@comment);
	54					692
1184	54					857	return scalar @comment;
1185							}
1186
1187
1188
1189							# this helper makes sure that each line is preceded with the correct comment
1190							# character
1191							sub _markup_comments
1192							{
1193	55			55		582	my $self = shift;
1194	55					730	my @comment = @_;
1195
1196	55					506	my $allCmt = $self->{allowed_comment_char};
1197	55					491	my $cmtChr = $self->{comment_char};
1198	55					632	foreach (@comment) {
1199	71	100				1348	m/^\s*[$allCmt]/ or ($_ = "$cmtChr $_");
1200							}
1201	55					670	@comment;
1202							}
1203
1204
1205
1206							=head2 GetSectionComment ($section)
1207
1208							Returns a list of lines, being the comment attached to section $section. In
1209							scalar context, returns a string containing the lines of the comment separated
1210							by newlines.
1211
1212							The lines are presented as-is, with whatever comment character was originally
1213							used on that line.
1214
1215							=cut
1216
1217							sub GetSectionComment
1218							{
1219	7			7	1	65	my $self = shift;
1220	7					63	my $sect = shift;
1221
1222	7	50				69	return undef if not defined $sect;
1223
1224	7	50				91	if ($self->{nocase}) {
1225	0					0	$sect = lc($sect);
1226							}
1227
1228	7	100				72	if (exists $self->{sCMT}{$sect}) {
1229	4					135	return @{$self->{sCMT}{$sect}};
	4					125
1230							} else {
1231	3					38	return undef;
1232							}
1233							}
1234
1235							=head2 DeleteSectionComment ($section)
1236
1237							Removes the comment for the specified section.
1238
1239							=cut
1240
1241							sub DeleteSectionComment
1242							{
1243	2			2	1	20	my $self = shift;
1244	2					20	my $sect = shift;
1245
1246	2	50				25	return undef if not defined $sect;
1247
1248	2	50				24	if ($self->{nocase}) {
1249	0					0	$sect = lc($sect);
1250							}
1251
1252	2					27	delete $self->{sCMT}{$sect};
1253							}
1254
1255							=head2 SetParameterComment ($section, $parameter, @comment)
1256
1257							Sets the comment attached to a particular parameter.
1258
1259							Any line of @comment that does not have a comment character will be
1260							prepended with one. See L</SetSectionComment($section, @comment)> above
1261
1262							=cut
1263
1264							sub SetParameterComment
1265							{
1266	1			1	1	10	my $self = shift;
1267	1					11	my $sect = shift;
1268	1					9	my $parm = shift;
1269	1					11	my @comment = @_;
1270
1271	1	50				12	defined($sect) \|\| return undef;
1272	1	50				12	defined($parm) \|\| return undef;
1273	1	50				11	@comment \|\| return undef;
1274
1275	1	50				12	if ($self->{nocase}) {
1276	0					0	$sect = lc($sect);
1277	0					0	$parm = lc($parm);
1278							}
1279
1280	1	50				14	if (not exists $self->{pCMT}{$sect}) {
1281	1					11	$self->{pCMT}{$sect} = {};
1282							}
1283
1284	1					13	$self->{pCMT}{$sect}{$parm} = [];
1285							# Note that at this point, it's possible to have a comment for a parameter,
1286							# without that parameter actually existing in the INI file.
1287	1					9	push @{$self->{pCMT}{$sect}{$parm}}, $self->_markup_comments(@comment);
	1					15
1288	1					13	return scalar @comment;
1289							}
1290
1291							=head2 GetParameterComment ($section, $parameter)
1292
1293							Gets the comment attached to a parameter.
1294
1295							=cut
1296
1297							sub GetParameterComment
1298							{
1299	3			3	1	29	my $self = shift;
1300	3					27	my $sect = shift;
1301	3					27	my $parm = shift;
1302
1303	3	50				31	defined($sect) \|\| return undef;
1304	3	50				29	defined($parm) \|\| return undef;
1305
1306	3	50				34	if ($self->{nocase}) {
1307	0					0	$sect = lc($sect);
1308	0					0	$parm = lc($parm);
1309							};
1310
1311	3	50				33	exists($self->{pCMT}{$sect}) \|\| return undef;
1312	3	50				34	exists($self->{pCMT}{$sect}{$parm}) \|\| return undef;
1313
1314	3					25	my @comment = @{$self->{pCMT}{$sect}{$parm}};
	3					36
1315	3	100				46	return (wantarray)?@comment:join " ", @comment;
1316							}
1317
1318							=head2 DeleteParameterComment ($section, $parmeter)
1319
1320							Deletes the comment attached to a parameter.
1321
1322							=cut
1323
1324							sub DeleteParameterComment
1325							{
1326	1			1	1	9	my $self = shift;
1327	1					11	my $sect = shift;
1328	1					9	my $parm = shift;
1329
1330	1	50				12	defined($sect) \|\| return undef;
1331	1	50				10	defined($parm) \|\| return undef;
1332
1333	1	50				13	if ($self->{nocase}) {
1334	0					0	$sect = lc($sect);
1335	0					0	$parm = lc($parm);
1336							};
1337
1338							# If the parameter doesn't exist, our goal has already been achieved
1339	1	50				13	exists($self->{pCMT}{$sect}) \|\| return 1;
1340	1	50				13	exists($self->{pCMT}{$sect}{$parm}) \|\| return 1;
1341
1342	1					11	delete $self->{pCMT}{$sect}{$parm};
1343	1					10	return 1;
1344							}
1345
1346							=head2 GetParameterEOT ($section, $parameter)
1347
1348							Accessor method for the EOT text (in fact, style) of the specified parameter. If any text is used as an EOT mark, this will be returned. If the parameter was not recorded using HERE style multiple lines, GetParameterEOT returns undef.
1349
1350							=cut
1351
1352							sub GetParameterEOT
1353							{
1354	0			0	1	0	my $self = shift;
1355	0					0	my $sect = shift;
1356	0					0	my $parm = shift;
1357
1358	0	0				0	defined($sect) \|\| return undef;
1359	0	0				0	defined($parm) \|\| return undef;
1360
1361	0	0				0	if ($self->{nocase}) {
1362	0					0	$sect = lc($sect);
1363	0					0	$parm = lc($parm);
1364							};
1365
1366	0	0				0	if (not exists $self->{EOT}{$sect}) {
1367	0					0	$self->{EOT}{$sect} = {};
1368							}
1369
1370	0	0				0	if (not exists $self->{EOT}{$sect}{$parm}) {
1371	0					0	return undef;
1372							}
1373	0					0	return $self->{EOT}{$sect}{$parm};
1374							}
1375
1376							=head2 SetParameterEOT ($section, $EOT)
1377
1378							Accessor method for the EOT text for the specified parameter. Sets the HERE style marker text to the value $EOT. Once the EOT text is set, that parameter will be saved in HERE style.
1379
1380							To un-set the EOT text, use DeleteParameterEOT ($section, $parameter).
1381
1382							=cut
1383
1384							sub SetParameterEOT
1385							{
1386	0			0	1	0	my $self = shift;
1387	0					0	my $sect = shift;
1388	0					0	my $parm = shift;
1389	0					0	my $EOT = shift;
1390
1391	0	0				0	defined($sect) \|\| return undef;
1392	0	0				0	defined($parm) \|\| return undef;
1393	0	0				0	defined($EOT) \|\| return undef;
1394
1395	0	0				0	if ($self->{nocase}) {
1396	0					0	$sect = lc($sect);
1397	0					0	$parm = lc($parm);
1398							};
1399
1400	0	0				0	if (not exists $self->{EOT}{$sect}) {
1401	0