SL/LxOfficeConf.pm

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