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