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