config.pm: replace Config::General
Config::General does not support Apache like definition and use of
variables. A minimal implementation of Apache-like configuration
allows to define variables by
Define <variable-name> <variable-value>
and use them later by
${variable-name}
.
This commit is contained in:
@@ -5,30 +5,16 @@ use warnings;
|
||||
no warnings 'redefine';
|
||||
|
||||
use FindBin();
|
||||
use Config::General();
|
||||
|
||||
#use base 'Exporter';
|
||||
our @EXPORT_OK = qw(get set);
|
||||
|
||||
my $config = undef;
|
||||
|
||||
sub set($) {
|
||||
my $value = shift;
|
||||
$config = $value;
|
||||
return;
|
||||
}
|
||||
|
||||
sub get($) {
|
||||
my $filename = shift;
|
||||
|
||||
return $config if ( defined $config ) && ( $config->{cache}->{cache_config} == 1 );
|
||||
|
||||
my $configuration = Config::General->new(
|
||||
-ConfigFile => $filename,
|
||||
-UTF8 => 1
|
||||
);
|
||||
config::set( $configuration->{DefaultConfig}->{config} );
|
||||
return $config;
|
||||
return read_config($filename);
|
||||
}
|
||||
|
||||
sub getFromScriptLocation() {
|
||||
@@ -37,5 +23,56 @@ sub getFromScriptLocation() {
|
||||
return config::get($configFile);
|
||||
}
|
||||
|
||||
sub read_config {
|
||||
my $file = $_[0];
|
||||
|
||||
my $vars = {};
|
||||
my @stack = ();
|
||||
my $entry = {};
|
||||
|
||||
open my $fh, '<', $file or die;
|
||||
while ( my $line = <$fh> ) {
|
||||
chomp $line;
|
||||
|
||||
# comments
|
||||
$line =~ s/\#.*//;
|
||||
|
||||
# trim
|
||||
$line =~ s/(^\s+)|(\s+)$//;
|
||||
next unless length $line;
|
||||
if ( $line =~ /^<\/([^>]+)>$/ ) {
|
||||
|
||||
# close tag
|
||||
my $name = $1;
|
||||
my $sentry = pop @stack;
|
||||
die unless $sentry->{name} eq $name;
|
||||
$entry = $sentry->{value};
|
||||
} elsif ( $line =~ /^<([^>]+)>$/ ) {
|
||||
|
||||
# open tag
|
||||
my $name = $1;
|
||||
$entry->{$name} = {};
|
||||
push @stack, { name => $name, value => $entry };
|
||||
$entry = $entry->{$name};
|
||||
} elsif ( $line =~ /^Define\s/ ) {
|
||||
# define vars
|
||||
my ( $attr, $key, $value ) = split /\s+/, $line, 3;
|
||||
for my $var ( keys %$vars ) {
|
||||
$value =~ s/\$\{$var\}/$vars->{$var}/;
|
||||
}
|
||||
$vars->{$key} = $value;
|
||||
} else {
|
||||
# attributes
|
||||
my ( $key, $value ) = split /\s+/, $line, 2;
|
||||
for my $var ( keys %$vars ) {
|
||||
$value =~ s/\$\{$var\}/$vars->{$var}/;
|
||||
}
|
||||
$entry->{$key} = $value;
|
||||
}
|
||||
}
|
||||
close $fh or die;
|
||||
return $entry->{config};
|
||||
}
|
||||
|
||||
#do not delete last line
|
||||
1;
|
||||
|
||||
Reference in New Issue
Block a user