kivitendo/SL/LxOfficeConf.pm @ 1feda885
| 67b21d42 | Moritz Bunkus | package SL::LxOfficeConf;
|
||
use strict;
|
||||
| 1feda885 | Moritz Bunkus | use Encode;
|
||
| 424d6ead | Moritz Bunkus | my $environment_initialized;
|
||
| e3ff1eb6 | Sven Schöling | sub safe_require {
|
||
my ($class, $may_fail);
|
||||
| 1feda885 | Moritz Bunkus | |||
my $failed = !eval { require Config::Std; };
|
||||
| e3ff1eb6 | Sven Schöling | |||
if ($failed) {
|
||||
if ($may_fail) {
|
||||
warn $@;
|
||||
return 0;
|
||||
} else {
|
||||
die $@;
|
||||
}
|
||||
}
|
||||
Config::Std->import;
|
||||
return 1;
|
||||
}
|
||||
| 67b21d42 | Moritz Bunkus | sub read {
|
||
| e3ff1eb6 | Sven Schöling | my ($class, $file_name, $may_fail) = @_;
|
||
| 28e11d24 | Moritz Bunkus | |||
| e3ff1eb6 | Sven Schöling | return unless $class->safe_require($may_fail);
|
||
read_config('config/lx_office.conf.default' => \%::lx_office_conf);
|
||||
| 67b21d42 | Moritz Bunkus | _decode_recursively(\%::lx_office_conf);
|
||
| c599fef2 | Moritz Bunkus | |||
| 28e11d24 | Moritz Bunkus | $file_name ||= 'config/lx_office.conf';
|
||
if (-f $file_name) {
|
||||
| e3ff1eb6 | Sven Schöling | read_config($file_name => \ my %local_conf);
|
||
| c599fef2 | Moritz Bunkus | _decode_recursively(\%local_conf);
|
||
_flat_merge(\%::lx_office_conf, \%local_conf);
|
||||
}
|
||||
| 424d6ead | Moritz Bunkus | |||
_init_environment();
|
||||
_determine_application_paths();
|
||||
| e3ff1eb6 | Sven Schöling | |||
return 1;
|
||||
| 67b21d42 | Moritz Bunkus | }
|
||
sub _decode_recursively {
|
||||
my ($obj) = @_;
|
||||
while (my ($key, $value) = each %{ $obj }) {
|
||||
if (ref($value) eq 'HASH') {
|
||||
_decode_recursively($value);
|
||||
} else {
|
||||
$obj->{$key} = decode('UTF-8', $value);
|
||||
}
|
||||
}
|
||||
}
|
||||
| c599fef2 | Moritz Bunkus | sub _flat_merge {
|
||
my ($dst, $src) = @_;
|
||||
while (my ($key, $value) = each %{ $src }) {
|
||||
if (!exists $dst->{$key}) {
|
||||
$dst->{$key} = $value;
|
||||
} else {
|
||||
map { $dst->{$key}->{$_} = $value->{$_} } keys %{ $value };
|
||||
}
|
||||
}
|
||||
}
|
||||
| 424d6ead | Moritz Bunkus | sub _init_environment {
|
||
return if $environment_initialized;
|
||||
my %key_map = ( lib => { name => 'PERL5LIB', append_path => 1 },
|
||||
path => { name => 'PATH', append_path => 1 },
|
||||
);
|
||||
my $cfg = $::lx_office_conf{environment} || {};
|
||||
while (my ($key, $value) = each %{ $cfg }) {
|
||||
next unless $value;
|
||||
my $info = $key_map{$key} || {};
|
||||
$key = $info->{name} || $key;
|
||||
if ($info->{append_path}) {
|
||||
$value = ':' . $value unless $value =~ m/^:/ || !$ENV{$key};
|
||||
| d92c7b01 | Sven Schöling | $value = $ENV{$key} . $value if $ENV{$key};
|
||
| 424d6ead | Moritz Bunkus | }
|
||
$ENV{$key} = $value;
|
||||
}
|
||||
$environment_initialized = 1;
|
||||
}
|
||||
sub _determine_application_paths {
|
||||
my @paths = grep { $_ } split m/:/, $ENV{PATH};
|
||||
foreach my $key (keys %{ $::lx_office_conf{applications} }) {
|
||||
my ($program) = split m/\s+/, $::lx_office_conf{applications}->{$key};
|
||||
next if $program =~ m|/|;
|
||||
foreach my $path (@paths) {
|
||||
next unless -f "${path}/${program}";
|
||||
$::lx_office_conf{applications}->{$key} = "${path}/" . $::lx_office_conf{applications}->{$key};
|
||||
last;
|
||||
}
|
||||
}
|
||||
}
|
||||
| 67b21d42 | Moritz Bunkus | 1;
|