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';
|
no warnings 'redefine';
|
||||||
|
|
||||||
use FindBin();
|
use FindBin();
|
||||||
use Config::General();
|
|
||||||
|
|
||||||
#use base 'Exporter';
|
#use base 'Exporter';
|
||||||
our @EXPORT_OK = qw(get set);
|
our @EXPORT_OK = qw(get set);
|
||||||
|
|
||||||
my $config = undef;
|
my $config = undef;
|
||||||
|
|
||||||
sub set($) {
|
|
||||||
my $value = shift;
|
|
||||||
$config = $value;
|
|
||||||
return;
|
|
||||||
}
|
|
||||||
|
|
||||||
sub get($) {
|
sub get($) {
|
||||||
my $filename = shift;
|
my $filename = shift;
|
||||||
|
return read_config($filename);
|
||||||
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;
|
|
||||||
}
|
}
|
||||||
|
|
||||||
sub getFromScriptLocation() {
|
sub getFromScriptLocation() {
|
||||||
@@ -37,5 +23,56 @@ sub getFromScriptLocation() {
|
|||||||
return config::get($configFile);
|
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
|
#do not delete last line
|
||||||
1;
|
1;
|
||||||
|
|||||||
Reference in New Issue
Block a user