local-lib5/lib/perl5/Config/General.pm

   1 #
   2 # Config::General.pm - Generic Config Module
   3 #
   4 # Purpose: Provide a convenient way for loading
   5 #          config values from a given file and
   6 #          return it as hash structure
   7 #
   8 # Copyright (c) 2000-2009 Thomas Linden <tlinden |AT| cpan.org>.
   9 # All Rights Reserved. Std. disclaimer applies.
  10 # Artificial License, same as perl itself. Have fun.
  11 #
  12 # namespace
  13 package Config::General;
  14
  15 use strict;
  16 use warnings;
  17 use English '-no_match_vars';
  18
  19 use IO::File;
  20 use FileHandle;
  21 use File::Spec::Functions qw(splitpath file_name_is_absolute catfile catpath);
  22 use File::Glob qw/:glob/;
  23
  24
  25 # on debian with perl > 5.8.4 croak() doesn't work anymore without this.
  26 # There is some require statement which dies 'cause it can't find Carp::Heavy,
  27 # I really don't understand, what the hell they made, but the debian perl
  28 # installation is definetly bullshit, damn!
  29 use Carp::Heavy;
  30
  31
  32 use Carp;
  33 use Exporter;
  34
  35 $Config::General::VERSION = 2.44;
  36
  37 use vars  qw(@ISA @EXPORT_OK);
  38 use base qw(Exporter);
  39 @EXPORT_OK = qw(ParseConfig SaveConfig SaveConfigString);
  40
  41 sub new {
  42   #
  43   # create new Config::General object
  44   #
  45   my($this, @param ) = @_;
  46   my $class = ref($this) || $this;
  47
  48   # define default options
  49   my $self = {
  50               # sha256 of current date
  51               # hopefully this lowers the probability that
  52               # this matches any configuration key or value out there
  53               # bugfix for rt.40925
  54               EOFseparator          => 'ad7d7b87f5b81d2a0d5cb75294afeb91aa4801b1f8e8532dc1b633c0e1d47037',
  55               SlashIsDirectory      => 0,
  56               AllowMultiOptions     => 1,
  57               MergeDuplicateOptions => 0,
  58               MergeDuplicateBlocks  => 0,
  59               LowerCaseNames        => 0,
  60               ApacheCompatible      => 0,
  61               UseApacheInclude      => 0,
  62               IncludeRelative       => 0,
  63               IncludeDirectories    => 0,
  64               IncludeGlob           => 0,
  65               IncludeAgain          => 0,
  66               AutoLaunder           => 0,
  67               AutoTrue              => 0,
  68               AutoTrueFlags         => {
  69                                         true  => '^(on|yes|true|1)$',
  70                                         false => '^(off|no|false|0)$',
  71                                        },
  72               DefaultConfig         => {},
  73               String                => '',
  74               level                 => 1,
  75               InterPolateVars       => 0,
  76               InterPolateEnv        => 0,
  77               ExtendedAccess        => 0,
  78               SplitPolicy           => 'guess', # also possible: whitespace, equalsign and custom
  79               SplitDelimiter        => 0,       # must be set by the user if SplitPolicy is 'custom'
  80               StoreDelimiter        => 0,       # will be set by me unless user uses 'custom' policy
  81               CComments             => 1,       # by default turned on
  82               BackslashEscape       => 0,       # by default turned off, allows escaping anything using  the backslash
  83               StrictObjects         => 1,       # be strict on non-existent keys in OOP mode
  84               StrictVars            => 1,       # be strict on undefined variables in Interpolate mode
  85               Tie                   => q(),      # could be set to a perl module for tie'ing new hashes
  86               parsed                => 0,       # internal state stuff for variable interpolation
  87               files                 => {},      # which files we have read, if any
  88               UTF8                  => 0,
  89               SaveSorted            => 0
  90              };
  91
  92   # create the class instance
  93   bless $self, $class;
  94
  95   if ($#param >= 1) {
  96     # use of the new hash interface!
  97     $self->_prepare(@param);
  98   }
  99   elsif ($#param == 0) {
 100     # use of the old style
 101     $self->{ConfigFile} = $param[0];
 102     if (ref($self->{ConfigFile}) eq 'HASH') {
 103       $self->{ConfigHash} = delete $self->{ConfigFile};
 104     }
 105   }
 106   else {
 107     # this happens if $#param == -1,1 thus no param was given to new!
 108     $self->{config} = $self->_hashref();
 109     $self->{parsed} = 1;
 110   }
 111
 112   # find split policy to use for option/value separation
 113   $self->_splitpolicy();
 114
 115   # bless into variable interpolation module if neccessary
 116   $self->_blessvars();
 117
 118   # process as usual
 119   if (!$self->{parsed}) {
 120     $self->_process();
 121   }
 122
 123   if ($self->{InterPolateVars}) {
 124     $self->{config} = $self->_clean_stack($self->{config});
 125   }
 126
 127   # bless into OOP namespace if required
 128   $self->_blessoop();
 129
 130   return $self;
 131 }
 132
 133
 134
 135 sub _process {
 136   #
 137   # call _read() and _parse() on the given config
 138   my($self) = @_;
 139
 140   if ($self->{DefaultConfig} && $self->{InterPolateVars}) {
 141     $self->{DefaultConfig} = $self->_interpolate_hash($self->{DefaultConfig}); # FIXME: _hashref() ?
 142   }
 143   if (exists $self->{StringContent}) {
 144     # consider the supplied string as config file
 145     $self->_read($self->{StringContent}, 'SCALAR');
 146     $self->{config} = $self->_parse($self->{DefaultConfig}, $self->{content});
 147   }
 148   elsif (exists $self->{ConfigHash}) {
 149     if (ref($self->{ConfigHash}) eq 'HASH') {
 150       # initialize with given hash
 151       $self->{config} = $self->{ConfigHash};
 152       $self->{parsed} = 1;
 153     }
 154     else {
 155       croak "Config::General: Parameter -ConfigHash must be a hash reference!\n";
 156     }
 157   }
 158   elsif (ref($self->{ConfigFile}) eq 'GLOB' || ref($self->{ConfigFile}) eq 'FileHandle') {
 159     # use the file the glob points to
 160     $self->_read($self->{ConfigFile});
 161     $self->{config} = $self->_parse($self->{DefaultConfig}, $self->{content});
 162   }
 163   else {
 164     if ($self->{ConfigFile}) {
 165       # open the file and read the contents in
 166       $self->{configfile} = $self->{ConfigFile};
 167       if ( file_name_is_absolute($self->{ConfigFile}) ) {
 168         # look if is is an absolute path and save the basename if it is absolute
 169         my ($volume, $path, undef) = splitpath($self->{ConfigFile});
 170         $path =~ s#/$##; # remove eventually existing trailing slash
 171         if (! $self->{ConfigPath}) {
 172           $self->{ConfigPath} = [];
 173         }
 174         unshift @{$self->{ConfigPath}}, catpath($volume, $path, q());
 175       }
 176       $self->_open($self->{configfile});
 177       # now, we parse immdediately, getall simply returns the whole hash
 178       $self->{config} = $self->_hashref();
 179       $self->{config} = $self->_parse($self->{DefaultConfig}, $self->{content});
 180     }
 181     else {
 182       # hm, no valid config file given, so try it as an empty object
 183       $self->{config} = $self->_hashref();
 184       $self->{parsed} = 1;
 185     }
 186   }
 187 }
 188
 189
 190 sub _blessoop {
 191   #
 192   # bless into ::Extended if neccessary
 193   my($self) = @_;
 194   if ($self->{ExtendedAccess}) {
 195     # we are blessing here again, to get into the ::Extended namespace
 196     # for inheriting the methods available overthere, which we doesn't have.
 197     bless $self, 'Config::General::Extended';
 198     eval {
 199       require Config::General::Extended;
 200     };
 201     if ($EVAL_ERROR) {
 202       croak "Config::General: " . $EVAL_ERROR;
 203     }
 204   }
 205 #  return $self;
 206 }
 207
 208 sub _blessvars {
 209   #
 210   # bless into ::Interpolated if neccessary
 211   my($self) = @_;
 212   if ($self->{InterPolateVars} || $self->{InterPolateEnv}) {
 213     # InterPolateEnv implies InterPolateVars
 214     $self->{InterPolateVars} = 1;
 215
 216     # we are blessing here again, to get into the ::InterPolated namespace
 217     # for inheriting the methods available overthere, which we doesn't have here.
 218     bless $self, 'Config::General::Interpolated';
 219     eval {
 220       require Config::General::Interpolated;
 221     };
 222     if ($EVAL_ERROR) {
 223       croak "Config::General: " . $EVAL_ERROR;
 224     }
 225     # pre-compile the variable regexp
 226     $self->{regex} = $self->_set_regex();
 227   }
 228 #  return $self;
 229 }
 230
 231
 232 sub _splitpolicy {
 233   #
 234   # find out what split policy to use
 235   my($self) = @_;
 236   if ($self->{SplitPolicy} ne 'guess') {
 237     if ($self->{SplitPolicy} eq 'whitespace') {
 238       $self->{SplitDelimiter} = '\s+';
 239       if (!$self->{StoreDelimiter}) {
 240         $self->{StoreDelimiter} = q(   );
 241       }
 242     }
 243     elsif ($self->{SplitPolicy} eq 'equalsign') {
 244       $self->{SplitDelimiter} = '\s*=\s*';
 245       if (!$self->{StoreDelimiter}) {
 246         $self->{StoreDelimiter} = ' = ';
 247       }
 248     }
 249     elsif ($self->{SplitPolicy} eq 'custom') {
 250       if (! $self->{SplitDelimiter} ) {
 251         croak "Config::General: SplitPolicy set to 'custom' but no SplitDelimiter set.\n";
 252       }
 253     }
 254     else {
 255       croak "Config::General: Unsupported SplitPolicy: $self->{SplitPolicy}.\n";
 256     }
 257   }
 258   else {
 259     if (!$self->{StoreDelimiter}) {
 260       $self->{StoreDelimiter} = q(   );
 261     }
 262   }
 263 }
 264
 265 sub _prepare {
 266   #
 267   # prepare the class parameters, mangle them, if there
 268   # are options to reset or to override, do it here.
 269   my ($self, %conf) = @_;
 270
 271   # save the parameter list for ::Extended's new() calls
 272   $self->{Params} = \%conf;
 273
 274   # be backwards compatible
 275   if (exists $conf{-file}) {
 276     $self->{ConfigFile} = delete $conf{-file};
 277   }
 278   if (exists $conf{-hash}) {
 279     $self->{ConfigHash} = delete $conf{-hash};
 280   }
 281
 282   # store input, file, handle, or array
 283   if (exists $conf{-ConfigFile}) {
 284     $self->{ConfigFile} = delete $conf{-ConfigFile};
 285   }
 286   if (exists $conf{-ConfigHash}) {
 287     $self->{ConfigHash} = delete $conf{-ConfigHash};
 288   }
 289
 290   # store search path for relative configs, if any
 291   if (exists $conf{-ConfigPath}) {
 292     my $configpath = delete $conf{-ConfigPath};
 293     $self->{ConfigPath} = ref $configpath eq 'ARRAY' ? $configpath : [$configpath];
 294   }
 295
 296   # handle options which contains values we need (strings, hashrefs or the like)
 297   if (exists $conf{-String} ) {
 298     #if (ref(\$conf{-String}) eq 'SCALAR') {
 299     if (not ref $conf{-String}) {
 300       if ( $conf{-String}) {
 301         $self->{StringContent} = $conf{-String};
 302       }
 303       delete $conf{-String};
 304     }
 305     # re-implement arrayref support, removed after 2.22 as _read were
 306     # re-organized
 307     # fixed bug#33385
 308     elsif(ref($conf{-String}) eq 'ARRAY') {
 309       $self->{StringContent} = join "\n", @{$conf{-String}};
 310     }
 311     else {
 312       croak "Config::General: Parameter -String must be a SCALAR or ARRAYREF!\n";
 313     }
 314     delete $conf{-String};
 315   }
 316   if (exists $conf{-Tie}) {
 317     if ($conf{-Tie}) {
 318       $self->{Tie} = delete $conf{-Tie};
 319       $self->{DefaultConfig} = $self->_hashref();
 320     }
 321   }
 322
 323   if (exists $conf{-FlagBits}) {
 324     if ($conf{-FlagBits} && ref($conf{-FlagBits}) eq 'HASH') {
 325       $self->{FlagBits} = 1;
 326       $self->{FlagBitsFlags} = $conf{-FlagBits};
 327     }
 328     delete $conf{-FlagBits};
 329   }
 330
 331   if (exists $conf{-DefaultConfig}) {
 332     if ($conf{-DefaultConfig} && ref($conf{-DefaultConfig}) eq 'HASH') {
 333       $self->{DefaultConfig} = $conf{-DefaultConfig};
 334     }
 335     elsif ($conf{-DefaultConfig} && ref($conf{-DefaultConfig}) eq q()) {
 336       $self->_read($conf{-DefaultConfig}, 'SCALAR');
 337       $self->{DefaultConfig} = $self->_parse($self->_hashref(), $self->{content});
 338       $self->{content} = ();
 339     }
 340     delete $conf{-DefaultConfig};
 341   }
 342
 343   # handle options which may either be true or false
 344   # allowing "human" logic about what is true and what is not
 345   foreach my $entry (keys %conf) {
 346     my $key = $entry;
 347     $key =~ s/^\-//;
 348     if (! exists $self->{$key}) {
 349       croak "Config::General: Unknown parameter: $entry => \"$conf{$entry}\" (key: <$key>)\n";
 350     }
 351     if ($conf{$entry} =~ /$self->{AutoTrueFlags}->{true}/io) {
 352       $self->{$key} = 1;
 353     }
 354     elsif ($conf{$entry} =~ /$self->{AutoTrueFlags}->{false}/io) {
 355       $self->{$key} = 0;
 356     }
 357     else {
 358       # keep it untouched
 359       $self->{$key} = $conf{$entry};
 360     }
 361   }
 362
 363   if ($self->{MergeDuplicateOptions}) {
 364     # override if not set by user
 365     if (! exists $conf{-AllowMultiOptions}) {
 366       $self->{AllowMultiOptions} = 0;
 367     }
 368   }
 369
 370   if ($self->{ApacheCompatible}) {
 371     # turn on all apache compatibility options which has
 372     # been incorporated during the years...
 373     $self->{UseApacheInclude}   = 1;
 374     $self->{IncludeRelative}    = 1;
 375     $self->{IncludeDirectories} = 1;
 376     $self->{IncludeGlob}        = 1;
 377     $self->{SlashIsDirectory}   = 1;
 378     $self->{SplitPolicy}        = 'whitespace';
 379     $self->{CComments}          = 0;
 380     $self->{BackslashEscape}    = 1;
 381   }
 382 }
 383
 384 sub getall {
 385   #
 386   # just return the whole config hash
 387   #
 388   my($this) = @_;
 389   return (exists $this->{config} ? %{$this->{config}} : () );
 390 }
 391
 392
 393 sub files {
 394   #
 395   # return a list of files opened so far
 396   #
 397   my($this) = @_;
 398   return (exists $this->{files} ? keys %{$this->{files}} : () );
 399 }
 400
 401
 402 sub _open {
 403   #
 404   # open the config file, or expand a directory or glob
 405   #
 406   my($this, $basefile, $basepath) = @_;
 407   my($fh, $configfile);
 408
 409   if($basepath) {
 410     # if this doesn't work we can still try later the global config path to use
 411     $configfile = catfile($basepath, $basefile);
 412   }
 413   else {
 414     $configfile = $basefile;
 415   }
 416
 417   if ($this->{IncludeGlob} and $configfile =~ /[*?\[\{\\]/) {
 418     # Something like: *.conf (or maybe dir/*.conf) was included; expand it and
 419     # pass each expansion through this method again.
 420     my @include = grep { -f $_ } bsd_glob($configfile, GLOB_BRACE | GLOB_QUOTE);
 421
 422     # applied patch by AlexK fixing rt.cpan.org#41030
 423     if ( !@include && defined $this->{ConfigPath} ) {
 424         foreach my $dir (@{$this->{ConfigPath}}) {
 425                 my ($volume, $path, undef) = splitpath($basefile);
 426                 if ( -d catfile( $dir, $path )  ) {
 427                         push @include, grep { -f $_ } bsd_glob(catfile($dir, $basefile), GLOB_BRACE | GLOB_QUOTE);
 428                         last;
 429                 }
 430         }
 431     }
 432
 433     if (@include == 1) {
 434       $configfile = $include[0];
 435     }
 436     else {
 437       # Multiple results or no expansion results (which is fine,
 438       # include foo/* shouldn't fail if there isn't anything matching)
 439       local $this->{IncludeGlob};
 440       for (@include) {
 441         $this->_open($_);
 442       }
 443       return;
 444     }
 445   }
 446
 447   if (!-e $configfile) {
 448     my $found;
 449     if (defined $this->{ConfigPath}) {
 450       # try to find the file within ConfigPath
 451       foreach my $dir (@{$this->{ConfigPath}}) {
 452         if( -e catfile($dir, $basefile) ) {
 453           $configfile = catfile($dir, $basefile);
 454           $found = 1;
 455           last; # found it
 456         }
 457       }
 458     }
 459     if (!$found) {
 460       my $path_message = defined $this->{ConfigPath} ? q( within ConfigPath: ) . join(q(.), @{$this->{ConfigPath}}) : q();
 461       croak qq{Config::General The file "$basefile" does not exist$path_message!};
 462     }
 463   }
 464
 465   local ($RS) = $RS;
 466   if (! $RS) {
 467     carp(q(\$RS (INPUT_RECORD_SEPARATOR) is undefined.  Guessing you want a line feed character));
 468     $RS = "\n";
 469   }
 470
 471   if (-d $configfile and $this->{IncludeDirectories}) {
 472     # A directory was included; include all the files inside that directory in ASCII order
 473     local *INCLUDEDIR;
 474     opendir INCLUDEDIR, $configfile or croak "Config::General: Could not open directory $configfile!($!)\n";
 475     my @files = sort grep { -f catfile($configfile, $_) } catfile($configfile, $_), readdir INCLUDEDIR;
 476     closedir INCLUDEDIR;
 477     local $this->{CurrentConfigFilePath} = $configfile;
 478     for (@files) {
 479       my $file = catfile($configfile, $_);
 480       if (! exists $this->{files}->{$file} or $this->{IncludeAgain} ) {
 481         # support re-read if used urged us to do so, otherwise ignore the file
 482         if ($this->{UTF8}) {
 483           $fh = new IO::File;
 484           open( $fh, "<:utf8", $file)
 485             or croak "Config::General: Could not open $file in UTF8 mode!($!)\n";
 486         }
 487         else {
 488           $fh = IO::File->new( $file, 'r') or croak "Config::General: Could not open $file!($!)\n";
 489         }
 490         $this->{files}->{"$file"} = 1;
 491         $this->_read($fh);
 492       }
 493       else {
 494         warn "File $file already loaded.  Use -IncludeAgain to load it again.\n";
 495       }
 496     }
 497   }
 498   elsif (-e _) {
 499     if (exists $this->{files}->{$configfile} and not $this->{IncludeAgain}) {
 500       # do not read the same file twice, just return
 501       warn "File $configfile already loaded.  Use -IncludeAgain to load it again.\n";
 502       return;
 503     }
 504     else {
 505       if ($this->{UTF8}) {
 506         $fh = new IO::File;
 507         open( $fh, "<:utf8", $configfile)
 508           or croak "Config::General: Could not open $configfile in UTF8 mode!($!)\n";
 509       }
 510       else {
 511         $fh = IO::File->new( "$configfile", 'r')
 512           or croak "Config::General: Could not open $configfile!($!)\n";
 513       }
 514
 515       $this->{files}->{$configfile}    = 1;
 516
 517       my ($volume, $path, undef)           = splitpath($configfile);
 518       local $this->{CurrentConfigFilePath} = catpath($volume, $path, q());
 519
 520       $this->_read($fh);
 521     }
 522   }
 523   return;
 524 }
 525
 526
 527 sub _read {
 528   #
 529   # store the config contents in @content
 530   # and prepare it somewhat for easier parsing later
 531   # (comments, continuing lines, and stuff)
 532   #
 533   my($this, $fh, $flag) = @_;
 534   my(@stuff, @content, $c_comment, $longline, $hier, $hierend, @hierdoc);
 535   local $_ = q();
 536
 537   if ($flag && $flag eq 'SCALAR') {
 538     if (ref($fh) eq 'ARRAY') {
 539       @stuff = @{$fh};
 540     }
 541     else {
 542       @stuff = split /\n/, $fh;
 543     }
 544   }
 545   else {
 546     @stuff = <$fh>;
 547   }
 548
 549   foreach (@stuff) {
 550     if ($this->{AutoLaunder}) {
 551       if (m/^(.*)$/) {
 552         $_ = $1;
 553       }
 554     }
 555
 556     chomp;
 557
 558     if ($this->{CComments}) {
 559       # look for C-Style comments, if activated
 560       if (/(\s*\/\*.*\*\/\s*)/) {
 561         # single c-comment on one line
 562         s/\s*\/\*.*\*\/\s*//;
 563       }
 564       elsif (/^\s*\/\*/) {
 565         # the beginning of a C-comment ("/*"), from now on ignore everything.
 566         if (/\*\/\s*$/) {
 567           # C-comment end is already there, so just ignore this line!
 568           $c_comment = 0;
 569         }
 570         else {
 571           $c_comment = 1;
 572         }
 573       }
 574       elsif (/\*\//) {
 575         if (!$c_comment) {
 576           warn "invalid syntax: found end of C-comment without previous start!\n";
 577         }
 578         $c_comment = 0;    # the current C-comment ends here, go on
 579         s/^.*\*\///;       # if there is still stuff, it will be read
 580       }
 581       next if($c_comment); # ignore EVERYTHING from now on, IF it IS a C-Comment
 582     }
 583
 584
 585     if ($hier) {
 586       # inside here-doc, only look for $hierend marker
 587       if (/^(\s*)\Q$hierend\E\s*$/) {
 588         my $indent = $1;                 # preserve indentation
 589         $hier .= ' ' . $this->{EOFseparator}; # bugfix of rt.40925
 590                                          # _parse will also preserver indentation
 591         if ($indent) {
 592           foreach (@hierdoc) {
 593             s/^$indent//;                # i.e. the end was: "    EOF" then we remove "    " from every here-doc line
 594             $hier .= $_ . "\n";          # and store it in $hier
 595           }
 596         }
 597         else {
 598           $hier .= join "\n", @hierdoc;  # there was no indentation of the end-string, so join it 1:1
 599         }
 600         push @{$this->{content}}, $hier; # push it onto the content stack
 601         @hierdoc = ();
 602         undef $hier;
 603         undef $hierend;
 604       }
 605       else {
 606         # everything else onto the stack
 607         push @hierdoc, $_;
 608       }
 609       next;
 610     }
 611
 612     ###
 613     ### non-heredoc entries from now on
 614     ##
 615
 616     # Remove comments and empty lines
 617     s/(?<!\\)#.*$//; # .+ => .* bugfix rt.cpan.org#44600
 618     next if /^\s*#/;
 619     next if /^\s*$/;
 620
 621
 622     # look for multiline option, indicated by a trailing backslash
 623     my $extra = $this->{BackslashEscape} ? '(?<!\\\\)' : q();
 624     if (/$extra\\$/) {
 625       chop;
 626       s/^\s*//;
 627       $longline .= $_;
 628       next;
 629     }
 630
 631     # remove the \ from all characters if BackslashEscape is turned on
 632     # FIXME (rt.cpan.org#33218
 633     if ($this->{BackslashEscape}) {
 634       s/\\(.)/$1/g;
 635     }
 636     else {
 637       # remove the \ char in front of masked "#", if any
 638       s/\\#/#/g;
 639     }
 640
 641
 642     # transform explicit-empty blocks to conforming blocks
 643     if (!$this->{ApacheCompatible} && /\s*<([^\/]+?.*?)\/>$/) {
 644       my $block = $1;
 645       if ($block !~ /\"/) {
 646         if ($block !~ /\s[^\s]/) {
 647           # fix of bug 7957, add quotation to pure slash at the
 648           # end of a block so that it will be considered as directory
 649           # unless the block is already quoted or contains whitespaces
 650           # and no quotes.
 651           if ($this->{SlashIsDirectory}) {
 652             push @{$this->{content}}, '<' . $block . '"/">';
 653             next;
 654           }
 655         }
 656       }
 657       my $orig  = $_;
 658       $orig     =~ s/\/>$/>/;
 659       $block    =~ s/\s\s*.*$//;
 660       push @{$this->{content}}, $orig, "</${block}>";
 661       next;
 662     }
 663
 664
 665     # look for here-doc identifier
 666     if ($this->{SplitPolicy} eq 'guess') {
 667       if (/^\s*([^=]+?)\s*=\s*<<\s*(.+?)\s*$/) {
 668         # try equal sign (fix bug rt#36607)
 669         $hier    = $1;  # the actual here-doc variable name
 670         $hierend = $2;  # the here-doc identifier, i.e. "EOF"
 671         next;
 672       }
 673       elsif (/^\s*(\S+?)\s+<<\s*(.+?)\s*$/) {
 674         # try whitespace
 675         $hier    = $1;  # the actual here-doc variable name
 676         $hierend = $2;  # the here-doc identifier, i.e. "EOF"
 677         next;
 678       }
 679     }
 680     else {
 681       # no guess, use one of the configured strict split policies
 682       if (/^\s*(.+?)($this->{SplitDelimiter})<<\s*(.+?)\s*$/) {
 683         $hier    = $1;  # the actual here-doc variable name
 684         $hierend = $3;  # the here-doc identifier, i.e. "EOF"
 685         next;
 686       }
 687     }
 688
 689
 690
 691     ###
 692     ### any "normal" config lines from now on
 693     ###
 694
 695     if ($longline) {
 696       # previous stuff was a longline and this is the last line of the longline
 697       s/^\s*//;
 698       $longline .= $_;
 699       push @{$this->{content}}, $longline;    # push it onto the content stack
 700       undef $longline;
 701       next;
 702     }
 703     else {
 704       # look for include statement(s)
 705       my $incl_file;
 706       my $path = '';
 707       if ( $this->{IncludeRelative} and defined $this->{CurrentConfigFilePath}) {
 708         $path = $this->{CurrentConfigFilePath};
 709       }
 710       elsif (defined $this->{ConfigPath}) {
 711         # fetch pathname of base config file, assuming the 1st one is the path of it
 712         $path = $this->{ConfigPath}->[0];
 713       }
 714
 715       # bugfix rt.cpan.org#38635: support quoted filenames
 716       if ($this->{UseApacheInclude}) {
 717          if (/^\s*include\s*(["'])(.*?)(?<!\\)\1$/i) {
 718            $incl_file = $2;
 719          }
 720          elsif (/^\s*include\s+(.+?)\s*$/i) {
 721            $incl_file = $1;
 722          }
 723       }
 724       else {
 725         if (/^\s*<<include\s+(.+?)>>\s*$/i) {
 726           $incl_file = $1;
 727         }
 728       }
 729
 730       if ($incl_file) {
 731         if ( $this->{IncludeRelative} && $path && !file_name_is_absolute($incl_file) ) {
 732           # include the file from within location of $this->{configfile}
 733           $this->_open( $incl_file, $path );
 734         }
 735         else {
 736           # include the file from within pwd, or absolute
 737           $this->_open($incl_file);
 738         }
 739       }
 740       else {
 741         # standard entry, (option = value)
 742         push @{$this->{content}}, $_;
 743       }
 744
 745     }
 746
 747   }
 748   return 1;
 749 }
 750
 751
 752
 753
 754
 755 sub _parse {
 756   #
 757   # parse the contents of the file
 758   #
 759   my($this, $config, $content) = @_;
 760   my(@newcontent, $block, $blockname, $chunk,$block_level);
 761   local $_;
 762
 763   foreach (@{$content}) {                                  # loop over content stack
 764     chomp;
 765     $chunk++;
 766     $_ =~ s/^\s+//;                                        # strip spaces @ end and begin
 767     $_ =~ s/\s+$//;
 768
 769     #
 770     # build option value assignment, split current input
 771     # using whitespace, equal sign or optionally here-doc
 772     # separator EOFseparator
 773     my ($option,$value);
 774     if (/$this->{EOFseparator}/) {
 775       ($option,$value) = split /\s*$this->{EOFseparator}\s*/, $_, 2;   # separated by heredoc-finding in _open()
 776     }
 777     else {
 778       if ($this->{SplitPolicy} eq 'guess') {
 779         # again the old regex. use equalsign SplitPolicy to get the
 780         # 2.00 behavior. the new regexes were too odd.
 781         ($option,$value) = split /\s*=\s*|\s+/, $_, 2;
 782       }
 783       else {
 784         # no guess, use one of the configured strict split policies
 785         ($option,$value) = split /$this->{SplitDelimiter}/, $_, 2;
 786       }
 787     }
 788
 789     if ($value && $value =~ /^"/ && $value =~ /"$/) {
 790       $value =~ s/^"//;                                    # remove leading and trailing "
 791       $value =~ s/"$//;
 792     }
 793     if (! defined $block) {                                # not inside a block @ the moment
 794       if (/^<([^\/]+?.*?)>$/) {                            # look if it is a block
 795         $block = $1;                                       # store block name
 796         if ($block =~ /^"([^"]+)"$/) {
 797           # quoted block, unquote it and do not split
 798           $block =~ s/"//g;
 799         }
 800         else {
 801           # If it is a named block store the name separately; allow the block and name to each be quoted
 802           if ($block =~ /^(?:"([^"]+)"|(\S+))(?:\s+(?:"([^"]+)"|(.*)))?$/) {
 803             $block = $1 || $2;
 804             $blockname = $3 || $4;
 805           }
 806         }
 807         if ($this->{InterPolateVars}) {
 808           # interpolate block(name), add "<" and ">" to the key, because
 809           # it is sure that such keys does not exist otherwise.
 810           $block     = $this->_interpolate($config, "<$block>", $block);
 811           if (defined $blockname) {
 812             $blockname = $this->_interpolate($config, "<$blockname>", "$blockname");
 813           }
 814         }
 815         if ($this->{LowerCaseNames}) {
 816           $block = lc $block;    # only for blocks lc(), if configured via new()
 817         }
 818         $this->{level} += 1;
 819         undef @newcontent;
 820         next;
 821       }
 822       elsif (/^<\/(.+?)>$/) { # it is an end block, but we don't have a matching block!
 823         croak "Config::General: EndBlock \"<\/$1>\" has no StartBlock statement (level: $this->{level}, chunk $chunk)!\n";
 824       }
 825       else {                                               # insert key/value pair into actual node
 826         if ($this->{LowerCaseNames}) {
 827           $option = lc $option;
 828         }
 829
 830         if (exists $config->{$option}) {
 831           if ($this->{MergeDuplicateOptions}) {
 832             $config->{$option} = $this->_parse_value($config, $option, $value);
 833
 834             # bugfix rt.cpan.org#33216
 835             if ($this->{InterPolateVars}) {
 836               # save pair on local stack
 837               $config->{__stack}->{$option} = $config->{$option};
 838             }
 839           }
 840           else {
 841             if (! $this->{AllowMultiOptions} ) {
 842               # no, duplicates not allowed
 843               croak "Config::General: Option \"$option\" occurs more than once (level: $this->{level}, chunk $chunk)!\n";
 844             }
 845             else {
 846               # yes, duplicates allowed
 847               if (ref($config->{$option}) ne 'ARRAY') {      # convert scalar to array
 848                 my $savevalue = $config->{$option};
 849                 delete $config->{$option};
 850                 push @{$config->{$option}}, $savevalue;
 851               }
 852               eval {
 853                 # check if arrays are supported by the underlying hash
 854                 my $i = scalar @{$config->{$option}};
 855               };
 856               if ($EVAL_ERROR) {
 857                 $config->{$option} = $this->_parse_value($config, $option, $value);
 858               }
 859               else {
 860                 # it's already an array, just push
 861                 push @{$config->{$option}}, $this->_parse_value($config, $option, $value);
 862               }
 863             }
 864           }
 865         }
 866         else {
 867           # standard config option, insert key/value pair into node
 868           $config->{$option} = $this->_parse_value($config, $option, $value);
 869
 870           if ($this->{InterPolateVars}) {
 871             # save pair on local stack
 872             $config->{__stack}->{$option} = $config->{$option};
 873           }
 874         }
 875       }
 876     }
 877     elsif (/^<([^\/]+?.*?)>$/) {    # found a start block inside a block, don't forget it
 878       $block_level++;               # $block_level indicates wether we are still inside a node
 879       push @newcontent, $_;         # push onto new content stack for later recursive call of _parse()
 880     }
 881     elsif (/^<\/(.+?)>$/) {
 882       if ($block_level) {           # this endblock is not the one we are searching for, decrement and push
 883         $block_level--;             # if it is 0, then the endblock was the one we searched for, see below
 884         push @newcontent, $_;       # push onto new content stack
 885       }
 886       else {                        # calling myself recursively, end of $block reached, $block_level is 0
 887         if (defined $blockname) {
 888           # a named block, make it a hashref inside a hash within the current node
 889
 890           if (! exists $config->{$block}) {
 891             # Make sure that the hash is not created implicitly
 892             $config->{$block} = $this->_hashref();
 893
 894             if ($this->{InterPolateVars}) {
 895               # inherit current __stack to new block
 896               $config->{$block}->{__stack} = $this->_copy($config->{__stack});
 897             }
 898           }
 899
 900           if (ref($config->{$block}) eq '') {
 901             croak "Config::General: Block <$block> already exists as scalar entry!\n";
 902           }
 903           elsif (ref($config->{$block}) eq 'ARRAY') {
 904             croak "Config::General: Cannot append named block <$block $blockname> to array of scalars!\n"
 905                  ."Block <$block> or scalar '$block' occurs more than once.\n"
 906                  ."Turn on -MergeDuplicateBlocks or make sure <$block> occurs only once in the config.\n";
 907           }
 908           elsif (exists $config->{$block}->{$blockname}) {
 909             # the named block already exists, make it an array
 910             if ($this->{MergeDuplicateBlocks}) {
 911               # just merge the new block with the same name as an existing one into
 912               # this one.
 913               $config->{$block}->{$blockname} = $this->_parse($config->{$block}->{$blockname}, \@newcontent);
 914             }
 915             else {
 916               if (! $this->{AllowMultiOptions}) {
 917                 croak "Config::General: Named block \"<$block $blockname>\" occurs more than once (level: $this->{level}, chunk $chunk)!\n";
 918               }
 919               else {                                       # preserve existing data
 920                 my $savevalue = $config->{$block}->{$blockname};
 921                 delete $config->{$block}->{$blockname};
 922                 my @ar;
 923                 if (ref $savevalue eq 'ARRAY') {
 924                   push @ar, @{$savevalue};                   # preserve array if any
 925                 }
 926                 else {
 927                   push @ar, $savevalue;
 928                 }
 929                 push @ar, $this->_parse( $this->_hashref(), \@newcontent);  # append it
 930                 $config->{$block}->{$blockname} = \@ar;
 931               }
 932             }
 933           }
 934           else {
 935             # the first occurence of this particular named block
 936             my $tmphash = $this->_hashref();
 937
 938             if ($this->{InterPolateVars}) {
 939               # inherit current __stack to new block
 940               $tmphash->{__stack} = $this->_copy($config->{__stack});
 941               #$tmphash->{__stack} = $config->{$block}->{__stack};
 942             }
 943
 944             $config->{$block}->{$blockname} = $this->_parse($tmphash, \@newcontent);
 945           }
 946         }
 947         else {
 948           # standard block
 949           if (exists $config->{$block}) {
 950             if (ref($config->{$block}) eq '') {
 951               croak "Config::General: Cannot create hashref from <$block> because there is\n"
 952                    ."already a scalar option '$block' with value '$config->{$block}'\n";
 953             }
 954
 955             # the block already exists, make it an array
 956             if ($this->{MergeDuplicateBlocks}) {
 957               # just merge the new block with the same name as an existing one into
 958               # this one.
 959               $config->{$block} = $this->_parse($config->{$block}, \@newcontent);
 960             }
 961             else {
 962               if (! $this->{AllowMultiOptions}) {
 963                 croak "Config::General: Block \"<$block>\" occurs more than once (level: $this->{level}, chunk $chunk)!\n";
 964               }
 965               else {
 966                 my $savevalue = $config->{$block};
 967                 delete $config->{$block};
 968                 my @ar;
 969                 if (ref $savevalue eq "ARRAY") {
 970                   push @ar, @{$savevalue};
 971                 }
 972                 else {
 973                   push @ar, $savevalue;
 974                 }
 975
 976                 # fixes rt#31529
 977                 my $tmphash = $this->_hashref();
 978                 if ($this->{InterPolateVars}) {
 979                   # inherit current __stack to new block
 980                   $tmphash->{__stack} = $this->_copy($config->{__stack});
 981                 }
 982
 983                 push @ar, $this->_parse( $tmphash, \@newcontent);
 984
 985                 $config->{$block} = \@ar;
 986               }
 987             }
 988           }
 989           else {
 990             # the first occurence of this particular block
 991             my $tmphash = $this->_hashref();
 992
 993             if ($this->{InterPolateVars}) {
 994               # inherit current __stack to new block
 995               $tmphash->{__stack} = $this->_copy($config->{__stack});
 996             }
 997
 998             $config->{$block} = $this->_parse($tmphash, \@newcontent);
 999           }
1000         }
1001         undef $blockname;
1002         undef $block;
1003         $this->{level} -= 1;
1004         next;
1005       }
1006     }
1007     else { # inside $block, just push onto new content stack
1008       push @newcontent, $_;
1009     }
1010   }
1011   if ($block) {
1012     # $block is still defined, which means, that it had
1013     # no matching endblock!
1014     croak "Config::General: Block \"<$block>\" has no EndBlock statement (level: $this->{level}, chunk $chunk)!\n";
1015   }
1016   return $config;
1017 }
1018
1019
1020 sub _copy {
1021   #
1022   # copy the contents of one hash into another
1023   # to circumvent invalid references
1024   # fixes rt.cpan.org bug #35122
1025   my($this, $source) = @_;
1026   my %hash = ();
1027   while (my ($key, $value) = each %{$source}) {
1028     $hash{$key} = $value;
1029   }
1030   return \%hash;
1031 }
1032
1033
1034 sub _parse_value {
1035   #
1036   # parse the value if value parsing is turned on
1037   # by either -AutoTrue and/or -FlagBits
1038   # otherwise just return the given value unchanged
1039   #
1040   my($this, $config, $option, $value) =@_;
1041
1042   # avoid "Use of uninitialized value"
1043   if (! defined $value) {
1044     $value = undef; # bigfix rt.cpan.org#42721  q();
1045   }
1046
1047   if ($this->{InterPolateVars}) {
1048     $value = $this->_interpolate($config, $option, $value);
1049   }
1050
1051   # make true/false values to 1 or 0 (-AutoTrue)
1052   if ($this->{AutoTrue}) {
1053     if ($value =~ /$this->{AutoTrueFlags}->{true}/io) {
1054       $value = 1;
1055     }
1056     elsif ($value =~ /$this->{AutoTrueFlags}->{false}/io) {
1057       $value = 0;
1058     }
1059   }
1060
1061   # assign predefined flags or undef for every flag | flag ... (-FlagBits)
1062   if ($this->{FlagBits}) {
1063     if (exists $this->{FlagBitsFlags}->{$option}) {
1064       my %__flags = map { $_ => 1 } split /\s*\|\s*/, $value;
1065       foreach my $flag (keys %{$this->{FlagBitsFlags}->{$option}}) {
1066         if (exists $__flags{$flag}) {
1067           $__flags{$flag} = $this->{FlagBitsFlags}->{$option}->{$flag};
1068         }
1069         else {
1070           $__flags{$flag} = undef;
1071         }
1072       }
1073       $value = \%__flags;
1074     }
1075   }
1076   return $value;
1077 }
1078
1079
1080
1081
1082
1083
1084 sub NoMultiOptions {
1085   #
1086   # turn AllowMultiOptions off, still exists for backward compatibility.
1087   # Since we do parsing from within new(), we must
1088   # call it again if one turns NoMultiOptions on!
1089   #
1090   croak q(Config::Genera: lThe NoMultiOptions() method is deprecated. Set 'AllowMultiOptions' to 'no' instead!);
1091 }
1092
1093
1094 sub save {
1095   #
1096   # this is the old version of save() whose API interface
1097   # has been changed. I'm very sorry 'bout this.
1098   #
1099   # I'll try to figure out, if it has been called correctly
1100   # and if yes, feed the call to Save(), otherwise croak.
1101   #
1102   my($this, $one, @two) = @_;
1103
1104   if ( (@two && $one) && ( (scalar @two) % 2 == 0) ) {
1105     # @two seems to be a hash
1106     my %h = @two;
1107     $this->save_file($one, \%h);
1108   }
1109   else {
1110     croak q(Config::General: The save() method is deprecated. Use the new save_file() method instead!);
1111   }
1112   return;
1113 }
1114
1115
1116 sub save_file {
1117   #
1118   # save the config back to disk
1119   #
1120   my($this, $file, $config) = @_;
1121   my $fh;
1122   my $config_string;
1123
1124   if (!$file) {
1125     croak "Config::General: Filename is required!";
1126   }
1127   else {
1128     if ($this->{UTF8}) {
1129       $fh = new IO::File;
1130       open($fh, ">:utf8", $file)
1131         or croak "Config::General: Could not open $file in UTF8 mode!($!)\n";
1132     }
1133     else {
1134       $fh = IO::File->new( "$file", 'w')
1135         or croak "Config::General: Could not open $file!($!)\n";
1136     }
1137     if (!$config) {
1138       if (exists $this->{config}) {
1139         $config_string = $this->_store(0, $this->{config});
1140       }
1141       else {
1142         croak "Config::General: No config hash supplied which could be saved to disk!\n";
1143       }
1144     }
1145     else {
1146       $config_string = $this->_store(0, $config);
1147     }
1148
1149     if ($config_string) {
1150       print {$fh} $config_string;
1151     }
1152     else {
1153       # empty config for whatever reason, I don't care
1154       print {$fh} q();
1155     }
1156
1157     close $fh;
1158   }
1159   return;
1160 }
1161
1162
1163
1164 sub save_string {
1165   #
1166   # return the saved config as a string
1167   #
1168   my($this, $config) = @_;
1169
1170   if (!$config || ref($config) ne 'HASH') {
1171     if (exists $this->{config}) {
1172       return $this->_store(0, $this->{config});
1173     }
1174     else {
1175       croak "Config::General: No config hash supplied which could be saved to disk!\n";
1176     }
1177   }
1178   else {
1179     return $this->_store(0, $config);
1180   }
1181   return;
1182 }
1183
1184
1185
1186 sub _store {
1187   #
1188   # internal sub for saving a block
1189   #
1190   my($this, $level, $config) = @_;
1191   local $_;
1192   my $indent = q(    ) x $level;
1193
1194   my $config_string = q();
1195
1196   if($this->{SaveSorted}) {
1197     # ahm, well this might look strange because the two loops
1198     # are obviously the same, but I don't know how to call
1199     # a foreach() with sort and without sort() on the same
1200     # line (I think it's impossible)
1201     foreach my $entry (sort keys %{$config}) {
1202       if (ref($config->{$entry}) eq 'ARRAY') {
1203         foreach my $line (sort @{$config->{$entry}}) {
1204           if (ref($line) eq 'HASH') {
1205             $config_string .= $this->_write_hash($level, $entry, $line);
1206           }
1207           else {
1208             $config_string .= $this->_write_scalar($level, $entry, $line);
1209           }
1210         }
1211       }
1212       elsif (ref($config->{$entry}) eq 'HASH') {
1213         $config_string .= $this->_write_hash($level, $entry, $config->{$entry});
1214       }
1215       else {
1216         $config_string .= $this->_write_scalar($level, $entry, $config->{$entry});
1217       }
1218     }
1219   }
1220   else {
1221     foreach my $entry (keys %{$config}) {
1222       if (ref($config->{$entry}) eq 'ARRAY') {
1223         foreach my $line (@{$config->{$entry}}) {
1224           if (ref($line) eq 'HASH') {
1225             $config_string .= $this->_write_hash($level, $entry, $line);
1226           }
1227           else {
1228             $config_string .= $this->_write_scalar($level, $entry, $line);
1229           }
1230         }
1231       }
1232       elsif (ref($config->{$entry}) eq 'HASH') {
1233         $config_string .= $this->_write_hash($level, $entry, $config->{$entry});
1234       }
1235       else {
1236         $config_string .= $this->_write_scalar($level, $entry, $config->{$entry});
1237       }
1238     }
1239   }
1240
1241   return $config_string;
1242 }
1243
1244
1245 sub _write_scalar {
1246   #
1247   # internal sub, which writes a scalar
1248   # it returns it, in fact
1249   #
1250   my($this, $level, $entry, $line) = @_;
1251
1252   my $indent = q(    ) x $level;
1253
1254   my $config_string;
1255
1256   if ($line =~ /\n/ || $line =~ /\\$/) {
1257     # it is a here doc
1258     my $delimiter;
1259     my $tmplimiter = 'EOF';
1260     while (!$delimiter) {
1261       # create a unique here-doc identifier
1262       if ($line =~ /$tmplimiter/s) {
1263         $tmplimiter .= q(%);
1264       }
1265       else {
1266         $delimiter = $tmplimiter;
1267       }
1268     }
1269     my @lines = split /\n/, $line;
1270     $config_string .= $indent . $entry . $this->{StoreDelimiter} . "<<$delimiter\n";
1271     foreach (@lines) {
1272       $config_string .= $indent . $_ . "\n";
1273     }
1274     $config_string .= $indent . "$delimiter\n";
1275   }
1276   else {
1277     # a simple stupid scalar entry
1278     $line =~ s/#/\\#/g;
1279     # bugfix rt.cpan.org#42287
1280     if ($line =~ /^\s/ or $line =~ /\s$/) {
1281       # need to quote it
1282       $line = "\"$line\"";
1283     }
1284     $config_string .= $indent . $entry . $this->{StoreDelimiter} . $line . "\n";
1285   }
1286
1287   return $config_string;
1288 }
1289
1290 sub _write_hash {
1291   #
1292   # internal sub, which writes a hash (block)
1293   # it returns it, in fact
1294   #
1295   my($this, $level, $entry, $line) = @_;
1296
1297   my $indent = q(    ) x $level;
1298   my $config_string;
1299
1300   if ($entry =~ /\s/) {
1301     # quote the entry if it contains whitespaces
1302     $entry = q(") . $entry . q(");
1303   }
1304
1305   $config_string .= $indent . q(<) . $entry . ">\n";
1306   $config_string .= $this->_store($level + 1, $line);
1307   $config_string .= $indent . q(</) . $entry . ">\n";
1308
1309   return $config_string
1310 }
1311
1312
1313 sub _hashref {
1314   #
1315   # return a probably tied new empty hash ref
1316   #
1317   my($this) = @_;
1318   if ($this->{Tie}) {
1319     eval {
1320       eval qq{require $this->{Tie}};
1321     };
1322     if ($EVAL_ERROR) {
1323       croak q(Config::General: Could not create a tied hash of type: ) . $this->{Tie} . q(: ) . $EVAL_ERROR;
1324     }
1325     my %hash;
1326     tie %hash, $this->{Tie};
1327     return \%hash;
1328   }
1329   else {
1330     return {};
1331   }
1332 }
1333
1334
1335
1336 #
1337 # Procedural interface
1338 #
1339 sub ParseConfig {
1340   #
1341   # @_ may contain everything which is allowed for new()
1342   #
1343   return (new Config::General(@_))->getall();
1344 }
1345
1346 sub SaveConfig {
1347   #
1348   # 2 parameters are required, filename and hash ref
1349   #
1350   my ($file, $hash) = @_;
1351
1352   if (!$file || !$hash) {
1353     croak q{Config::General::SaveConfig(): filename and hash argument required.};
1354   }
1355   else {
1356     if (ref($hash) ne 'HASH') {
1357       croak q(Config::General::SaveConfig() The second parameter must be a reference to a hash!);
1358     }
1359     else {
1360       (new Config::General(-ConfigHash => $hash))->save_file($file);
1361     }
1362   }
1363   return;
1364 }
1365
1366 sub SaveConfigString {
1367   #
1368   # same as SaveConfig, but return the config,
1369   # instead of saving it
1370   #
1371   my ($hash) = @_;
1372
1373   if (!$hash) {
1374     croak q{Config::General::SaveConfigString(): Hash argument required.};
1375   }
1376   else {
1377     if (ref($hash) ne 'HASH') {
1378       croak q(Config::General::SaveConfigString() The parameter must be a reference to a hash!);
1379     }
1380     else {
1381       return (new Config::General(-ConfigHash => $hash))->save_string();
1382     }
1383   }
1384   return;
1385 }
1386
1387
1388
1389 # keep this one
1390 1;
1391 __END__
1392
1393
1394
1395
1396
1397 =head1 NAME
1398
1399 Config::General - Generic Config Module
1400
1401 =head1 SYNOPSIS
1402
1403  #
1404  # the OOP way
1405  use Config::General;
1406  $conf = new Config::General("rcfile");
1407  my %config = $conf->getall;
1408
1409  #
1410  # the procedural way
1411  use Config::General qw(ParseConfig SaveConfig SaveConfigString);
1412  my %config = ParseConfig("rcfile");
1413
1414 =head1 DESCRIPTION
1415
1416 This module opens a config file and parses its contents for you. The B<new> method
1417 requires one parameter which needs to be a filename. The method B<getall> returns a hash
1418 which contains all options and its associated values of your config file.
1419
1420 The format of config files supported by B<Config::General> is inspired by the well known Apache config
1421 format, in fact, this module is 100% compatible to Apache configs, but you can also just use simple
1422  name/value pairs in your config files.
1423
1424 In addition to the capabilities of an Apache config file it supports some enhancements such as here-documents,
1425 C-style comments or multiline options.
1426
1427
1428 =head1 SUBROUTINES/METHODS
1429
1430 =over
1431
1432 =item new()
1433
1434 Possible ways to call B<new()>:
1435
1436  $conf = new Config::General("rcfile");
1437
1438  $conf = new Config::General(\%somehash);
1439
1440  $conf = new Config::General( %options ); # see below for description of possible options
1441
1442
1443 This method returns a B<Config::General> object (a hash blessed into "Config::General" namespace.
1444 All further methods must be used from that returned object. see below.
1445
1446 You can use the new style with hash parameters or the old style which is of course
1447 still supported. Possible parameters to B<new()> are:
1448
1449 * a filename of a configfile, which will be opened and parsed by the parser
1450
1451 or
1452
1453 * a hash reference, which will be used as the config.
1454
1455 An alternative way to call B<new()> is supplying an option- hash with one or more of
1456 the following keys set:
1457
1458 =over
1459
1460 =item B<-ConfigFile>
1461
1462 A filename or a filehandle, i.e.:
1463
1464  -ConfigFile => "rcfile" or -ConfigFile => \$FileHandle
1465
1466
1467
1468 =item B<-ConfigHash>
1469
1470 A hash reference, which will be used as the config, i.e.:
1471
1472  -ConfigHash => \%somehash
1473
1474
1475
1476 =item B<-String>
1477
1478 A string which contains a whole config, or an arrayref
1479 containing the whole config line by line.
1480 The parser will parse the contents of the string instead
1481 of a file. i.e:
1482
1483  -String => $complete_config
1484
1485 it is also possible to feed an array reference to -String:
1486
1487  -String => \@config_lines
1488
1489
1490
1491 =item B<-AllowMultiOptions>
1492
1493 If the value is "no", then multiple identical options are disallowed.
1494 The default is "yes".
1495 i.e.:
1496
1497  -AllowMultiOptions => "yes"
1498
1499 see B<IDENTICAL OPTIONS> for details.
1500
1501 =item B<-LowerCaseNames>
1502
1503 If set to a true value, then all options found in the config will be converted
1504 to lowercase. This allows you to provide case-in-sensitive configs. The
1505 values of the options will B<not> lowercased.
1506
1507
1508
1509 =item B<-UseApacheInclude>
1510
1511 If set to a true value, the parser will consider "include ..." as valid include
1512 statement (just like the well known Apache include statement).
1513
1514
1515
1516 =item B<-IncludeRelative>
1517
1518 If set to a true value, included files with a relative path (i.e. "cfg/blah.conf")
1519 will be opened from within the location of the configfile instead from within the
1520 location of the script($0). This works only if the configfile has a absolute pathname
1521 (i.e. "/etc/main.conf").
1522
1523 If the variable B<-ConfigPath> has been set and if the file to be included could
1524 not be found in the location relative to the current config file, the module
1525 will search within B<-ConfigPath> for the file. See the description of B<-ConfigPath>
1526 for more details.
1527
1528
1529 =item B<-IncludeDirectories>
1530
1531 If set to a true value, you may specify include a directory, in which case all
1532 files inside the directory will be loaded in ASCII order.  Directory includes
1533 will not recurse into subdirectories.  This is comparable to including a
1534 directory in Apache-style config files.
1535
1536
1537 =item B<-IncludeGlob>
1538
1539 If set to a true value, you may specify a glob pattern for an include to
1540 include all matching files (e.g. <<include conf.d/*.conf>>).  Also note that as
1541 with standard file patterns, * will not match dot-files, so <<include dir/*>>
1542 is often more desirable than including a directory with B<-IncludeDirectories>.
1543
1544
1545 =item B<-IncludeAgain>
1546
1547 If set to a true value, you will be able to include a sub-configfile
1548 multiple times.  With the default, false, you will get a warning about
1549 duplicate includes and only the first include will succeed.
1550
1551 Reincluding a configfile can be useful if it contains data that you want to
1552 be present in multiple places in the data tree.  See the example under
1553 L</INCLUDES>.
1554
1555 Note, however, that there is currently no check for include recursion.
1556
1557
1558 =item B<-ConfigPath>
1559
1560 As mentioned above, you can use this variable to specify a search path for relative
1561 config files which have to be included. Config::General will search within this
1562 path for the file if it cannot find the file at the location relative to the
1563 current config file.
1564
1565 To provide multiple search paths you can specify an array reference for the
1566 path.  For example:
1567
1568  @path = qw(/usr/lib/perl /nfs/apps/lib /home/lib);
1569  ..
1570  -ConfigPath => \@path
1571
1572
1573
1574 =item B<-MergeDuplicateBlocks>
1575
1576 If set to a true value, then duplicate blocks, that means blocks and named blocks,
1577 will be merged into a single one (see below for more details on this).
1578 The default behavior of Config::General is to create an array if some junk in a
1579 config appears more than once.
1580
1581
1582 =item B<-MergeDuplicateOptions>
1583
1584 If set to a true value, then duplicate options will be merged. That means, if the
1585 same option occurs more than once, the last one will be used in the resulting
1586 config hash.
1587
1588 Setting this option implies B<-AllowMultiOptions == false> unless you set
1589 B<-AllowMultiOptions> explicit to 'true'. In this case duplicate blocks are
1590 allowed and put into an array but duplicate options will be merged.
1591
1592
1593 =item B<-AutoLaunder>
1594
1595 If set to a true value, then all values in your config file will be laundered
1596 to allow them to be used under a -T taint flag.  This could be regarded as circumventing
1597 the purpose of the -T flag, however, if the bad guys can mess with your config file,
1598 you have problems that -T will not be able to stop.  AutoLaunder will only handle
1599 a config file being read from -ConfigFile.
1600
1601
1602
1603 =item B<-AutoTrue>
1604
1605 If set to a true value, then options in your config file, whose values are set to
1606 true or false values, will be normalised to 1 or 0 respectively.
1607
1608 The following values will be considered as B<true>:
1609
1610  yes, on, 1, true
1611
1612 The following values will be considered as B<false>:
1613
1614  no, off, 0, false
1615
1616 This effect is case-insensitive, i.e. both "Yes" or "oN" will result in 1.
1617
1618
1619 =item B<-FlagBits>
1620
1621 This option takes one required parameter, which must be a hash reference.
1622
1623 The supplied hash reference needs to define variables for which you
1624 want to preset values. Each variable you have defined in this hash-ref
1625 and which occurs in your config file, will cause this variable being
1626 set to the preset values to which the value in the config file refers to.
1627
1628 Multiple flags can be used, separated by the pipe character |.
1629
1630 Well, an example will clarify things:
1631
1632  my $conf = new Config::General(
1633          -ConfigFile => "rcfile",
1634          -FlagBits => {
1635               Mode => {
1636                  CLEAR    => 1,
1637                  STRONG   => 1,
1638                  UNSECURE => "32bit" }
1639          }
1640  );
1641
1642 In this example we are defining a variable named I<"Mode"> which
1643 may contain one or more of "CLEAR", "STRONG" and "UNSECURE" as value.
1644
1645 The appropriate config entry may look like this:
1646
1647  # rcfile
1648  Mode = CLEAR | UNSECURE
1649
1650 The parser will create a hash which will be the value of the key "Mode". This
1651 hash will contain B<all> flags which you have pre-defined, but only those
1652 which were set in the config will contain the pre-defined value, the other
1653 ones will be undefined.
1654
1655 The resulting config structure would look like this after parsing:
1656
1657  %config = (
1658              Mode => {
1659                        CLEAR    => 1,
1660                        UNSECURE => "32bit",
1661                        STRONG   => undef,
1662                      }
1663            );
1664
1665 This method allows the user (or, the "maintainer" of the configfile for your
1666 application) to set multiple pre-defined values for one option.
1667
1668 Please beware, that all occurrences of those variables will be handled this
1669 way, there is no way to distinguish between variables in different scopes.
1670 That means, if "Mode" would also occur inside a named block, it would
1671 also parsed this way.
1672
1673 Values which are not defined in the hash-ref supplied to the parameter B<-FlagBits>
1674 and used in the corresponding variable in the config will be ignored.
1675
1676 Example:
1677
1678  # rcfile
1679  Mode = BLAH | CLEAR
1680
1681 would result in this hash structure:
1682
1683   %config = (
1684              Mode => {
1685                        CLEAR    => 1,
1686                        UNSECURE => undef,
1687                        STRONG   => undef,
1688                      }
1689            );
1690
1691 "BLAH" will be ignored silently.
1692
1693
1694 =item B<-DefaultConfig>
1695
1696 This can be a hash reference or a simple scalar (string) of a config. This
1697 causes the module to preset the resulting config hash with the given values,
1698 which allows you to set default values for particular config options directly.
1699
1700
1701 =item B<-Tie>
1702
1703 B<-Tie> takes the name of a Tie class as argument that each new hash should be
1704 based off of.
1705
1706 This hash will be used as the 'backing hash' instead of a standard Perl hash,
1707 which allows you to affect the way, variable storing will be done. You could, for
1708 example supply a tied hash, say Tie::DxHash, which preserves ordering of the
1709 keys in the config (which a standard Perl hash won't do). Or, you could supply
1710 a hash tied to a DBM file to save the parsed variables to disk.
1711
1712 There are many more things to do in tie-land, see L<tie> to get some interesting
1713 ideas.
1714
1715 If you want to use the B<-Tie> feature together with B<-DefaultConfig> make sure
1716 that the hash supplied to B<-DefaultConfig> must be tied to the same Tie class.
1717
1718 Make sure that the hash which receives the generated hash structure (e.g. which
1719 you are using in the assignment: %hash = $config->getall()) must be tied to
1720 the same Tie class.
1721
1722 Example:
1723
1724  use Config::General qw(ParseConfig);
1725  use Tie::IxHash;
1726  tie my %hash, "Tie::IxHash";
1727  %hash = ParseConfig(
1728            -ConfigFile => shift(),
1729            -Tie => "Tie::IxHash"
1730          );
1731
1732
1733 =item B<-InterPolateVars>
1734
1735 If set to a true value, variable interpolation will be done on your config
1736 input. See L<Config::General::Interpolated> for more information.
1737
1738 =item B<-InterPolateEnv>
1739
1740 If set to a true value, environment variables can be used in
1741 configs.
1742
1743 This implies B<-InterPolateVars>.
1744
1745 =item B<-ExtendedAccess>
1746
1747 If set to a true value, you can use object oriented (extended) methods to
1748 access the parsed config. See L<Config::General::Extended> for more informations.
1749
1750 =item B<-StrictObjects>
1751
1752 By default this is turned on, which causes Config::General to croak with an
1753 error if you try to access a non-existent key using the OOP-way (B<-ExtendedAcess>
1754 enabled). If you turn B<-StrictObjects> off (by setting to 0 or "no") it will
1755 just return an empty object/hash/scalar. This is valid for OOP-access 8via AUTOLOAD
1756 and for the methods obj(), hash() and value().
1757
1758
1759 =item B<-StrictVars>
1760
1761 By default this is turned on, which causes Config::General to croak with an
1762 error if an undefined variable with B<InterPolateVars> turned on occurs
1763 in a config. Set to I<false> (i.e. 0) to avoid such error messages.
1764
1765 =item B<-SplitPolicy>
1766
1767 You can influence the way how Config::General decides which part of a line
1768 in a config file is the key and which one is the value. By default it tries
1769 its best to guess. That means you can mix equalsign assignments and whitespace
1770 assignments.
1771
1772 However, somtime you may wish to make it more strictly for some reason. In
1773 this case you can set B<-SplitPolicy>. The possible values are: 'guess' which
1774 is the default, 'whitespace' which causes the module to split by whitespace,
1775 'equalsign' which causes it to split strictly by equal sign, or 'custom'. In the
1776 latter case you must also set B<-SplitDelimiter> to some regular expression
1777 of your choice. For example:
1778
1779  -SplitDelimiter => '\s*:\s*'
1780
1781 will cause the module to split by colon while whitespace which surrounds
1782 the delimiter will be removed.
1783
1784 Please note that the delimiter used when saving a config (save_file() or save_string())
1785 will be chosen according to the current B<-SplitPolicy>. If -SplitPolicy is
1786 set to 'guess' or 'whitespace', 3 spaces will be used to delimit saved
1787 options. If 'custom' is set, then you need to set B<-StoreDelimiter>.
1788
1789 =item B<-SplitDelimiter>
1790
1791 Set this to any arbitrary regular expression which will be used for option/value
1792 splitting. B<-SplitPolicy> must be set to 'custom' to make this work.
1793
1794 =item B<-StoreDelimiter>
1795
1796 You can use this parameter to specify a custom delimiter to use when saving
1797 configs to a file or string. You only need to set it if you want to store
1798 the config back to disk and if you have B<-SplitPolicy> set to 'custom'.
1799
1800 Be very careful with this parameter.
1801
1802
1803 =item B<-CComments>
1804
1805 Config::General is able to notice c-style comments (see section COMMENTS).
1806 But for some reason you might no need this. In this case you can turn
1807 this feature off by setting B<-CComments> to a false value('no', 0, 'off').
1808
1809 By default B<-CComments> is turned on.
1810
1811
1812 =item B<-BackslashEscape>
1813
1814 If you turn on this parameter, a backslash can be used to escape any special
1815 character within configurations.
1816
1817 By default it is turned off.
1818
1819 Be careful with this option, as it removes all backslashes after parsing.
1820
1821 B<This option might be removed in future versions>.
1822
1823 =item B<-SlashIsDirectory>
1824
1825 If you turn on this parameter, a single slash as the last character
1826 of a named block will be considered as a directory name.
1827
1828 By default this flag is turned off, which makes the module somewhat
1829 incompatible to Apache configs, since such a setup will be normally
1830 considered as an explicit empty block, just as XML defines it.
1831
1832 For example, if you have the following config:
1833
1834  <Directory />
1835    Index index.awk
1836  </Directory>
1837
1838 you will get such an error message from the parser:
1839
1840  EndBlock "</Directory>" has no StartBlock statement (level: 1, chunk 10)!
1841
1842 This is caused by the fact that the config chunk below will be
1843 internally converted to:
1844
1845  <Directory><Directory />
1846    Index index.awk
1847  </Directory>
1848
1849 Now there is one '</Directory>' too much. The proper solution is
1850 to use quotation to circumvent this error:
1851
1852  <Directory "/">
1853    Index index.awk
1854  </Directory>
1855
1856 However, a raw apache config comes without such quotes. In this
1857 case you may consider to turn on B<-SlashIsDirectory>.
1858
1859 Please note that this is a new option (incorporated in version 2.30),
1860 it may lead to various unexpected side effects or other failures.
1861 You've been warned.
1862
1863 =item B<-ApacheCompatible>
1864
1865 Over the past years a lot of options has been incorporated
1866 into Config::General to be able to parse real Apache configs.
1867
1868 The new B<-ApacheCompatible> option now makes it possible to
1869 tweak all options in a way that Apache configs can be parsed.
1870
1871 This is called "apache compatibility mode" - if you will ever
1872 have problems with parsing Apache configs without this option
1873 being set, you'll get no help by me. Thanks :)
1874
1875 The following options will be set:
1876
1877  UseApacheInclude   = 1
1878  IncludeRelative    = 1
1879  IncludeDirectories = 1
1880  IncludeGlob        = 1
1881  SlashIsDirectory   = 1
1882  SplitPolicy        = 'equalsign'
1883  CComments          = 0
1884  BackslashEscape    = 1
1885
1886 Take a look into the particular documentation sections what
1887 those options are doing.
1888
1889 Beside setting some options it also turns off support for
1890 explicit empty blocks.
1891
1892 =item B<-UTF8>
1893
1894 If turned on, all files will be opened in utf8 mode. This may
1895 not work properly with older versions of Perl.
1896
1897 =item B<-SaveSorted>
1898
1899 If you want to save configs in a sorted manner, turn this
1900 parameter on. It is not enabled by default.
1901
1902 =back
1903
1904
1905
1906
1907 =item getall()
1908
1909 Returns a hash structure which represents the whole config.
1910
1911 =item files()
1912
1913 Returns a list of all files read in.
1914
1915 =item save_file()
1916
1917 Writes the config hash back to the hard disk. This method takes one or two
1918 parameters. The first parameter must be the filename where the config
1919 should be written to. The second parameter is optional, it must be a
1920 reference to a hash structure, if you set it. If you do not supply this second parameter
1921 then the internal config hash, which has already been parsed, will be
1922 used.
1923
1924 Please note that any occurence of comments will be ignored by getall()
1925 and thus be lost after you call this method.
1926
1927 You need also to know that named blocks will be converted to nested blocks
1928 (which is the same from the perl point of view). An example:
1929
1930  <user hans>
1931    id 13
1932  </user>
1933
1934 will become the following after saving:
1935
1936  <user>
1937    <hans>
1938       id 13
1939    </hans>
1940  </user>
1941
1942 Example:
1943
1944  $conf_obj->save_file("newrcfile", \%config);
1945
1946 or, if the config has already been parsed, or if it didn't change:
1947
1948  $conf_obj->save_file("newrcfile");
1949
1950
1951 =item save_string()
1952
1953 This method is equivalent to the previous save_file(), but it does not
1954 store the generated config to a file. Instead it returns it as a string,
1955 which you can save yourself afterwards.
1956
1957 It takes one optional parameter, which must be a reference to a hash structure.
1958 If you omit this parameter, the internal config hash, which has already been parsed,
1959 will be used.
1960
1961 Example:
1962
1963  my $content = $conf_obj->save_string(\%config);
1964
1965 or:
1966
1967  my $content = $conf_obj->save_string();
1968
1969
1970 =back
1971
1972
1973 =head1 CONFIG FILE FORMAT
1974
1975 Lines beginning with B<#> and empty lines will be ignored. (see section COMMENTS!)
1976 Spaces at the beginning and the end of a line will also be ignored as well as tabulators.
1977 If you need spaces at the end or the beginning of a value you can surround it with
1978 double quotes.
1979 An option line starts with its name followed by a value. An equal sign is optional.
1980 Some possible examples:
1981
1982  user    max
1983  user  = max
1984  user            max
1985
1986 If there are more than one statements with the same name, it will create an array
1987 instead of a scalar. See the example below.
1988
1989 The method B<getall> returns a hash of all values.
1990
1991
1992 =head1 BLOCKS
1993
1994 You can define a B<block> of options. A B<block> looks much like a block
1995 in the wellknown Apache config format. It starts with E<lt>B<blockname>E<gt> and ends
1996 with E<lt>/B<blockname>E<gt>. An example:
1997
1998  <database>
1999     host   = muli
2000     user   = moare
2001     dbname = modb
2002     dbpass = D4r_9Iu
2003  </database>
2004
2005 Blocks can also be nested. Here is a more complicated example:
2006
2007  user   = hans
2008  server = mc200
2009  db     = maxis
2010  passwd = D3rf$
2011  <jonas>
2012         user    = tom
2013         db      = unknown
2014         host    = mila
2015         <tablestructure>
2016                 index   int(100000)
2017                 name    char(100)
2018                 prename char(100)
2019                 city    char(100)
2020                 status  int(10)
2021                 allowed moses
2022                 allowed ingram
2023                 allowed joice
2024         </tablestructure>
2025  </jonas>
2026
2027 The hash which the method B<getall> returns look like that:
2028
2029  print Data::Dumper(\%hash);
2030  $VAR1 = {
2031           'passwd' => 'D3rf$',
2032           'jonas'  => {
2033                        'tablestructure' => {
2034                                              'prename' => 'char(100)',
2035                                              'index'   => 'int(100000)',
2036                                              'city'    => 'char(100)',
2037                                              'name'    => 'char(100)',
2038                                              'status'  => 'int(10)',
2039                                              'allowed' => [
2040                                                             'moses',
2041                                                             'ingram',
2042                                                             'joice',
2043                                                           ]
2044                                            },
2045                        'host'           => 'mila',
2046                        'db'             => 'unknown',
2047                        'user'           => 'tom'
2048                      },
2049           'db'     => 'maxis',
2050           'server' => 'mc200',
2051           'user'   => 'hans'
2052         };
2053
2054 If you have turned on B<-LowerCaseNames> (see new()) then blocks as in the
2055 following example:
2056
2057  <Dir>
2058    <AttriBUTES>
2059      Owner  root
2060    </attributes>
2061  </dir>
2062
2063 would produce the following hash structure:
2064
2065  $VAR1 = {
2066           'dir' => {
2067                     'attributes' => {
2068                                      'owner  => "root",
2069                                     }
2070                    }
2071          };
2072
2073 As you can see, the keys inside the config hash are normalized.
2074
2075 Please note, that the above config block would result in a
2076 valid hash structure, even if B<-LowerCaseNames> is not set!
2077 This is because I<Config::General> does not
2078 use the block names to check if a block ends, instead it uses an internal
2079 state counter, which indicates a block end.
2080
2081 If the module cannot find an end-block statement, then this block will be ignored.
2082
2083
2084
2085 =head1 NAMED BLOCKS
2086
2087 If you need multiple blocks of the same name, then you have to name every block.
2088 This works much like Apache config. If the module finds a named block, it will
2089 create a hashref with the left part of the named block as the key containing
2090 one or more hashrefs with the right part of the block as key containing everything
2091 inside the block(which may again be nested!). As examples says more than words:
2092
2093  # given the following sample
2094  <Directory /usr/frisco>
2095         Limit Deny
2096         Options ExecCgi Index
2097  </Directory>
2098  <Directory /usr/frik>
2099         Limit DenyAll
2100         Options None
2101  </Directory>
2102
2103  # you will get:
2104  $VAR1 = {
2105           'Directory' => {
2106                            '/usr/frik' => {
2107                                             'Options' => 'None',
2108                                             'Limit' => 'DenyAll'
2109                                           },
2110                            '/usr/frisco' => {
2111                                               'Options' => 'ExecCgi Index',
2112                                               'Limit' => 'Deny'
2113                                             }
2114                          }
2115         };
2116
2117 You cannot have more than one named block with the same name because it will
2118 be stored in a hashref and therefore be overwritten if a block occurs once more.
2119
2120
2121 =head1 WHITESPACE IN BLOCKS
2122
2123 The normal behavior of Config::General is to look for whitespace in
2124 block names to decide if it's a named block or just a simple block.
2125
2126 Sometimes you may need blocknames which have whitespace in their names.
2127
2128 With named blocks this is no problem, as the module only looks for the
2129 first whitespace:
2130
2131  <person hugo gera>
2132  </person>
2133
2134 would be parsed to:
2135
2136  $VAR1 = {
2137           'person' => {
2138                        'hugo gera' => {
2139                                       },
2140                       }
2141          };
2142
2143 The problem occurs, if you want to have a simple block containing whitespace:
2144
2145  <hugo gera>
2146  </hugo gera>
2147
2148 This would be parsed as a named block, which is not what you wanted. In this
2149 very case you may use quotation marks to indicate that it is not a named block:
2150
2151  <"hugo gera">
2152  </"hugo gera">
2153
2154 The save() method of the module inserts automatically quotation marks in such
2155 cases.
2156
2157
2158 =head1 EXPLICIT EMPTY BLOCKS
2159
2160 Beside the notation of blocks mentioned above it is possible to use
2161 explicit empty blocks.
2162
2163 Normally you would write this in your config to define an empty
2164 block:
2165
2166  <driver Apache>
2167  </driver>
2168
2169 To save writing you can also write:
2170
2171  <driver Apache/>
2172
2173 which is the very same as above. This works for normal blocks and
2174 for named blocks.
2175
2176
2177
2178 =head1 IDENTICAL OPTIONS
2179
2180 You may have more than one line of the same option with different values.
2181
2182 Example:
2183  log  log1
2184  log  log2
2185  log  log2
2186
2187 You will get a scalar if the option occurred only once or an array if it occurred
2188 more than once. If you expect multiple identical options, then you may need to
2189 check if an option occurred more than once:
2190
2191  $allowed = $hash{jonas}->{tablestructure}->{allowed};
2192  if(ref($allowed) eq "ARRAY") {
2193      @ALLOWED = @{$allowed};
2194  else {
2195      @ALLOWED = ($allowed);
2196  }
2197
2198 The same applies to blocks and named blocks too (they are described in more detail
2199 below). For example, if you have the following config:
2200
2201  <dir blah>
2202    user max
2203  </dir>
2204  <dir blah>
2205    user hannes
2206  </dir>
2207
2208 then you would end up with a data structure like this:
2209
2210  $VAR1 = {
2211           'dir' => {
2212                     'blah' => [
2213                                 {
2214                                   'user' => 'max'
2215                                 },
2216                                 {
2217                                   'user' => 'hannes'
2218                                 }
2219                               ]
2220                     }
2221           };
2222
2223 As you can see, the two identical blocks are stored in a hash which contains
2224 an array(-reference) of hashes.
2225
2226 Under some rare conditions you might not want this behavior with blocks (and
2227 named blocks too). If you want to get one single hash with the contents of
2228 both identical blocks, then you need to turn the B<new()> parameter B<-MergeDuplicateBlocks>
2229 on (see above). The parsed structure of the example above would then look like
2230 this:
2231
2232  $VAR1 = {
2233           'dir' => {
2234                     'blah' => {
2235                                'user' => [
2236                                            'max',
2237                                            'hannes'
2238                                          ]
2239                               }
2240                     }
2241           };
2242
2243 As you can see, there is only one hash "dir->{blah}" containing multiple
2244 "user" entries. As you can also see, turning on  B<-MergeDuplicateBlocks>
2245 does not affect scalar options (i.e. "option = value"). In fact you can
2246 tune merging of duplicate blocks and options independent from each other.
2247
2248 If you don't want to allow more than one identical options, you may turn it off
2249 by setting the flag I<AllowMultiOptions> in the B<new()> method to "no".
2250 If turned off, Config::General will complain about multiple occurring options
2251 with identical names!
2252
2253
2254
2255 =head1 LONG LINES
2256
2257 If you have a config value, which is too long and would take more than one line,
2258 you can break it into multiple lines by using the backslash character at the end
2259 of the line. The Config::General module will concatenate those lines to one single-value.
2260
2261 Example:
2262
2263 command = cat /var/log/secure/tripwire | \
2264            mail C<-s> "report from tripwire" \
2265            honey@myotherhost.nl
2266
2267 command will become:
2268  "cat /var/log/secure/tripwire | mail C<-s> 'report from twire' honey@myotherhost.nl"
2269
2270
2271 =head1 HERE DOCUMENTS
2272
2273 You can also define a config value as a so called "here-document". You must tell
2274 the module an identifier which idicates the end of a here document. An
2275 identifier must follow a "<<".
2276
2277 Example:
2278
2279  message <<EOF
2280    we want to
2281    remove the
2282    homedir of
2283    root.
2284  EOF
2285
2286 Everything between the two "EOF" strings will be in the option I<message>.
2287
2288 There is a special feature which allows you to use indentation with here documents.
2289 You can have any amount of whitespace or tabulators in front of the end
2290 identifier. If the module finds spaces or tabs then it will remove exactly those
2291 amount of spaces from every line inside the here-document.
2292
2293 Example:
2294
2295  message <<EOF
2296          we want to
2297          remove the
2298          homedir of
2299          root.
2300       EOF
2301
2302 After parsing, message will become:
2303
2304    we want to
2305    remove the
2306    homedir of
2307    root.
2308
2309 because there were the string "     " in front of EOF, which were cut from every
2310 line inside the here-document.
2311
2312
2313
2314 =head1 INCLUDES
2315
2316 You can include an external file at any posision in your config file using the following statement
2317 in your config file:
2318
2319  <<include externalconfig.rc>>
2320
2321 If you turned on B<-UseApacheInclude> (see B<new()>), then you can also use the following
2322 statement to include an external file:
2323
2324  include externalconfig.rc
2325
2326 This file will be inserted at the position where it was found as if the contents of this file
2327 were directly at this position.
2328
2329 You can also recursively include files, so an included file may include another one and so on.
2330 Beware that you do not recursively load the same file, you will end with an error message like
2331 "too many open files in system!".
2332
2333 By default included files with a relative pathname will be opened from within the current
2334 working directory. Under some circumstances it maybe possible to
2335 open included files from the directory, where the configfile resides. You need to turn on
2336 the option B<-IncludeRelative> (see B<new()>) if you want that. An example:
2337
2338  my $conf = Config::General(
2339                              -ConfigFile => "/etc/crypt.d/server.cfg"
2340                              -IncludeRelative => 1
2341                            );
2342
2343  /etc/crypt.d/server.cfg:
2344   <<include acl.cfg>>
2345
2346 In this example Config::General will try to include I<acl.cfg> from I</etc/crypt.d>:
2347
2348  /etc/crypt.d/acl.cfg
2349
2350 The default behavior (if B<-IncludeRelative> is B<not> set!) will be to open just I<acl.cfg>,
2351 wherever it is, i.e. if you did a chdir("/usr/local/etc"), then Config::General will include:
2352
2353  /usr/local/etc/acl.cfg
2354
2355 Include statements can be case insensitive (added in version 1.25).
2356
2357 Include statements will be ignored within C-Comments and here-documents.
2358
2359 By default, a config file will only be included the first time it is
2360 referenced.  If you wish to include a file in multiple places, set
2361 B</-IncludeAgain> to true. But be warned: this may lead to infinite loops,
2362 so make sure, you're not including the same file from within itself!
2363
2364 Example:
2365
2366     # main.cfg
2367     <object billy>
2368         class=Some::Class
2369         <printers>
2370             include printers.cfg
2371         </printers>
2372         # ...
2373     </object>
2374     <object bob>
2375         class=Another::Class
2376         <printers>
2377             include printers.cfg
2378         </printers>
2379         # ...
2380     </object>
2381
2382 Now C<printers.cfg> will be include in both the C<billy> and C<bob> objects.
2383
2384 You will have to be careful to not recursively include a file.  Behaviour
2385 in this case is undefined.
2386
2387
2388
2389 =head1 COMMENTS
2390
2391 A comment starts with the number sign B<#>, there can be any number of spaces and/or
2392 tab stops in front of the #.
2393
2394 A comment can also occur after a config statement. Example:
2395
2396  username = max  # this is the comment
2397
2398 If you want to comment out a large block you can use C-style comments. A B</*> signals
2399 the begin of a comment block and the B<*/> signals the end of the comment block.
2400 Example:
2401
2402  user  = max # valid option
2403  db    = tothemax
2404  /*
2405  user  = andors
2406  db    = toand
2407  */
2408
2409 In this example the second options of user and db will be ignored. Please beware of the fact,
2410 if the Module finds a B</*> string which is the start of a comment block, but no matching
2411 end block, it will ignore the whole rest of the config file!
2412
2413 B<NOTE:> If you require the B<#> character (number sign) to remain in the option value, then
2414 you can use a backslash in front of it, to escape it. Example:
2415
2416  bgcolor = \#ffffcc
2417
2418 In this example the value of $config{bgcolor} will be "#ffffcc", Config::General will not treat
2419 the number sign as the begin of a comment because of the leading backslash.
2420
2421 Inside here-documents escaping of number signs is NOT required!
2422
2423
2424 =head1 OBJECT ORIENTED INTERFACE
2425
2426 There is a way to access a parsed config the OO-way.
2427 Use the module B<Config::General::Extended>, which is
2428 supplied with the Config::General distribution.
2429
2430 =head1 VARIABLE INTERPOLATION
2431
2432 You can use variables inside your config files if you like. To do
2433 that you have to use the module B<Config::General::Interpolated>,
2434 which is supplied with the Config::General distribution.
2435
2436
2437 =head1 EXPORTED FUNCTIONS
2438
2439 Config::General exports some functions too, which makes it somewhat
2440 easier to use it, if you like this.
2441
2442 How to import the functions:
2443
2444  use Config::General qw(ParseConfig SaveConfig SaveConfigString);
2445
2446 =over
2447
2448 =item B<ParseConfig()>
2449
2450 This function takes exactly all those parameters, which are
2451 allowed to the B<new()> method of the standard interface.
2452
2453 Example:
2454
2455  use Config::General qw(ParseConfig);
2456  my %config = ParseConfig(-ConfigFile => "rcfile", -AutoTrue => 1);
2457
2458
2459 =item B<SaveConfig()>
2460
2461 This function requires two arguments, a filename and a reference
2462 to a hash structure.
2463
2464 Example:
2465
2466  use Config::General qw(SaveConfig);
2467  ..
2468  SaveConfig("rcfile", \%some_hash);
2469
2470
2471 =item B<SaveConfigString()>
2472
2473 This function requires a reference to a config hash as parameter.
2474 It generates a configuration based on this hash as the object-interface
2475 method B<save_string()> does.
2476
2477 Example:
2478
2479  use Config::General qw(ParseConfig SaveConfigString);
2480  my %config = ParseConfig(-ConfigFile => "rcfile");
2481  .. # change %config something
2482  my $content = SaveConfigString(\%config);
2483
2484
2485 =back
2486
2487 =head1 CONFIGURATION AND ENVIRONMENT
2488
2489 No environment variables will be used.
2490
2491 =head1 SEE ALSO
2492
2493 I recommend you to read the following documents, which are supplied with Perl:
2494
2495  perlreftut                     Perl references short introduction
2496  perlref                        Perl references, the rest of the story
2497  perldsc                        Perl data structures intro
2498  perllol                        Perl data structures: arrays of arrays
2499
2500  Config::General::Extended      Object oriented interface to parsed configs
2501  Config::General::Interpolated  Allows to use variables inside config files
2502
2503 =head1 LICENSE AND COPYRIGHT
2504
2505 Copyright (c) 2000-2009 Thomas Linden
2506
2507 This library is free software; you can redistribute it and/or
2508 modify it under the same terms as Perl itself.
2509
2510 =head1 BUGS AND LIMITATIONS
2511
2512 See rt.cpan.org for current bugs, if any.
2513
2514 =head1 INCOMPATIBILITIES
2515
2516 None known.
2517
2518 =head1 DIAGNOSTICS
2519
2520 To debug Config::General use the Perl debugger, see L<perldebug>.
2521
2522 =head1 DEPENDENCIES
2523
2524 Config::General depends on the modules L<FileHandle>,
2525 L<File::Spec::Functions>, L<File::Glob>, which all are
2526 shipped with Perl.
2527
2528 =head1 AUTHOR
2529
2530 Thomas Linden <tlinden |AT| cpan.org>
2531
2532 =head1 VERSION
2533
2534 2.44
2535
2536 =cut
2537