1 | # reads in configuration files
|
---|
2 |
|
---|
3 | package cfgread;
|
---|
4 |
|
---|
5 |
|
---|
6 | sub read_cfg_line {
|
---|
7 | my ($handle) = @_;
|
---|
8 | my $line = "";
|
---|
9 | my @line = ();
|
---|
10 | my $linecontinues = 0;
|
---|
11 |
|
---|
12 | while (defined($line = <$handle>)) {
|
---|
13 | $line =~ s/^\#.*$//; # remove comments
|
---|
14 | $line =~ s/\cM|\cJ//g; # remove end-of-line characters
|
---|
15 | $line =~ s/^\s+//; # remove initial white space
|
---|
16 | $linecontinues = $line =~ s/\\$//;
|
---|
17 | while ($line =~ s/\s*(\"[^\"]*\"|\'[^\']*\'|\S+)\s*//) {
|
---|
18 | if (defined $1) {
|
---|
19 | # remove any enclosing quotes
|
---|
20 | my $entry = $1;
|
---|
21 | $entry =~ s/^([\"\'])(.*)\1$/$2/;
|
---|
22 |
|
---|
23 | # substitute an environment variables
|
---|
24 | $entry =~ s/\$(\w+)/$ENV{$1}/g;
|
---|
25 | $entry =~ s/\$\{(\w+)\}/$ENV{$1}/g;
|
---|
26 |
|
---|
27 | push (@line, $entry);
|
---|
28 | } else {
|
---|
29 | push (@line, "");
|
---|
30 | }
|
---|
31 | }
|
---|
32 |
|
---|
33 | if (scalar(@line) > 0 && !$linecontinues) {
|
---|
34 | # print STDERR "line: \"" . join ("\" \"", @line) . "\"\n";
|
---|
35 | return \@line;
|
---|
36 | }
|
---|
37 | }
|
---|
38 |
|
---|
39 | return undef;
|
---|
40 | }
|
---|
41 |
|
---|
42 | sub write_cfg_line {
|
---|
43 | my ($handle, $line) = @_;
|
---|
44 | print $handle join ("\t", @$line), "\n";
|
---|
45 | }
|
---|
46 |
|
---|
47 |
|
---|
48 | # stringexp and arrayexp should be something like
|
---|
49 | # '^(this|that)$'
|
---|
50 | sub read_cfg_file {
|
---|
51 | my ($filename, $stringexp, $arrayexp, $hashexp) = @_;
|
---|
52 | my ($line);
|
---|
53 | my $data = {};
|
---|
54 |
|
---|
55 | if (open (COLCFG, $filename)) {
|
---|
56 | while (defined ($line = &read_cfg_line('COLCFG'))) {
|
---|
57 | if (scalar(@$line) >= 2) {
|
---|
58 | my $key = shift (@$line);
|
---|
59 | if (defined $stringexp && $key =~ /$stringexp/) {
|
---|
60 | $data->{$key} = shift (@$line);
|
---|
61 |
|
---|
62 | } elsif (defined $arrayexp && $key =~ /$arrayexp/) {
|
---|
63 | push (@{$data->{$key}}, @$line);
|
---|
64 |
|
---|
65 | } elsif (defined $hashexp && $key =~ /$hashexp/) {
|
---|
66 | my $k = shift @$line;
|
---|
67 | my $v = shift @$line;
|
---|
68 | $data->{$key}->{$k} = $v;
|
---|
69 | }
|
---|
70 | }
|
---|
71 | }
|
---|
72 | close (COLCFG);
|
---|
73 | } else {
|
---|
74 | print STDERR "cfgread::read_cfg_file couldn't read the cfg file $filename\n";
|
---|
75 | }
|
---|
76 |
|
---|
77 | return $data;
|
---|
78 | }
|
---|
79 |
|
---|
80 |
|
---|
81 | # stringexp and arrayexp should be something like
|
---|
82 | # '^(this|that)$'
|
---|
83 | sub write_cfg_file {
|
---|
84 | my ($filename, $data, $stringexp, $arrayexp, $hashexp) = @_;
|
---|
85 |
|
---|
86 | if (open (COLCFG, ">$filename")) {
|
---|
87 | foreach $key (sort(keys(%$data))) {
|
---|
88 | if ($key =~ /$stringexp/) {
|
---|
89 | &write_cfg_line ('COLCFG', [$key, $data->{$key}]);
|
---|
90 | } elsif ($key =~ /$arrayexp/) {
|
---|
91 | &write_cfg_line ('COLCFG', [$key, @{$data->{$key}}]);
|
---|
92 | } elsif ($key =~ /$hashexp/) {
|
---|
93 | foreach $k (keys (%{$data->{$key}})) {
|
---|
94 | &write_cfg_line ('COLCFG', [$key, $k, $data->{$key}->{$k}]);
|
---|
95 | }
|
---|
96 | }
|
---|
97 | }
|
---|
98 | close (COLCFG);
|
---|
99 | } else {
|
---|
100 | print STDERR "cfgread::write_cfg_file couldn't write the cfg file $filename\n";
|
---|
101 | }
|
---|
102 | }
|
---|
103 |
|
---|
104 |
|
---|
105 | 1;
|
---|