(added) Module for reading the config file and getting access to the
[koha.git] / C4 / Context.pm
1 # Copyright 2002 Katipo Communications
2 #
3 # This file is part of Koha.
4 #
5 # Koha is free software; you can redistribute it and/or modify it under the
6 # terms of the GNU General Public License as published by the Free Software
7 # Foundation; either version 2 of the License, or (at your option) any later
8 # version.
9 #
10 # Koha is distributed in the hope that it will be useful, but WITHOUT ANY
11 # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
12 # A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
13 #
14 # You should have received a copy of the GNU General Public License along with
15 # Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
16 # Suite 330, Boston, MA  02111-1307 USA
17
18 package C4::Context;
19 use strict;
20 use DBI;
21
22 use vars qw($VERSION $AUTOLOAD),
23         qw($context),
24         qw(@context_stack);
25
26 $VERSION = do { my @v = '$Revision$' =~ /\d+/g;
27                 shift(@v) . "." . join("_", map {sprintf "%03d", $_ } @v); };
28
29 =head1 NAME
30
31 C4::Context - Maintain and manipulate the context of a Koha script
32
33 =head1 SYNOPSIS
34
35   use C4::Context;
36
37   use C4::Context("/path/to/koha.conf");
38
39   $config_value = C4::Context->config("config_variable");
40   $db_handle = C4::Context->dbh;
41
42 =head1 DESCRIPTION
43
44 When a Koha script runs, it makes use of a certain number of things:
45 configuration settings in F</etc/koha.conf>, a connection to the Koha
46 database, and so forth. These things make up the I<context> in which
47 the script runs.
48
49 This module takes care of setting up the context for a script:
50 figuring out which configuration file to load, and loading it, opening
51 a connection to the right database, and so forth.
52
53 Most scripts will only use one context. They can simply have
54
55   use C4::Context;
56
57 at the top.
58
59 Other scripts may need to use several contexts. For instance, if a
60 library has two databases, one for a certain collection, and the other
61 for everything else, it might be necessary for a script to use two
62 different contexts to search both databases. Such scripts should use
63 the C<&set_context> and C<&restore_context> functions, below.
64
65 By default, C4::Context reads the configuration from
66 F</etc/koha.conf>. This may be overridden by setting the C<$KOHA_CONF>
67 environment variable to the pathname of a configuration file to use.
68
69 =head1 METHODS
70
71 =over 2
72
73 =cut
74 #'
75 # In addition to what is said in the POD above, a Context object is a
76 # reference-to-hash with the following fields:
77 #
78 # config
79 #       A reference-to-hash whose keys and values are the
80 #       configuration variables and values specified in the config
81 #       file (/etc/koha.conf).
82 # dbh
83 #       A handle to the appropriate database for this context.
84 # dbh_stack
85 #       Used by &set_dbh and &restore_dbh to hold other database
86 #       handles for this context.
87
88 use constant CONFIG_FNAME => "/etc/koha.conf";
89                                 # Default config file, if none is specified
90
91 $context = undef;               # Initially, no context is set
92 @context_stack = ();            # Initially, no saved contexts
93
94 # read_config_file
95 # Reads the specified Koha config file. Returns a reference-to-hash
96 # whose keys are the configuration variables, and whose values are the
97 # configuration values (duh).
98 # Returns undef in case of error.
99 sub read_config_file
100 {
101         my $fname = shift;      # Config file to read
102         my $retval;             # Return value: ref-to-hash holding the
103                                 # configuration
104
105         open (CONF, $fname) or return undef;
106
107         while (<CONF>)
108         {
109                 my $var;                # Variable name
110                 my $value;              # Variable value
111
112                 chomp;
113                 s/#.*//;                # Strip comments
114                 next if /^\s*$/;        # Ignore blank lines
115
116                 # Look for a line of the form
117                 #       var = value
118                 if (!/^\s*(\w+)\s*=\s*(.*?)\s*$/)
119                 {
120                         # FIXME - Complain about bogus line
121                         next;
122                 }
123
124                 # Found a variable assignment
125                 # FIXME - Ought to complain is this line sets a
126                 # variable that was already set.
127                 $var = $1;
128                 $value = $2;
129                 $retval->{$var} = $value;
130         }
131         close CONF;
132
133         return $retval;
134 }
135
136 sub import
137 {
138         my $package = shift;
139         my $conf_fname = shift;         # Config file name
140         my $context;
141
142         # Create a new context from the given config file name, if
143         # any, then set it as the current context.
144         $context = __PACKAGE__->new($conf_fname);
145         $context->set_context;
146 }
147
148 =item new
149
150   $context = new C4::Context;
151   $context = new C4::Context("/path/to/koha.conf");
152
153 Allocates a new context. Initializes the context from the specified
154 file, which defaults to either the file given by the C<$KOHA_CONF>
155 environment variable, or F</etc/koha.conf>.
156
157 C<&new> does not set this context as the new default context; for
158 that, use C<&set_context>.
159
160 =cut
161 #'
162 sub new
163 {
164         my $class = shift;
165         my $conf_fname = shift;         # Config file to load
166         my $self = {};
167
168         # Figure out a good config file to load if none was specified.
169         if (!defined($conf_fname))
170         {
171                 # If the $KOHA_CONF environment variable is set, use
172                 # that. Otherwise, use the built-in default.
173                 $conf_fname = $ENV{"KOHA_CONF"} ||
174                                 CONFIG_FNAME;
175         }
176
177         $self->{"config_file"} = $conf_fname;
178
179         # Load the desired config file.
180         $self->{"config"} = &read_config_file($conf_fname);
181         return null if !defined($self->{"config"});
182
183         $self->{"dbh"} = undef;         # Database handle
184
185         bless $self, $class;
186         return $self;
187 }
188
189 =item set_context
190
191   $context = new C4::Context;
192   $context->set_context();
193 or
194   set_context C4::Context $context;
195
196   ...
197   restore_context C4::Context;
198
199 In some cases, it might be necessary for a script to use multiple
200 contexts. C<&set_context> saves the current context on a stack, then
201 sets the context to C<$context>, which will be used in future
202 operations. To restore the previous context, use C<&restore_context>.
203
204 =cut
205 #'
206 sub set_context
207 {
208         my $self = shift;
209         my $new_context;        # The context to set
210
211         # Figure out whether this is a class or instance method call.
212         #
213         # We're going to make the assumption that control got here
214         # through valid means, i.e., that the caller used an instance
215         # or class method call, and that control got here through the
216         # usual inheritance mechanisms. The caller can, of course,
217         # break this assumption by playing silly buggers, but that's
218         # harder to do than doing it properly, and harder to check
219         # for.
220         if (ref($self) eq "")
221         {
222                 # Class method. The new context is the next argument.
223                 $new_context = shift;
224         } else {
225                 # Instance method. The new context is $self.
226                 $new_context = $self;
227         }
228
229         # Save the old context, if any, on the stack
230         push @context_stack, $context if defined($context);
231
232         # Set the new context
233         $context = $new_context;
234 }
235
236 =item restore_context
237
238   &restore_context;
239
240 Restores the context set by C<&set_context>.
241
242 =cut
243 #'
244 sub restore_context
245 {
246         my $self = shift;
247
248         if ($#context_stack < 0)
249         {
250                 # Stack underflow.
251                 die "Context stack underflow";
252         }
253
254         # Pop the old context and set it.
255         $context = pop @context_stack;
256
257         # FIXME - Should this return something, like maybe the context
258         # that was current when this was called?
259 }
260
261 =item config
262
263   $value = C4::Config->config("config_variable");
264
265   $value = C4::Config->config_variable;
266
267 Returns the value of a variable specified in the configuration file
268 from which the current context was created.
269
270 The second form is more compact, but of course may conflict with
271 method names. If there is a configuration variable called "new", then
272 C<C4::Config-E<gt>new> will not return it.
273
274 =cut
275 #'
276 sub config
277 {
278         my $self = shift;
279         my $var = shift;                # The config variable to return
280
281         return undef if !defined($context->{"config"});
282                         # Presumably $self->{config} might be
283                         # undefined if the config file given to &new
284                         # didn't exist, and the caller didn't bother
285                         # to check the return value.
286
287         # Return the value of the requested config variable
288         return $context->{"config"}{$var};
289 }
290
291 # AUTOLOAD
292 # This implements C4::Config->foo, and simply returns
293 # C4::Config->config("foo"), as described in the documentation for
294 # &config, above.
295 sub AUTOLOAD
296 {
297         my $self = shift;
298
299         $AUTOLOAD =~ s/.*:://;          # Chop off the package name,
300                                         # leaving only the function name.
301         return $self->config($AUTOLOAD);
302 }
303
304 # _new_dbh
305 # Internal helper function (not a method!). This creates a new
306 # database connection from the data given in the current context, and
307 # returns it.
308 sub _new_dbh
309 {
310         my $db_driver = $context->{"config"}{"db_scheme"} || "mysql";
311         my $db_name   = $context->{"config"}{"database"};
312         my $db_host   = $context->{"config"}{"hostname"};
313         my $db_user   = $context->{"config"}{"user"};
314         my $db_passwd = $context->{"config"}{"pass"};
315
316         return DBI->connect("DBI:$db_driver:$db_name:$db_host",
317                             $db_user, $db_passwd);
318 }
319
320 =item dbh
321
322   $dbh = C4::Context->dbh;
323
324 Returns a database handle connected to the Koha database for the
325 current context. If no connection has yet been made, this method
326 creates one, and connects to the database.
327
328 This database handle is cached for future use: if you call
329 C<C4::Context-E<gt>dbh> twice, you will get the same handle both
330 times. If you need a second database handle, use C<&new_dbh> and
331 possibly C<&set_dbh>.
332
333 =cut
334 #'
335 sub dbh
336 {
337         my $self = shift;
338
339         # If there's already a database handle, return it.
340         return $context->{"dbh"} if defined($context->{"dbh"});
341
342         # No database handle yet. Create one.
343         $context->{"dbh"} = &_new_dbh();
344
345         return $context->{"dbh"};
346 }
347
348 =item new_dbh
349
350   $dbh = C4::Context->new_dbh;
351
352 Creates a new connection to the Koha database for the current context,
353 and returns the database handle (a C<DBI::db> object).
354
355 The handle is not saved anywhere: this method is strictly a
356 convenience function; the point is that it knows which database to
357 connect to so that the caller doesn't have to know.
358
359 =cut
360 #'
361 sub new_dbh
362 {
363         my $self = shift;
364
365         return &_new_dbh();
366 }
367
368 =item set_dbh
369
370   $my_dbh = C4::Connect->new_dbh;
371   C4::Connect->set_dbh($my_dbh);
372   ...
373   C4::Connect->restore_dbh;
374
375 C<&set_dbh> and C<&restore_dbh> work in a manner analogous to
376 C<&set_context> and C<&restore_context>.
377
378 C<&set_dbh> saves the current database handle on a stack, then sets
379 the current database handle to C<$my_dbh>.
380
381 C<$my_dbh> is assumed to be a good database handle.
382
383 =cut
384 #'
385 sub set_dbh
386 {
387         my $self = shift;
388         my $new_dbh = shift;
389
390         # Save the current database handle on the handle stack.
391         # We assume that $new_dbh is all good: if the caller wants to
392         # screw himself by passing an invalid handle, that's fine by
393         # us.
394         push @{$context->{"dbh_stack"}}, $context->{"dbh"};
395         $context->{"dbh"} = $new_dbh;
396 }
397
398 =item restore_dbh
399
400   C4::Context->restore_dbh;
401
402 Restores the database handle saved by an earlier call to
403 C<C4::Context-E<gt>set_dbh>.
404
405 =cut
406 #'
407 sub restore_dbh
408 {
409         my $self = shift;
410
411         if ($#{$context->{"dbh_stack"}} < 0)
412         {
413                 # Stack underflow
414                 die "DBH stack underflow";
415         }
416
417         # Pop the old database handle and set it.
418         $context->{"dbh"} = pop @{$context->{"dbh_stack"}};
419
420         # FIXME - If it is determined that restore_context should
421         # return something, then this function should, too.
422 }
423
424 1;
425 __END__
426 =back
427
428 =head1 ENVIRONMENT
429
430 =over 4
431
432 =item C<KOHA_CONF>
433
434 Specifies the configuration file to read.
435
436 =back
437
438 =head1 SEE ALSO
439
440 L<DBI(3)|DBI>
441
442 =head1 AUTHOR
443
444 Andrew Arensburger
445
446 =cut