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