You can not select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
353 lines
10 KiB
353 lines
10 KiB
package NGCP::BulkProcessor::LoadConfig;
|
|
use strict;
|
|
|
|
## no critic
|
|
|
|
use Cwd 'abs_path';
|
|
|
|
use NGCP::BulkProcessor::Globals qw(
|
|
$system_name
|
|
$system_instance_label
|
|
$local_fqdn
|
|
get_application_version
|
|
$application_path
|
|
$working_path
|
|
$executable_path
|
|
$cpucount
|
|
$enablemultithreading
|
|
$is_perl_debug
|
|
update_masterconfig
|
|
@config_search_paths
|
|
);
|
|
|
|
use NGCP::BulkProcessor::Logging qw(
|
|
getlogger
|
|
configurationinfo
|
|
);
|
|
|
|
use NGCP::BulkProcessor::LogError qw(
|
|
fileerror
|
|
filewarn
|
|
configurationwarn
|
|
configurationerror
|
|
);
|
|
|
|
use YAML qw();
|
|
$YAML::UseCode = 1;
|
|
|
|
use Config::Any qw();
|
|
use NGCP::BulkProcessor::Utils qw(format_number trim);
|
|
|
|
require Exporter;
|
|
our @ISA = qw(Exporter);
|
|
our @EXPORT_OK = qw(
|
|
load_config
|
|
parse_regexp
|
|
split_tuple
|
|
$SIMPLE_CONFIG_TYPE
|
|
$YAML_CONFIG_TYPE
|
|
$ANY_CONFIG_TYPE
|
|
);
|
|
|
|
my $tuplesplitpattern = join('|',(quotemeta(','),
|
|
quotemeta(';'),
|
|
#quotemeta('/')
|
|
)
|
|
);
|
|
|
|
our $SIMPLE_CONFIG_TYPE = 1;
|
|
our $YAML_CONFIG_TYPE = 2;
|
|
our $ANY_CONFIG_TYPE = 3;
|
|
#my $logger = getlogger(__PACKAGE__);
|
|
|
|
my $debug_config_ext_prefix = 'debug';
|
|
|
|
sub load_config {
|
|
|
|
my ($configfile,$process_code,$configtype,$configparser_args) = @_;
|
|
|
|
my $is_master = 'CODE' ne ref $process_code;
|
|
my $data;
|
|
my $variant = $configfile;
|
|
if (defined $configfile) {
|
|
my @variants = ();
|
|
if ($is_perl_debug) {
|
|
push(@variants,_prefix_ext($configfile,$debug_config_ext_prefix));
|
|
}
|
|
push(@variants,$configfile);
|
|
my %dupes = ();
|
|
while (not defined $data and ($variant = shift @variants)) {
|
|
next if exists $dupes{$variant};
|
|
$dupes{$variant} = 1;
|
|
|
|
if (-e $variant) {
|
|
$data = _parse_config($variant,$configtype,$configparser_args);
|
|
} else {
|
|
my @paths = ();
|
|
my %path_dupes = ();
|
|
my @search_paths = (@config_search_paths,$executable_path,$application_path); #todo: add /etc/bulkprocessor or similar here once
|
|
($variant,$data) = _search_path($variant,$configtype,$configparser_args,\@search_paths,\@paths,\%path_dupes);
|
|
@search_paths = ();
|
|
if (not defined $data) {
|
|
if (index($executable_path,$application_path) > -1) {
|
|
my $module_path = 'NGCP/BulkProcessor/' . substr($executable_path,length($application_path));
|
|
push(@search_paths,map { eval{ Cwd::abs_path($_ . '/') . '/' . $module_path; }; } @INC);
|
|
}
|
|
push(@search_paths,map { eval{ Cwd::abs_path($_ . '/') . '/'; }; } @INC);
|
|
($variant,$data) = _search_path($variant,$configtype,$configparser_args,\@search_paths,\@paths,\%path_dupes);
|
|
}
|
|
}
|
|
}
|
|
if (not defined $data) {
|
|
configurationerror($configfile,'no ' . ($is_master ? 'master config' : 'config') . ' variant found',getlogger(__PACKAGE__));
|
|
}
|
|
} else {
|
|
fileerror('no ' . ($is_master ? 'master config' : 'config') . ' file specified',getlogger(__PACKAGE__));
|
|
return 0;
|
|
}
|
|
|
|
if ($is_master) {
|
|
my %context = (
|
|
data => $data,
|
|
configfile => $variant,
|
|
split_tuplecode => \&split_tuple,
|
|
format_numbercode => \&format_number,
|
|
parse_regexpcode => \&parse_regexp,
|
|
configurationinfocode => \&configurationinfo,
|
|
configurationwarncode => \&configurationwarn,
|
|
configurationerrorcode => \&configurationerror,
|
|
fileerrorcode => \&fileerror,
|
|
simpleconfigtype => $SIMPLE_CONFIG_TYPE,
|
|
yamlconfigtype => $YAML_CONFIG_TYPE,
|
|
anyconfigtype => $ANY_CONFIG_TYPE,
|
|
configlogger => getlogger(__PACKAGE__),
|
|
);
|
|
my ($result,$loadconfig_args,$postprocesscode) = update_masterconfig(%context);
|
|
_splashinfo($variant);
|
|
if (defined $loadconfig_args and 'ARRAY' eq ref $loadconfig_args) {
|
|
foreach my $loadconfig_arg (@$loadconfig_args) {
|
|
$result &= load_config(@$loadconfig_arg);
|
|
}
|
|
}
|
|
if (defined $postprocesscode and 'CODE' eq ref $postprocesscode) {
|
|
$result &= &$postprocesscode(%context);
|
|
}
|
|
return $result;
|
|
} else {
|
|
my $result = &$process_code($data,$variant);
|
|
my $msg = 'config file ' . $variant . ' loaded';
|
|
$msg .= ' (' . abs_path($variant) . ')' if $variant ne abs_path($variant);
|
|
configurationinfo($msg,getlogger(__PACKAGE__));
|
|
return $result;
|
|
}
|
|
|
|
}
|
|
|
|
sub _prefix_ext {
|
|
my ($configfile,$ext_suffix) = @_;
|
|
return $configfile unless $ext_suffix;
|
|
if ($configfile =~ /\.([^\.]+)$/) {
|
|
$configfile =~ s/\.([^\.]+)$/.$ext_suffix.$1/;
|
|
} else {
|
|
$configfile .= '.' . $ext_suffix;
|
|
}
|
|
return $configfile;
|
|
}
|
|
|
|
sub _search_path {
|
|
|
|
my ($configfile,$configtype,$configparser_args,$search_paths,$paths,$dupes) = @_;
|
|
my $data = undef;
|
|
$dupes //= {};
|
|
while (not defined $data and (my $path = shift @$search_paths)) {
|
|
next if exists $dupes->{$path};
|
|
push(@$paths,$path);
|
|
$dupes->{$path} = 1;
|
|
my $relative_configfile = $path . $configfile;
|
|
if (-e $relative_configfile) {
|
|
$configfile = $relative_configfile;
|
|
$data = _parse_config($configfile,$configtype,$configparser_args);
|
|
#} else {
|
|
# configurationwarn($configfile,'no ' . ($is_master ? 'master config' : 'config') . ' file ' . $relative_configfile,getlogger(__PACKAGE__));
|
|
}
|
|
}
|
|
return ($configfile,$data);
|
|
|
|
}
|
|
|
|
sub _splashinfo {
|
|
|
|
my ($configfile) = @_;
|
|
configurationinfo($system_name . (length($system_instance_label) ? ' (' . $system_instance_label . ')' : '') . ' [' . $local_fqdn . ']',getlogger(__PACKAGE__));
|
|
configurationinfo('application version: ' . get_application_version(),getlogger(__PACKAGE__));
|
|
configurationinfo('application path: ' . $application_path,getlogger(__PACKAGE__));
|
|
configurationinfo('working path: ' . $working_path,getlogger(__PACKAGE__));
|
|
configurationinfo($cpucount . ' cpu(s), multithreading ' . ($enablemultithreading ? 'enabled' : 'disabled'),getlogger(__PACKAGE__));
|
|
my $msg = 'master config file ' . $configfile . ' loaded';
|
|
$msg .= ' (' . abs_path($configfile) . ')' if $configfile ne abs_path($configfile);
|
|
configurationinfo($msg,getlogger(__PACKAGE__));
|
|
configurationinfo('WARNING: running perl debug',getlogger(__PACKAGE__)) if $is_perl_debug;
|
|
|
|
}
|
|
|
|
sub _parse_config {
|
|
my ($file,$configtype,$configparser_args) = @_;
|
|
my $data;
|
|
if (defined $configtype) {
|
|
if ($configtype == $SIMPLE_CONFIG_TYPE) {
|
|
$data = _parse_simple_config($file,$configparser_args);
|
|
} elsif ($configtype == $YAML_CONFIG_TYPE) {
|
|
$data = _parse_yaml_config($file,$configparser_args);
|
|
} elsif ($configtype == $ANY_CONFIG_TYPE) {
|
|
$data = _parse_any_config($file,$configparser_args);
|
|
} else {
|
|
$data = _parse_simple_config($file,$configparser_args);
|
|
}
|
|
} else {
|
|
$data = _parse_simple_config($file,$configparser_args);
|
|
}
|
|
return $data;
|
|
}
|
|
|
|
sub split_tuple {
|
|
|
|
my $token = shift;
|
|
return map { local $_ = $_; trim($_); } split(/$tuplesplitpattern/,$token);
|
|
|
|
}
|
|
|
|
sub parse_regexp {
|
|
|
|
my ($token,$file) = @_;
|
|
my $regexp = undef;
|
|
my $result = 1;
|
|
if (defined $token and length($token) > 0) {
|
|
eval {
|
|
$regexp = qr/$token/;
|
|
};
|
|
if ($@ or !defined $regexp) {
|
|
configurationerror($file,'invalid pattern: ' . $@,getlogger(__PACKAGE__));
|
|
$result = 0;
|
|
}
|
|
}
|
|
return ($result,$regexp);
|
|
|
|
}
|
|
|
|
#sub parse_float {
|
|
#
|
|
# my ($value) = @_;
|
|
# my $output = $value;
|
|
# if (index($output,",") > -1) {
|
|
# $output =~ s/,/\./g;
|
|
# }
|
|
# $output = sprintf("%f",$output);
|
|
# #$output =~ s/0+$//g;
|
|
# #$output =~ s/\.$//g;
|
|
# #if ($output =~ /\..+/) {
|
|
# # $output =~ s/0+$//g;
|
|
# # $output =~ s/\.$//g;
|
|
# #}
|
|
# if (index($output,".") > -1) {
|
|
# $output =~ s/0+$//g;
|
|
# $output =~ s/\.$//g;
|
|
# }
|
|
# return $output;
|
|
#
|
|
#}
|
|
|
|
sub _parse_simple_config {
|
|
|
|
my ($file,$configparser_args) = @_;
|
|
|
|
my $config = {};
|
|
local *CF;
|
|
|
|
if (not open (CF, '<' . $file)) {
|
|
fileerror('parsing simple format - cannot open file ' . $file . ': ' . $!,getlogger(__PACKAGE__));
|
|
return $config;
|
|
}
|
|
|
|
read(CF, my $data, -s $file);
|
|
close(CF);
|
|
|
|
my @lines = split(/\015\012|\012|\015/,$data);
|
|
my $count = 0;
|
|
|
|
foreach my $line(@lines) {
|
|
$count++;
|
|
|
|
next if($line =~ /^\s*#/);
|
|
next if($line !~ /^\s*\S+\s*=.*$/);
|
|
|
|
#my $cindex = index($line,'#');
|
|
#if ($cindex >= 0) {
|
|
# $line = substr($line,0,$cindex);
|
|
#}
|
|
|
|
my ($key,$value) = split(/=/,$line,2);
|
|
|
|
# Remove whitespaces at the beginning and at the end
|
|
|
|
$key =~ s/^\s+//g;
|
|
$key =~ s/\s+$//g;
|
|
$value =~ s/^\s+//g;
|
|
$value =~ s/\s+$//g;
|
|
|
|
if (exists $config->{$key}) {
|
|
configurationwarn($file,'parsing simple format - parameter ' . $key . ' defined twice in line ' . $count,getlogger(__PACKAGE__));
|
|
}
|
|
|
|
$config->{$key} = $value;
|
|
#print $key . "\n";
|
|
}
|
|
|
|
return $config;
|
|
|
|
}
|
|
|
|
sub _parse_yaml_config {
|
|
|
|
my ($file,$configparser_args) = @_;
|
|
|
|
my $config;
|
|
unless (-e $file and -f _ and -r _) {
|
|
filewarn('parsing yaml format - cannot open file ' . $file,getlogger(__PACKAGE__));
|
|
return $config;
|
|
}
|
|
|
|
eval {
|
|
$config = YAML::LoadFile($file) // {};
|
|
};
|
|
if ($@) {
|
|
configurationerror($file,'parsing yaml format - error: ' . $@,getlogger(__PACKAGE__));
|
|
}
|
|
|
|
return $config;
|
|
|
|
}
|
|
|
|
sub _parse_any_config {
|
|
|
|
my ($file,$configparser_args) = @_;
|
|
|
|
my $config;
|
|
|
|
unless (-e $file and -f _ and -r _) {
|
|
filewarn('parsing any format - cannot open file ' . $file,getlogger(__PACKAGE__));
|
|
return $config;
|
|
}
|
|
|
|
eval {
|
|
$config = Config::Any->load_files( { files => [ $file ], (defined $configparser_args ? %$configparser_args : ()) } ) // {};
|
|
};
|
|
if ($@) {
|
|
configurationerror($file,'parsing any format - error: ' . $@,getlogger(__PACKAGE__));
|
|
}
|
|
|
|
return $config;
|
|
|
|
}
|
|
|
|
1;
|