lib/LiCoM/Config.pm

   1 package LiCoM::Config;
   2
   3 use strict;
   4 use warnings;
   5
   6 use Exporter;
   7
   8 @LiCoM::Config::EXPORT_OK = ('get_config read_config');
   9 @LiCoM::Config::ISA = ('Exporter');
  10
  11 our $Config = {};
  12
  13 return (1);
  14
  15 =head1 STATIC FUNCTIONS
  16
  17 =over 4
  18
  19 =item LiCoM::Config-E<gt>B<get_config> (I<$key>)
  20
  21 Returns the value for I<$key> or undef if it's unknown.
  22
  23 =cut
  24
  25 sub get_config
  26 {
  27         my $pkg = shift;
  28         my $key = shift;
  29
  30         if (!%$Config)
  31         {
  32                 read_config ();
  33         }
  34
  35         return ($Config->{$key});
  36 }
  37
  38 =item LiCoM::Config-E<gt>B<set_config> (I<$key>, I<$value>)
  39
  40 Sets the value of I<$key> to I<$value>.
  41
  42 =cut
  43
  44 sub set_config
  45 {
  46         my $pkg = shift;
  47         my $key = shift;
  48         my $val = shift;
  49
  50         $Config->{$key} = $val;
  51 }
  52
  53 =item LiCoM::Config-E<gt>B<read_config> ([I<@files>])
  54
  55 Read the config from the files given or F</etc/licom/licom.conf> and
  56 F<~/.licomrc> if no files were given.
  57
  58 =cut
  59
  60 sub read_config
  61 {
  62         my @files = ('/etc/licom/licom.conf');
  63
  64         if (@_)
  65         {
  66                 @files = @_;
  67         }
  68         elsif (defined ($ENV{'HOME'}) and (-d $ENV{'HOME'}))
  69         {
  70                 push (@files, $ENV{'HOME'} . '/.licomrc');
  71         }
  72
  73         for (@files)
  74         {
  75                 my $file = $_;
  76                 next unless (-r $file);
  77
  78                 read_file ($file, $config);
  79         }
  80
  81         return ($config);
  82 }
  83
  84 sub read_file
  85 {
  86         my $file   = @_ ? shift : '/etc/licom/licom.conf';
  87         my $config = @_ ? shift : {};
  88         my $fh;
  89
  90         open ($fh, "< $file") or die ("open ($file): $!");
  91         for (<$fh>)
  92         {
  93                 chomp;
  94                 my $line = $_;
  95
  96                 if ($line =~ m/^(\w+):\s*"(.+)"\s*$/)
  97                 {
  98                         my $key = lc ($1);
  99                         my $val = $2;
 100
 101                         $config->{$key} = $val;
 102                 }
 103         }
 104
 105         close ($fh);
 106
 107         return ($config);
 108 }
 109
 110 =back
 111
 112 =head1 AUTHOR
 113
 114 Florian octo Forster E<lt>octo at verplant.orgE<gt>
 115
 116 =cut