0.11_09 commit
[bse.git] / site / cgi-bin / modules / BSE / Cfg.pm
CommitLineData
589b789c
TC
1package BSE::Cfg;
2use strict;
3use FindBin;
4use constant MAIN_CFG => 'bse.cfg';
5use constant CFG_DEPTH => 5; # unused so far
6use constant CACHE_AGE => 30;
7use constant VAR_DEPTH => 10;
8
9my %cache;
10
11
12=head1 NAME
13
14 BSE::Cfg - configuration file for BSE
15
16=head1 SYNOPSIS
17
18 my $cfg = BSE::Cfg->new();
19 my $entry1 = $cfg->entry($section, $key); # undef on failure
20 my $entry2 = $cfg->entryErr($section, $key); # abort on failure
21 my $entry3 = $cfg->entryVar($section, $key); # replace variables in value
22
23=head1 DESCRIPTION
24
25Provides a simple configuration file object for BSE.
26
27Currently just provides access to a single config file, but could
28later be modified to provide access to one based on the current site,
29for use in a mod_perl version of BSE.
30
31=head1 METHODS
32
33=over
34
35=item BSE::Cfg->new
36
37Create a new configuration file object. Currently takes no
38parameters, but may do so in the future.
39
40=cut
41
42sub new {
43 my ($class, %opts) = @_;
44
45 #my $file = _find_cfg(MAIN_CFG)
46 # or _load_error("Cannot find config file ".MAIN_CFG);
3bc94f98 47 my $file = _find_cfg(MAIN_CFG) || _find_cfg(MAIN_CFG, ".")
589b789c
TC
48 or return bless { config => {} }, $class;
49
50 return $class->_load_cfg($file);
51}
52
53=item entry($section, $key)
54
55Returns the value of the given $key from section $section.
56
57If the section or key doesn not exist, return undef.
58
59=cut
60
61sub entry {
62 my ($self, $section, $key) = @_;
63
b19047a6
TC
64 $self->{config}{lc $section}
65 && $self->{config}{lc $section}{values}{lc $key};
589b789c
TC
66}
67
68=item entries($section)
69
70Returns a keyword/value list of the entries from the given section.
71
72This can be assigned to a hash by the caller. There is no particular
73order to the keys.
74
b19047a6
TC
75The keys are all lower-case.
76
589b789c
TC
77=cut
78
79sub entries {
80 my ($self, $section) = @_;
81
82 if ($self->{config}{lc $section}) {
b19047a6
TC
83 return %{$self->{config}{lc $section}{values}};
84 }
85 return;
86}
87
88=item entriesCS($section)
89
90Returns a keyword/value list of the entries from the given section.
91
92This can be assigned to a hash by the caller. There is no particular
93order to the keys.
94
95The keys are in original case.
96
97=cut
98
99sub entriesCS {
100 my ($self, $section) = @_;
101
102 if ($self->{config}{lc $section}) {
103 return %{$self->{config}{lc $section}{case}};
589b789c
TC
104 }
105 return;
106}
107
108=item entryErr($section, $key)
109
110Same as the entry() method, except that it dies if the key or section
111does not exist.
112
113=cut
114
115sub entryErr {
116 my ($self, $section, $key) = @_;
117
118 my $value = $self->entry($section, $key);
119 defined $value
120 or $self->_error("Cannot find $key in $section");
121
122 return $value;
123}
124
125=item entryVar($section, $key)
126
127Same as the entryErr() method, except that if the value found contains
128'$(word1/word2)' it is replaced with the value from section 'word1'
129key 'word2', similarly '$(word1)' is replaced with key 'word1' from
130the current section.
131
132This is nested.
133
134Dies if any key is not found.
135
136Dies if there are more than 10 levels of variable substitution done.
137
138=cut
139
140sub entryVar {
141 my ($self, $section, $key, $depth) = @_;
142
143 $depth ||= 0;
144 $depth < VAR_DEPTH
145 or $self->_error("Too many levels of variables getting $key from $section");
146 my $value = $self->entryErr($section, $key);
147 $value =~ s!\$\((\w+)/(\w+)\)! $self->entryVar($1, $2, $depth+1) !eg;
148 $value =~ s!\$\((\w+)\)! $self->entryVar($section, $1, $depth+1) !eg;
149
150 $value;
151}
152
531fb3bc
TC
153=item entryIfVar($section, $key)
154
155Same as entryVar(), except that it returns undef if there is no value
156for the given section/key.
157
158=cut
159
160sub entryIfVar {
161 my ($self, $section, $key) = @_;
162
163 my $value = $self->entry($section, $key);
164 if (defined $value) {
165 $value = $self->entryVar($section, $key);
166 }
167
168 $value;
169}
170
589b789c
TC
171=item entryBool($section, $key, [ $def ])
172
173=cut
174
175sub entryBool {
176 my ($self, $section, $key, $def) = @_;
177
178 my $entry = $self->entry($section, $key);
179 if (defined $entry) {
2404a911 180 return($entry =~ /^(?:yes|true|y|t|1*)$/i);
589b789c
TC
181 }
182 else {
183 return $def;
184 }
185}
186
187=back
188
189=head1 INTERNAL METHODS
190
191=over
192
193=item _find_cfg($name [, $path])
194
195Attempts to find a file $name in $path or one of it's ancestor
196directories. If $path is not supplied use $FindBin::Bin.
197
198Not a method.
199
200=cut
201
202sub _find_cfg {
203 my ($name, $path) = @_;
204
205 $path ||= $FindBin::Bin;
206 my $depth = 0;
207 until (-e "$path/$name" || ++$depth > CFG_DEPTH) {
208 $path .= "/..";
209 }
210
211 my $file = "$path/$name";
212 -e $file or return;
213
214 return $file;
215}
216
217=item _load_error($msg)
218
219Displays an error message and exits.
220
221Not a method.
222
223=cut
224
225sub _load_error {
226 my ($msg) = @_;
227
228 print "Content-Type: text/html\n\n";
229 print "<html><head><title>BSE Error</title></head>\n";
230 print "<body>",CGI::escapeHTML($msg),"</body>\n";
231 print "</html>\n";
232 exit;
233}
234
235=item _load_cfg($file)
236
237Does the basic load of the config file.
238
239=cut
240
241sub _load_cfg {
242 my ($class, $file) = @_;
243
244 if ($cache{$file} && $cache{$file}{when} + CACHE_AGE > time) {
245 return $cache{$file};
246 }
247
248 my $section;
249 my %sections;
250 open CFG, "< $file"
251 or _load_error("Cannot open config file $file: $!");
252 while (<CFG>) {
253 chomp;
254 next if /^\s*$/ || /^\s*[#;]/;
255 if (/^\[([^]]+)\]\s*$/) {
256 $section = lc $1;
257 }
258 elsif (/^\s*([^=\s]+)\s*=\s*(.*)$/) {
259 $section or next;
b19047a6 260 $sections{$section}{values}{lc $1} = $2;
531fb3bc 261 $sections{$section}{case}{$1} = $2;
589b789c
TC
262 }
263 }
264 close CFG;
265
266 my $self = bless { config=>\%sections, when=>time }, $class;
267 $cache{$file} = $self;
268
269 return $self;
270}
271
272=item _error($msg)
273
274Error handling for entryErr(). Saves the message and dies.
275
276=cut
277
278sub _error {
279 my ($self, $msg) = @_;
280
281 $self->{error} = $msg;
282 die "$msg\n";
283}
284
285
2861;
287
288=head1 AUTHOR
289
290Tony Cook <tony@develop-help.com>
291
292=cut