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 # $Id$
  19
  20 package C4::Context;
  21 use strict;
  22 use DBI;
  23 use C4::Boolean;
  24
  25 use vars qw($VERSION $AUTOLOAD),
  26         qw($context),
  27         qw(@context_stack);
  28
  29 $VERSION = do { my @v = '$Revision$' =~ /\d+/g;
  30                 shift(@v) . "." . join("_", map {sprintf "%03d", $_ } @v); };
  31
  32 =head1 NAME
  33
  34 C4::Context - Maintain and manipulate the context of a Koha script
  35
  36 =head1 SYNOPSIS
  37
  38   use C4::Context;
  39
  40   use C4::Context("/path/to/koha.conf");
  41
  42   $config_value = C4::Context->config("config_variable");
  43   $db_handle = C4::Context->dbh;
  44   $stopwordhash = C4::Context->stopwords;
  45
  46 =head1 DESCRIPTION
  47
  48 When a Koha script runs, it makes use of a certain number of things:
  49 configuration settings in F</etc/koha.conf>, a connection to the Koha
  50 database, and so forth. These things make up the I<context> in which
  51 the script runs.
  52
  53 This module takes care of setting up the context for a script:
  54 figuring out which configuration file to load, and loading it, opening
  55 a connection to the right database, and so forth.
  56
  57 Most scripts will only use one context. They can simply have
  58
  59   use C4::Context;
  60
  61 at the top.
  62
  63 Other scripts may need to use several contexts. For instance, if a
  64 library has two databases, one for a certain collection, and the other
  65 for everything else, it might be necessary for a script to use two
  66 different contexts to search both databases. Such scripts should use
  67 the C<&set_context> and C<&restore_context> functions, below.
  68
  69 By default, C4::Context reads the configuration from
  70 F</etc/koha.conf>. This may be overridden by setting the C<$KOHA_CONF>
  71 environment variable to the pathname of a configuration file to use.
  72
  73 =head1 METHODS
  74
  75 =over 2
  76
  77 =cut
  78 #'
  79 # In addition to what is said in the POD above, a Context object is a
  80 # reference-to-hash with the following fields:
  81 #
  82 # config
  83 #       A reference-to-hash whose keys and values are the
  84 #       configuration variables and values specified in the config
  85 #       file (/etc/koha.conf).
  86 # dbh
  87 #       A handle to the appropriate database for this context.
  88 # dbh_stack
  89 #       Used by &set_dbh and &restore_dbh to hold other database
  90 #       handles for this context.
  91
  92 use constant CONFIG_FNAME => "/etc/koha.conf";
  93                                 # Default config file, if none is specified
  94
  95 $context = undef;               # Initially, no context is set
  96 @context_stack = ();            # Initially, no saved contexts
  97
  98 # read_config_file
  99 # Reads the specified Koha config file. Returns a reference-to-hash
 100 # whose keys are the configuration variables, and whose values are the
 101 # configuration values (duh).
 102 # Returns undef in case of error.
 103 sub read_config_file
 104 {
 105         my $fname = shift;      # Config file to read
 106         my $retval = {};        # Return value: ref-to-hash holding the
 107                                 # configuration
 108
 109         open (CONF, $fname) or return undef;
 110
 111         while (<CONF>)
 112         {
 113                 my $var;                # Variable name
 114                 my $value;              # Variable value
 115
 116                 chomp;
 117                 s/#.*//;                # Strip comments
 118                 next if /^\s*$/;        # Ignore blank lines
 119
 120                 # Look for a line of the form
 121                 #       var = value
 122                 if (!/^\s*(\w+)\s*=\s*(.*?)\s*$/)
 123                 {
 124                         # FIXME - Complain about bogus line
 125                         next;
 126                 }
 127
 128                 # Found a variable assignment
 129                 # FIXME - Ought to complain is this line sets a
 130                 # variable that was already set.
 131                 $var = $1;
 132                 $value = $2;
 133                 $retval->{$var} = $value;
 134         }
 135         close CONF;
 136
 137         return $retval;
 138 }
 139
 140 sub import
 141 {
 142         my $package = shift;
 143         my $conf_fname = shift;         # Config file name
 144         my $context;
 145
 146         # Create a new context from the given config file name, if
 147         # any, then set it as the current context.
 148         $context = new C4::Context($conf_fname);
 149         return undef if !defined($context);
 150         $context->set_context;
 151 }
 152
 153 =item new
 154
 155   $context = new C4::Context;
 156   $context = new C4::Context("/path/to/koha.conf");
 157
 158 Allocates a new context. Initializes the context from the specified
 159 file, which defaults to either the file given by the C<$KOHA_CONF>
 160 environment variable, or F</etc/koha.conf>.
 161
 162 C<&new> does not set this context as the new default context; for
 163 that, use C<&set_context>.
 164
 165 =cut
 166 #'
 167 sub new
 168 {
 169         my $class = shift;
 170         my $conf_fname = shift;         # Config file to load
 171         my $self = {};
 172
 173         # check that the specified config file exists
 174         undef $conf_fname unless (defined $conf_fname && -e $conf_fname);
 175         # Figure out a good config file to load if none was specified.
 176         if (!defined($conf_fname))
 177         {
 178                 # If the $KOHA_CONF environment variable is set, use
 179                 # that. Otherwise, use the built-in default.
 180                 $conf_fname = $ENV{"KOHA_CONF"} ||
 181                                 CONFIG_FNAME;
 182         }
 183         $self->{"config_file"} = $conf_fname;
 184
 185         # Load the desired config file.
 186         $self->{"config"} = &read_config_file($conf_fname);
 187         return undef if !defined($self->{"config"});
 188
 189         $self->{"dbh"} = undef;         # Database handle
 190         $self->{"stopwords"} = undef; # stopwords list
 191
 192         bless $self, $class;
 193         return $self;
 194 }
 195
 196 =item set_context
 197
 198   $context = new C4::Context;
 199   $context->set_context();
 200 or
 201   set_context C4::Context $context;
 202
 203   ...
 204   restore_context C4::Context;
 205
 206 In some cases, it might be necessary for a script to use multiple
 207 contexts. C<&set_context> saves the current context on a stack, then
 208 sets the context to C<$context>, which will be used in future
 209 operations. To restore the previous context, use C<&restore_context>.
 210
 211 =cut
 212 #'
 213 sub set_context
 214 {
 215         my $self = shift;
 216         my $new_context;        # The context to set
 217
 218         # Figure out whether this is a class or instance method call.
 219         #
 220         # We're going to make the assumption that control got here
 221         # through valid means, i.e., that the caller used an instance
 222         # or class method call, and that control got here through the
 223         # usual inheritance mechanisms. The caller can, of course,
 224         # break this assumption by playing silly buggers, but that's
 225         # harder to do than doing it properly, and harder to check
 226         # for.
 227         if (ref($self) eq "")
 228         {
 229                 # Class method. The new context is the next argument.
 230                 $new_context = shift;
 231         } else {
 232                 # Instance method. The new context is $self.
 233                 $new_context = $self;
 234         }
 235
 236         # Save the old context, if any, on the stack
 237         push @context_stack, $context if defined($context);
 238
 239         # Set the new context
 240         $context = $new_context;
 241 }
 242
 243 =item restore_context
 244
 245   &restore_context;
 246
 247 Restores the context set by C<&set_context>.
 248
 249 =cut
 250 #'
 251 sub restore_context
 252 {
 253         my $self = shift;
 254
 255         if ($#context_stack < 0)
 256         {
 257                 # Stack underflow.
 258                 die "Context stack underflow";
 259         }
 260
 261         # Pop the old context and set it.
 262         $context = pop @context_stack;
 263
 264         # FIXME - Should this return something, like maybe the context
 265         # that was current when this was called?
 266 }
 267
 268 =item config
 269
 270   $value = C4::Context->config("config_variable");
 271
 272   $value = C4::Context->config_variable;
 273
 274 Returns the value of a variable specified in the configuration file
 275 from which the current context was created.
 276
 277 The second form is more compact, but of course may conflict with
 278 method names. If there is a configuration variable called "new", then
 279 C<C4::Config-E<gt>new> will not return it.
 280
 281 =cut
 282 #'
 283 sub config
 284 {
 285         my $self = shift;
 286         my $var = shift;                # The config variable to return
 287
 288         return undef if !defined($context->{"config"});
 289                         # Presumably $self->{config} might be
 290                         # undefined if the config file given to &new
 291                         # didn't exist, and the caller didn't bother
 292                         # to check the return value.
 293
 294         # Return the value of the requested config variable
 295         return $context->{"config"}{$var};
 296 }
 297
 298 =item preference
 299
 300   $sys_preference = C4::Context->preference("some_variable");
 301
 302 Looks up the value of the given system preference in the
 303 systempreferences table of the Koha database, and returns it. If the
 304 variable is not set, or in case of error, returns the undefined value.
 305
 306 =cut
 307 #'
 308 # FIXME - The preferences aren't likely to change over the lifetime of
 309 # the script (and things might break if they did change), so perhaps
 310 # this function should cache the results it finds.
 311 sub preference
 312 {
 313         my $self = shift;
 314         my $var = shift;                # The system preference to return
 315         my $retval;                     # Return value
 316         my $dbh = C4::Context->dbh;     # Database handle
 317         my $sth;                        # Database query handle
 318
 319         # Look up systempreferences.variable==$var
 320         $retval = $dbh->selectrow_array(<<EOT);
 321                 SELECT  value
 322                 FROM    systempreferences
 323                 WHERE   variable='$var'
 324                 LIMIT   1
 325 EOT
 326         return $retval;
 327 }
 328
 329 sub boolean_preference ($) {
 330         my $self = shift;
 331         my $var = shift;                # The system preference to return
 332         my $it = preference($self, $var);
 333         return defined($it)? C4::Boolean::true_p($it): undef;
 334 }
 335
 336 # AUTOLOAD
 337 # This implements C4::Config->foo, and simply returns
 338 # C4::Context->config("foo"), as described in the documentation for
 339 # &config, above.
 340
 341 # FIXME - Perhaps this should be extended to check &config first, and
 342 # then &preference if that fails. OTOH, AUTOLOAD could lead to crappy
 343 # code, so it'd probably be best to delete it altogether so as not to
 344 # encourage people to use it.
 345 sub AUTOLOAD
 346 {
 347         my $self = shift;
 348
 349         $AUTOLOAD =~ s/.*:://;          # Chop off the package name,
 350                                         # leaving only the function name.
 351         return $self->config($AUTOLOAD);
 352 }
 353
 354 # _new_dbh
 355 # Internal helper function (not a method!). This creates a new
 356 # database connection from the data given in the current context, and
 357 # returns it.
 358 sub _new_dbh
 359 {
 360         my $db_driver = $context->{"config"}{"db_scheme"} || "mysql";
 361                 # FIXME - It should be possible to use "MySQL" instead
 362                 # of "mysql", "PostgreSQL" instead of "Pg", and so
 363                 # forth.
 364         my $db_name   = $context->{"config"}{"database"};
 365         my $db_host   = $context->{"config"}{"hostname"};
 366         my $db_user   = $context->{"config"}{"user"};
 367         my $db_passwd = $context->{"config"}{"pass"};
 368         return DBI->connect("DBI:$db_driver:$db_name:$db_host",
 369                             $db_user, $db_passwd);
 370 }
 371
 372 =item dbh
 373
 374   $dbh = C4::Context->dbh;
 375
 376 Returns a database handle connected to the Koha database for the
 377 current context. If no connection has yet been made, this method
 378 creates one, and connects to the database.
 379
 380 This database handle is cached for future use: if you call
 381 C<C4::Context-E<gt>dbh> twice, you will get the same handle both
 382 times. If you need a second database handle, use C<&new_dbh> and
 383 possibly C<&set_dbh>.
 384
 385 =cut
 386 #'
 387 sub dbh
 388 {
 389         my $self = shift;
 390
 391         # If there's already a database handle, return it.
 392         return $context->{"dbh"} if defined($context->{"dbh"});
 393
 394         # No database handle yet. Create one.
 395         $context->{"dbh"} = &_new_dbh();
 396
 397         return $context->{"dbh"};
 398 }
 399
 400 =item new_dbh
 401
 402   $dbh = C4::Context->new_dbh;
 403
 404 Creates a new connection to the Koha database for the current context,
 405 and returns the database handle (a C<DBI::db> object).
 406
 407 The handle is not saved anywhere: this method is strictly a
 408 convenience function; the point is that it knows which database to
 409 connect to so that the caller doesn't have to know.
 410
 411 =cut
 412 #'
 413 sub new_dbh
 414 {
 415         my $self = shift;
 416
 417         return &_new_dbh();
 418 }
 419
 420 =item set_dbh
 421
 422   $my_dbh = C4::Connect->new_dbh;
 423   C4::Connect->set_dbh($my_dbh);
 424   ...
 425   C4::Connect->restore_dbh;
 426
 427 C<&set_dbh> and C<&restore_dbh> work in a manner analogous to
 428 C<&set_context> and C<&restore_context>.
 429
 430 C<&set_dbh> saves the current database handle on a stack, then sets
 431 the current database handle to C<$my_dbh>.
 432
 433 C<$my_dbh> is assumed to be a good database handle.
 434
 435 =cut
 436 #'
 437 sub set_dbh
 438 {
 439         my $self = shift;
 440         my $new_dbh = shift;
 441
 442         # Save the current database handle on the handle stack.
 443         # We assume that $new_dbh is all good: if the caller wants to
 444         # screw himself by passing an invalid handle, that's fine by
 445         # us.
 446         push @{$context->{"dbh_stack"}}, $context->{"dbh"};
 447         $context->{"dbh"} = $new_dbh;
 448 }
 449
 450 =item restore_dbh
 451
 452   C4::Context->restore_dbh;
 453
 454 Restores the database handle saved by an earlier call to
 455 C<C4::Context-E<gt>set_dbh>.
 456
 457 =cut
 458 #'
 459 sub restore_dbh
 460 {
 461         my $self = shift;
 462
 463         if ($#{$context->{"dbh_stack"}} < 0)
 464         {
 465                 # Stack underflow
 466                 die "DBH stack underflow";
 467         }
 468
 469         # Pop the old database handle and set it.
 470         $context->{"dbh"} = pop @{$context->{"dbh_stack"}};
 471
 472         # FIXME - If it is determined that restore_context should
 473         # return something, then this function should, too.
 474 }
 475
 476 =item stopwords
 477
 478   $dbh = C4::Context->stopwords;
 479
 480 Returns a hash with stopwords.
 481
 482 This hash is cached for future use: if you call
 483 C<C4::Context-E<gt>stopwords> twice, you will get the same hash without real DB access
 484
 485 =cut
 486 #'
 487 sub stopwords
 488 {
 489         my $retval = {};
 490
 491         # If the hash already exists, return it.
 492         return $context->{"stopwords"} if defined($context->{"stopwords"});
 493
 494         # No hash. Create one.
 495         $context->{"stopwords"} = &_new_stopwords();
 496
 497         return $context->{"stopwords"};
 498 }
 499
 500 # _new_stopwords
 501 # Internal helper function (not a method!). This creates a new
 502 # hash with stopwords
 503 sub _new_stopwords
 504 {
 505         my $dbh = C4::Context->dbh;
 506         my $stopwordlist;
 507         my $sth = $dbh->prepare("select word from stopwords");
 508         $sth->execute;
 509         while (my $stopword = $sth->fetchrow_array) {
 510                 my $retval = {};
 511                 $stopwordlist->{$stopword} = uc($stopword);
 512         }
 513         return $stopwordlist;
 514 }
 515
 516 1;
 517 __END__
 518
 519 =back
 520
 521 =head1 ENVIRONMENT
 522
 523 =over 4
 524
 525 =item C<KOHA_CONF>
 526
 527 Specifies the configuration file to read.
 528
 529 =back
 530
 531 =head1 SEE ALSO
 532
 533 DBI(3)
 534
 535 =head1 AUTHOR
 536
 537 Andrew Arensburger <arensb at ooblick dot com>
 538
 539 =cut