0.11_09 commit
[bse.git] / site / cgi-bin / modules / BSE / Cfg.pm
1 package BSE::Cfg;
2 use strict;
3 use FindBin;
4 use constant MAIN_CFG => 'bse.cfg';
5 use constant CFG_DEPTH => 5; # unused so far
6 use constant CACHE_AGE => 30;
7 use constant VAR_DEPTH => 10;
8
9 my %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
25 Provides a simple configuration file object for BSE.
26
27 Currently just provides access to a single config file, but could
28 later be modified to provide access to one based on the current site,
29 for use in a mod_perl version of BSE.
30
31 =head1 METHODS
32
33 =over
34
35 =item BSE::Cfg->new
36
37 Create a new configuration file object.  Currently takes no
38 parameters, but may do so in the future.
39
40 =cut
41
42 sub new {
43   my ($class, %opts) = @_;
44
45   #my $file = _find_cfg(MAIN_CFG)
46   #  or _load_error("Cannot find config file ".MAIN_CFG);
47   my $file = _find_cfg(MAIN_CFG) || _find_cfg(MAIN_CFG, ".")
48     or return bless { config => {} }, $class;
49
50   return $class->_load_cfg($file);
51 }
52
53 =item entry($section, $key)
54
55 Returns the value of the given $key from section $section.
56
57 If the section or key doesn not exist, return undef.
58
59 =cut
60
61 sub entry {
62   my ($self, $section, $key) = @_;
63
64   $self->{config}{lc $section} 
65     && $self->{config}{lc $section}{values}{lc $key};
66 }
67
68 =item entries($section)
69
70 Returns a keyword/value list of the entries from the given section.
71
72 This can be assigned to a hash by the caller.  There is no particular
73 order to the keys.
74
75 The keys are all lower-case.
76
77 =cut
78
79 sub entries {
80   my ($self, $section) = @_;
81
82   if ($self->{config}{lc $section}) {
83     return %{$self->{config}{lc $section}{values}};
84   }
85   return;
86 }
87
88 =item entriesCS($section)
89
90 Returns a keyword/value list of the entries from the given section.
91
92 This can be assigned to a hash by the caller.  There is no particular
93 order to the keys.
94
95 The keys are in original case.
96
97 =cut
98
99 sub entriesCS {
100   my ($self, $section) = @_;
101
102   if ($self->{config}{lc $section}) {
103     return %{$self->{config}{lc $section}{case}};
104   }
105   return;
106 }
107
108 =item entryErr($section, $key)
109
110 Same as the entry() method, except that it dies if the key or section
111 does not exist.
112
113 =cut
114
115 sub 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
127 Same as the entryErr() method, except that if the value found contains
128 '$(word1/word2)' it is replaced with the value from section 'word1'
129 key 'word2', similarly '$(word1)' is replaced with key 'word1' from
130 the current section.
131
132 This is nested.
133
134 Dies if any key is not found.
135
136 Dies if there are more than 10 levels of variable substitution done.
137
138 =cut
139
140 sub 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
153 =item entryIfVar($section, $key)
154
155 Same as entryVar(), except that it returns undef if there is no value
156 for the given section/key.
157
158 =cut
159
160 sub 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
171 =item entryBool($section, $key, [ $def ])
172
173 =cut
174
175 sub entryBool {
176   my ($self, $section, $key, $def) = @_;
177
178   my $entry = $self->entry($section, $key);
179   if (defined $entry) {
180     return($entry =~ /^(?:yes|true|y|t|1*)$/i);
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
195 Attempts to find a file $name in $path or one of it's ancestor
196 directories.  If $path is not supplied use $FindBin::Bin.
197
198 Not a method.
199
200 =cut
201
202 sub _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
219 Displays an error message and exits.
220
221 Not a method.
222
223 =cut
224
225 sub _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
237 Does the basic load of the config file.
238
239 =cut
240
241 sub _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;
260       $sections{$section}{values}{lc $1} = $2;
261       $sections{$section}{case}{$1} = $2;
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
274 Error handling for entryErr().  Saves the message and dies.
275
276 =cut
277
278 sub _error {
279   my ($self, $msg) = @_;
280
281   $self->{error} = $msg;
282   die "$msg\n";
283 }
284
285
286 1;
287
288 =head1 AUTHOR
289
290 Tony Cook <tony@develop-help.com>
291
292 =cut