##// END OF EJS Templates
First draft of new (universal) build script(s) for bamboo
Jani Honkonen -
r1132:f8e33580b2a2
parent child
Show More
This diff has been collapsed as it changes many lines, (3094 lines changed) Show them Hide them
@@ -0,0 +1,3094
1 package Config::IniFiles;
2
3 use vars qw($VERSION);
4
5 $VERSION = '2.72';
6
7 require 5.004;
8 use strict;
9 use warnings;
10 use Carp;
11 use Symbol 'gensym','qualify_to_ref'; # For the 'any data type' hack
12 use Fcntl qw( SEEK_SET SEEK_CUR );
13
14 use List::MoreUtils qw(any none);
15
16 use File::Basename qw( dirname );
17 use File::Temp qw/ tempfile /;
18
19 @Config::IniFiles::errors = ( );
20
21 # $Header: /home/shlomi/progs/perl/cpan/Config/IniFiles/config-inifiles-cvsbackup/config-inifiles/IniFiles.pm,v 2.41 2003-12-08 10:50:56 domq Exp $
22
23 =head1 NAME
24
25 Config::IniFiles - A module for reading .ini-style configuration files.
26
27 =head1 SYNOPSIS
28
29 use Config::IniFiles;
30 my $cfg = Config::IniFiles->new( -file => "/path/configfile.ini" );
31 print "The value is " . $cfg->val( 'Section', 'Parameter' ) . "."
32 if $cfg->val( 'Section', 'Parameter' );
33
34 =head1 DESCRIPTION
35
36 Config::IniFiles provides a way to have readable configuration files outside
37 your Perl script. Configurations can be imported (inherited, stacked,...),
38 sections can be grouped, and settings can be accessed from a tied hash.
39
40 =head1 FILE FORMAT
41
42 INI files consist of a number of sections, each preceded with the
43 section name in square brackets, followed by parameter names and
44 their values.
45
46 [a section]
47 Parameter=Value
48
49 [section 2]
50 AnotherParameter=Some value
51 Setting=Something else
52 Parameter=Different scope than the one in the first section
53
54 The first non-blank character of the line indicating a section must
55 be a left bracket and the last non-blank character of a line indicating
56 a section must be a right bracket. The characters making up the section
57 name can be any symbols at all. However section names must be unique.
58
59 Parameters are specified in each section as Name=Value. Any spaces
60 around the equals sign will be ignored, and the value extends to the
61 end of the line (including any whitespace at the end of the line.
62 Parameter names are localized to the namespace of the section, but must
63 be unique within a section.
64
65 Both the hash mark (#) and the semicolon (;) are comment characters.
66 by default (this can be changed by configuration). Lines that begin with
67 either of these characters will be ignored. Any amount of whitespace may
68 precede the comment character.
69
70 Multi-line or multi-valued parameters may also be defined ala UNIX
71 "here document" syntax:
72
73 Parameter=<<EOT
74 value/line 1
75 value/line 2
76 EOT
77
78 You may use any string you want in place of "EOT". Note that whatever
79 follows the "<<" and what appears at the end of the text MUST match
80 exactly, including any trailing whitespace.
81
82 Alternately, as a configuration option (default is off), continuation
83 lines can be allowed:
84
85 [Section]
86 Parameter=this parameter \
87 spreads across \
88 a few lines
89
90
91 =head1 USAGE -- Object Interface
92
93 Get a new Config::IniFiles object with the I<new> method:
94
95 $cfg = Config::IniFiles->new( -file => "/path/config_file.ini" );
96 $cfg = new Config::IniFiles -file => "/path/config_file.ini";
97
98 Optional named parameters may be specified after the configuration
99 file name. See the I<new> in the B<METHODS> section, below.
100
101 Values from the config file are fetched with the val method:
102
103 $value = $cfg->val('Section', 'Parameter');
104
105 If you want a multi-line/value field returned as an array, just
106 specify an array as the receiver:
107
108 @values = $cfg->val('Section', 'Parameter');
109
110 =head1 METHODS
111
112 =head2 new ( [-option=>value ...] )
113
114 Returns a new configuration object (or "undef" if the configuration
115 file has an error, in which case check the global C<@Config::IniFiles::errors>
116 array for reasons why). One Config::IniFiles object is required per configuration
117 file. The following named parameters are available:
118
119 =over 10
120
121
122 =item I<-file> filename
123
124 Specifies a file to load the parameters from. This 'file' may actually be
125 any of the following things:
126
127 1) the pathname of a file
128
129 $cfg = Config::IniFiles->new( -file => "/path/to/config_file.ini" );
130
131 2) a simple filehandle
132
133 $cfg = Config::IniFiles->new( -file => STDIN );
134
135 3) a filehandle glob
136
137 open( CONFIG, "/path/to/config_file.ini" );
138 $cfg = Config::IniFiles->new( -file => *CONFIG );
139
140 4) a reference to a glob
141
142 open( CONFIG, "/path/to/config_file.ini" );
143 $cfg = Config::IniFiles->new( -file => \*CONFIG );
144
145 5) an IO::File object
146
147 $io = IO::File->new( "/path/to/config_file.ini" );
148 $cfg = Config::IniFiles->new( -file => $io );
149
150 or
151
152 open my $fh, '<', "/path/to/config_file.ini" or die $!;
153 $cfg = Config::IniFiles->new( -file => $fh );
154
155 6) A reference to a scalar (requires newer versions of IO::Scalar)
156
157 $ini_file_contents = <<EOT
158 [section name]
159 Parameter=A value
160 Setting=Another value
161 EOT
162
163 $cfg = Config::IniFiles->new( -file => \$ini_file_contents );
164
165
166 If this option is not specified, (i.e. you are creating a config file from scratch)
167 you must specify a target file using L<SetFileName> in order to save the parameters.
168
169
170 =item I<-default> section
171
172 Specifies a section to be used for default values. For example, in the
173 following configuration file, if you look up the "permissions" parameter
174 in the "joe" section, there is none.
175
176 [all]
177 permissions=Nothing
178
179 [jane]
180 name=Jane
181 permissions=Open files
182
183 [joe]
184 name=Joseph
185
186 If you create your Config::IniFiles object with a default section of "all" like this:
187
188 $cfg = Config::IniFiles->new( -file => "file.ini", -default => "all" );
189
190 Then requsting a value for a "permissions" in the [joe] section will
191 check for a value from [all] before returning undef.
192
193 $permissions = $cfg->val( "joe", "permissions"); // returns "Nothing"
194
195
196 =item I<-fallback> section
197
198 Specifies a section to be used for parameters outside a section. Default is none.
199 Without -fallback specified (which is the default), reading a configuration file
200 which has a parameter outside a section will fail. With this set to, say,
201 "GENERAL", this configuration:
202
203 wrong=wronger
204
205 [joe]
206 name=Joseph
207
208 will be assumed as:
209
210 [GENERAL]
211 wrong=wronger
212
213 [joe]
214 name=Joseph
215
216 Note that Config::IniFiles will also omit the fallback section header when
217 outputing such configuration.
218
219 =item I<-nocase> 0|1
220
221 Set -nocase => 1 to handle the config file in a case-insensitive
222 manner (case in values is preserved, however). By default, config
223 files are case-sensitive (i.e., a section named 'Test' is not the same
224 as a section named 'test'). Note that there is an added overhead for
225 turning off case sensitivity.
226
227
228 =item I<-import> object
229
230 This allows you to import or inherit existing setting from another
231 Config::IniFiles object. When importing settings from another object,
232 sections with the same name will be merged and parameters that are
233 defined in both the imported object and the I<-file> will take the
234 value of given in the I<-file>.
235
236 If a I<-default> section is also given on this call, and it does not
237 coincide with the default of the imported object, the new default
238 section will be used instead. If no I<-default> section is given,
239 then the default of the imported object will be used.
240
241
242 =item I<-allowcontinue> 0|1
243
244 Set -allowcontinue => 1 to enable continuation lines in the config file.
245 i.e. if a line ends with a backslash C<\>, then the following line is
246 appended to the parameter value, dropping the backslash and the newline
247 character(s).
248
249 Default behavior is to keep a trailing backslash C<\> as a parameter
250 value. Note that continuation cannot be mixed with the "here" value
251 syntax.
252
253
254 =item I<-allowempty> 0|1
255
256 If set to 1, then empty files are allowed at L</ReadConfig|ReadConfig()>
257 time. If set to 0 (the default), an empty configuration file is considered
258 an error.
259
260
261 =item I<-negativedeltas> 0|1
262
263 If set to 1 (the default if importing this object from another one),
264 parses and honors lines of the following form in the configuration
265 file:
266
267 ; [somesection] is deleted
268
269 or
270
271 [inthissection]
272 ; thisparameter is deleted
273
274 If set to 0 (the default if not importing), these comments are treated
275 like ordinary ones.
276
277 The L</WriteConfig|WriteConfig(-delta=>1)> form will output such
278 comments to indicate deleted sections or parameters. This way,
279 reloading a delta file using the same imported object produces the
280 same results in memory again. See L<IMPORT / DELTA FEATURES> for more
281 details.
282
283 =item I<-commentchar> 'char'
284
285 The default comment character is C<#>. You may change this by specifying
286 this option to another character. This can be any character except
287 alphanumeric characters, square brackets or the "equal" sign.
288
289
290 =item I<-allowedcommentchars> 'chars'
291
292 Allowed default comment characters are C<#> and C<;>. By specifying this
293 option you may change the range of characters that are used to denote a
294 comment line to include any set of characters
295
296 Note: that the character specified by B<-commentchar> (see above) is
297 I<always> part of the allowed comment characters.
298
299 Note 2: The given string is evaluated as a regular expression character
300 class, so '\' must be escaped if you wish to use it.
301
302
303 =item I<-reloadwarn> 0|1
304
305 Set -reloadwarn => 1 to enable a warning message (output to STDERR)
306 whenever the config file is reloaded. The reload message is of the
307 form:
308
309 PID <PID> reloading config file <file> at YYYY.MM.DD HH:MM:SS
310
311 Default behavior is to not warn (i.e. -reloadwarn => 0).
312
313 This is generally only useful when using Config::IniFiles in a server
314 or daemon application. The application is still responsible for determining
315 when the object is to be reloaded.
316
317
318 =item I<-nomultiline> 0|1
319
320 Set -nomultiline => 1 to output multi-valued parameter as:
321
322 param=value1
323 param=value2
324
325 instead of the default:
326
327 param=<<EOT
328 value1
329 value2
330 EOT
331
332 As the later might not be compatible with all applications.
333
334 =item I<-handle_trailing_comment> 0|1
335
336 Set -handle_trailing_comment => 1 to enable support of parameter trailing
337 comments.
338
339 For example, if we have a parameter line like this:
340
341 param1=value1;comment1
342
343 by default, handle_trailing_comment will be set to B<0>, and we will get
344 I<value1;comment1> as the value of I<param1>. If we have
345 -handle_trailing_comment set to B<1>, then we will get I<value1>
346 as the value for I<param1>, and I<comment1> as the trailing comment of
347 I<param1>.
348
349 Set and get methods for trailing comments are provided as
350 L</SetParameterTrailingComment> and L</GetParameterTrailingComment>.
351
352 =back
353
354 =cut
355
356 sub _nocase
357 {
358 my $self = shift;
359
360 if (@_)
361 {
362 $self->{nocase} = (shift(@_) ? 1 : 0);
363 }
364
365 return $self->{nocase};
366 }
367
368 sub _is_parm_in_sect
369 {
370 my ($self, $sect, $parm) = @_;
371
372 return any { $_ eq $parm } @{$self->{myparms}{$sect}};
373 }
374
375 sub new {
376 my $class = shift;
377 my %parms = @_;
378
379 my $errs = 0;
380 my @groups = ( );
381
382 my $self = bless {
383 default => '',
384 fallback =>undef,
385 fallback_used => 0,
386 imported =>undef,
387 v =>{},
388 cf => undef,
389 firstload => 1,
390 nomultiline => 0,
391 handle_trailing_comment => 0,
392 }, $class;
393
394 if( ref($parms{-import}) && ($parms{-import}->isa('Config::IniFiles')) ) {
395 $self->{imported}=$parms{-import}; # ReadConfig will load the data
396 $self->{negativedeltas}=1;
397 } elsif( defined $parms{-import} ) {
398 carp "Invalid -import value \"$parms{-import}\" was ignored.";
399 } # end if
400 delete $parms{-import};
401
402 # Copy the original parameters so we
403 # can use them when we build new sections
404 %{$self->{startup_settings}} = %parms;
405
406 # Parse options
407 my($k, $v);
408 local $_;
409 $self->_nocase(0);
410
411 # Handle known parameters first in this order,
412 # because each() could return parameters in any order
413 if (defined ($v = delete $parms{'-file'})) {
414 # Should we be pedantic and check that the file exists?
415 # .. no, because now it could be a handle, IO:: object or something else
416 $self->{cf} = $v;
417 }
418 if (defined ($v = delete $parms{'-nocase'})) {
419 $self->_nocase($v);
420 }
421 if (defined ($v = delete $parms{'-default'})) {
422 $self->{default} = $self->_nocase ? lc($v) : $v;
423 }
424 if (defined ($v = delete $parms{'-fallback'})) {
425 $self->{fallback} = $self->_nocase ? lc($v) : $v;
426 }
427 if (defined ($v = delete $parms{'-reloadwarn'})) {
428 $self->{reloadwarn} = $v ? 1 : 0;
429 }
430 if (defined ($v = delete $parms{'-nomultiline'})) {
431 $self->{nomultiline} = $v ? 1 : 0;
432 }
433 if (defined ($v = delete $parms{'-allowcontinue'})) {
434 $self->{allowcontinue} = $v ? 1 : 0;
435 }
436 if (defined ($v = delete $parms{'-allowempty'})) {
437 $self->{allowempty} = $v ? 1 : 0;
438 }
439 if (defined ($v = delete $parms{'-negativedeltas'})) {
440 $self->{negativedeltas} = $v ? 1 : 0;
441 }
442 if (defined ($v = delete $parms{'-commentchar'})) {
443 if(!defined $v || length($v) != 1) {
444 carp "Comment character must be unique.";
445 $errs++;
446 }
447 elsif($v =~ /[\[\]=\w]/) {
448 # must not be square bracket, equal sign or alphanumeric
449 carp "Illegal comment character.";
450 $errs++;
451 }
452 else {
453 $self->{comment_char} = $v;
454 }
455 }
456 if (defined ($v = delete $parms{'-allowedcommentchars'})) {
457 # must not be square bracket, equal sign or alphanumeric
458 if(!defined $v || $v =~ /[\[\]=\w]/) {
459 carp "Illegal value for -allowedcommentchars.";
460 $errs++;
461 }
462 else {
463 $self->{allowed_comment_char} = $v;
464 }
465 }
466
467 if (defined ($v = delete $parms{'-handle_trailing_comment'})) {
468 $self->{handle_trailing_comment} = $v ? 1 : 0;
469 }
470
471 $self->{comment_char} = '#' unless exists $self->{comment_char};
472 $self->{allowed_comment_char} = ';' unless exists $self->{allowed_comment_char};
473 # make sure that comment character is always allowed
474 $self->{allowed_comment_char} .= $self->{comment_char};
475
476 $self->{_comments_at_end_of_file} = [];
477
478 # Any other parameters are unkown
479 while (($k, $v) = each %parms) {
480 carp "Unknown named parameter $k=>$v";
481 $errs++;
482 }
483
484 return undef if $errs;
485
486 if ($self->ReadConfig) {
487 return $self;
488 } else {
489 return undef;
490 }
491 }
492
493
494 =head2 val ($section, $parameter [, $default] )
495
496 Returns the value of the specified parameter (C<$parameter>) in section
497 C<$section>, returns undef (or C<$default> if specified) if no section or
498 no parameter for the given section exists.
499
500
501 If you want a multi-line/value field returned as an array, just
502 specify an array as the receiver:
503
504 @values = $cfg->val('Section', 'Parameter');
505
506 A multi-line/value field that is returned in a scalar context will be
507 joined using $/ (input record separator, default is \n) if defined,
508 otherwise the values will be joined using \n.
509
510 =cut
511
512 sub _caseify {
513 my ($self, @refs) = @_;
514
515 if (not $self->_nocase)
516 {
517 return;
518 }
519
520 foreach my $ref (@refs) {
521 ${$ref} = lc(${$ref})
522 }
523
524 return;
525 }
526
527 sub val
528 {
529 my ($self, $sect, $parm, $def) = @_;
530
531 # Always return undef on bad parameters
532 if (not (defined($sect) && defined($parm)))
533 {
534 return;
535 }
536
537 $self->_caseify(\$sect, \$parm);
538
539 my $val_sect =
540 defined($self->{v}{$sect}{$parm})
541 ? $sect
542 : $self->{default}
543 ;
544
545 my $val = $self->{v}{$val_sect}{$parm};
546
547 # If the value is undef, make it $def instead (which could just be undef)
548 if (!defined ($val))
549 {
550 $val = $def;
551 }
552
553 # Return the value in the desired context
554 if (wantarray)
555 {
556 if (ref($val) eq "ARRAY")
557 {
558 return @$val;
559 }
560 elsif (defined($val))
561 {
562 return $val;
563 }
564 else
565 {
566 return;
567 }
568 }
569 elsif (ref($val) eq "ARRAY")
570 {
571 return join( (defined($/) ? $/ : "\n"), @$val);
572 }
573 else
574 {
575 return $val;
576 }
577 }
578
579 =head2 exists($section, $parameter)
580
581 True if and only if there exists a section C<$section>, with
582 a parameter C<$parameter> inside, not counting default values.
583
584 =cut
585
586 sub exists {
587 my ($self, $sect, $parm) = @_;
588
589 $self->_caseify(\$sect, \$parm);
590
591 return (exists $self->{v}{$sect}{$parm});
592 }
593
594
595
596 =head2 push ($section, $parameter, $value, [ $value2, ...])
597
598 Pushes new values at the end of existing value(s) of parameter
599 C<$parameter> in section C<$section>. See below for methods to write
600 the new configuration back out to a file.
601
602 You may not set a parameter that didn't exist in the original
603 configuration file. B<push> will return I<undef> if this is
604 attempted. See B<newval> below to do this. Otherwise, it returns 1.
605
606 =cut
607
608 sub push {
609 my ($self, $sect, $parm, @vals) = @_;
610
611 return undef if not defined $sect;
612 return undef if not defined $parm;
613
614 $self->_caseify(\$sect, \$parm);
615
616 return undef if (! defined($self->{v}{$sect}{$parm}));
617
618 return 1 if (! @vals);
619
620 $self->_touch_parameter($sect, $parm);
621
622 $self->{EOT}{$sect}{$parm} = 'EOT' if
623 (!defined $self->{EOT}{$sect}{$parm});
624
625 $self->{v}{$sect}{$parm} = [$self->{v}{$sect}{$parm}] unless
626 (ref($self->{v}{$sect}{$parm}) eq "ARRAY");
627
628 CORE::push @{$self->{v}{$sect}{$parm}}, @vals;
629 return 1;
630 }
631
632 =head2 setval ($section, $parameter, $value, [ $value2, ... ])
633
634 Sets the value of parameter C<$parameter> in section C<$section> to
635 C<$value> (or to a set of values). See below for methods to write
636 the new configuration back out to a file.
637
638 You may not set a parameter that didn't exist in the original
639 configuration file. B<setval> will return I<undef> if this is
640 attempted. See B<newval> below to do this. Otherwise, it returns 1.
641
642 =cut
643
644 sub setval {
645 my $self = shift;
646 my $sect = shift;
647 my $parm = shift;
648 my @val = @_;
649
650 return undef if not defined $sect;
651 return undef if not defined $parm;
652
653 $self->_caseify(\$sect, \$parm);
654
655 if (defined($self->{v}{$sect}{$parm})) {
656 $self->_touch_parameter($sect, $parm);
657 if (@val > 1) {
658 $self->{v}{$sect}{$parm} = \@val;
659 $self->{EOT}{$sect}{$parm} = 'EOT';
660 } else {
661 $self->{v}{$sect}{$parm} = shift @val;
662 }
663 return 1;
664 } else {
665 return undef;
666 }
667 }
668
669 =head2 newval($section, $parameter, $value [, $value2, ...])
670
671 Assignes a new value, C<$value> (or set of values) to the
672 parameter C<$parameter> in section C<$section> in the configuration
673 file.
674
675 =cut
676
677 sub newval {
678 my $self = shift;
679 my $sect = shift;
680 my $parm = shift;
681 my @val = @_;
682
683 return undef if not defined $sect;
684 return undef if not defined $parm;
685
686 $self->_caseify(\$sect, \$parm);
687
688 $self->AddSection($sect);
689
690 if (none { $_ eq $parm } @{$self->{parms}{$sect}})
691 {
692 CORE::push(@{$self->{parms}{$sect}}, $parm)
693 }
694
695 $self->_touch_parameter($sect, $parm);
696 if (@val > 1) {
697 $self->{v}{$sect}{$parm} = \@val;
698 if (!defined $self->{EOT}{$sect}{$parm})
699 {
700 $self->{EOT}{$sect}{$parm} = 'EOT';
701 }
702 } else {
703 $self->{v}{$sect}{$parm} = shift @val;
704 }
705 return 1
706 }
707
708 =head2 delval($section, $parameter)
709
710 Deletes the specified parameter from the configuration file
711
712 =cut
713
714 sub delval {
715 my $self = shift;
716 my $sect = shift;
717 my $parm = shift;
718
719 return undef if not defined $sect;
720 return undef if not defined $parm;
721
722 $self->_caseify(\$sect, \$parm);
723
724 $self->{parms}{$sect} = [grep {$_ ne $parm} @{$self->{parms}{$sect}}];
725 $self->_touch_parameter($sect, $parm);
726 delete $self->{v}{$sect}{$parm};
727
728 return 1;
729 }
730
731 =head2 ReadConfig
732
733 Forces the configuration file to be re-read. Returns undef if the
734 file can not be opened, no filename was defined (with the C<-file>
735 option) when the object was constructed, or an error occurred while
736 reading.
737
738 If an error occurs while parsing the INI file the @Config::IniFiles::errors
739 array will contain messages that might help you figure out where the
740 problem is in the file.
741
742 =cut
743
744 # Auxillary function to make deep (aliasing-free) copies of data
745 # structures. Ignores blessed objects in tree (could be taught not
746 # to, if needed)
747 sub _deepcopy {
748 my $ref = shift;
749
750 if (! ref($ref)) {
751 return $ref;
752 }
753
754 if (UNIVERSAL::isa($ref, "ARRAY")) {
755 return [map {_deepcopy($_)} @$ref];
756 }
757
758 if (UNIVERSAL::isa($ref, "HASH")) {
759 my $return = {};
760 foreach my $k (keys %$ref) {
761 $return->{$k} = _deepcopy($ref->{$k});
762 }
763 return $return;
764 }
765
766 carp "Unhandled data structure in $ref, cannot _deepcopy()";
767 }
768
769 # Internal method, gets the next line, taking proper care of line endings.
770 sub _nextline {
771 my ($self, $fh) = @_;
772 local $_;
773 if (!exists $self->{line_ends}) {
774 # no $self->{line_ends} is a hint set by caller that we are at
775 # the first line (kludge kludge).
776 {
777 local $/=\1;
778 my $nextchar;
779 do {
780 $nextchar=<$fh>;
781 return undef if (!defined $nextchar);
782 $_ .= $nextchar;
783 } until (m/((\015|\012|\025|\n)$)/s);
784 $self->{line_ends}=$1;
785 if ($nextchar eq "\x0d") {
786 # peek at the next char
787 $nextchar = <$fh>;
788 if ($nextchar eq "\x0a") {
789 $self->{line_ends} .= "\x0a";
790 } else {
791 seek $fh, -1, SEEK_CUR();
792 }
793 }
794 }
795
796 # If there's a UTF BOM (Byte-Order-Mark) in the first
797 # character of the first line then remove it before processing
798 # ( http://www.unicode.org/unicode/faq/utf_bom.html#22 )
799 s/^ο»Ώ//;
800
801 return $_;
802 } else {
803 local $/=$self->{line_ends};
804 return scalar <$fh>;
805 }
806 }
807
808 # Internal method, closes or resets the file handle. To be called
809 # whenever ReadConfig() returns.
810 sub _rollback {
811 my ($self, $fh) = @_;
812 # Only close if this is a filename, if it's
813 # an open handle, then just roll back to the start
814 if( !ref($self->{cf}) ) {
815 close($fh);
816 } else {
817 # Attempt to rollback to beginning, no problem if this fails (e.g. STDIN)
818 seek( $fh, 0, SEEK_SET() );
819 } # end if
820 }
821
822 sub _no_filename
823 {
824 my $self = shift;
825
826 return not length $self->{cf};
827 }
828
829 sub _read_line_num
830 {
831 my $self = shift;
832
833 if (@_)
834 {
835 $self->{_read_line_num} = shift;
836 }
837
838 return $self->{_read_line_num};
839 }
840
841 # Reads the next line and removes the end of line from it.
842 sub _read_next_line
843 {
844 my ($self, $fh) = @_;
845
846 my $line = $self->_nextline($fh);
847
848 if (! defined($line))
849 {
850 return undef;
851 }
852
853 $self->_read_line_num( $self->_read_line_num() + 1);
854
855 # Remove line ending char(s)
856 $line =~ s/(\015\012?|\012|\025|\n)\z//;
857
858 return $line;
859 }
860
861 sub _add_error
862 {
863 my ($self, $msg) = @_;
864
865 CORE::push(@Config::IniFiles::errors, $msg);
866
867 return;
868 }
869
870 # The current section - used for parsing.
871 sub _curr_sect
872 {
873 my $self = shift;
874
875 if (@_)
876 {
877 $self->{_curr_sect} = shift;
878 }
879
880 return $self->{_curr_sect};
881 }
882
883 # The current parameter - used for parsing.
884 sub _curr_parm
885 {
886 my $self = shift;
887
888 if (@_)
889 {
890 $self->{_curr_parm} = shift;
891 }
892
893 return $self->{_curr_parm};
894 }
895
896 # Current location - section and parameter.
897 sub _curr_loc
898 {
899 my $self = shift;
900
901 return ($self->_curr_sect, $self->_curr_parm);
902 }
903
904 # The current value - used in parsing.
905 sub _curr_val
906 {
907 my $self = shift;
908
909 if (@_)
910 {
911 $self->{_curr_val} = shift;
912 }
913
914 return $self->{_curr_val};
915 }
916
917 sub _curr_cmts
918 {
919 my $self = shift;
920
921 if (@_)
922 {
923 $self->{_curr_cmts} = shift;
924 }
925
926 return $self->{_curr_cmts};
927 }
928
929 sub _curr_end_comment
930 {
931 my $self = shift;
932
933 if (@_)
934 {
935 $self->{_curr_end_comment} = shift;
936 }
937
938 return $self->{_curr_end_comment};
939 }
940
941 my $RET_CONTINUE = 1;
942 my $RET_BREAK;
943
944 sub _ReadConfig_handle_comment
945 {
946 my ($self, $line) = @_;
947
948 if ($self->{negativedeltas} and
949 my ($to_delete) = $line =~ m/\A$self->{comment_char} (.*) is deleted\z/
950 )
951 {
952 if (my ($sect) = $to_delete =~ m/\A\[(.*)\]\z/)
953 {
954 $self->DeleteSection($sect);
955 }
956 else
957 {
958 $self->delval($self->_curr_sect, $to_delete);
959 }
960 }
961 else
962 {
963 CORE::push(@{$self->_curr_cmts}, $line);
964 }
965
966 return $RET_CONTINUE;
967 }
968
969 sub _ReadConfig_new_section
970 {
971 my ($self, $sect) = @_;
972
973 $self->_caseify(\$sect);
974
975 $self->_curr_sect($sect);
976 $self->AddSection($self->_curr_sect);
977 $self->SetSectionComment($self->_curr_sect, @{$self->_curr_cmts});
978 $self->_curr_cmts([]);
979
980 return $RET_CONTINUE;
981 }
982
983 sub _handle_fallback_sect
984 {
985 my ($self) = @_;
986
987 if ((!defined($self->_curr_sect)) and defined($self->{fallback}))
988 {
989 $self->_curr_sect($self->{fallback});
990 $self->{fallback_used}++;
991 }
992
993 return;
994 }
995
996 sub _ReadConfig_load_value
997 {
998 my ($self, $val_aref) = @_;
999
1000 # Now load value
1001 if (exists $self->{v}{$self->_curr_sect}{$self->_curr_parm} &&
1002 exists $self->{myparms}{$self->_curr_sect} &&
1003 $self->_is_parm_in_sect($self->_curr_loc))
1004 {
1005 $self->push($self->_curr_loc, @$val_aref);
1006 }
1007 else
1008 {
1009 # Loaded parameters shadow imported ones, instead of appending
1010 # to them
1011 $self->newval($self->_curr_loc, @$val_aref);
1012 }
1013
1014 return;
1015 }
1016
1017 sub _test_for_fallback_or_no_sect
1018 {
1019 my ($self, $fh) = @_;
1020
1021 $self->_handle_fallback_sect;
1022
1023 if (!defined $self->_curr_sect) {
1024 $self->_add_error(
1025 sprintf('%d: %s', $self->_read_line_num(),
1026 qq#parameter found outside a section#
1027 )
1028 );
1029 $self->_rollback($fh);
1030 return $RET_BREAK;
1031 }
1032
1033 return $RET_CONTINUE;
1034 }
1035
1036 sub _ReadConfig_handle_here_doc_param
1037 {
1038 my ($self, $fh, $eotmark, $val_aref) = @_;
1039
1040 my $foundeot = 0;
1041 my $startline = $self->_read_line_num();
1042
1043 HERE_DOC_LOOP:
1044 while (defined( my $line = $self->_read_next_line($fh) ))
1045 {
1046 if ($line eq $eotmark)
1047 {
1048 $foundeot = 1;
1049 last HERE_DOC_LOOP;
1050 }
1051 else
1052 {
1053 # Untaint
1054 my ($contents) = $line =~ /(.*)/ms;
1055 CORE::push(@$val_aref, $contents);
1056 }
1057 }
1058
1059 if (! $foundeot)
1060 {
1061 $self->_add_error(sprintf('%d: %s', $startline,
1062 qq#no end marker ("$eotmark") found#));
1063 $self->_rollback();
1064 return $RET_BREAK;
1065 }
1066
1067 return $RET_CONTINUE;
1068 }
1069
1070 sub _ReadConfig_handle_non_here_doc_param
1071 {
1072 my ($self, $fh, $val_aref) = @_;
1073
1074 my $allCmt = $self->{allowed_comment_char};
1075 my $end_commenthandle = $self->{handle_trailing_comment};
1076
1077 # process continuation lines, if any
1078 $self->_process_continue_val($fh);
1079
1080 # we should split value and comments if there is any comment
1081 if ($end_commenthandle and
1082 my ($value_to_assign, $end_comment_to_assign) = $self->_curr_val =~ /(.*?)\s*[$allCmt]\s*([^$allCmt]*)$/)
1083 {
1084 $self->_curr_val($value_to_assign);
1085 $self->_curr_end_comment($end_comment_to_assign);
1086 }
1087 else
1088 {
1089 $self->_curr_end_comment(q{});
1090 }
1091
1092 @{$val_aref} = ($self->_curr_val);
1093
1094 return;
1095 }
1096
1097
1098 sub _ReadConfig_populate_values
1099 {
1100 my ($self, $val_aref, $eotmark) = @_;
1101
1102 $self->_ReadConfig_load_value($val_aref);
1103
1104 $self->SetParameterComment($self->_curr_loc, @{ $self->_curr_cmts });
1105 $self->_curr_cmts([]);
1106 if (defined $eotmark)
1107 {
1108 $self->SetParameterEOT($self->_curr_loc, $eotmark);
1109 }
1110 # if handle_trailing_comment is off, this line makes no sense, since all $end_comment=""
1111 $self->SetParameterTrailingComment($self->_curr_loc, $self->_curr_end_comment);
1112
1113 return;
1114 }
1115
1116 sub _ReadConfig_param_assignment
1117 {
1118 my ($self, $fh, $line, $parm, $value_to_assign) = @_;
1119
1120 $self->_curr_val($value_to_assign);
1121 $self->_curr_end_comment(undef());
1122
1123 if (!defined( $self->_test_for_fallback_or_no_sect($fh) ))
1124 {
1125 return $RET_BREAK;
1126 }
1127
1128 $self->_caseify(\$parm);
1129 $self->_curr_parm($parm);
1130
1131 my @val = ( );
1132 my $eotmark;
1133
1134 if (($eotmark) = $self->_curr_val =~ /\A<<(.*)$/)
1135 {
1136 if (! defined($self->_ReadConfig_handle_here_doc_param(
1137 $fh, $eotmark, \@val
1138 ))
1139 )
1140 {
1141 return $RET_BREAK;
1142 }
1143 }
1144 else
1145 {
1146 $self->_ReadConfig_handle_non_here_doc_param( $fh, \@val );
1147 }
1148
1149 $self->_ReadConfig_populate_values(\@val, $eotmark);
1150
1151 return $RET_CONTINUE;
1152 }
1153
1154 # Return 1 to continue - undef to terminate the loop.
1155 sub _ReadConfig_handle_line
1156 {
1157 my ($self, $fh, $line) = @_;
1158
1159 my $allCmt = $self->{allowed_comment_char};
1160
1161 # ignore blank lines
1162 if ($line =~ /\A\s*\z/)
1163 {
1164 return $RET_CONTINUE;
1165 }
1166
1167 # collect comments
1168 if ($line =~/\A\s*[$allCmt]/)
1169 {
1170 return $self->_ReadConfig_handle_comment($line);
1171 }
1172
1173 # New Section
1174 if (my ($sect) = $line =~ /\A\s*\[\s*(\S|\S.*\S)\s*\]\s*\z/)
1175 {
1176 return $self->_ReadConfig_new_section($sect);
1177 }
1178
1179 # New parameter
1180 if (my ($parm, $value_to_assign) = $line =~ /^\s*([^=]*?[^=\s])\s*=\s*(.*)$/)
1181 {
1182 return $self->_ReadConfig_param_assignment($fh, $line, $parm, $value_to_assign);
1183 }
1184
1185 $self->_add_error(
1186 sprintf("Line %d in file %s is mal-formed:\n\t\%s",
1187 $self->_read_line_num(), $self->GetFileName(), $line
1188 )
1189 );
1190
1191 return $RET_CONTINUE;
1192 }
1193
1194 sub _ReadConfig_lines_loop
1195 {
1196 my ($self, $fh) = @_;
1197
1198 $self->_curr_sect(undef());
1199 $self->_curr_parm(undef());
1200 $self->_curr_val(undef());
1201 $self->_curr_cmts([]);
1202
1203 while ( defined(my $line = $self->_read_next_line($fh)) )
1204 {
1205 if (!defined(
1206 scalar( $self->_ReadConfig_handle_line($fh, $line) )
1207 )
1208 )
1209 {
1210 return undef;
1211 }
1212 }
1213
1214 return 1;
1215 }
1216
1217 sub ReadConfig
1218 {
1219 my $self = shift;
1220
1221 @Config::IniFiles::errors = ( );
1222
1223 # Initialize (and clear out) storage hashes
1224 $self->{sects} = [];
1225 $self->{parms} = {};
1226 $self->{group} = {};
1227 $self->{v} = {};
1228 $self->{sCMT} = {};
1229 $self->{pCMT} = {};
1230 $self->{EOT} = {};
1231 $self->{mysects} = []; # A pair of hashes to remember which params are loaded
1232 $self->{myparms} = {}; # or set using the API vs. imported - useful for
1233 $self->{peCMT} = {}; # this will store trailing comments at the end of single-lined params
1234 # import shadowing, see below, and WriteConfig(-delta=>1)
1235
1236 if( defined $self->{imported} ) {
1237 # Run up the import tree to the top, then reload coming
1238 # back down, maintaining the imported file names and our
1239 # file name.
1240 # This is only needed on a re-load though
1241 $self->{imported}->ReadConfig() unless ($self->{firstload});
1242
1243 foreach my $field (qw(sects parms group v sCMT pCMT EOT)) {
1244 $self->{$field} = _deepcopy($self->{imported}->{$field});
1245 }
1246 } # end if
1247
1248 if ($self->_no_filename)
1249 {
1250 return 1;
1251 }
1252
1253 # If this is a reload and we want warnings then send one to the STDERR log
1254 unless( $self->{firstload} || !$self->{reloadwarn} ) {
1255 my ($ss, $mm, $hh, $DD, $MM, $YY) = (localtime(time))[0..5];
1256 printf STDERR
1257 "PID %d reloading config file %s at %d.%02d.%02d %02d:%02d:%02d\n",
1258 $$, $self->{cf}, $YY+1900, $MM+1, $DD, $hh, $mm, $ss;
1259 }
1260
1261 # Turn off. Future loads are reloads
1262 $self->{firstload} = 0;
1263
1264 # Get a filehandle, allowing almost any type of 'file' parameter
1265 my $fh = $self->_make_filehandle( $self->{cf} );
1266 if (!$fh) {
1267 carp "Failed to open $self->{cf}: $!";
1268 return undef;
1269 }
1270
1271 # Get mod time of file so we can retain it (if not from STDIN)
1272 # also check if it's a real file (could have been a filehandle made from a scalar).
1273 if (ref($fh) ne "IO::Scalar" && -e $fh)
1274 {
1275 my @stats = stat $fh;
1276 $self->{file_mode} = sprintf("%04o", $stats[2]) if defined $stats[2];
1277 }
1278
1279
1280 # The first lines of the file must be blank, comments or start with [
1281 my $first = '';
1282
1283 delete $self->{line_ends}; # Marks start of parsing for _nextline()
1284
1285 $self->_read_line_num(0);
1286
1287 if (!defined($self->_ReadConfig_lines_loop($fh)))
1288 {
1289 return undef;
1290 }
1291
1292 # Special case: return undef if file is empty. (suppress this line to
1293 # restore the more intuitive behaviour of accepting empty files)
1294 if (! keys %{$self->{v}} && ! $self->{allowempty}) {
1295 $self->_add_error("Empty file treated as error");
1296 $self->_rollback($fh);
1297 return undef;
1298 }
1299
1300 if ( defined (my $defaultsect=$self->{startup_settings}->{-default}) )
1301 {
1302 $self->AddSection($defaultsect);
1303 }
1304
1305 $self->_SetEndComments(@{ $self->_curr_cmts });
1306
1307 $self->_rollback($fh);
1308 return (@Config::IniFiles::errors ? undef : 1);
1309 }
1310
1311
1312 =head2 Sections
1313
1314 Returns an array containing section names in the configuration file.
1315 If the I<nocase> option was turned on when the config object was
1316 created, the section names will be returned in lowercase.
1317
1318 =cut
1319
1320 sub Sections {
1321 my $self = shift;
1322
1323 return @{_aref_or_empty($self->{sects})};
1324 }
1325
1326 =head2 SectionExists ( $sect_name )
1327
1328 Returns 1 if the specified section exists in the INI file, 0 otherwise (undefined if section_name is not defined).
1329
1330 =cut
1331
1332 sub SectionExists {
1333 my $self = shift;
1334 my $sect = shift;
1335
1336 return undef if not defined $sect;
1337
1338 $self->_caseify(\$sect);
1339
1340 return ((any { $_ eq $sect } @{$self->{sects}}) ? 1 : 0);
1341 }
1342
1343 =head2 AddSection ( $sect_name )
1344
1345 Ensures that the named section exists in the INI file. If the section already
1346 exists, nothing is done. In this case, the "new" section will possibly contain
1347 data already.
1348
1349 If you really need to have a new section with no parameters in it, check that
1350 the name that you're adding isn't in the list of sections already.
1351
1352 =cut
1353
1354 sub _AddSection_Helper
1355 {
1356 my ($self, $sect) = @_;
1357
1358 CORE::push @{$self->{sects}}, $sect;
1359 $self->_touch_section($sect);
1360
1361 $self->SetGroupMember($sect);
1362
1363 # Set up the parameter names and values lists
1364 $self->{parms}{$sect} ||= [];
1365
1366 if (!defined($self->{v}{$sect})) {
1367 $self->{sCMT}{$sect} = [];
1368 $self->{pCMT}{$sect} = {}; # Comments above parameters
1369 $self->{parms}{$sect} = [];
1370 $self->{v}{$sect} = {};
1371 }
1372
1373 return;
1374 }
1375
1376 sub AddSection {
1377 my ($self, $sect) = @_;
1378
1379 return undef if not defined $sect;
1380
1381 $self->_caseify(\$sect);
1382
1383 if ( $self->SectionExists($sect))
1384 {
1385 return;
1386 }
1387
1388 return $self->_AddSection_Helper($sect);
1389 }
1390
1391 # Marks a section as modified by us (this includes deleted by us).
1392 sub _touch_section {
1393 my ($self, $sect) = @_;
1394
1395 $self->{mysects} ||= [];
1396
1397 if (none { $_ eq $sect } @{$self->{mysects}})
1398 {
1399 CORE::push @{$self->{mysects}}, $sect;
1400 }
1401
1402 return;
1403 }
1404
1405 # Marks a parameter as modified by us (this includes deleted by us).
1406 sub _touch_parameter {
1407 my ($self, $sect, $parm) = @_;
1408
1409 $self->_touch_section($sect);
1410 return if (!exists $self->{v}{$sect});
1411 $self->{myparms}{$sect} ||= [];
1412
1413 if (! $self->_is_parm_in_sect($sect, $parm))
1414 {
1415 CORE::push @{$self->{myparms}{$sect}}, $parm;
1416 }
1417
1418 return;
1419 }
1420
1421
1422 =head2 DeleteSection ( $sect_name )
1423
1424 Completely removes the entire section from the configuration.
1425
1426 =cut
1427
1428 sub DeleteSection {
1429 my $self = shift;
1430 my $sect = shift;
1431
1432 return undef if not defined $sect;
1433
1434 $self->_caseify(\$sect);
1435
1436 # This is done the fast way, change if data structure changes!!
1437 delete $self->{v}{$sect};
1438 delete $self->{sCMT}{$sect};
1439 delete $self->{pCMT}{$sect};
1440 delete $self->{EOT}{$sect};
1441 delete $self->{parms}{$sect};
1442 delete $self->{myparms}{$sect};
1443
1444 $self->{sects} = [grep {$_ ne $sect} @{$self->{sects}}];
1445 $self->_touch_section($sect);
1446
1447 $self->RemoveGroupMember($sect);
1448
1449 return 1;
1450 } # end DeleteSection
1451
1452 =head2 Parameters ($sect_name)
1453
1454 Returns an array containing the parameters contained in the specified
1455 section.
1456
1457 =cut
1458
1459 sub _aref_or_empty
1460 {
1461 my ($aref) = @_;
1462
1463 return ((defined($aref) and ref($aref) eq 'ARRAY') ? $aref : []);
1464 }
1465
1466 sub Parameters {
1467 my $self = shift;
1468 my $sect = shift;
1469
1470 return undef if not defined $sect;
1471
1472 $self->_caseify(\$sect);
1473
1474 return @{_aref_or_empty($self->{parms}{$sect})};
1475 }
1476
1477 =head2 Groups
1478
1479 Returns an array containing the names of available groups.
1480
1481 Groups are specified in the config file as new sections of the form
1482
1483 [GroupName MemberName]
1484
1485 This is useful for building up lists. Note that parameters within a
1486 "member" section are referenced normally (i.e., the section name is
1487 still "Groupname Membername", including the space) - the concept of
1488 Groups is to aid people building more complex configuration files.
1489
1490 =cut
1491
1492 sub Groups
1493 {
1494 my $self = shift;
1495
1496 if (ref($self->{group}) eq 'HASH')
1497 {
1498 return keys %{$self->{group}};
1499 }
1500 else
1501 {
1502 return ();
1503 }
1504 }
1505
1506 =head2 SetGroupMember ( $sect )
1507
1508 Makes sure that the specified section is a member of the appropriate group.
1509
1510 Only intended for use in newval.
1511
1512 =cut
1513
1514 sub _group_member_handling_skeleton
1515 {
1516 my ($self, $sect, $method) = @_;
1517
1518 return undef if not defined $sect;
1519
1520 if (! (my ($group) = ($sect =~ /\A(\S+)\s+\S/)))
1521 {
1522 return 1;
1523 }
1524 else
1525 {
1526 return $self->$method($sect, $group);
1527 }
1528 }
1529
1530 sub _SetGroupMember_helper
1531 {
1532 my ($self, $sect, $group) = @_;
1533
1534 if (not exists($self->{group}{$group})) {
1535 $self->{group}{$group} = [];
1536 }
1537
1538 if (none {$_ eq $sect} @{$self->{group}{$group}}) {
1539 CORE::push @{$self->{group}{$group}}, $sect;
1540 }
1541
1542 return;
1543 }
1544
1545 sub SetGroupMember {
1546 my ($self, $sect) = @_;
1547
1548 return $self->_group_member_handling_skeleton($sect, '_SetGroupMember_helper');
1549 }
1550
1551 =head2 RemoveGroupMember ( $sect )
1552
1553 Makes sure that the specified section is no longer a member of the
1554 appropriate group. Only intended for use in DeleteSection.
1555
1556 =cut
1557
1558 sub _RemoveGroupMember_helper
1559 {
1560 my ($self, $sect, $group) = @_;
1561
1562 if (!exists $self->{group}{$group})
1563 {
1564 return;
1565 }
1566
1567 $self->{group}{$group} =
1568 [grep { $_ ne $sect } @{$self->{group}{$group}}];
1569
1570 return;
1571 }
1572
1573 sub RemoveGroupMember
1574 {
1575 my ($self, $sect) = @_;
1576
1577 return $self->_group_member_handling_skeleton($sect, '_RemoveGroupMember_helper');
1578 }
1579
1580 =head2 GroupMembers ($group)
1581
1582 Returns an array containing the members of specified $group. Each element
1583 of the array is a section name. For example, given the sections
1584
1585 [Group Element 1]
1586 ...
1587
1588 [Group Element 2]
1589 ...
1590
1591 GroupMembers would return ("Group Element 1", "Group Element 2").
1592
1593 =cut
1594
1595 sub GroupMembers {
1596 my ($self, $group) = @_;
1597
1598 return undef if not defined $group;
1599
1600 $self->_caseify(\$group);
1601
1602 return @{_aref_or_empty($self->{group}{$group})};
1603 }
1604
1605 =head2 SetWriteMode ($mode)
1606
1607 Sets the mode (permissions) to use when writing the INI file.
1608
1609 $mode must be a string representation of the octal mode.
1610
1611 =cut
1612
1613 sub SetWriteMode
1614 {
1615 my ($self, $mode) = @_;
1616
1617 if (not (defined($mode) && ($mode =~ m/[0-7]{3}/)))
1618 {
1619 return undef;
1620 }
1621
1622 return ($self->{file_mode} = $mode);
1623 }
1624
1625 =head2 GetWriteMode ($mode)
1626
1627 Gets the current mode (permissions) to use when writing the INI file.
1628
1629 $mode is a string representation of the octal mode.
1630
1631 =cut
1632
1633 sub GetWriteMode
1634 {
1635 my $self = shift;
1636
1637 return $self->{file_mode};
1638 }
1639
1640 =head2 WriteConfig ($filename [, %options])
1641
1642 Writes out a new copy of the configuration file. A temporary file
1643 (ending in '-new') is written out and then renamed to the specified
1644 filename. Also see B<BUGS> below.
1645
1646 If C<-delta> is set to a true value in %options, and this object was
1647 imported from another (see L</new>), only the differences between this
1648 object and the imported one will be recorded. Negative deltas will be
1649 encoded into comments, so that a subsequent invocation of I<new()>
1650 with the same imported object produces the same results (see the
1651 I<-negativedeltas> option in L</new>).
1652
1653 C<%options> is not required.
1654
1655 Returns true on success, C<undef> on failure.
1656
1657 =cut
1658
1659 sub _write_config_to_filename
1660 {
1661 my ($self, $filename, %parms) = @_;
1662
1663 if (-e $filename) {
1664 if (not (-w $filename))
1665 {
1666 #carp "File $filename is not writable. Refusing to write config";
1667 return undef;
1668 }
1669 my $mode = (stat $filename)[2];
1670 $self->{file_mode} = sprintf "%04o", ($mode & 0777);
1671 #carp "Using mode $self->{file_mode} for file $file";
1672 }
1673
1674 my ($fh, $new_file) = tempfile(
1675 "temp.ini-XXXXXXXXXX",
1676 DIR => dirname($filename)
1677 );
1678 $self->OutputConfigToFileHandle($fh, $parms{-delta});
1679 close($fh);
1680 if (!rename( $new_file, $filename )) {
1681 carp "Unable to rename temp config file ($new_file) to ${filename}: $!";
1682 return undef;
1683 }
1684 if (exists $self->{file_mode}) {
1685 chmod oct($self->{file_mode}), $filename;
1686 }
1687
1688 return 1;
1689 }
1690
1691 sub _write_config_with_a_made_fh
1692 {
1693 my ($self, $fh, %parms) = @_;
1694
1695 # Only roll back if it's not STDIN (if it is, Carp)
1696 if( $fh == \*STDIN )
1697 {
1698 carp "Cannot write configuration file to STDIN.";
1699 }
1700 else
1701 {
1702 seek( $fh, 0, SEEK_SET() );
1703 $self->OutputConfigToFileHandle($fh, $parms{-delta});
1704 seek( $fh, 0, SEEK_SET() );
1705 } # end if
1706
1707 return 1;
1708 }
1709
1710 sub _write_config_to_fh
1711 {
1712 my ($self, $file, %parms) = @_;
1713
1714 # Get a filehandle, allowing almost any type of 'file' parameter
1715 ## NB: If this were a filename, this would fail because _make_file
1716 ## opens a read-only handle, but we have already checked that case
1717 ## so re-using the logic is ok [JW/WADG]
1718 my $fh = $self->_make_filehandle( $file );
1719
1720 if (!$fh) {
1721 carp "Could not find a filehandle for the input stream ($file): $!";
1722 return undef;
1723 }
1724
1725 return $self->_write_config_with_a_made_fh($fh, %parms);
1726 }
1727
1728 sub WriteConfig {
1729 my ($self, $file, %parms) = @_;
1730
1731 return undef unless defined $file;
1732
1733 # If we are using a filename, then do mode checks and write to a
1734 # temporary file to avoid a race condition
1735 if( !ref($file) )
1736 {
1737 return $self->_write_config_to_filename($file, %parms);
1738 }
1739 # Otherwise, reset to the start of the file and write, unless we are using
1740 # STDIN
1741 else
1742 {
1743 return $self->_write_config_to_fh($file, %parms);
1744 }
1745 }
1746
1747 =head2 RewriteConfig
1748
1749 Same as WriteConfig, but specifies that the original configuration
1750 file should be rewritten.
1751
1752 =cut
1753
1754 sub RewriteConfig {
1755 my $self = shift;
1756
1757 if ($self->_no_filename)
1758 {
1759 return 1;
1760 }
1761
1762 return $self->WriteConfig($self->{cf});
1763 }
1764
1765 =head2 GetFileName
1766
1767 Returns the filename associated with this INI file.
1768
1769 If no filename has been specified, returns undef.
1770
1771 =cut
1772
1773 sub GetFileName
1774 {
1775 my $self = shift;
1776
1777 return $self->{cf};
1778 }
1779
1780 =head2 SetFileName ($filename)
1781
1782 If you created the Config::IniFiles object without initialising from
1783 a file, or if you just want to change the name of the file to use for
1784 ReadConfig/RewriteConfig from now on, use this method.
1785
1786 Returns $filename if that was a valid name, undef otherwise.
1787
1788 =cut
1789
1790 sub SetFileName {
1791 my ($self, $new_filename) = @_;
1792
1793 if ( length($new_filename) > 0 ) {
1794 return ($self->{cf} = $new_filename);
1795 }
1796 else {
1797 return undef;
1798 }
1799 }
1800
1801 =head2 $ini->OutputConfigToFileHandle($fh, $delta)
1802
1803 Writes OutputConfig to the $fh filehandle. $delta should be set to 1
1804 1 if writing only delta. This is a newer and safer version of
1805 C<OutputConfig()> and one is encouraged to use it instead.
1806
1807 =head2 $ini->OutputConfig($delta)
1808
1809 Writes OutputConfig to STDOUT. Use select() to redirect STDOUT to
1810 the output target before calling this function. Optional argument
1811 should be set to 1 if writing only delta. Also see OutputConfigToFileHandle
1812
1813 =cut
1814
1815 sub _calc_eot_mark
1816 {
1817 my ($self, $sect, $parm, $val) = @_;
1818
1819 my $eotmark = $self->{EOT}{$sect}{$parm} || 'EOT';
1820
1821 # Make sure the $eotmark does not occur inside the string.
1822 my @letters = ('A' .. 'Z');
1823 my $joined_val = join(q{ }, @$val);
1824 while (index($joined_val, $eotmark) >= 0)
1825 {
1826 $eotmark .= $letters[rand(@letters)];
1827 }
1828
1829 return $eotmark;
1830 }
1831
1832 sub _OutputParam {
1833 my ($self, $sect, $parm, $val, $end_comment, $output_cb) = @_;
1834
1835 my $line_loop = sub {
1836 my ($mapper) = @_;
1837
1838 foreach my $line (@{$val}[0 .. $#$val-1]) {
1839 $output_cb->($mapper->($line));
1840 }
1841 $output_cb->(
1842 $mapper->($val->[-1]),
1843 ($end_comment ? (" $self->{comment_char} $end_comment") : ()),
1844 );
1845 return;
1846 };
1847
1848 if (! @$val) {
1849 # An empty variable - see:
1850 # https://rt.cpan.org/Public/Bug/Display.html?id=68554
1851 $output_cb->("$parm=");
1852 }
1853 elsif ((@$val == 1) or $self->{nomultiline}) {
1854 $line_loop->(sub { my ($line) = @_; return "$parm=$line"; });
1855 }
1856 else
1857 {
1858 my $eotmark = $self->_calc_eot_mark($sect, $parm, $val);
1859
1860 $output_cb->("$parm= <<$eotmark");
1861 $line_loop->(sub { my ($line) = @_; return $line; });
1862 $output_cb->($eotmark);
1863 }
1864
1865 return;
1866 }
1867
1868 sub OutputConfig {
1869 my ($self, $delta) = @_;
1870
1871 return $self->OutputConfigToFileHandle(select(), $delta);
1872 }
1873
1874 sub _output_comments
1875 {
1876 my ($self, $print_line, $comments_aref) = @_;
1877
1878 if (ref($comments_aref) eq 'ARRAY') {
1879 foreach my $comment (@$comments_aref) {
1880 $print_line->($comment);
1881 }
1882 }
1883
1884 return;
1885 }
1886
1887 sub _process_continue_val
1888 {
1889 my ($self, $fh) = @_;
1890
1891 if (not $self->{allowcontinue})
1892 {
1893 return;
1894 }
1895
1896 my $val = $self->_curr_val;
1897
1898 while($val =~ s/\\\z//) {
1899 $val .= $self->_read_next_line($fh);
1900 }
1901
1902 $self->_curr_val($val);
1903
1904 return;
1905 }
1906
1907 sub _output_param_total
1908 {
1909 my ($self, $sect, $parm, $print_line, $split_val, $delta) = @_;
1910 if (!defined $self->{v}{$sect}{$parm}) {
1911 if ($delta) {
1912 $print_line->("$self->{comment_char} $parm is deleted");
1913 }
1914 else {
1915 warn "Weird unknown parameter $parm" if $^W;
1916 }
1917 return;
1918 }
1919
1920 $self->_output_comments($print_line, $self->{pCMT}{$sect}{$parm});
1921
1922 my $val = $self->{v}{$sect}{$parm};
1923 my $end_comment = $self->{peCMT}{$sect}{$parm};
1924
1925 return if ! defined ($val); # No parameter exists !!
1926
1927 $self->_OutputParam(
1928 $sect,
1929 $parm,
1930 $split_val->($val),
1931 (defined($end_comment) ? $end_comment : ""),
1932 $print_line,
1933 );
1934
1935 return;
1936 }
1937
1938 sub _output_section {
1939 my ($self, $sect, $print_line, $split_val, $delta, $position) = @_;
1940
1941 if (!defined $self->{v}{$sect}) {
1942 if ($delta) {
1943 $print_line->("$self->{comment_char} [$sect] is deleted");
1944 } else {
1945 warn "Weird unknown section $sect" if $^W;
1946 }
1947 return;
1948 }
1949 return if not defined $self->{v}{$sect};
1950 $print_line->() if ($position > 0);
1951 $self->_output_comments($print_line, $self->{sCMT}{$sect});
1952
1953 if (!
1954 ($self->{fallback_used} and $sect eq $self->{fallback})
1955 )
1956 {
1957 $print_line->("[$sect]");
1958 }
1959 return if ref($self->{v}{$sect}) ne 'HASH';
1960
1961 foreach my $parm (@{$self->{$delta ? "myparms" : "parms"}{$sect}}) {
1962 $self->_output_param_total(
1963 $sect, $parm, $print_line, $split_val, $delta
1964 );
1965 }
1966
1967 return;
1968 }
1969
1970 sub OutputConfigToFileHandle {
1971 # We need no strict 'refs' to be able to print to $fh if it points
1972 # to a glob filehandle.
1973 no strict 'refs';
1974 my ($self, $fh, $delta) = @_;
1975
1976 my $ors = $self->{line_ends} || $\ || "\n"; # $\ is normally unset, but use input by default
1977 my $print_line = sub { print {$fh} (@_, $ors); };
1978 my $split_val = sub {
1979 my ($val) = @_;
1980
1981 return ((ref($val) eq 'ARRAY')
1982 ? $val
1983 : [split /[$ors]/, $val, -1]
1984 );
1985 };
1986
1987 my $position = 0;
1988
1989 foreach my $sect (@{$self->{$delta ? "mysects" : "sects"}}) {
1990 $self->_output_section(
1991 $sect, $print_line, $split_val, $delta, $position++
1992 );
1993 }
1994
1995 $self->_output_comments($print_line, [ $self->_GetEndComments() ] );
1996
1997 return 1;
1998 }
1999
2000 =head2 SetSectionComment($section, @comment)
2001
2002 Sets the comment for section $section to the lines contained in @comment.
2003
2004 Each comment line will be prepended with the comment character (default
2005 is C<#>) if it doesn't already have a comment character (ie: if the
2006 line does not start with whitespace followed by an allowed comment
2007 character, default is C<#> and C<;>).
2008
2009 To clear a section comment, use DeleteSectionComment ($section)
2010
2011 =cut
2012
2013 sub SetSectionComment
2014 {
2015 my ($self, $sect, @comment) = @_;
2016
2017 if (not (defined($sect) && @comment))
2018 {
2019 return undef;
2020 }
2021
2022 $self->_caseify(\$sect);
2023
2024 $self->_touch_section($sect);
2025 # At this point it's possible to have a comment for a section that
2026 # doesn't exist. This comment will not get written to the INI file.
2027 $self->{sCMT}{$sect} = $self->_markup_comments(\@comment);
2028
2029 return scalar @comment;
2030 }
2031
2032
2033
2034 # this helper makes sure that each line is preceded with the correct comment
2035 # character
2036 sub _markup_comments
2037 {
2038 my ($self, $comment_aref) = @_;
2039
2040 my $allCmt = $self->{allowed_comment_char};
2041 my $cmtChr = $self->{comment_char};
2042
2043 my $is_comment = qr/\A\s*[$allCmt]/;
2044
2045 # TODO : Maybe create a qr// out of it.
2046 return [map { ($_ =~ $is_comment) ? $_ : "$cmtChr $_" } @$comment_aref];
2047 }
2048
2049
2050
2051 =head2 GetSectionComment ($section)
2052
2053 Returns a list of lines, being the comment attached to section $section. In
2054 scalar context, returns a string containing the lines of the comment separated
2055 by newlines.
2056
2057 The lines are presented as-is, with whatever comment character was originally
2058 used on that line.
2059
2060 =cut
2061
2062 sub _return_comment
2063 {
2064 my ($self, $comment_aref) = @_;
2065
2066 my $delim = defined($/) ? $/ : "\n";
2067
2068 return wantarray() ? @$comment_aref : join($delim, @$comment_aref);
2069 }
2070
2071 sub GetSectionComment
2072 {
2073 my ($self, $sect) = @_;
2074
2075 return undef if not defined $sect;
2076
2077 $self->_caseify(\$sect);
2078
2079 if (! exists $self->{sCMT}{$sect}) {
2080 return undef;
2081 }
2082
2083 return $self->_return_comment( $self->{sCMT}{$sect} );
2084 }
2085
2086 =head2 DeleteSectionComment ($section)
2087
2088 Removes the comment for the specified section.
2089
2090 =cut
2091
2092 sub DeleteSectionComment
2093 {
2094 my $self = shift;
2095 my $sect = shift;
2096
2097 return undef if not defined $sect;
2098
2099 $self->_caseify(\$sect);
2100 $self->_touch_section($sect);
2101
2102 delete $self->{sCMT}{$sect};
2103
2104 return;
2105 }
2106
2107 =head2 SetParameterComment ($section, $parameter, @comment)
2108
2109 Sets the comment attached to a particular parameter.
2110
2111 Any line of @comment that does not have a comment character will be
2112 prepended with one. See L</SetSectionComment($section, @comment)> above
2113
2114 =cut
2115
2116 sub SetParameterComment
2117 {
2118 my ($self, $sect, $parm, @comment) = @_;
2119
2120 if (not (defined($sect) && defined($parm) && @comment))
2121 {
2122 return undef;
2123 }
2124
2125 $self->_caseify(\$sect, \$parm);
2126
2127 $self->_touch_parameter($sect, $parm);
2128
2129 # Note that at this point, it's possible to have a comment for a parameter,
2130 # without that parameter actually existing in the INI file.
2131 $self->{pCMT}{$sect}{$parm} = $self->_markup_comments(\@comment);
2132
2133 return scalar @comment;
2134 }
2135
2136 sub _SetEndComments
2137 {
2138 my $self = shift;
2139 my @comments = @_;
2140
2141 $self->{_comments_at_end_of_file} = \@comments;
2142
2143 return 1;
2144 }
2145
2146 sub _GetEndComments {
2147 my $self = shift;
2148
2149 return @{$self->{_comments_at_end_of_file}};
2150 }
2151
2152 =head2 GetParameterComment ($section, $parameter)
2153
2154 Gets the comment attached to a parameter. In list context returns all
2155 comments - in scalar context returns them joined by newlines.
2156
2157 =cut
2158
2159 sub GetParameterComment
2160 {
2161 my ($self, $sect, $parm) = @_;
2162
2163 if (not (defined($sect) && defined($parm)))
2164 {
2165 return undef;
2166 }
2167
2168 $self->_caseify(\$sect, \$parm);
2169
2170 if (not (exists( $self->{pCMT}{$sect} )
2171 && exists( $self->{pCMT}{$sect}{$parm} )))
2172 {
2173 return undef;
2174 }
2175
2176 return $self->_return_comment( $self->{pCMT}{$sect}{$parm} );
2177 }
2178
2179 =head2 DeleteParameterComment ($section, $parmeter)
2180
2181 Deletes the comment attached to a parameter.
2182
2183 =cut
2184
2185 sub DeleteParameterComment
2186 {
2187 my ($self, $sect, $parm) = @_;
2188
2189 if (not (defined($sect) && defined($parm)))
2190 {
2191 return undef;
2192 }
2193
2194 $self->_caseify(\$sect, \$parm);
2195
2196 # If the parameter doesn't exist, our goal has already been achieved
2197 if ( exists( $self->{pCMT}{$sect} )
2198 && exists( $self->{pCMT}{$sect}{$parm} ))
2199 {
2200 $self->_touch_parameter($sect, $parm);
2201 delete $self->{pCMT}{$sect}{$parm};
2202 }
2203
2204 return 1;
2205 }
2206
2207 =head2 GetParameterEOT ($section, $parameter)
2208
2209 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.
2210
2211 =cut
2212
2213 sub GetParameterEOT
2214 {
2215 my ($self, $sect, $parm) = @_;
2216
2217 if (not (defined($sect) && defined($parm)))
2218 {
2219 return undef;
2220 }
2221
2222 $self->_caseify(\$sect, \$parm);
2223
2224 return $self->{EOT}{$sect}{$parm};
2225 }
2226
2227 =head2 $cfg->SetParameterEOT ($section, $parameter, $EOT)
2228
2229 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.
2230
2231 To un-set the EOT text, use DeleteParameterEOT ($section, $parameter).
2232
2233 =cut
2234
2235 sub SetParameterEOT
2236 {
2237 my ($self, $sect, $parm, $EOT) = @_;
2238
2239 if (not (defined($sect) && defined($parm) && defined($EOT)))
2240 {
2241 return undef;
2242 }
2243
2244 $self->_caseify(\$sect, \$parm);
2245
2246 $self->_touch_parameter($sect, $parm);
2247
2248 $self->{EOT}{$sect}{$parm} = $EOT;
2249
2250 return;
2251 }
2252
2253 =head2 DeleteParameterEOT ($section, $parmeter)
2254
2255 Removes the EOT marker for the given section and parameter.
2256 When writing a configuration file, if no EOT marker is defined
2257 then "EOT" is used.
2258
2259 =cut
2260
2261 sub DeleteParameterEOT
2262 {
2263 my ($self, $sect, $parm) = @_;
2264
2265 if (not (defined($sect) && defined($parm)))
2266 {
2267 return undef;
2268 }
2269
2270 $self->_caseify(\$sect, \$parm);
2271
2272 $self->_touch_parameter($sect, $parm);
2273 delete $self->{EOT}{$sect}{$parm};
2274
2275 return;
2276 }
2277
2278 =head2 SetParameterTrailingComment ($section, $parameter, $cmt)
2279
2280 Set the end trailing comment for the given section and parameter.
2281 If there is a old comment for the parameter, it will be
2282 overwritten by the new one.
2283
2284 If there is a new parameter trailing comment to be added, the
2285 value should be added first.
2286
2287 =cut
2288
2289 sub SetParameterTrailingComment
2290 {
2291 my ($self, $sect, $parm, $cmt) = @_;
2292
2293 if (not (defined($sect) && defined($parm) && defined($cmt)))
2294 {
2295 return undef;
2296 }
2297
2298 $self->_caseify(\$sect, \$parm);
2299
2300 # confirm the parameter exist
2301 return undef if not exists $self->{v}{$sect}{$parm};
2302
2303 $self->_touch_parameter($sect, $parm);
2304 $self->{peCMT}{$sect}{$parm} = $cmt;
2305
2306 return 1;
2307 }
2308
2309 =head2 GetParameterTrailingComment ($section, $parameter)
2310
2311 An accessor method to read the trailing comment after the parameter.
2312 The trailing comment will be returned if there is one. A null string
2313 will be returned if the parameter exists but no comment for it.
2314 otherwise, L<undef> will be returned.
2315
2316 =cut
2317
2318 sub GetParameterTrailingComment
2319 {
2320 my ($self, $sect, $parm) = @_;
2321
2322 if (not (defined($sect) && defined($parm)))
2323 {
2324 return undef;
2325 }
2326
2327 $self->_caseify(\$sect, \$parm);
2328
2329 # confirm the parameter exist
2330 return undef if not exists $self->{v}{$sect}{$parm};
2331 return $self->{peCMT}{$sect}{$parm};
2332 }
2333
2334 =head2 Delete
2335
2336 Deletes the entire configuration file in memory.
2337
2338 =cut
2339
2340 sub Delete {
2341 my $self = shift;
2342
2343 foreach my $section ($self->Sections()) {
2344 $self->DeleteSection($section);
2345 }
2346
2347 return 1;
2348 } # end Delete
2349
2350
2351
2352 =head1 USAGE -- Tied Hash
2353
2354 =head2 tie %ini, 'Config::IniFiles', (-file=>$filename, [-option=>value ...] )
2355
2356 Using C<tie>, you can tie a hash to a B<Config::IniFiles> object. This creates a new
2357 object which you can access through your hash, so you use this instead of the
2358 B<new> method. This actually creates a hash of hashes to access the values in
2359 the INI file. The options you provide through C<tie> are the same as given for
2360 the B<new> method, above.
2361
2362 Here's an example:
2363
2364 use Config::IniFiles;
2365
2366 my %ini
2367 tie %ini, 'Config::IniFiles', ( -file => "/path/configfile.ini" );
2368
2369 print "We have $ini{Section}{Parameter}." if $ini{Section}{Parameter};
2370
2371 Accessing and using the hash works just like accessing a regular hash and
2372 many of the object methods are made available through the hash interface.
2373
2374 For those methods that do not coincide with the hash paradigm, you can use
2375 the Perl C<tied> function to get at the underlying object tied to the hash
2376 and call methods on that object. For example, to write the hash out to a new
2377 ini file, you would do something like this:
2378
2379 tied( %ini )->WriteConfig( "/newpath/newconfig.ini" ) ||
2380 die "Could not write settings to new file.";
2381
2382 =head2 $val = $ini{$section}{$parameter}
2383
2384 Returns the value of $parameter in $section.
2385
2386 Multiline values accessed through a hash will be returned
2387 as a list in list context and a concatenated value in scalar
2388 context.
2389
2390 =head2 $ini{$section}{$parameter} = $value;
2391
2392 Sets the value of C<$parameter> in C<$section> to C<$value>.
2393
2394 To set a multiline or multiv-alue parameter just assign an
2395 array reference to the hash entry, like this:
2396
2397 $ini{$section}{$parameter} = [$value1, $value2, ...];
2398
2399 If the parameter did not exist in the original file, it will
2400 be created. However, Perl does not seem to extend autovivification
2401 to tied hashes. That means that if you try to say
2402
2403 $ini{new_section}{new_paramters} = $val;
2404
2405 and the section 'new_section' does not exist, then Perl won't
2406 properly create it. In order to work around this you will need
2407 to create a hash reference in that section and then assign the
2408 parameter value. Something like this should do nicely:
2409
2410 $ini{new_section} = {};
2411 $ini{new_section}{new_paramters} = $val;
2412
2413 =head2 %hash = %{$ini{$section}}
2414
2415 Using the tie interface, you can copy whole sections of the
2416 ini file into another hash. Note that this makes a copy of
2417 the entire section. The new hash in no longer tied to the
2418 ini file, In particular, this means -default and -nocase
2419 settings will not apply to C<%hash>.
2420
2421
2422 =head2 $ini{$section} = {}; %{$ini{$section}} = %parameters;
2423
2424 Through the hash interface, you have the ability to replace
2425 the entire section with a new set of parameters. This call
2426 will fail, however, if the argument passed in NOT a hash
2427 reference. You must use both lines, as shown above so that
2428 Perl recognizes the section as a hash reference context
2429 before COPYing over the values from your C<%parameters> hash.
2430
2431 =head2 delete $ini{$section}{$parameter}
2432
2433 When tied to a hash, you can use the Perl C<delete> function
2434 to completely remove a parameter from a section.
2435
2436 =head2 delete $ini{$section}
2437
2438 The tied interface also allows you to delete an entire
2439 section from the ini file using the Perl C<delete> function.
2440
2441 =head2 %ini = ();
2442
2443 If you really want to delete B<all> the items in the ini file, this
2444 will do it. Of course, the changes won't be written to the actual
2445 file unless you call B<RewriteConfig> on the object tied to the hash.
2446
2447 =head2 Parameter names
2448
2449 =over 4
2450
2451 =item my @keys = keys %{$ini{$section}}
2452
2453 =item while (($k, $v) = each %{$ini{$section}}) {...}
2454
2455 =item if( exists %{$ini{$section}}, $parameter ) {...}
2456
2457 =back
2458
2459 When tied to a hash, you use the Perl C<keys> and C<each>
2460 functions to iteratively list the parameters (C<keys>) or
2461 parameters and their values (C<each>) in a given section.
2462
2463 You can also use the Perl C<exists> function to see if a
2464 parameter is defined in a given section.
2465
2466 Note that none of these will return parameter names that
2467 are part of the default section (if set), although accessing
2468 an unknown parameter in the specified section will return a
2469 value from the default section if there is one.
2470
2471
2472 =head2 Section names
2473
2474 =over 4
2475
2476 =item foreach( keys %ini ) {...}
2477
2478 =item while (($k, $v) = each %ini) {...}
2479
2480 =item if( exists %ini, $section ) {...}
2481
2482 =back
2483
2484 When tied to a hash, you use the Perl C<keys> and C<each>
2485 functions to iteratively list the sections in the ini file.
2486
2487 You can also use the Perl C<exists> function to see if a
2488 section is defined in the file.
2489
2490 =cut
2491
2492 ############################################################
2493 #
2494 # TIEHASH Methods
2495 #
2496 # Description:
2497 # These methods allow you to tie a hash to the
2498 # Config::IniFiles object. Note that, when tied, the
2499 # user wants to look at thinks like $ini{sec}{parm}, but the
2500 # TIEHASH only provides one level of hash interace, so the
2501 # root object gets asked for a $ini{sec}, which this
2502 # implements. To further tie the {parm} hash, the internal
2503 # class Config::IniFiles::_section, is provided, below.
2504 #
2505 ############################################################
2506 # ----------------------------------------------------------
2507 # Date Modification Author
2508 # ----------------------------------------------------------
2509 # 2000May09 Created method JW
2510 # ----------------------------------------------------------
2511 sub TIEHASH {
2512 my $class = shift;
2513 my %parms = @_;
2514
2515 # Get a new object
2516 my $self = $class->new( %parms );
2517
2518 return $self;
2519 } # end TIEHASH
2520
2521
2522 # ----------------------------------------------------------
2523 # Date Modification Author
2524 # ----------------------------------------------------------
2525 # 2000May09 Created method JW
2526 # ----------------------------------------------------------
2527 sub FETCH {
2528 my $self = shift;
2529 my( $key ) = @_;
2530
2531 $self->_caseify(\$key);
2532 return if (! $self->{v}{$key});
2533
2534 my %retval;
2535 tie %retval, 'Config::IniFiles::_section', $self, $key;
2536 return \%retval;
2537
2538 } # end FETCH
2539
2540 # ----------------------------------------------------------
2541 # Date Modification Author
2542 # ----------------------------------------------------------
2543 # 2000Jun14 Fixed bug where wrong ref was saved JW
2544 # 2000Oct09 Fixed possible but in %parms with defaults JW
2545 # 2001Apr04 Fixed -nocase problem in storing JW
2546 # ----------------------------------------------------------
2547 sub STORE {
2548 my $self = shift;
2549 my( $key, $ref ) = @_;
2550
2551 return undef unless ref($ref) eq 'HASH';
2552
2553 $self->_caseify(\$key);
2554
2555 $self->AddSection($key);
2556 $self->{v}{$key} = {%$ref};
2557 $self->{parms}{$key} = [keys %$ref];
2558 $self->{myparms}{$key} = [keys %$ref];
2559
2560 return 1;
2561 } # end STORE
2562
2563
2564 # ----------------------------------------------------------
2565 # Date Modification Author
2566 # ----------------------------------------------------------
2567 # 2000May09 Created method JW
2568 # 2000Dec17 Now removes comments, groups and EOTs too JW
2569 # 2001Arp04 Fixed -nocase problem JW
2570 # ----------------------------------------------------------
2571 sub DELETE {
2572 my $self = shift;
2573 my( $key ) = @_;
2574
2575 my $retval=$self->FETCH($key);
2576 $self->DeleteSection($key);
2577 return $retval;
2578 } # end DELETE
2579
2580
2581 # ----------------------------------------------------------
2582 # Date Modification Author
2583 # ----------------------------------------------------------
2584 # 2000May09 Created method JW
2585 # ----------------------------------------------------------
2586 sub CLEAR {
2587 my $self = shift;
2588
2589 return $self->Delete();
2590 } # end CLEAR
2591
2592 # ----------------------------------------------------------
2593 # Date Modification Author
2594 # ----------------------------------------------------------
2595 # 2000May09 Created method JW
2596 # ----------------------------------------------------------
2597 sub FIRSTKEY {
2598 my $self = shift;
2599
2600 $self->{tied_enumerator}=0;
2601 return $self->NEXTKEY();
2602 } # end FIRSTKEY
2603
2604
2605 # ----------------------------------------------------------
2606 # Date Modification Author
2607 # ----------------------------------------------------------
2608 # 2000May09 Created method JW
2609 # ----------------------------------------------------------
2610 sub NEXTKEY {
2611 my $self = shift;
2612 my( $last ) = @_;
2613
2614 my $i=$self->{tied_enumerator}++;
2615 my $key=$self->{sects}[$i];
2616 return if (! defined $key);
2617 return wantarray ? ($key, $self->FETCH($key)) : $key;
2618 } # end NEXTKEY
2619
2620
2621 # ----------------------------------------------------------
2622 # Date Modification Author
2623 # ----------------------------------------------------------
2624 # 2000May09 Created method JW
2625 # 2001Apr04 Fixed -nocase bug and false true bug JW
2626 # ----------------------------------------------------------
2627 sub EXISTS {
2628 my $self = shift;
2629 my( $key ) = @_;
2630 return $self->SectionExists($key);
2631 } # end EXISTS
2632
2633
2634 # ----------------------------------------------------------
2635 # DESTROY is used by TIEHASH and the Perl garbage collector,
2636 # ----------------------------------------------------------
2637 # Date Modification Author
2638 # ----------------------------------------------------------
2639 # 2000May09 Created method JW
2640 # ----------------------------------------------------------
2641 sub DESTROY {
2642 # my $self = shift;
2643 } # end if
2644
2645
2646 # ----------------------------------------------------------
2647 # Sub: _make_filehandle
2648 #
2649 # Args: $thing
2650 # $thing An input source
2651 #
2652 # Description: Takes an input source of a filehandle,
2653 # filehandle glob, reference to a filehandle glob, IO::File
2654 # object or scalar filename and returns a file handle to
2655 # read from it with.
2656 # ----------------------------------------------------------
2657 # Date Modification Author
2658 # ----------------------------------------------------------
2659 # 06Dec2001 Added to support input from any source JW
2660 # ----------------------------------------------------------
2661 sub _make_filehandle {
2662 my $self = shift;
2663
2664 #
2665 # This code is 'borrowed' from Lincoln D. Stein's GD.pm module
2666 # with modification for this module. Thanks Lincoln!
2667 #
2668
2669 no strict 'refs';
2670 my $thing = shift;
2671
2672 if (ref($thing) eq "SCALAR") {
2673 if (eval { require IO::Scalar; $IO::Scalar::VERSION >= 2.109; }) {
2674 return IO::Scalar->new($thing);
2675 } else {
2676 warn "SCALAR reference as file descriptor requires IO::stringy ".
2677 "v2.109 or later" if ($^W);
2678 return;
2679 }
2680 }
2681
2682 return $thing if defined(fileno $thing);
2683
2684 # otherwise try qualifying it into caller's package
2685 my $fh = qualify_to_ref($thing,caller(1));
2686 return $fh if defined(fileno $fh);
2687
2688 # otherwise treat it as a file to open
2689 $fh = gensym;
2690 open($fh,$thing) || return;
2691
2692 return $fh;
2693 } # end _make_filehandle
2694
2695 ############################################################
2696 #
2697 # INTERNAL PACKAGE: Config::IniFiles::_section
2698 #
2699 # Description:
2700 # This package is used to provide a single-level TIEHASH
2701 # interface to the sections in the IniFile. When tied, the
2702 # user wants to look at thinks like $ini{sec}{parm}, but the
2703 # TIEHASH only provides one level of hash interace, so the
2704 # root object gets asked for a $ini{sec} and must return a
2705 # has reference that accurately covers the '{parm}' part.
2706 #
2707 # This package is only used when tied and is inter-woven
2708 # between the sections and their parameters when the TIEHASH
2709 # method is called by Perl. It's a very simple implementation
2710 # of a tied hash object that simply maps onto the object API.
2711 #
2712 ############################################################
2713 # Date Modification Author
2714 # ----------------------------------------------------------
2715 # 2000.May.09 Created to excapsulate TIEHASH interface JW
2716 ############################################################
2717 package Config::IniFiles::_section;
2718
2719 use strict;
2720 use warnings;
2721 use Carp;
2722 use vars qw( $VERSION );
2723
2724 $Config::IniFiles::_section::VERSION = 2.16;
2725
2726 # ----------------------------------------------------------
2727 # Sub: Config::IniFiles::_section::TIEHASH
2728 #
2729 # Args: $class, $config, $section
2730 # $class The class that this is being tied to.
2731 # $config The parent Config::IniFiles object
2732 # $section The section this tied object refers to
2733 #
2734 # Description: Builds the object that implements accesses to
2735 # the tied hash.
2736 # ----------------------------------------------------------
2737 # Date Modification Author
2738 # ----------------------------------------------------------
2739 # ----------------------------------------------------------
2740 sub TIEHASH {
2741 my $proto = shift;
2742 my $class = ref($proto) || $proto;
2743 my ($config, $section) = @_;
2744
2745 # Make a new object
2746 return bless {config=>$config, section=>$section}, $class;
2747 } # end TIEHASH
2748
2749
2750 # ----------------------------------------------------------
2751 # Sub: Config::IniFiles::_section::FETCH
2752 #
2753 # Args: $key
2754 # $key The name of the key whose value to get
2755 #
2756 # Description: Returns the value associated with $key. If
2757 # the value is a list, returns a list reference.
2758 # ----------------------------------------------------------
2759 # Date Modification Author
2760 # ----------------------------------------------------------
2761 # 2000Jun15 Fixed bugs in -default handler JW
2762 # 2000Dec07 Fixed another bug in -deault handler JW
2763 # 2002Jul04 Returning scalar values (Bug:447532) AS
2764 # ----------------------------------------------------------
2765 sub FETCH {
2766 my ($self, $key) = @_;
2767 my @retval=$self->{config}->val($self->{section}, $key);
2768 return (@retval <= 1) ? $retval[0] : \@retval;
2769 } # end FETCH
2770
2771
2772 # ----------------------------------------------------------
2773 # Sub: Config::IniFiles::_section::STORE
2774 #
2775 # Args: $key, @val
2776 # $key The key under which to store the value
2777 # @val The value to store, either an array or a scalar
2778 #
2779 # Description: Sets the value for the specified $key
2780 # ----------------------------------------------------------
2781 # Date Modification Author
2782 # ----------------------------------------------------------
2783 # 2001Apr04 Fixed -nocase bug JW
2784 # ----------------------------------------------------------
2785 sub STORE {
2786 my ($self, $key, @val) = @_;
2787 return $self->{config}->newval($self->{section}, $key, @val);
2788 } # end STORE
2789
2790
2791 # ----------------------------------------------------------
2792 # Sub: Config::IniFiles::_section::DELETE
2793 #
2794 # Args: $key
2795 # $key The key to remove from the hash
2796 #
2797 # Description: Removes the specified key from the hash and
2798 # returns its former value.
2799 # ----------------------------------------------------------
2800 # Date Modification Author
2801 # ----------------------------------------------------------
2802 # 2001Apr04 Fixed -nocase bug JW
2803 # ----------------------------------------------------------
2804 sub DELETE {
2805 my ($self, $key) = @_;
2806 my $retval=$self->{config}->val($self->{section}, $key);
2807 $self->{config}->delval($self->{section}, $key);
2808 return $retval;
2809 } # end DELETE
2810
2811 # ----------------------------------------------------------
2812 # Sub: Config::IniFiles::_section::CLEAR
2813 #
2814 # Args: (None)
2815 #
2816 # Description: Empties the entire hash
2817 # ----------------------------------------------------------
2818 # Date Modification Author
2819 # ----------------------------------------------------------
2820 # ----------------------------------------------------------
2821 sub CLEAR {
2822 my ($self) = @_;
2823 return $self->{config}->DeleteSection($self->{section});
2824 } # end CLEAR
2825
2826 # ----------------------------------------------------------
2827 # Sub: Config::IniFiles::_section::EXISTS
2828 #
2829 # Args: $key
2830 # $key The key to look for
2831 #
2832 # Description: Returns whether the key exists
2833 # ----------------------------------------------------------
2834 # Date Modification Author
2835 # ----------------------------------------------------------
2836 # 2001Apr04 Fixed -nocase bug JW
2837 # ----------------------------------------------------------
2838 sub EXISTS {
2839 my ($self, $key) = @_;
2840 return $self->{config}->exists($self->{section},$key);
2841 } # end EXISTS
2842
2843 # ----------------------------------------------------------
2844 # Sub: Config::IniFiles::_section::FIRSTKEY
2845 #
2846 # Args: (None)
2847 #
2848 # Description: Returns the first key in the hash
2849 # ----------------------------------------------------------
2850 # Date Modification Author
2851 # ----------------------------------------------------------
2852 # ----------------------------------------------------------
2853 sub FIRSTKEY {
2854 my $self = shift;
2855
2856 $self->{tied_enumerator}=0;
2857 return $self->NEXTKEY();
2858 } # end FIRSTKEY
2859
2860 # ----------------------------------------------------------
2861 # Sub: Config::IniFiles::_section::NEXTKEY
2862 #
2863 # Args: $last
2864 # $last The last key accessed by the interator
2865 #
2866 # Description: Returns the next key in line
2867 # ----------------------------------------------------------
2868 # Date Modification Author
2869 # ----------------------------------------------------------
2870 # ----------------------------------------------------------
2871 sub NEXTKEY {
2872 my $self = shift;
2873 my( $last ) = @_;
2874
2875 my $i=$self->{tied_enumerator}++;
2876 my @keys = $self->{config}->Parameters($self->{section});
2877 my $key=$keys[$i];
2878 return if (! defined $key);
2879 return wantarray ? ($key, $self->FETCH($key)) : $key;
2880 } # end NEXTKEY
2881
2882
2883 # ----------------------------------------------------------
2884 # Sub: Config::IniFiles::_section::DESTROY
2885 #
2886 # Args: (None)
2887 #
2888 # Description: Called on cleanup
2889 # ----------------------------------------------------------
2890 # Date Modification Author
2891 # ----------------------------------------------------------
2892 # ----------------------------------------------------------
2893 sub DESTROY {
2894 # my $self = shift
2895 } # end DESTROY
2896
2897 1;
2898
2899 =head1 IMPORT / DELTA FEATURES
2900
2901 The I<-import> option to L</new> allows one to stack one
2902 I<Config::IniFiles> object on top of another (which might be itself
2903 stacked in turn and so on recursively, but this is beyond the
2904 point). The effect, as briefly explained in L</new>, is that the
2905 fields appearing in the composite object will be a superposition of
2906 those coming from the ``original'' one and the lines coming from the
2907 file, the latter taking precedence. For example, let's say that
2908 C<$master> and C<overlay> were created like this:
2909
2910 my $master = Config::IniFiles->new(-file => "master.ini");
2911 my $overlay = Config::IniFiles->new(-file => "overlay.ini",
2912 -import => $master);
2913
2914 If the contents of C<master.ini> and C<overlay.ini> are respectively
2915
2916 ; master.ini
2917 [section1]
2918 arg0=unchanged from master.ini
2919 arg1=val1
2920
2921 [section2]
2922 arg2=val2
2923
2924 and
2925
2926 ; overlay.ini
2927 [section1]
2928 arg1=overriden
2929
2930 Then C<< $overlay->val("section1", "arg1") >> is "overriden", while
2931 C<< $overlay->val("section1", "arg0") >> is "unchanged from
2932 master.ini".
2933
2934 This feature may be used to ship a ``global defaults'' configuration
2935 file for a Perl application, that can be overridden piecewise by a
2936 much shorter, per-site configuration file. Assuming UNIX-style path
2937 names, this would be done like this:
2938
2939 my $defaultconfig = Config::IniFiles->new
2940 (-file => "/usr/share/myapp/myapp.ini.default");
2941 my $config = Config::IniFiles->new
2942 (-file => "/etc/myapp.ini", -import => $defaultconfig);
2943 # Now use $config and forget about $defaultconfig in the rest of
2944 # the program
2945
2946 Starting with version 2.39, I<Config::IniFiles> also provides features
2947 to keep the importing / per-site configuration file small, by only
2948 saving those options that were modified by the running program. That
2949 is, if one calls
2950
2951 $overlay->setval("section1", "arg1", "anotherval");
2952 $overlay->newval("section3", "arg3", "val3");
2953 $overlay->WriteConfig(-delta=>1);
2954
2955 C<overlay.ini> would now contain
2956
2957 ; overlay.ini
2958 [section1]
2959 arg1=anotherval
2960
2961 [section3]
2962 arg3=val3
2963
2964 This is called a I<delta file> (see L</WriteConfig>). The untouched
2965 [section2] and arg0 do not appear, and the config file is therefore
2966 shorter; while of course, reloading the configuration into C<$master>
2967 and C<$overlay>, either through C<< $overlay->ReadConfig() >> or through
2968 the same code as above (e.g. when application restarts), would yield
2969 exactly the same result had the overlay object been saved in whole to
2970 the file system.
2971
2972 The only problem with this delta technique is one cannot delete the
2973 default values in the overlay configuration file, only change
2974 them. This is solved by a file format extension, enabled by the
2975 I<-negativedeltas> option to L</new>: if, say, one would delete
2976 parameters like this,
2977
2978 $overlay->DeleteSection("section2");
2979 $overlay->delval("section1", "arg0");
2980 $overlay->WriteConfig(-delta=>1);
2981
2982 The I<overlay.ini> file would now read:
2983
2984 ; overlay.ini
2985 [section1]
2986 ; arg0 is deleted
2987 arg1=anotherval
2988
2989 ; [section2] is deleted
2990
2991 [section3]
2992 arg3=val3
2993
2994 Assuming C<$overlay> was later re-read with C<< -negativedeltas => 1 >>,
2995 the parser would interpret the deletion comments to yield the correct
2996 result, that is, [section2] and arg0 would cease to exist in the
2997 C<$overlay> object.
2998
2999 =cut
3000
3001
3002 =head1 DIAGNOSTICS
3003
3004 =head2 @Config::IniFiles::errors
3005
3006 Contains a list of errors encountered while parsing the configuration
3007 file. If the I<new> method returns B<undef>, check the value of this
3008 to find out what's wrong. This value is reset each time a config file
3009 is read.
3010
3011 =head1 BUGS
3012
3013 =over 3
3014
3015 =item *
3016
3017 The output from [Re]WriteConfig/OutputConfig might not be as pretty as
3018 it can be. Comments are tied to whatever was immediately below them.
3019 And case is not preserved for Section and Parameter names if the -nocase
3020 option was used.
3021
3022 =item *
3023
3024 No locking is done by [Re]WriteConfig. When writing servers, take
3025 care that only the parent ever calls this, and consider making your
3026 own backup.
3027
3028 =back
3029
3030 =head1 Data Structure
3031
3032 Note that this is only a reference for the package maintainers - one of the
3033 upcoming revisions to this package will include a total clean up of the
3034 data structure.
3035
3036 $iniconf->{cf} = "config_file_name"
3037 ->{startup_settings} = \%orginal_object_parameters
3038 ->{firstload} = 0 OR 1
3039 ->{imported} = $object WHERE $object->isa("Config::IniFiles")
3040 ->{nocase} = 0
3041 ->{reloadwarn} = 0
3042 ->{sects} = \@sections
3043 ->{mysects} = \@sections
3044 ->{sCMT}{$sect} = \@comment_lines
3045 ->{group}{$group} = \@group_members
3046 ->{parms}{$sect} = \@section_parms
3047 ->{myparms}{$sect} = \@section_parms
3048 ->{EOT}{$sect}{$parm} = "end of text string"
3049 ->{pCMT}{$sect}{$parm} = \@comment_lines
3050 ->{v}{$sect}{$parm} = $value OR \@values
3051
3052 =head1 AUTHOR and ACKNOWLEDGEMENTS
3053
3054 The original code was written by Scott Hutton.
3055 Then handled for a time by Rich Bowen (thanks!),
3056 and was later managed by Jeremy Wadsack (thanks!),
3057 and now is managed by Shlomi Fish ( L<http://www.shlomifish.org/> )
3058 with many contributions from various other people.
3059
3060 In particular, special thanks go to (in roughly chronological order):
3061
3062 Bernie Cosell, Alan Young, Alex Satrapa, Mike Blazer, Wilbert van de Pieterman,
3063 Steve Campbell, Robert Konigsberg, Scott Dellinger, R. Bernstein,
3064 Daniel Winkelmann, Pires Claudio, Adrian Phillips,
3065 Marek Rouchal, Luc St Louis, Adam Fischler, Kay RοΏ½pke, Matt Wilson,
3066 Raviraj Murdeshwar and Slaven Rezic, Florian Pfaff
3067
3068 Geez, that's a lot of people. And apologies to the folks who were missed.
3069
3070 If you want someone to bug about this, that would be:
3071
3072 Shlomi Fish <shlomif@cpan.org>
3073
3074 If you want more information, or want to participate, go to:
3075
3076 L<http://sourceforge.net/projects/config-inifiles/>
3077
3078 Please submit bug reports using the Request Tracker interface at
3079 L<https://rt.cpan.org/Public/Dist/Display.html?Name=Config-IniFiles> .
3080
3081 Development discussion occurs on the mailing list
3082 config-inifiles-dev@lists.sourceforge.net, which you can subscribe
3083 to by going to the project web site (link above).
3084
3085 This program is free software; you can redistribute it and/or
3086 modify it under the same terms as Perl itself.
3087
3088 =cut
3089
3090 1;
3091
3092 # Please keep the following within the last four lines of the file
3093 #[JW for editor]:mode=perl:tabSize=8:indentSize=2:noTabs=true:indentOnEnter=true:
3094
@@ -0,0 +1,48
1 use lib 'test/scripts'; # for IniFiles
2 use File::Basename;
3 use IniFiles;
4 use feature "switch";
5
6 # read command line params
7 my $jobname = shift;
8
9 # read ini file
10 my $scriptdir = File::Basename::dirname($0);
11 my $inifile = $scriptdir . "/jobs.ini";
12 my %cfg;
13 tie %cfg, 'Config::IniFiles', ( -file => $inifile );
14
15 # get section from ini by jobname
16 my %build = %{$cfg{$jobname}};
17
18 # print out the ini settings
19 print "\n\n$jobname\n";
20 print "**********\n";
21 foreach (keys %build) {
22 print $_ . " : " . $build{$_} . "\n";
23 }
24
25 # examine the platform
26 given ($build{'Platform'}) {
27 when ("Win7") {
28 # construct a build command
29 my @cmd;
30 if ($build{'ToolChain'} eq "mingw") {
31 @cmd = ($scriptdir . "\\build_win_mingw.bat", $build{'QtDir'}, $build{'Config'}, $build{'MinGWDir'});
32 }
33 if ($build{'ToolChain'} eq "vs2005") {
34 @cmd = ($scriptdir . "\\build_win_vs2005.bat", $build{'QtDir'}, $build{'Config'});
35 }
36 if ($build{'ToolChain'} eq "vs2008") {
37 @cmd = ($scriptdir . "\\build_win_vs2008.bat", $build{'QtDir'}, $build{'Config'});
38 }
39 if ($build{'ToolChain'} eq "vs2010") {
40 @cmd = ($scriptdir . "\\build_win_vs2010.bat", $build{'QtDir'}, $build{'Config'});
41 }
42 # run the build command
43 system (@cmd) == 0 or die "system @cmd failed: $?";
44 }
45 default {
46 die "Unknown platform " . $build{'Platform'};
47 }
48 } No newline at end of file
@@ -0,0 +1,8
1 set QTDIR=%1
2 set PATH=%1\bin;
3 set PATH=%PATH%;%3
4 set PATH=%PATH%;%SystemRoot%\System32
5 set QMAKESPEC=win32-g++
6 qmake -r charts.pro CONFIG+=%2
7 @echo on
8 mingw32-make No newline at end of file
@@ -0,0 +1,10
1 set QTDIR=%1
2 set PATH=%1\bin;%PATH%;
3 set QMAKESPEC=win32-msvc2005
4 call "C:\Program Files (x86)\Microsoft Visual Studio 8\VC\vcvarsall.bat" x86
5 @echo on
6 set INCLUDE=%INCLUDE%;C:\Program Files (x86)\Microsoft SDKs\Windows\v7.0A\Include
7 set LIB=%LIB%;C:\Program Files (x86)\Microsoft SDKs\Windows\v7.0A\Lib
8 qmake -r charts.pro CONFIG+=%2
9 @echo on
10 nmake
@@ -0,0 +1,8
1 set QTDIR=%1
2 set PATH=%1\bin;%PATH%;
3 set QMAKESPEC=win32-msvc2008
4 call "C:\Program Files (x86)\Microsoft Visual Studio 9.0\VC\vcvarsall.bat" x86
5 @echo on
6 qmake -r charts.pro CONFIG+=%2
7 @echo on
8 nmake
@@ -0,0 +1,8
1 set QTDIR=%1
2 set PATH=%1\bin;%PATH%;
3 set QMAKESPEC=win32-msvc2010
4 call "C:\Program Files (x86)\Microsoft Visual Studio 10.0\VC\vcvarsall.bat" x86
5 @echo on
6 qmake -r charts.pro CONFIG+=%2
7 @echo on
8 nmake
@@ -0,0 +1,50
1
2 [Win7 MinGW debug QtC v4.8.0 (Jani's machine)]
3 Platform=Win7
4 QtDir=D:\Qt\4.8.0-MinGW-Commercial
5 ToolChain=mingw
6 Config=debug
7 MinGWDir=D:\Qt\mingw\bin
8
9 [Win7 MinGW release QtC v4.8.0 (Jani's machine)]
10 Platform=Win7
11 QtDir=D:\Qt\4.8.0-MinGW-Commercial
12 ToolChain=mingw
13 Config=release
14 MinGWDir=D:\Qt\mingw\bin
15
16 [Win7 vs2005 debug QtC v4.7.5 (Jani's machine)]
17 Platform=Win7
18 QtDir=D:\Qt\qt-win-commercial-4.7.5-vs2005
19 ToolChain=vs2005
20 Config=debug
21
22 [Win7 vs2005 release QtC v4.7.5 (Jani's machine)]
23 Platform=Win7
24 QtDir=D:\Qt\qt-win-commercial-4.7.5-vs2005
25 ToolChain=vs2005
26 Config=release
27
28 [Win7 vs2008 debug QtC v4.8.2 (Jani's machine)]
29 Platform=Win7
30 QtDir=D:\Qt\qt-win-commercial-4.8.2-vs2008-15-Apr-2012
31 ToolChain=vs2008
32 Config=debug
33
34 [Win7 vs2008 release QtC v4.8.2 (Jani's machine)]
35 Platform=Win7
36 QtDir=D:\Qt\qt-win-commercial-4.8.2-vs2008-15-Apr-2012
37 ToolChain=vs2008
38 Config=release
39
40 [Win7 vs2010 debug QtC v4.8.0 (Jani's machine)]
41 Platform=Win7
42 QtDir=D:\Qt\qt-win-commercial-4.8.0-vs2010
43 ToolChain=vs2010
44 Config=debug
45
46 [Win7 vs2010 release QtC v4.8.0 (Jani's machine)]
47 Platform=Win7
48 QtDir=D:\Qt\qt-win-commercial-4.8.0-vs2010
49 ToolChain=vs2010
50 Config=release No newline at end of file
General Comments 0
You need to be logged in to leave comments. Login now