modules/ConfigParser.pm

   1 package ConfigParser;
   2
   3 # ************************************************************
   4 # Description   : Reads a generic config file and store the values
   5 # Author        : Chad Elliott
   6 # Create Date   : 6/12/2006
   7 # ************************************************************
   8
   9 # ************************************************************
  10 # Pragmas
  11 # ************************************************************
  12
  13 use strict;
  14
  15 use Parser;
  16
  17 use vars qw(@ISA);
  18 @ISA = qw(Parser);
  19
  20 # ************************************************************
  21 # Subroutine Section
  22 # ************************************************************
  23
  24 sub new {
  25   my($class, $valid) = @_;
  26   my $self = $class->SUPER::new();
  27
  28   ## Set up the internal data members
  29   $self->{'values'} = {};
  30   $self->{'clean'}  = {};
  31   $self->{'valid'}  = $valid;
  32   $self->{'warned'} = {};
  33
  34   return $self;
  35 }
  36
  37
  38 sub parse_line {
  39   my($self, $if, $line) = @_;
  40   my $error;
  41
  42   if ($line eq '') {
  43   }
  44   elsif ($line =~ /^([^=]+)\s*=\s*(.*)$/) {
  45     ## Save the name, removing any trailing white space, and the value
  46     ## too.
  47     my $name  = $1;
  48     my $clean = $2;
  49
  50     ## Pre-process the name and value
  51     my $value = $self->preprocess($clean);
  52     $name = $self->preprocess($name);
  53     $name =~ s/\\/\//g;
  54
  55     ## Store the name value pair
  56     if (!defined $self->{'valid'}) {
  57       ## There are no valid names, so all names are valid, except an
  58       ## empty name.
  59       if ($name ne '') {
  60         $self->{'values'}->{$name} = $value;
  61         $self->{'clean'}->{$name} = $clean;
  62       }
  63     }
  64     elsif (defined $self->{'valid'}->{lc($name)}) {
  65       ## This is a valid value, so we can store it.
  66       $self->{'values'}->{lc($name)} = $value;
  67       $self->{'clean'}->{lc($name)} = $clean;
  68     }
  69     else {
  70       $error = "Invalid keyword: $name";
  71     }
  72   }
  73   else {
  74     $error = "Unrecognized line: $line";
  75   }
  76
  77   return (defined $error ? 0 : 1), $error;
  78 }
  79
  80
  81 sub get_names {
  82   my @names = keys %{$_[0]->{'values'}};
  83   return \@names;
  84 }
  85
  86
  87 sub get_value {
  88   ## Try the tag first and if that doesn't work make it all lower-case.
  89   my($self, $tag) = @_;
  90   return $self->{'values'}->{$tag} || $self->{'values'}->{lc($tag)};
  91 }
  92
  93
  94 sub get_unprocessed {
  95   ## Try the tag first and if that doesn't work make it all lower-case.
  96   my($self, $tag) = @_;
  97   return $self->{'clean'}->{$tag} || $self->{'clean'}->{lc($tag)};
  98 }
  99
 100
 101 sub preprocess {
 102   my($self, $str) = @_;
 103
 104   ## We need to replace $(...) with the equivalent environment variable
 105   ## value.
 106   while ($str =~ /\$(\?)?([\(\w\)]+)/) {
 107     my $optional = $1;
 108     my $name = $2;
 109     $name =~ s/[\(\)]//g;
 110     my $val = $ENV{$name};
 111
 112     if (!defined $val) {
 113       if (defined $optional) {
 114         $str =~ s/\$\?\S+//;
 115         next;
 116       }
 117       ## If the environment variable is not set, we will end up removing
 118       ## the reference, but we need to warn the user that we're doing so.
 119       $val = '';
 120       if (!defined $self->{'warned'}->{$name}) {
 121         $self->diagnostic("$name was used in the configuration file, " .
 122                           "but was not defined.");
 123         $self->{'warned'}->{$name} = 1;
 124       }
 125     }
 126
 127     ## Do the replacement
 128     $str =~ s/\$\??([\(\w\)]+)/$val/;
 129   }
 130
 131   ## Remove leading and trailing spaces
 132   $str =~ s/^\s+//;
 133   $str =~ s/\s+$//;
 134
 135   return $str;
 136 }
 137
 138 1;