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 =item zebraconfig
 315 $serverdir=C4::Context->zebraconfig("biblioserver")->{directory};
 316
 317 returns the zebra server specific details for different zebra servers
 318 similar to C4:Context->config
 319 =cut
 320
 321 sub zebraconfig
 322 {
 323         my $self = shift;
 324         my $var = shift;                # The config variable to return
 325
 326         return undef if !defined($context->{"server"});
 327         # Return the value of the requested config variable
 328         return $context->{"server"}->{$var};
 329 }
 330 =item preference
 331
 332   $sys_preference = C4::Context->preference("some_variable");
 333
 334 Looks up the value of the given system preference in the
 335 systempreferences table of the Koha database, and returns it. If the
 336 variable is not set, or in case of error, returns the undefined value.
 337
 338 =cut
 339
 340 #'
 341 # FIXME - The preferences aren't likely to change over the lifetime of
 342 # the script (and things might break if they did change), so perhaps
 343 # this function should cache the results it finds.
 344 sub preference
 345 {
 346         my $self = shift;
 347         my $var = shift;                # The system preference to return
 348         my $retval;                     # Return value
 349         my $dbh = C4::Context->dbh;     # Database handle
 350         my $sth;                        # Database query handle
 351
 352         # Look up systempreferences.variable==$var
 353         $retval = $dbh->selectrow_array(<<EOT);
 354                 SELECT  value
 355                 FROM    systempreferences
 356                 WHERE   variable='$var'
 357                 LIMIT   1
 358 EOT
 359         return $retval;
 360 }
 361
 362 sub boolean_preference ($) {
 363         my $self = shift;
 364         my $var = shift;                # The system preference to return
 365         my $it = preference($self, $var);
 366         return defined($it)? C4::Boolean::true_p($it): undef;
 367 }
 368
 369 # AUTOLOAD
 370 # This implements C4::Config->foo, and simply returns
 371 # C4::Context->config("foo"), as described in the documentation for
 372 # &config, above.
 373
 374 # FIXME - Perhaps this should be extended to check &config first, and
 375 # then &preference if that fails. OTOH, AUTOLOAD could lead to crappy
 376 # code, so it'd probably be best to delete it altogether so as not to
 377 # encourage people to use it.
 378 sub AUTOLOAD
 379 {
 380         my $self = shift;
 381
 382         $AUTOLOAD =~ s/.*:://;          # Chop off the package name,
 383                                         # leaving only the function name.
 384         return $self->config($AUTOLOAD);
 385 }
 386
 387 =item Zconn
 388
 389 $Zconn = C4::Context->Zconn
 390 $Zconnauth = C4::Context->Zconnauth
 391 Returns a connection to the Zebra database for the current
 392 context. If no connection has yet been made, this method
 393 creates one and connects.
 394
 395 =cut
 396
 397 sub Zconn {
 398         my $self = shift;
 399 my $server=shift;
 400         my $Zconn;
 401       if (defined($context->{"Zconn"})) {
 402             $Zconn = $context->{"Zconn"};
 403                     return $context->{"Zconn"};
 404         } else {
 405                 $context->{"Zconn"} = &new_Zconn($server);
 406                 return $context->{"Zconn"};
 407         }
 408 }
 409
 410 sub Zconnauth {
 411         my $self = shift;
 412 my $server=shift;
 413         my $Zconnauth;
 414          if (defined($context->{"Zconnauth"})) {
 415             $Zconnauth = $context->{"Zconnauth"};
 416                     return $context->{"Zconnauth"};
 417         } else {
 418                 $context->{"Zconnauth"} = &new_Zconnauth($server);
 419                 return $context->{"Zconnauth"};
 420         }
 421 }
 422
 423
 424
 425 =item new_Zconn
 426
 427 Internal helper function. creates a new database connection from
 428 the data given in the current context and returns it.
 429
 430 =cut
 431
 432 sub new_Zconn {
 433 use ZOOM;
 434 my $server=shift;
 435 my $tried==0;
 436 my $Zconn;
 437 my ($tcp,$host,$port)=split /:/,$context->{"listen"}->{$server}->{"content"};
 438
 439 retry:
 440         eval {
 441                 $Zconn=new ZOOM::Connection($context->config("hostname"),$port,databaseName=>$context->{"config"}->{$server},
 442                 preferredRecordSyntax => "USmarc",elementSetName=> "F");
 443         };
 444         if ($@){
 445 ###Uncomment the lines below if you want to automatically restart your zebra if its stop
 446 ###The system call is for Windows it should be changed to unix deamon starting for Unix platforms
 447 #               if ($@->code==10000 && $tried==0){ ##No connection try restarting Zebra
 448 #               $tried==1;
 449 #               my $res=system('sc start "Z39.50 Server" >c:/zebraserver/error.log');
 450 #               goto "retry";
 451 #               }else{
 452                 warn "Error ", $@->code(), ": ", $@->message(), "\n";
 453                 $Zconn="error";
 454                 return $Zconn;
 455 #               }
 456         }
 457
 458         return $Zconn;
 459 }
 460
 461 ## Zebra handler with write permission
 462 sub new_Zconnauth {
 463 use ZOOM;
 464 my $server=shift;
 465 my $tried==0;
 466 my $Zconnauth;
 467 my ($tcp,$host,$port)=split /:/,$context->{"listen"}->{$server}->{"content"};
 468 retry:
 469 eval{
 470  $Zconnauth=new ZOOM::Connection($context->config("hostname"),$port,databaseName=>$context->{"config"}->{$server},
 471                                                 user=>$context->{"config"}->{"zebrauser"},
 472                                                 password=>$context->{"config"}->{"zebrapass"},preferredRecordSyntax => "USmarc",elementSetName=> "F");
 473 };
 474         if ($@){
 475 ###Uncomment the lines below if you want to automatically restart your zebra if its stop
 476 ###The system call is for Windows it should be changed to unix deamon starting for Unix platforms
 477 #               if ($@->code==10000 && $tried==0){ ##No connection try restarting Zebra
 478 #               $tried==1;
 479 #               my $res=system('sc start "Z39.50 Server" >c:/zebraserver/error.log');
 480 #               goto "retry";
 481 #               }else{
 482                 warn "Error ", $@->code(), ": ", $@->message(), "\n";
 483                 $Zconnauth="error";
 484                 return $Zconnauth;
 485 #               }
 486         }
 487         return $Zconnauth;
 488 }
 489
 490
 491 # _new_dbh
 492 # Internal helper function (not a method!). This creates a new
 493 # database connection from the data given in the current context, and
 494 # returns it.
 495 sub _new_dbh
 496 {
 497         ##correct name for db_schme
 498         my $db_driver;
 499         if ($context->config("db_scheme")){
 500         $db_driver=db_scheme2dbi($context->config("db_scheme"));
 501         }else{
 502         $db_driver="mysql";
 503         }
 504
 505         my $db_name   = $context->config("database");
 506         my $db_host   = $context->config("hostname");
 507         my $db_user   = $context->config("user");
 508         my $db_passwd = $context->config("pass");
 509         my $dbh= DBI->connect("DBI:$db_driver:$db_name:$db_host",
 510                             $db_user, $db_passwd);
 511         # Koha 3.0 is utf-8, so force utf8 communication between mySQL and koha, whatever the mysql default config.
 512         # this is better than modifying my.cnf (and forcing all communications to be in utf8)
 513         $dbh->do("set NAMES 'utf8'");
 514         return $dbh;
 515 }
 516
 517 =item dbh
 518
 519   $dbh = C4::Context->dbh;
 520
 521 Returns a database handle connected to the Koha database for the
 522 current context. If no connection has yet been made, this method
 523 creates one, and connects to the database.
 524
 525 This database handle is cached for future use: if you call
 526 C<C4::Context-E<gt>dbh> twice, you will get the same handle both
 527 times. If you need a second database handle, use C<&new_dbh> and
 528 possibly C<&set_dbh>.
 529
 530 =cut
 531
 532 #'
 533 sub dbh
 534 {
 535         my $self = shift;
 536         my $sth;
 537
 538         if (defined($context->{"dbh"})) {
 539             $sth=$context->{"dbh"}->prepare("select 1");
 540             return $context->{"dbh"} if (defined($sth->execute));
 541         }
 542
 543         # No database handle or it died . Create one.
 544         $context->{"dbh"} = &_new_dbh();
 545
 546         return $context->{"dbh"};
 547 }
 548
 549 =item new_dbh
 550
 551   $dbh = C4::Context->new_dbh;
 552
 553 Creates a new connection to the Koha database for the current context,
 554 and returns the database handle (a C<DBI::db> object).
 555
 556 The handle is not saved anywhere: this method is strictly a
 557 convenience function; the point is that it knows which database to
 558 connect to so that the caller doesn't have to know.
 559
 560 =cut
 561
 562 #'
 563 sub new_dbh
 564 {
 565         my $self = shift;
 566
 567         return &_new_dbh();
 568 }
 569
 570 =item set_dbh
 571
 572   $my_dbh = C4::Connect->new_dbh;
 573   C4::Connect->set_dbh($my_dbh);
 574   ...
 575   C4::Connect->restore_dbh;
 576
 577 C<&set_dbh> and C<&restore_dbh> work in a manner analogous to
 578 C<&set_context> and C<&restore_context>.
 579
 580 C<&set_dbh> saves the current database handle on a stack, then sets
 581 the current database handle to C<$my_dbh>.
 582
 583 C<$my_dbh> is assumed to be a good database handle.
 584
 585 =cut
 586
 587 #'
 588 sub set_dbh
 589 {
 590         my $self = shift;
 591         my $new_dbh = shift;
 592
 593         # Save the current database handle on the handle stack.
 594         # We assume that $new_dbh is all good: if the caller wants to
 595         # screw himself by passing an invalid handle, that's fine by
 596         # us.
 597         push @{$context->{"dbh_stack"}}, $context->{"dbh"};
 598         $context->{"dbh"} = $new_dbh;
 599 }
 600
 601 =item restore_dbh
 602
 603   C4::Context->restore_dbh;
 604
 605 Restores the database handle saved by an earlier call to
 606 C<C4::Context-E<gt>set_dbh>.
 607
 608 =cut
 609
 610 #'
 611 sub restore_dbh
 612 {
 613         my $self = shift;
 614
 615         if ($#{$context->{"dbh_stack"}} < 0)
 616         {
 617                 # Stack underflow
 618                 die "DBH stack underflow";
 619         }
 620
 621         # Pop the old database handle and set it.
 622         $context->{"dbh"} = pop @{$context->{"dbh_stack"}};
 623
 624         # FIXME - If it is determined that restore_context should
 625         # return something, then this function should, too.
 626 }
 627
 628 =item marcfromkohafield
 629
 630   $dbh = C4::Context->marcfromkohafield;
 631
 632 Returns a hash with marcfromkohafield.
 633
 634 This hash is cached for future use: if you call
 635 C<C4::Context-E<gt>marcfromkohafield> twice, you will get the same hash without real DB access
 636
 637 =cut
 638
 639 #'
 640 sub marcfromkohafield
 641 {
 642         my $retval = {};
 643
 644         # If the hash already exists, return it.
 645         return $context->{"marcfromkohafield"} if defined($context->{"marcfromkohafield"});
 646
 647         # No hash. Create one.
 648         $context->{"marcfromkohafield"} = &_new_marcfromkohafield();
 649
 650         return $context->{"marcfromkohafield"};
 651 }
 652
 653 # _new_marcfromkohafield
 654 # Internal helper function (not a method!). This creates a new
 655 # hash with stopwords
 656 sub _new_marcfromkohafield
 657 {
 658         my $dbh = C4::Context->dbh;
 659         my $marcfromkohafield;
 660         my $sth = $dbh->prepare("select frameworkcode,kohafield,tagfield,tagsubfield from marc_subfield_structure where kohafield > ''");
 661         $sth->execute;
 662         while (my ($frameworkcode,$kohafield,$tagfield,$tagsubfield) = $sth->fetchrow) {
 663                 my $retval = {};
 664                 $marcfromkohafield->{$frameworkcode}->{$kohafield} = [$tagfield,$tagsubfield];
 665         }
 666         return $marcfromkohafield;
 667 }
 668
 669 =item stopwords
 670
 671   $dbh = C4::Context->stopwords;
 672
 673 Returns a hash with stopwords.
 674
 675 This hash is cached for future use: if you call
 676 C<C4::Context-E<gt>stopwords> twice, you will get the same hash without real DB access
 677
 678 =cut
 679
 680 #'
 681 sub stopwords
 682 {
 683         my $retval = {};
 684
 685         # If the hash already exists, return it.
 686         return $context->{"stopwords"} if defined($context->{"stopwords"});
 687
 688         # No hash. Create one.
 689         $context->{"stopwords"} = &_new_stopwords();
 690
 691         return $context->{"stopwords"};
 692 }
 693
 694 # _new_stopwords
 695 # Internal helper function (not a method!). This creates a new
 696 # hash with stopwords
 697 sub _new_stopwords
 698 {
 699         my $dbh = C4::Context->dbh;
 700         my $stopwordlist;
 701         my $sth = $dbh->prepare("select word from stopwords");
 702         $sth->execute;
 703         while (my $stopword = $sth->fetchrow_array) {
 704                 my $retval = {};
 705                 $stopwordlist->{$stopword} = uc($stopword);
 706         }
 707         $stopwordlist->{A} = "A" unless $stopwordlist;
 708         return $stopwordlist;
 709 }
 710
 711 =item userenv
 712
 713   C4::Context->userenv;
 714
 715 Builds a hash for user environment variables.
 716
 717 This hash shall be cached for future use: if you call
 718 C<C4::Context-E<gt>userenv> twice, you will get the same hash without real DB access
 719
 720 set_userenv is called in Auth.pm
 721
 722 =cut
 723
 724 #'
 725 sub userenv
 726 {
 727         my $var = $context->{"activeuser"};
 728         return $context->{"userenv"}->{$var} if (defined $context->{"userenv"}->{$var});
 729         return 0;
 730         warn "NO CONTEXT for $var";
 731 }
 732
 733 =item set_userenv
 734
 735   C4::Context->set_userenv($usernum, $userid, $usercnum, $userfirstname, $usersurname, $userbranch, $userflags, $emailaddress);
 736
 737 Informs a hash for user environment variables.
 738
 739 This hash shall be cached for future use: if you call
 740 C<C4::Context-E<gt>userenv> twice, you will get the same hash without real DB access
 741
 742 set_userenv is called in Auth.pm
 743
 744 =cut
 745 #'
 746 sub set_userenv{
 747         my ($usernum, $userid, $usercnum, $userfirstname, $usersurname, $userbranch, $branchname, $userflags, $emailaddress,$branchprinter)= @_;
 748         my $var=$context->{"activeuser"};
 749         my $cell = {
 750                 "number"     => $usernum,
 751                 "id"         => $userid,
 752                 "cardnumber" => $usercnum,
 753 #               "firstname"  => $userfirstname,
 754 #               "surname"    => $usersurname,
 755 #possibly a law problem
 756                 "branch"     => $userbranch,
 757                 "branchname" => $branchname,
 758                 "flags"      => $userflags,
 759                 "emailaddress"  => $emailaddress,
 760                 "branchprinter" => $branchprinter,
 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.41  2006/05/20 14:36:09  tgarip1957
 830 # Typo error. Missing '>'
 831 #
 832 # Revision 1.40  2006/05/20 14:28:02  tgarip1957
 833 # Adding support to read zebra database name from config files
 834 #
 835 # Revision 1.39  2006/05/19 09:52:54  alaurin
 836 # committing new feature ip and printer management
 837 # adding two fields in branches table (branchip,branchprinter)
 838 #
 839 # branchip : if the library enter an ip or ip range any librarian that connect from computer in this ip range will be temporarly affected to the corresponding branch .
 840 #
 841 # branchprinter : the library  can select a default printer for a branch
 842 #
 843 # Revision 1.38  2006/05/14 00:22:31  tgarip1957
 844 # Adding support for getting details of different zebra servers
 845 #
 846 # Revision 1.37  2006/05/13 19:51:39  tgarip1957
 847 # Now reads koha.xml rather than koha.conf.
 848 # koha.xml contains both the koha configuration and zebraserver configuration.
 849 # Zebra connection is modified to allow connection to authority zebra as well.
 850 # It will break head if koha.conf is not replaced with koha.xml
 851 #
 852 # Revision 1.36  2006/05/09 13:28:08  tipaul
 853 # adding the branchname and the librarian name in every page :
 854 # - modified userenv to add branchname
 855 # - modifier menus.inc to have the librarian name & userenv displayed on every page. they are in a librarian_information div.
 856 #
 857 # Revision 1.35  2006/04/13 08:40:11  plg
 858 # bug fixed: typo on Zconnauth name
 859 #
 860 # Revision 1.34  2006/04/10 21:40:23  tgarip1957
 861 # 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:
 862 # zebradb=localhost
 863 # zebraport=<your port>
 864 # zebrauser=<username>
 865 # zebrapass=<password>
 866 #
 867 # The zebra.cfg file should read:
 868 # perm.anonymous:r
 869 # perm.username:rw
 870 # passw.c:<yourpasswordfile>
 871 #
 872 # Password file should be prepared with Apaches htpasswd utility in encrypted mode and should exist in a folder zebra.cfg can read
 873 #
 874 # Revision 1.33  2006/03/15 11:21:56  plg
 875 # bug fixed: utf-8 data where not displayed correctly in screens. Supposing
 876 # your data are truely utf-8 encoded in your database, they should be
 877 # correctly displayed. "set names 'UTF8'" on mysql connection (C4/Context.pm)
 878 # is mandatory and "binmode" to utf8 (C4/Interface/CGI/Output.pm) seemed to
 879 # converted data twice, so it was removed.
 880 #
 881 # Revision 1.32  2006/03/03 17:25:01  hdl
 882 # Bug fixing : a line missed a comment sign.
 883 #
 884 # Revision 1.31  2006/03/03 16:45:36  kados
 885 # Remove the search that tests the Zconn -- warning, still no fault
 886 # tollerance
 887 #
 888 # Revision 1.30  2006/02/22 00:56:59  kados
 889 # First go at a connection object for Zebra. You can now get a
 890 # connection object by doing:
 891 #
 892 # my $Zconn = C4::Context->Zconn;
 893 #
 894 # My initial tests indicate that as soon as your funcion ends
 895 # (ie, when you're done doing something) the connection will be
 896 # closed automatically. There may be some other way to make the
 897 # connection more stateful, I'm not sure...
 898 #
 899 # Local Variables:
 900 # tab-width: 4
 901 # End: