lib/LiCoM/Config.pm

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