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;