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     $name =~ s/\s+$//;
  50
  51     ## Pre-process the name and value
  52     my $value = $self->preprocess($clean);
  53     $name = $self->preprocess($name);
  54     $name =~ s/\\/\//g;
  55
  56     ## Store the name value pair
  57     if (!defined $self->{'valid'}) {
  58       ## There are no valid names, so all names are valid, except an
  59       ## empty name.
  60       if ($name ne '') {
  61         $self->{'values'}->{$name} = $value;
  62         $self->{'clean'}->{$name} = $clean;
  63       }
  64     }
  65     elsif (defined $self->{'valid'}->{lc($name)}) {
  66       ## This is a valid value, so we can store it.
  67       $self->{'values'}->{lc($name)} = $value;
  68       $self->{'clean'}->{lc($name)} = $clean;
  69     }
  70     else {
  71       $error = "Invalid keyword: $name";
  72     }
  73   }
  74   else {
  75     $error = "Unrecognized line: $line";
  76   }
  77
  78   return (defined $error ? 0 : 1), $error;
  79 }
  80
  81
  82 sub get_names {
  83   my @names = keys %{$_[0]->{'values'}};
  84   return \@names;
  85 }
  86
  87
  88 sub get_value {
  89   ## Try the tag first and if that doesn't work make it all lower-case.
  90   my($self, $tag) = @_;
  91   return $self->{'values'}->{$tag} || $self->{'values'}->{lc($tag)};
  92 }
  93
  94
  95 sub get_unprocessed {
  96   ## Try the tag first and if that doesn't work make it all lower-case.
  97   my($self, $tag) = @_;
  98   return $self->{'clean'}->{$tag} || $self->{'clean'}->{lc($tag)};
  99 }
 100
 101
 102 sub preprocess {
 103   my($self, $str) = @_;
 104
 105   ## We need to replace $(...) with the equivalent environment variable
 106   ## value.
 107   while ($str =~ /\$(\?)?([\(\w\)]+)/) {
 108     my $optional = $1;
 109     my $name = $2;
 110     $name =~ s/[\(\)]//g;
 111     my $val = $ENV{$name};
 112
 113     if (!defined $val) {
 114       if (defined $optional) {
 115         $str =~ s/\$\?\S+//;
 116         next;
 117       }
 118       ## If the environment variable is not set, we will end up removing
 119       ## the reference, but we need to warn the user that we're doing so.
 120       $val = '';
 121       if (!defined $self->{'warned'}->{$name}) {
 122         $self->diagnostic("$name was used in the configuration file, " .
 123                           "but was not defined.");
 124         $self->{'warned'}->{$name} = 1;
 125       }
 126     }
 127
 128     ## Do the replacement
 129     $str =~ s/\$\??([\(\w\)]+)/$val/;
 130   }
 131   return $str;
 132 }
 133
 134 1;