SL/LxOfficeConf.pm

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