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