Commit | Line | Data |
---|---|---|
01c223d0 BOFG |
1 | ##---------------------------------------------------------------------------## |
2 | ## File: | |
3 | ## $Id: Config.pm,v 1.8 2002/09/20 02:58:38 ehood Exp $ | |
4 | ## Description: | |
5 | ## POD at end of file. | |
6 | ##---------------------------------------------------------------------------## | |
7 | ## Copyright (C) 2002 Earl Hood <earl@earlhood.com> | |
8 | ## | |
9 | ## This program is free software; you can redistribute it and/or modify | |
10 | ## it under the terms of the GNU General Public License as published by | |
11 | ## the Free Software Foundation; either version 2 of the License, or | |
12 | ## (at your option) any later version. | |
13 | ## | |
14 | ## This program is distributed in the hope that it will be useful, | |
15 | ## but WITHOUT ANY WARRANTY; without even the implied warranty of | |
16 | ## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
17 | ## GNU General Public License for more details. | |
18 | ## | |
19 | ## You should have received a copy of the GNU General Public License | |
20 | ## along with this program; if not, write to the Free Software | |
21 | ## Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA | |
22 | ## 02111-1307, USA | |
23 | ##---------------------------------------------------------------------------## | |
24 | ||
25 | package MHArc::Config; | |
26 | ||
27 | BEGIN { | |
28 | $Debug = 0; | |
29 | $Cache = 1; | |
30 | } | |
31 | ||
32 | sub load { | |
33 | my $self = { }; | |
34 | my $mod = shift; # Name of module | |
35 | my $fname = shift; # Filename to read configuration from | |
36 | my $class = ref($mod) || $mod; | |
37 | ||
38 | bless $self, $class; | |
39 | $self->read_filename($fname); | |
40 | } | |
41 | ||
42 | sub read_filename { | |
43 | my $self = shift; | |
44 | my $in_file = shift; | |
45 | ||
46 | READ_FILE: { | |
47 | if ($in_file eq '-') { | |
48 | $fh = \*STDIN; | |
49 | $self->parse_config_sh($fh); | |
50 | last READ_FILE; | |
51 | } | |
52 | ||
53 | my $filename = $in_file; | |
54 | my $cache_file = $in_file . '.cache.pl'; | |
55 | ||
56 | if ($Cache) { | |
57 | my $cache_mtime; | |
58 | if (-e $cache_file) { | |
59 | $cache_mtime = (stat(_))[9]; | |
60 | print 'Cache mtime: ', $cache_mtime, "\n" if $Debug; | |
61 | } | |
62 | if (!(-e $filename)) { | |
63 | $filename .= '.dist'; | |
64 | if (-e $filename) { | |
65 | warn qq/Warning: Using "$filename"\n/; | |
66 | } else { | |
67 | die qq/ERROR: "$in_file" does not exist\n/; | |
68 | } | |
69 | } | |
70 | my $file_mtime = (stat(_))[9]; | |
71 | print 'Config mtime: ', $file_mtime, "\n" if $Debug; | |
72 | if (defined($cache_mtime) && ($cache_mtime >= $file_mtime)) { | |
73 | print "Using cache\n" if $Debug; | |
74 | delete $INC{$cache_file}; | |
75 | my $vars; | |
76 | eval { | |
77 | $vars = require $cache_file; | |
78 | }; | |
79 | if ($@) { | |
80 | warn qq/Warning: Problem requiring "$cache_file": $@\n/; | |
81 | } else { | |
82 | $self = $vars; | |
83 | last READ_FILE; | |
84 | } | |
85 | } | |
86 | } | |
87 | ||
88 | local(*FILE); | |
89 | open(FILE, $filename) || | |
90 | die qq/ERROR: Unable to open "$filename": $!\n/; | |
91 | print "Using $filename\n" if $Debug; | |
92 | $self->parse_config_sh(\*FILE); | |
93 | close(FILE); | |
94 | ||
95 | if ($Cache) { | |
96 | eval { | |
97 | require Data::Dumper; | |
98 | local $Data::Dumper::Terse = 1; | |
99 | local $Data::Dumper::Indent = 0; | |
100 | print 'Create cache ', $cache_file, "\n" if $Debug; | |
101 | open(FILE, '>'.$cache_file) || | |
102 | die qq/Unable to create "$cache_file": $!\n/; | |
103 | print FILE '# DO NOT EDIT THIS FILE!', "\n", | |
104 | Data::Dumper::Dumper($self), ';'; | |
105 | close(FILE); | |
106 | }; | |
107 | if ($@) { | |
108 | warn qq/Warning: Problem writing "$cache_file": $@\n/; | |
109 | unlink($cache_file); | |
110 | }; | |
111 | } | |
112 | } | |
113 | ||
114 | # Check for MHONARC_LIB, and if defined, add to perl's @INC | |
115 | if ($self->{'MHONARC_LIB'}) { | |
116 | print 'Adding ', $self->{'MHONARC_LIB'}, "to \@INC\n" if $Debug; | |
117 | unshift(@INC, $self->{'MHONARC_LIB'}); | |
118 | } | |
119 | $self; | |
120 | } | |
121 | ||
122 | sub parse_config_sh { | |
123 | my $self = shift; | |
124 | my $fh = shift; | |
125 | ||
126 | my($line, $key, $value); | |
127 | while (defined($line = <$fh>)) { | |
128 | next unless $line =~ /\S/; | |
129 | next if $line =~ /^\s*#/; | |
130 | chomp $line; | |
131 | ($key, $value) = split(/=/, $line, 2); | |
132 | ||
133 | if ($value =~ s/^'//) { | |
134 | $value =~ s/'$//; | |
135 | } else { | |
136 | $value =~ s/^"//; $value =~ s/"$//; | |
137 | $value = _expand_vars($self, $value); | |
138 | } | |
139 | $self->{$key} = $value; | |
140 | } | |
141 | } | |
142 | ||
143 | sub dump_config { | |
144 | my $self = shift; | |
145 | my $fh = shift; | |
146 | ||
147 | foreach my $key (sort keys %$self) { | |
148 | print $fh $key, '=', $self->{$key}, "\n"; | |
149 | } | |
150 | } | |
151 | ||
152 | sub _expand_vars { | |
153 | my $map = shift; | |
154 | my $str = shift; | |
155 | ||
156 | $str =~ s/(^|[^\$])\$(\{[^}]+\}|[\w]+)/$1 . _var_lookup($map, $2);/ge; | |
157 | $str; | |
158 | } | |
159 | ||
160 | sub _var_lookup { | |
161 | my $map = shift; | |
162 | my $key = shift; | |
163 | $key =~ s/[{}]//g; | |
164 | defined($map->{$key}) ? $map->{$key} : | |
165 | defined($ENV{$key}) ? $ENV{$key} : ""; | |
166 | } | |
167 | ||
168 | #my $config = MHArc::Config->load('-'); | |
169 | #foreach (sort keys %$config) { | |
170 | # print "$_=", $config->{$_}, "\n"; | |
171 | #} | |
172 | ||
173 | #========================================================================== | |
174 | 1; | |
175 | __END__ | |
176 | ||
177 | =head1 NAME | |
178 | ||
179 | MHArc::Config - Load mail archive configuration file | |
180 | ||
181 | =head1 SYNOPSIS | |
182 | ||
183 | $conf = MHArc::Config->load($filename); | |
184 | print $conf->{'HTML_DIR'}; | |
185 | ||
186 | =head1 DESCRIPTION | |
187 | ||
188 | This module will load in the archive configuration file. The | |
189 | archive configuration file defines variables in Bourne shell syntax format. | |
190 | ||
191 | B<NOTE:> Only a subset of the Bourne shell syntax is supported, so do | |
192 | not get fancy with the file. | |
193 | ||
194 | The C<load> static method will create a new configuration instance | |
195 | that is a bless hash reference. The variables defined in the file | |
196 | will be the hash keys. | |
197 | ||
198 | B<NOTE:> If the filename specified does not exist, then the C<load()> | |
199 | method will check for the filename with a C<.dist> extension. It | |
200 | is recommended to not rely on the C<.dist> version since it will | |
201 | get overwritten on software updates. | |
202 | ||
203 | =head1 CACHING | |
204 | ||
205 | This module will create a cached version of the file loaded to | |
206 | make subsequent loadings quicker. The cached file will be called | |
207 | C<E<lt>filenameE<gt>.cache.pl> and will contain the configuration | |
208 | data in a Perl format. | |
209 | ||
210 | When loading the configuration of a file, the timestamps of the | |
211 | cache file and the regular file are compared. If the cache is newer, | |
212 | it is used. Else, the regular file will be loaded and a new cache | |
213 | file created. | |
214 | ||
215 | =head1 VARIABLES | |
216 | ||
217 | =over | |
218 | ||
219 | =item C<$MHArc::Config::Cache> | |
220 | ||
221 | If set to C<0>, no cache processing will be done. Configuration will | |
222 | be loaded directly from specified file. | |
223 | ||
224 | =item C<$MHArc::Config::Debug> | |
225 | ||
226 | If set to C<1>, diagnostic information will be printed. This variable | |
227 | should only be used for debugging and not in production. | |
228 | ||
229 | =back | |
230 | ||
231 | =head1 VERSION | |
232 | ||
233 | C<$Id: Config.pm,v 1.8 2002/09/20 02:58:38 ehood Exp $> | |
234 | ||
235 | =head1 AUTHOR | |
236 | ||
237 | Earl Hood, earl@earlhood.com | |
238 | ||
239 | This module is part of the mharc archiving system and comes with | |
240 | ABSOLUTELY NO WARRANTY and may be copied only under the terms of | |
241 | the GNU General Public License, which may be found in the MHArc | |
242 | distribution. | |
243 | ||
244 | =cut | |
245 |