view release on metacpan or  search on metacpan

General.pm  view on Meta::CPAN

#
# Config::General.pm - Generic Config Module
#
# Purpose: Provide a convenient way for loading
#          config values from a given file and
#          return it as hash structure
#
# Copyright (c) 2000-2025 Thomas Linden <tlinden |AT| cpan.org>.
# All Rights Reserved. Std. disclaimer applies.
# Licensed under the Artistic License 2.0.
#
# namespace
package Config::General;

use strict;
use warnings;
use English '-no_match_vars';

use IO::File;
use FileHandle;
use File::Spec::Functions qw(splitpath file_name_is_absolute catfile catpath);
use File::Glob qw/:glob/;


# on debian with perl > 5.8.4 croak() doesn't work anymore without this.
# There is some require statement which dies 'cause it can't find Carp::Heavy,
# I really don't understand, what the hell they made, but the debian perl
# installation is definitely bullshit, damn!
use Carp::Heavy;


use Carp;
use Exporter;

$Config::General::VERSION = "2.67";

use base qw(Exporter);
our @EXPORT_OK = qw(ParseConfig SaveConfig SaveConfigString);

use constant _UTF8_BOM => "\x{ef}\x{bb}\x{bf}";

sub new {
  #
  # create new Config::General object
  #
  my($this, @param ) = @_;
  my $class = ref($this) || $this;

  # define default options
  my $self = {
              # sha256 of current date
              # hopefully this lowers the probability that
              # this matches any configuration key or value out there
              # bugfix for rt.40925
              EOFseparator          => 'ad7d7b87f5b81d2a0d5cb75294afeb91aa4801b1f8e8532dc1b633c0e1d47037',
              SlashIsDirectory      => 0,
              AllowMultiOptions     => 1,
              MergeDuplicateOptions => 0,
              MergeDuplicateBlocks  => 0,
              LowerCaseNames        => 0,
              ApacheCompatible      => 0,
              UseApacheInclude      => 0,
              IncludeRelative       => 0,
              IncludeDirectories    => 0,
              IncludeGlob           => 0,
              IncludeAgain          => 0,
              AutoLaunder           => 0,
              AutoTrue              => 0,
              AutoTrueFlags         => {
                                        true  => '^(on|yes|true|1)$',
                                        false => '^(off|no|false|0)$',
                                       },
              DefaultConfig         => {},
              String                => '',
              level                 => 1,
              InterPolateVars       => 0,
              InterPolateEnv        => 0,
              ExtendedAccess        => 0,
              SplitPolicy           => 'guess', # also possible: whitespace, equalsign and custom
              SplitDelimiter        => 0,       # must be set by the user if SplitPolicy is 'custom'
              StoreDelimiter        => 0,       # will be set by me unless user uses 'custom' policy
              CComments             => 1,       # by default turned on
              BackslashEscape       => 0,       # deprecated
              StrictObjects         => 1,       # be strict on non-existent keys in OOP mode
              StrictVars            => 1,       # be strict on undefined variables in Interpolate mode
              Tie                   => q(),      # could be set to a perl module for tie'ing new hashes
              parsed                => 0,       # internal state stuff for variable interpolation
              files                 => {},      # which files we have read, if any
              UTF8                  => 0,
              SaveSorted            => 0,
              ForceArray            => 0,       # force single value array if value enclosed in []
              AllowSingleQuoteInterpolation => 0,
              NoEscape              => 0,
              NormalizeBlock        => 0,
              NormalizeOption       => 0,
              NormalizeValue        => 0,
              Plug                  => {},
              UseApacheIfDefine     => 0,
              Define                => {},
              AlwaysQuoteOutput     => 0

General.pm  view on Meta::CPAN

  local ($RS) = $RS;
  if (! $RS) {
    carp(q(\$RS (INPUT_RECORD_SEPARATOR) is undefined.  Guessing you want a line feed character));
    $RS = "\n";
  }

  if (-d $configfile and $this->{IncludeDirectories}) {
    # A directory was included; include all the files inside that directory in ASCII order
    local *INCLUDEDIR;
    opendir INCLUDEDIR, $configfile or croak "Config::General: Could not open directory $configfile!($!)\n";
    #my @files = sort grep { -f catfile($configfile, $_) } catfile($configfile, $_), readdir INCLUDEDIR;
    # fixes rt.cpan.org#139261
    my @files = sort grep { -f catfile($configfile, $_) } readdir INCLUDEDIR;
    closedir INCLUDEDIR;
    local $this->{CurrentConfigFilePath} = $configfile;
    for (@files) {
      my $file = catfile($configfile, $_);
      if (! exists $this->{files}->{$file} or $this->{IncludeAgain} ) {
        # support re-read if used urged us to do so, otherwise ignore the file
        $fh = $this->_openfile_for_read($file);
        $this->{files}->{"$file"} = 1;
        $this->_read($fh);
      }
      else {
        warn "File $file already loaded.  Use -IncludeAgain to load it again.\n";
      }
    }
  }
  elsif (-d $configfile) {
    croak "Config::General: config file argument is a directory, expecting a file!\n";
  }
  elsif (-e _) {
    if (exists $this->{files}->{$configfile} and not $this->{IncludeAgain}) {
      # do not read the same file twice, just return
      warn "File $configfile already loaded.  Use -IncludeAgain to load it again.\n";
      return;
    }
    else {
      $fh = $this->_openfile_for_read($configfile);
      $this->{files}->{$configfile}    = 1;

      my ($volume, $path, undef)           = splitpath($configfile);
      local $this->{CurrentConfigFilePath} = catpath($volume, $path, q());

      $this->_read($fh);
    }
  }
  return;
}


sub _openfile_for_read {
  #
  # actually open a file, turn on utf8 mode if requested by bom
  #
  my ($this, $file) = @_;

  my $fh = IO::File->new( $file, 'r')
    or croak "Config::General: Could not open $file!($!)\n";

  # attempt to read an initial utf8 byte-order mark (BOM)
  my $n_read  = sysread $fh, my $read_BOM, length(_UTF8_BOM);
  my $has_BOM = $n_read == length(_UTF8_BOM) && $read_BOM eq _UTF8_BOM;

  # set utf8 perlio layer if BOM was found or if option -UTF8 is turned on
  binmode $fh, ":utf8" if $this->{UTF8} || $has_BOM;

  # rewind to beginning of file if we read chars that were not the BOM
  sysseek $fh, 0, 0 if $n_read && !$has_BOM;

  return $fh;
}



sub _read {
  #
  # store the config contents in @content
  # and prepare it somewhat for easier parsing later
  # (comments, continuing lines, and stuff)
  #
  my($this, $fh, $flag) = @_;


  my(@stuff, @content, $c_comment, $longline, $hier, $hierend, @hierdoc);
  local $_ = q();

  if ($flag && $flag eq 'SCALAR') {
    if (ref($fh) eq 'ARRAY') {
      @stuff = @{$fh};
    }
    else {
      @stuff = split /\n/, $fh;
    }
  }
  else {
    @stuff = <$fh>;
  }

  my $cont;
  ($cont, $fh, @stuff) = $this->_hook('pre_read', $fh, @stuff);
  return if(!$cont);

  if ($this->{UseApacheIfDefine}) {
    $this->_process_apache_ifdefine(\@stuff);
  }

  foreach (@stuff) {
    if ($this->{AutoLaunder}) {
      if (m/^(.*)$/) {
        $_ = $1;
      }
    }

    chomp;


    if ($hier) {
      # inside here-doc, only look for $hierend marker
      if (/^(\s*)\Q$hierend\E\s*$/) {
        my $indent = $1;                 # preserve indentation
        $hier .= ' ' . $this->{EOFseparator}; # bugfix of rt.40925
        # _parse will also preserver indentation
        if ($indent) {
          foreach (@hierdoc) {
            s/^$indent//;                # i.e. the end was: "    EOF" then we remove "    " from every here-doc line
            $hier .= $_ . "\n";          # and store it in $hier
          }
        }