Merge branch 'b-3.6.1' into mebil
[kivitendo-erp.git] / SL / LxOfficeConf.pm
1 package SL::LxOfficeConf;
2
3 use strict;
4
5 use Encode;
6
7 my $environment_initialized;
8
9 sub safe_require {
10   my ($class, $may_fail) = @_;
11
12   eval {
13     require Config::Std;
14     require SL::System::Process;
15     1;
16   } or do {
17     if ($may_fail) {
18       warn $@;
19       return 0;
20     } else {
21       die $@;
22     }
23   };
24
25   Config::Std->import;
26
27   return 1;
28 }
29
30 sub read {
31   my ($class, $file_name, $may_fail) = @_;
32
33   return unless $class->safe_require($may_fail);
34
35   # Backwards compatibility: read lx_office.conf.default if
36   # kivitendo.conf.default does't exist.
37   my $dir            = SL::System::Process->exe_dir;
38   my $default_config = -f "${dir}/config/kivitendo.conf.default" ? 'kivitendo' : 'lx_office';
39   read_config("${dir}/config/${default_config}.conf.default" => \%::lx_office_conf);
40   _decode_recursively(\%::lx_office_conf);
41
42   $file_name ||= -f "${dir}/config/kivitendo.conf" ? "${dir}/config/kivitendo.conf" : "${dir}/config/lx_office.conf";
43
44   if (-f $file_name) {
45     read_config($file_name => \ my %local_conf);
46     _decode_recursively(\%local_conf);
47     _flat_merge(\%::lx_office_conf, \%local_conf);
48   }
49
50   _init_environment();
51   _determine_application_paths();
52
53   return 1;
54 }
55
56 sub _decode_recursively {
57   my ($obj) = @_;
58
59   while (my ($key, $value) = each %{ $obj }) {
60     if (ref($value) eq 'HASH') {
61       _decode_recursively($value);
62     } else {
63       $obj->{$key} = decode('UTF-8', $value);
64     }
65   }
66 }
67
68 sub _flat_merge {
69   my ($dst, $src) = @_;
70
71   while (my ($key, $value) = each %{ $src }) {
72     if (!exists $dst->{$key}) {
73       $dst->{$key} = $value;
74
75     } else {
76       map { $dst->{$key}->{$_} = $value->{$_} } keys %{ $value };
77     }
78   }
79 }
80
81 sub _init_environment {
82   return if $environment_initialized;
83
84   my %key_map = ( lib  => { name => 'PERL5LIB', append_path => 1 },
85                   path => { name => 'PATH',     append_path => 1 },
86                 );
87   my $cfg     = $::lx_office_conf{environment} || {};
88
89   while (my ($key, $value) = each %{ $cfg }) {
90     next unless $value;
91
92     my $info = $key_map{$key} || {};
93     $key     = $info->{name}  || $key;
94
95     if ($info->{append_path}) {
96       $value = ':' . $value unless $value =~ m/^:/ || !$ENV{$key};
97       $value = $ENV{$key} . $value if $ENV{$key};
98     }
99
100     $ENV{$key} = $value;
101   }
102
103   $environment_initialized = 1;
104 }
105
106 sub _determine_application_paths {
107   my @paths = grep { $_ } split m/:/, $ENV{PATH};
108
109   foreach my $key (keys %{ $::lx_office_conf{applications} }) {
110     my ($program) = split m/\s+/, $::lx_office_conf{applications}->{$key};
111     next if $program =~ m|/|;
112
113     foreach my $path (@paths) {
114       next unless -f "${path}/${program}";
115       $::lx_office_conf{applications}->{$key} = "${path}/" . $::lx_office_conf{applications}->{$key};
116       last;
117     }
118   }
119 }
120
121 1;