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 package C4::Context;
  20 use strict;
  21 use DBI;
  22 use C4::Boolean;
  23 use XML::Simple;
  24 use vars qw($VERSION $AUTOLOAD),
  25         qw($context),
  26         qw(@context_stack);
  27
  28 $VERSION = do { my @v = '$Revision$' =~ /\d+/g;
  29                 shift(@v) . "." . join("_", map {sprintf "%03d", $_ } @v); };
  30
  31 =head1 NAME
  32
  33 C4::Context - Maintain and manipulate the context of a Koha script
  34
  35 =head1 SYNOPSIS
  36
  37   use C4::Context;
  38
  39   use C4::Context("/path/to/koha.xml");
  40
  41   $config_value = C4::Context->config("config_variable");
  42   $db_handle = C4::Context->dbh;
  43   $stopwordhash = C4::Context->stopwords;
  44
  45 =head1 DESCRIPTION
  46
  47 When a Koha script runs, it makes use of a certain number of things:
  48 configuration settings in F</etc/koha.conf>, a connection to the Koha
  49 database, and so forth. These things make up the I<context> in which
  50 the script runs.
  51
  52 This module takes care of setting up the context for a script:
  53 figuring out which configuration file to load, and loading it, opening
  54 a connection to the right database, and so forth.
  55
  56 Most scripts will only use one context. They can simply have
  57
  58   use C4::Context;
  59
  60 at the top.
  61
  62 Other scripts may need to use several contexts. For instance, if a
  63 library has two databases, one for a certain collection, and the other
  64 for everything else, it might be necessary for a script to use two
  65 different contexts to search both databases. Such scripts should use
  66 the C<&set_context> and C<&restore_context> functions, below.
  67
  68 By default, C4::Context reads the configuration from
  69 F</etc/koha.conf>. This may be overridden by setting the C<$KOHA_CONF>
  70 environment variable to the pathname of a configuration file to use.
  71
  72 =head1 METHODS
  73
  74 =over 2
  75
  76 =cut
  77
  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.xml).
  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 # Zconn
  92 #       A connection object for the Zebra server
  93
  94 use constant CONFIG_FNAME => "/etc/koha.xml";
  95                                 # Default config file, if none is specified
  96
  97 $context = undef;               # Initially, no context is set
  98 @context_stack = ();            # Initially, no saved contexts
  99
 100 # read_config_file
 101 # Reads the specified Koha config file. Returns a reference-to-hash
 102 # whose keys are the configuration variables, and whose values are the
 103 # configuration values (duh).
 104 # Returns undef in case of error.
 105 #
 106 # Revision History:
 107 # 2004-08-10 A. Tarallo: Added code that checks if a variable is already
 108 # assigned and prints a message, otherwise create a new entry in the hash to
 109 # be returned.
 110 # Also added code that complaints if finds a line that isn't a variable
 111 # assignmet and skips the line.
 112 # Added a quick hack that makes the translation between the db_schema
 113 # and the DBI driver for that schema.
 114 #
 115 sub read_config_file
 116 {
 117         my $fname = shift;      # Config file to read
 118
 119         my $retval = {};        # Return value: ref-to-hash holding the
 120                                 # configuration
 121
 122 my $koha = XMLin($fname, keyattr => ['id'],forcearray => ['listen']);
 123
 124         return $koha;
 125 }
 126
 127 # db_scheme2dbi
 128 # Translates the full text name of a database into de appropiate dbi name
 129 #
 130 sub db_scheme2dbi
 131 {
 132         my $name = shift;
 133
 134         for ($name) {
 135 # FIXME - Should have other databases.
 136                 if (/mysql/i) { return("mysql"); }
 137                 if (/Postgres|Pg|PostgresSQL/) { return("Pg"); }
 138                 if (/oracle/i) { return("Oracle"); }
 139         }
 140         return undef;           # Just in case
 141 }
 142
 143 sub import
 144 {
 145         my $package = shift;
 146         my $conf_fname = shift;         # Config file name
 147         my $context;
 148
 149         # Create a new context from the given config file name, if
 150         # any, then set it as the current context.
 151         $context = new C4::Context($conf_fname);
 152         return undef if !defined($context);
 153         $context->set_context;
 154 }
 155
 156 =item new
 157
 158   $context = new C4::Context;
 159   $context = new C4::Context("/path/to/koha.conf");
 160
 161 Allocates a new context. Initializes the context from the specified
 162 file, which defaults to either the file given by the C<$KOHA_CONF>
 163 environment variable, or F</etc/koha.conf>.
 164
 165 C<&new> does not set this context as the new default context; for
 166 that, use C<&set_context>.
 167
 168 =cut
 169
 170 #'
 171 # Revision History:
 172 # 2004-08-10 A. Tarallo: Added check if the conf file is not empty
 173 sub new
 174 {
 175         my $class = shift;
 176         my $conf_fname = shift;         # Config file to load
 177         my $self = {};
 178
 179         # check that the specified config file exists and is not empty
 180         undef $conf_fname unless
 181             (defined $conf_fname && -e $conf_fname && -s $conf_fname);
 182         # Figure out a good config file to load if none was specified.
 183         if (!defined($conf_fname))
 184         {
 185                 # If the $KOHA_CONF environment variable is set, use
 186                 # that. Otherwise, use the built-in default.
 187                 $conf_fname = $ENV{"KOHA_CONF"} || CONFIG_FNAME;
 188         }
 189                 # Load the desired config file.
 190         $self = read_config_file($conf_fname);
 191         $self->{"config_file"} = $conf_fname;
 192
 193
 194
 195         warn "read_config_file($conf_fname) returned undef" if !defined($self->{"config"});
 196         return undef if !defined($self->{"config"});
 197
 198         $self->{"dbh"} = undef;         # Database handle
 199         $self->{"Zconn"} = undef;       # Zebra Connection
 200         $self->{"Zconnauth"} = undef;   # Zebra Connection for updating
 201         $self->{"stopwords"} = undef; # stopwords list
 202         $self->{"marcfromkohafield"} = undef; # the hash with relations between koha table fields and MARC field/subfield
 203         $self->{"userenv"} = undef;             # User env
 204         $self->{"activeuser"} = undef;          # current active user
 205
 206         bless $self, $class;
 207         return $self;
 208 }
 209
 210 =item set_context
 211
 212   $context = new C4::Context;
 213   $context->set_context();
 214 or
 215   set_context C4::Context $context;
 216
 217   ...
 218   restore_context C4::Context;
 219
 220 In some cases, it might be necessary for a script to use multiple
 221 contexts. C<&set_context> saves the current context on a stack, then
 222 sets the context to C<$context>, which will be used in future
 223 operations. To restore the previous context, use C<&restore_context>.
 224
 225 =cut
 226
 227 #'
 228 sub set_context
 229 {
 230         my $self = shift;
 231         my $new_context;        # The context to set
 232
 233         # Figure out whether this is a class or instance method call.
 234         #
 235         # We're going to make the assumption that control got here
 236         # through valid means, i.e., that the caller used an instance
 237         # or class method call, and that control got here through the
 238         # usual inheritance mechanisms. The caller can, of course,
 239         # break this assumption by playing silly buggers, but that's
 240         # harder to do than doing it properly, and harder to check
 241         # for.
 242         if (ref($self) eq "")
 243         {
 244                 # Class method. The new context is the next argument.
 245                 $new_context = shift;
 246         } else {
 247                 # Instance method. The new context is $self.
 248                 $new_context = $self;
 249         }
 250
 251         # Save the old context, if any, on the stack
 252         push @context_stack, $context if defined($context);
 253
 254         # Set the new context
 255         $context = $new_context;
 256 }
 257
 258 =item restore_context
 259
 260   &restore_context;
 261
 262 Restores the context set by C<&set_context>.
 263
 264 =cut
 265
 266 #'
 267 sub restore_context
 268 {
 269         my $self = shift;
 270
 271         if ($#context_stack < 0)
 272         {
 273                 # Stack underflow.
 274                 die "Context stack underflow";
 275         }
 276
 277         # Pop the old context and set it.
 278         $context = pop @context_stack;
 279
 280         # FIXME - Should this return something, like maybe the context
 281         # that was current when this was called?
 282 }
 283
 284 =item config
 285
 286   $value = C4::Context->config("config_variable");
 287
 288   $value = C4::Context->config_variable;
 289
 290 Returns the value of a variable specified in the configuration file
 291 from which the current context was created.
 292
 293 The second form is more compact, but of course may conflict with
 294 method names. If there is a configuration variable called "new", then
 295 C<C4::Config-E<gt>new> will not return it.
 296
 297 =cut
 298
 299 #'
 300 sub config
 301 {
 302         my $self = shift;
 303         my $var = shift;                # The config variable to return
 304
 305         return undef if !defined($context->{"config"});
 306                         # Presumably $self->{config} might be
 307                         # undefined if the config file given to &new
 308                         # didn't exist, and the caller didn't bother
 309                         # to check the return value.
 310
 311         # Return the value of the requested config variable
 312         return $context->{"config"}->{$var};
 313 }
 314
 315 =item preference
 316
 317   $sys_preference = C4::Context->preference("some_variable");
 318
 319 Looks up the value of the given system preference in the
 320 systempreferences table of the Koha database, and returns it. If the
 321 variable is not set, or in case of error, returns the undefined value.
 322
 323 =cut
 324
 325 #'
 326 # FIXME - The preferences aren't likely to change over the lifetime of
 327 # the script (and things might break if they did change), so perhaps
 328 # this function should cache the results it finds.
 329 sub preference
 330 {
 331         my $self = shift;
 332         my $var = shift;                # The system preference to return
 333         my $retval;                     # Return value
 334         my $dbh = C4::Context->dbh;     # Database handle
 335         my $sth;                        # Database query handle
 336
 337         # Look up systempreferences.variable==$var
 338         $retval = $dbh->selectrow_array(<<EOT);
 339                 SELECT  value
 340                 FROM    systempreferences
 341                 WHERE   variable='$var'
 342                 LIMIT   1
 343 EOT
 344         return $retval;
 345 }
 346
 347 sub boolean_preference ($) {
 348         my $self = shift;
 349         my $var = shift;                # The system preference to return
 350         my $it = preference($self, $var);
 351         return defined($it)? C4::Boolean::true_p($it): undef;
 352 }
 353
 354 # AUTOLOAD
 355 # This implements C4::Config->foo, and simply returns
 356 # C4::Context->config("foo"), as described in the documentation for
 357 # &config, above.
 358
 359 # FIXME - Perhaps this should be extended to check &config first, and
 360 # then &preference if that fails. OTOH, AUTOLOAD could lead to crappy
 361 # code, so it'd probably be best to delete it altogether so as not to
 362 # encourage people to use it.
 363 sub AUTOLOAD
 364 {
 365         my $self = shift;
 366
 367         $AUTOLOAD =~ s/.*:://;          # Chop off the package name,
 368                                         # leaving only the function name.
 369         return $self->config($AUTOLOAD);
 370 }
 371
 372 =item Zconn
 373
 374 $Zconn = C4::Context->Zconn
 375 $Zconnauth = C4::Context->Zconnauth
 376 Returns a connection to the Zebra database for the current
 377 context. If no connection has yet been made, this method
 378 creates one and connects.
 379
 380 =cut
 381
 382 sub Zconn {
 383         my $self = shift;
 384 my $server=shift;
 385         my $Zconn;
 386       if (defined($context->{"Zconn"})) {
 387             $Zconn = $context->{"Zconn"};
 388                     return $context->{"Zconn"};
 389         } else {
 390                 $context->{"Zconn"} = &new_Zconn($server);
 391                 return $context->{"Zconn"};
 392         }
 393 }
 394
 395 sub Zconnauth {
 396         my $self = shift;
 397 my $server=shift;
 398         my $Zconnauth;
 399          if (defined($context->{"Zconnauth"})) {
 400             $Zconnauth = $context->{"Zconnauth"};
 401                     return $context->{"Zconnauth"};
 402         } else {
 403                 $context->{"Zconnauth"} = &new_Zconnauth($server);
 404                 return $context->{"Zconnauth"};
 405         }
 406 }
 407
 408
 409
 410 =item new_Zconn
 411
 412 Internal helper function. creates a new database connection from
 413 the data given in the current context and returns it.
 414
 415 =cut
 416
 417 sub new_Zconn {
 418 use ZOOM;
 419 my $server=shift;
 420 my $tried==0;
 421 my $Zconn;
 422 my ($tcp,$host,$port)=split /:/,$context->{"listen"}->{$server}->{"content"};
 423
 424 retry:
 425         eval {
 426                 $Zconn=new ZOOM::Connection($context->config("hostname"),$port,
 427                 preferredRecordSyntax => "USmarc",elementSetName=> "F");
 428         };
 429         if ($@){
 430 ###Uncomment the lines below if you want to automatically restart your zebra if its stop
 431 ###The system call is for Windows it should be changed to unix deamon starting for Unix platforms
 432 #               if ($@->code==10000 && $tried==0){ ##No connection try restarting Zebra
 433 #               $tried==1;
 434 #               my $res=system('sc start "Z39.50 Server" >c:/zebraserver/error.log');
 435 #               goto "retry";
 436 #               }else{
 437                 warn "Error ", $@->code(), ": ", $@->message(), "\n";
 438                 $Zconn="error";
 439                 return $Zconn;
 440 #               }
 441         }
 442
 443         return $Zconn;
 444 }
 445
 446 ## Zebra handler with write permission
 447 sub new_Zconnauth {
 448 use ZOOM;
 449 my $server=shift;
 450 my $tried==0;
 451 my $Zconnauth;
 452 my ($tcp,$host,$port)=split /:/,$context->{"listen"}->{$server}->{"content"};
 453 retry:
 454 eval{
 455  $Zconnauth=new ZOOM::Connection($context->config("hostname"),$port,
 456                                                 user=>$context->{"config"}->{"zebrauser"},
 457                                                 password=>$context->{"config"}->{"zebrapass"},preferredRecordSyntax => "USmarc",elementSetName=> "F");
 458 };
 459         if ($@){
 460 ###Uncomment the lines below if you want to automatically restart your zebra if its stop
 461 ###The system call is for Windows it should be changed to unix deamon starting for Unix platforms
 462 #               if ($@->code==10000 && $tried==0){ ##No connection try restarting Zebra
 463 #               $tried==1;
 464 #               my $res=system('sc start "Z39.50 Server" >c:/zebraserver/error.log');
 465 #               goto "retry";
 466 #               }else{
 467                 warn "Error ", $@->code(), ": ", $@->message(), "\n";
 468                 $Zconnauth="error";
 469                 return $Zconnauth;
 470 #               }
 471         }
 472         return $Zconnauth;
 473 }
 474
 475
 476 # _new_dbh
 477 # Internal helper function (not a method!). This creates a new
 478 # database connection from the data given in the current context, and
 479 # returns it.
 480 sub _new_dbh
 481 {
 482         ##correct name for db_schme
 483         my $db_driver;
 484         if ($context->config("db_scheme")){
 485         $db_driver=db_scheme2dbi($context->config("db_scheme"));
 486         }else{
 487         $db_driver="mysql";
 488         }
 489
 490         my $db_name   = $context->config("database");
 491         my $db_host   = $context->config("hostname");
 492         my $db_user   = $context->config("user");
 493         my $db_passwd = $context->config("pass");
 494         my $dbh= DBI->connect("DBI:$db_driver:$db_name:$db_host",
 495                             $db_user, $db_passwd);
 496         # Koha 3.0 is utf-8, so force utf8 communication between mySQL and koha, whatever the mysql default config.
 497         # this is better than modifying my.cnf (and forcing all communications to be in utf8)
 498         $dbh->do("set NAMES 'utf8'");
 499         return $dbh;
 500 }
 501
 502 =item dbh
 503
 504   $dbh = C4::Context->dbh;
 505
 506 Returns a database handle connected to the Koha database for the
 507 current context. If no connection has yet been made, this method
 508 creates one, and connects to the database.
 509
 510 This database handle is cached for future use: if you call
 511 C<C4::Context-E<gt>dbh> twice, you will get the same handle both
 512 times. If you need a second database handle, use C<&new_dbh> and
 513 possibly C<&set_dbh>.
 514
 515 =cut
 516
 517 #'
 518 sub dbh
 519 {
 520         my $self = shift;
 521         my $sth;
 522
 523         if (defined($context->{"dbh"})) {
 524             $sth=$context->{"dbh"}->prepare("select 1");
 525             return $context->{"dbh"} if (defined($sth->execute));
 526         }
 527
 528         # No database handle or it died . Create one.
 529         $context->{"dbh"} = &_new_dbh();
 530
 531         return $context->{"dbh"};
 532 }
 533
 534 =item new_dbh
 535
 536   $dbh = C4::Context->new_dbh;
 537
 538 Creates a new connection to the Koha database for the current context,
 539 and returns the database handle (a C<DBI::db> object).
 540
 541 The handle is not saved anywhere: this method is strictly a
 542 convenience function; the point is that it knows which database to
 543 connect to so that the caller doesn't have to know.
 544
 545 =cut
 546
 547 #'
 548 sub new_dbh
 549 {
 550         my $self = shift;
 551
 552         return &_new_dbh();
 553 }
 554
 555 =item set_dbh
 556
 557   $my_dbh = C4::Connect->new_dbh;
 558   C4::Connect->set_dbh($my_dbh);
 559   ...
 560   C4::Connect->restore_dbh;
 561
 562 C<&set_dbh> and C<&restore_dbh> work in a manner analogous to
 563 C<&set_context> and C<&restore_context>.
 564
 565 C<&set_dbh> saves the current database handle on a stack, then sets
 566 the current database handle to C<$my_dbh>.
 567
 568 C<$my_dbh> is assumed to be a good database handle.
 569
 570 =cut
 571
 572 #'
 573 sub set_dbh
 574 {
 575         my $self = shift;
 576         my $new_dbh = shift;
 577
 578         # Save the current database handle on the handle stack.
 579         # We assume that $new_dbh is all good: if the caller wants to
 580         # screw himself by passing an invalid handle, that's fine by
 581         # us.
 582         push @{$context->{"dbh_stack"}}, $context->{"dbh"};
 583         $context->{"dbh"} = $new_dbh;
 584 }
 585
 586 =item restore_dbh
 587
 588   C4::Context->restore_dbh;
 589
 590 Restores the database handle saved by an earlier call to
 591 C<C4::Context-E<gt>set_dbh>.
 592
 593 =cut
 594
 595 #'
 596 sub restore_dbh
 597 {
 598         my $self = shift;
 599
 600         if ($#{$context->{"dbh_stack"}} < 0)
 601         {
 602                 # Stack underflow
 603                 die "DBH stack underflow";
 604         }
 605
 606         # Pop the old database handle and set it.
 607         $context->{"dbh"} = pop @{$context->{"dbh_stack"}};
 608
 609         # FIXME - If it is determined that restore_context should
 610         # return something, then this function should, too.
 611 }
 612
 613 =item marcfromkohafield
 614
 615   $dbh = C4::Context->marcfromkohafield;
 616
 617 Returns a hash with marcfromkohafield.
 618
 619 This hash is cached for future use: if you call
 620 C<C4::Context-E<gt>marcfromkohafield> twice, you will get the same hash without real DB access
 621
 622 =cut
 623
 624 #'
 625 sub marcfromkohafield
 626 {
 627         my $retval = {};
 628
 629         # If the hash already exists, return it.
 630         return $context->{"marcfromkohafield"} if defined($context->{"marcfromkohafield"});
 631
 632         # No hash. Create one.
 633         $context->{"marcfromkohafield"} = &_new_marcfromkohafield();
 634
 635         return $context->{"marcfromkohafield"};
 636 }
 637
 638 # _new_marcfromkohafield
 639 # Internal helper function (not a method!). This creates a new
 640 # hash with stopwords
 641 sub _new_marcfromkohafield
 642 {
 643         my $dbh = C4::Context->dbh;
 644         my $marcfromkohafield;
 645         my $sth = $dbh->prepare("select frameworkcode,kohafield,tagfield,tagsubfield from marc_subfield_structure where kohafield > ''");
 646         $sth->execute;
 647         while (my ($frameworkcode,$kohafield,$tagfield,$tagsubfield) = $sth->fetchrow) {
 648                 my $retval = {};
 649                 $marcfromkohafield->{$frameworkcode}->{$kohafield} = [$tagfield,$tagsubfield];
 650         }
 651         return $marcfromkohafield;
 652 }
 653
 654 =item stopwords
 655
 656   $dbh = C4::Context->stopwords;
 657
 658 Returns a hash with stopwords.
 659
 660 This hash is cached for future use: if you call
 661 C<C4::Context-E<gt>stopwords> twice, you will get the same hash without real DB access
 662
 663 =cut
 664
 665 #'
 666 sub stopwords
 667 {
 668         my $retval = {};
 669
 670         # If the hash already exists, return it.
 671         return $context->{"stopwords"} if defined($context->{"stopwords"});
 672
 673         # No hash. Create one.
 674         $context->{"stopwords"} = &_new_stopwords();
 675
 676         return $context->{"stopwords"};
 677 }
 678
 679 # _new_stopwords
 680 # Internal helper function (not a method!). This creates a new
 681 # hash with stopwords
 682 sub _new_stopwords
 683 {
 684         my $dbh = C4::Context->dbh;
 685         my $stopwordlist;
 686         my $sth = $dbh->prepare("select word from stopwords");
 687         $sth->execute;
 688         while (my $stopword = $sth->fetchrow_array) {
 689                 my $retval = {};
 690                 $stopwordlist->{$stopword} = uc($stopword);
 691         }
 692         $stopwordlist->{A} = "A" unless $stopwordlist;
 693         return $stopwordlist;
 694 }
 695
 696 =item userenv
 697
 698   C4::Context->userenv;
 699
 700 Builds a hash for user environment variables.
 701
 702 This hash shall be cached for future use: if you call
 703 C<C4::Context-E<gt>userenv> twice, you will get the same hash without real DB access
 704
 705 set_userenv is called in Auth.pm
 706
 707 =cut
 708
 709 #'
 710 sub userenv
 711 {
 712         my $var = $context->{"activeuser"};
 713         return $context->{"userenv"}->{$var} if (defined $context->{"userenv"}->{$var});
 714         return 0;
 715         warn "NO CONTEXT for $var";
 716 }
 717
 718 =item set_userenv
 719
 720   C4::Context->set_userenv($usernum, $userid, $usercnum, $userfirstname, $usersurname, $userbranch, $userflags, $emailaddress);
 721
 722 Informs a hash for user environment variables.
 723
 724 This hash shall be cached for future use: if you call
 725 C<C4::Context-E<gt>userenv> twice, you will get the same hash without real DB access
 726
 727 set_userenv is called in Auth.pm
 728
 729 =cut
 730 #'
 731 sub set_userenv{
 732         my ($usernum, $userid, $usercnum, $userfirstname, $usersurname, $userbranch, $branchname, $userflags, $emailaddress)= @_;
 733         my $var=$context->{"activeuser"};
 734         my $cell = {
 735                 "number"     => $usernum,
 736                 "id"         => $userid,
 737                 "cardnumber" => $usercnum,
 738 #               "firstname"  => $userfirstname,
 739 #               "surname"    => $usersurname,
 740 #possibly a law problem
 741                 "branch"     => $userbranch,
 742                 "branchname" => $branchname,
 743                 "flags"      => $userflags,
 744                 "emailaddress"  => $emailaddress,
 745         };
 746         $context->{userenv}->{$var} = $cell;
 747         return $cell;
 748 }
 749
 750 =item _new_userenv
 751
 752   C4::Context->_new_userenv($session);
 753
 754 Builds a hash for user environment variables.
 755
 756 This hash shall be cached for future use: if you call
 757 C<C4::Context-E<gt>userenv> twice, you will get the same hash without real DB access
 758
 759 _new_userenv is called in Auth.pm
 760
 761 =cut
 762
 763 #'
 764 sub _new_userenv
 765 {
 766         shift;
 767         my ($sessionID)= @_;
 768         $context->{"activeuser"}=$sessionID;
 769 }
 770
 771 =item _unset_userenv
 772
 773   C4::Context->_unset_userenv;
 774
 775 Destroys the hash for activeuser user environment variables.
 776
 777 =cut
 778 #'
 779
 780 sub _unset_userenv
 781 {
 782         my ($sessionID)= @_;
 783         undef $context->{"activeuser"} if ($context->{"activeuser"} eq $sessionID);
 784 }
 785
 786
 787
 788 1;
 789 __END__
 790
 791 =back
 792
 793 =head1 ENVIRONMENT
 794
 795 =over 4
 796
 797 =item C<KOHA_CONF>
 798
 799 Specifies the configuration file to read.
 800
 801 =back
 802
 803 =head1 SEE ALSO
 804
 805 DBI(3)
 806
 807 =head1 AUTHOR
 808
 809 Andrew Arensburger <arensb at ooblick dot com>
 810
 811 =cut
 812 # $Log$
 813 # Revision 1.37  2006/05/13 19:51:39  tgarip1957
 814 # Now reads koha.xml rather than koha.conf.
 815 # koha.xml contains both the koha configuration and zebraserver configuration.
 816 # Zebra connection is modified to allow connection to authority zebra as well.
 817 # It will break head if koha.conf is not replaced with koha.xml
 818 #
 819 # Revision 1.36  2006/05/09 13:28:08  tipaul
 820 # adding the branchname and the librarian name in every page :
 821 # - modified userenv to add branchname
 822 # - modifier menus.inc to have the librarian name & userenv displayed on every page. they are in a librarian_information div.
 823 #
 824 # Revision 1.35  2006/04/13 08:40:11  plg
 825 # bug fixed: typo on Zconnauth name
 826 #
 827 # Revision 1.34  2006/04/10 21:40:23  tgarip1957
 828 # A new handler defined for zebra Zconnauth with read/write permission. Zconnauth should only be called in biblio.pm where write operations are. Use of this handler will break things unless koha.conf contains new variables:
 829 # zebradb=localhost
 830 # zebraport=<your port>
 831 # zebrauser=<username>
 832 # zebrapass=<password>
 833 #
 834 # The zebra.cfg file should read:
 835 # perm.anonymous:r
 836 # perm.username:rw
 837 # passw.c:<yourpasswordfile>
 838 #
 839 # Password file should be prepared with Apaches htpasswd utility in encrypted mode and should exist in a folder zebra.cfg can read
 840 #
 841 # Revision 1.33  2006/03/15 11:21:56  plg
 842 # bug fixed: utf-8 data where not displayed correctly in screens. Supposing
 843 # your data are truely utf-8 encoded in your database, they should be
 844 # correctly displayed. "set names 'UTF8'" on mysql connection (C4/Context.pm)
 845 # is mandatory and "binmode" to utf8 (C4/Interface/CGI/Output.pm) seemed to
 846 # converted data twice, so it was removed.
 847 #
 848 # Revision 1.32  2006/03/03 17:25:01  hdl
 849 # Bug fixing : a line missed a comment sign.
 850 #
 851 # Revision 1.31  2006/03/03 16:45:36  kados
 852 # Remove the search that tests the Zconn -- warning, still no fault
 853 # tollerance
 854 #
 855 # Revision 1.30  2006/02/22 00:56:59  kados
 856 # First go at a connection object for Zebra. You can now get a
 857 # connection object by doing:
 858 #
 859 # my $Zconn = C4::Context->Zconn;
 860 #
 861 # My initial tests indicate that as soon as your funcion ends
 862 # (ie, when you're done doing something) the connection will be
 863 # closed automatically. There may be some other way to make the
 864 # connection more stateful, I'm not sure...
 865 #
 866 # Local Variables:
 867 # tab-width: 4
 868 # End: