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.xml>, a connection to the Koha
  49 databases, 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.xml>. 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.xml");
 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.xml>.
 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="biblioserver"; #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         $Zconn->option(cqlfile=> $context->{"config"}->{"zebradir"}."/etc/cql.properties");
 444         $Zconn->option(cclfile=> $context->{"config"}->{"zebradir"}."/etc/ccl.properties");
 445         };
 446         if ($@){
 447 ###Uncomment the lines below if you want to automatically restart your zebra if its stop
 448 ###The system call is for Windows it should be changed to unix deamon starting for Unix platforms
 449 #               if ($@->code==10000 && $tried==0){ ##No connection try restarting Zebra
 450 #               $tried==1;
 451 #               my $res=system('sc start "Z39.50 Server" >c:/zebraserver/error.log');
 452 #               goto "retry";
 453 #               }else{
 454                 warn "Error ", $@->code(), ": ", $@->message(), "\n";
 455                 $Zconn="error";
 456                 return $Zconn;
 457 #               }
 458         }
 459
 460         return $Zconn;
 461 }
 462
 463 ## Zebra handler with write permission
 464 sub new_Zconnauth {
 465 use ZOOM;
 466 my $server=shift;
 467 my $tried=0;
 468 my $Zconnauth;
 469 my ($tcp,$host,$port)=split /:/,$context->{"listen"}->{$server}->{"content"};
 470         my $o = new ZOOM::Options();
 471         $o->option(async => 1);
 472         $o->option(preferredRecordSyntax => "usmarc");
 473         $o->option(elementSetName => "F");
 474         $o->option(user=>$context->{"config"}->{"zebrauser"});
 475         $o->option(password=>$context->{"config"}->{"zebrapass"});
 476         $o->option(databaseName=>$context->{"config"}->{$server});
 477
 478 retry:
 479 eval{
 480  $Zconnauth=new ZOOM::Connection($context->config("hostname"),$port,databaseName=>$context->{"config"}->{$server},
 481                                                 user=>$context->{"config"}->{"zebrauser"},
 482                                                 password=>$context->{"config"}->{"zebrapass"},preferredRecordSyntax => "USmarc",elementSetName=> "F");
 483 };
 484         if ($@){
 485 ###Uncomment the lines below if you want to automatically restart your zebra if its stop
 486 ###The system call is for Windows it should be changed to unix deamon starting for Unix platforms
 487 #               if ($@->code==10000 && $tried==0){ ##No connection try restarting Zebra
 488 #               $tried==1;
 489 #               my $res=system('sc start "Z39.50 Server" >c:/zebraserver/error.log');
 490 #               goto "retry";
 491 #               }else{
 492                 warn "Error ", $@->code(), ": ", $@->message(), "\n";
 493                 $Zconnauth="error";
 494                 return $Zconnauth;
 495 #               }
 496         }
 497         return $Zconnauth;
 498 }
 499
 500
 501 # _new_dbh
 502 # Internal helper function (not a method!). This creates a new
 503 # database connection from the data given in the current context, and
 504 # returns it.
 505 sub _new_dbh
 506 {
 507         ##correct name for db_schme
 508         my $db_driver;
 509         if ($context->config("db_scheme")){
 510         $db_driver=db_scheme2dbi($context->config("db_scheme"));
 511         }else{
 512         $db_driver="mysql";
 513         }
 514
 515         my $db_name   = $context->config("database");
 516         my $db_host   = $context->config("hostname");
 517         my $db_user   = $context->config("user");
 518         my $db_passwd = $context->config("pass");
 519         my $dbh= DBI->connect("DBI:$db_driver:$db_name:$db_host",
 520                             $db_user, $db_passwd);
 521         # Koha 3.0 is utf-8, so force utf8 communication between mySQL and koha, whatever the mysql default config.
 522         # this is better than modifying my.cnf (and forcing all communications to be in utf8)
 523         $dbh->do("set NAMES 'utf8'");
 524         return $dbh;
 525 }
 526
 527 =item dbh
 528
 529   $dbh = C4::Context->dbh;
 530
 531 Returns a database handle connected to the Koha database for the
 532 current context. If no connection has yet been made, this method
 533 creates one, and connects to the database.
 534
 535 This database handle is cached for future use: if you call
 536 C<C4::Context-E<gt>dbh> twice, you will get the same handle both
 537 times. If you need a second database handle, use C<&new_dbh> and
 538 possibly C<&set_dbh>.
 539
 540 =cut
 541
 542 #'
 543 sub dbh
 544 {
 545         my $self = shift;
 546         my $sth;
 547
 548         if (defined($context->{"dbh"})) {
 549             $sth=$context->{"dbh"}->prepare("select 1");
 550             return $context->{"dbh"} if (defined($sth->execute));
 551         }
 552
 553         # No database handle or it died . Create one.
 554         $context->{"dbh"} = &_new_dbh();
 555
 556         return $context->{"dbh"};
 557 }
 558
 559 =item new_dbh
 560
 561   $dbh = C4::Context->new_dbh;
 562
 563 Creates a new connection to the Koha database for the current context,
 564 and returns the database handle (a C<DBI::db> object).
 565
 566 The handle is not saved anywhere: this method is strictly a
 567 convenience function; the point is that it knows which database to
 568 connect to so that the caller doesn't have to know.
 569
 570 =cut
 571
 572 #'
 573 sub new_dbh
 574 {
 575         my $self = shift;
 576
 577         return &_new_dbh();
 578 }
 579
 580 =item set_dbh
 581
 582   $my_dbh = C4::Connect->new_dbh;
 583   C4::Connect->set_dbh($my_dbh);
 584   ...
 585   C4::Connect->restore_dbh;
 586
 587 C<&set_dbh> and C<&restore_dbh> work in a manner analogous to
 588 C<&set_context> and C<&restore_context>.
 589
 590 C<&set_dbh> saves the current database handle on a stack, then sets
 591 the current database handle to C<$my_dbh>.
 592
 593 C<$my_dbh> is assumed to be a good database handle.
 594
 595 =cut
 596
 597 #'
 598 sub set_dbh
 599 {
 600         my $self = shift;
 601         my $new_dbh = shift;
 602
 603         # Save the current database handle on the handle stack.
 604         # We assume that $new_dbh is all good: if the caller wants to
 605         # screw himself by passing an invalid handle, that's fine by
 606         # us.
 607         push @{$context->{"dbh_stack"}}, $context->{"dbh"};
 608         $context->{"dbh"} = $new_dbh;
 609 }
 610
 611 =item restore_dbh
 612
 613   C4::Context->restore_dbh;
 614
 615 Restores the database handle saved by an earlier call to
 616 C<C4::Context-E<gt>set_dbh>.
 617
 618 =cut
 619
 620 #'
 621 sub restore_dbh
 622 {
 623         my $self = shift;
 624
 625         if ($#{$context->{"dbh_stack"}} < 0)
 626         {
 627                 # Stack underflow
 628                 die "DBH stack underflow";
 629         }
 630
 631         # Pop the old database handle and set it.
 632         $context->{"dbh"} = pop @{$context->{"dbh_stack"}};
 633
 634         # FIXME - If it is determined that restore_context should
 635         # return something, then this function should, too.
 636 }
 637
 638 =item marcfromkohafield
 639
 640   $dbh = C4::Context->marcfromkohafield;
 641
 642 Returns a hash with marcfromkohafield.
 643
 644 This hash is cached for future use: if you call
 645 C<C4::Context-E<gt>marcfromkohafield> twice, you will get the same hash without real DB access
 646
 647 =cut
 648
 649 #'
 650 sub marcfromkohafield
 651 {
 652         my $retval = {};
 653
 654         # If the hash already exists, return it.
 655         return $context->{"marcfromkohafield"} if defined($context->{"marcfromkohafield"});
 656
 657         # No hash. Create one.
 658         $context->{"marcfromkohafield"} = &_new_marcfromkohafield();
 659
 660         return $context->{"marcfromkohafield"};
 661 }
 662
 663 # _new_marcfromkohafield
 664 # Internal helper function (not a method!). This creates a new
 665 # hash with stopwords
 666 sub _new_marcfromkohafield
 667 {
 668         my $dbh = C4::Context->dbh;
 669         my $marcfromkohafield;
 670         my $sth = $dbh->prepare("select frameworkcode,kohafield,tagfield,tagsubfield from marc_subfield_structure where kohafield > ''");
 671         $sth->execute;
 672         while (my ($frameworkcode,$kohafield,$tagfield,$tagsubfield) = $sth->fetchrow) {
 673                 my $retval = {};
 674                 $marcfromkohafield->{$frameworkcode}->{$kohafield} = [$tagfield,$tagsubfield];
 675         }
 676         return $marcfromkohafield;
 677 }
 678
 679 =item stopwords
 680
 681   $dbh = C4::Context->stopwords;
 682
 683 Returns a hash with stopwords.
 684
 685 This hash is cached for future use: if you call
 686 C<C4::Context-E<gt>stopwords> twice, you will get the same hash without real DB access
 687
 688 =cut
 689
 690 #'
 691 sub stopwords
 692 {
 693         my $retval = {};
 694
 695         # If the hash already exists, return it.
 696         return $context->{"stopwords"} if defined($context->{"stopwords"});
 697
 698         # No hash. Create one.
 699         $context->{"stopwords"} = &_new_stopwords();
 700
 701         return $context->{"stopwords"};
 702 }
 703
 704 # _new_stopwords
 705 # Internal helper function (not a method!). This creates a new
 706 # hash with stopwords
 707 sub _new_stopwords
 708 {
 709         my $dbh = C4::Context->dbh;
 710         my $stopwordlist;
 711         my $sth = $dbh->prepare("select word from stopwords");
 712         $sth->execute;
 713         while (my $stopword = $sth->fetchrow_array) {
 714                 my $retval = {};
 715                 $stopwordlist->{$stopword} = uc($stopword);
 716         }
 717         $stopwordlist->{A} = "A" unless $stopwordlist;
 718         return $stopwordlist;
 719 }
 720
 721 =item userenv
 722
 723   C4::Context->userenv;
 724
 725 Builds a hash for user environment variables.
 726
 727 This hash shall be cached for future use: if you call
 728 C<C4::Context-E<gt>userenv> twice, you will get the same hash without real DB access
 729
 730 set_userenv is called in Auth.pm
 731
 732 =cut
 733
 734 #'
 735 sub userenv
 736 {
 737         my $var = $context->{"activeuser"};
 738         return $context->{"userenv"}->{$var} if (defined $context->{"userenv"}->{$var});
 739         return 0;
 740         warn "NO CONTEXT for $var";
 741 }
 742
 743 =item set_userenv
 744
 745   C4::Context->set_userenv($usernum, $userid, $usercnum, $userfirstname, $usersurname, $userbranch, $userflags, $emailaddress);
 746
 747 Informs a hash for user environment variables.
 748
 749 This hash shall be cached for future use: if you call
 750 C<C4::Context-E<gt>userenv> twice, you will get the same hash without real DB access
 751
 752 set_userenv is called in Auth.pm
 753
 754 =cut
 755 #'
 756 sub set_userenv{
 757         my ($usernum, $userid, $usercnum, $userfirstname, $usersurname, $userbranch, $branchname, $userflags, $emailaddress,$branchprinter)= @_;
 758         my $var=$context->{"activeuser"};
 759         my $cell = {
 760                 "number"     => $usernum,
 761                 "id"         => $userid,
 762                 "cardnumber" => $usercnum,
 763 #               "firstname"  => $userfirstname,
 764 #               "surname"    => $usersurname,
 765 #possibly a law problem
 766                 "branch"     => $userbranch,
 767                 "branchname" => $branchname,
 768                 "flags"      => $userflags,
 769                 "emailaddress"  => $emailaddress,
 770                 "branchprinter" => $branchprinter,
 771         };
 772         $context->{userenv}->{$var} = $cell;
 773         return $cell;
 774 }
 775
 776 =item _new_userenv
 777
 778   C4::Context->_new_userenv($session);
 779
 780 Builds a hash for user environment variables.
 781
 782 This hash shall be cached for future use: if you call
 783 C<C4::Context-E<gt>userenv> twice, you will get the same hash without real DB access
 784
 785 _new_userenv is called in Auth.pm
 786
 787 =cut
 788
 789 #'
 790 sub _new_userenv
 791 {
 792         shift;
 793         my ($sessionID)= @_;
 794         $context->{"activeuser"}=$sessionID;
 795 }
 796
 797 =item _unset_userenv
 798
 799   C4::Context->_unset_userenv;
 800
 801 Destroys the hash for activeuser user environment variables.
 802
 803 =cut
 804 #'
 805
 806 sub _unset_userenv
 807 {
 808         my ($sessionID)= @_;
 809         undef $context->{"activeuser"} if ($context->{"activeuser"} eq $sessionID);
 810 }
 811
 812
 813
 814 1;
 815 __END__
 816
 817 =back
 818
 819 =head1 ENVIRONMENT
 820
 821 =over 4
 822
 823 =item C<KOHA_CONF>
 824
 825 Specifies the configuration file to read.
 826
 827 =back
 828
 829 =head1 SEE ALSO
 830
 831 DBI(3)
 832
 833 =head1 AUTHOR
 834
 835 Andrew Arensburger <arensb at ooblick dot com>
 836
 837 =cut
 838 # $Log$
 839 # Revision 1.43  2006/08/10 12:49:37  toins
 840 # sync with dev_week.
 841 #
 842 # Revision 1.42  2006/07/04 14:36:51  toins
 843 # Head & rel_2_2 merged
 844 #
 845 # Revision 1.41  2006/05/20 14:36:09  tgarip1957
 846 # Typo error. Missing '>'
 847 #
 848 # Revision 1.40  2006/05/20 14:28:02  tgarip1957
 849 # Adding support to read zebra database name from config files
 850 #
 851 # Revision 1.39  2006/05/19 09:52:54  alaurin
 852 # committing new feature ip and printer management
 853 # adding two fields in branches table (branchip,branchprinter)
 854 #
 855 # 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 .
 856 #
 857 # branchprinter : the library  can select a default printer for a branch
 858 #
 859 # Revision 1.38  2006/05/14 00:22:31  tgarip1957
 860 # Adding support for getting details of different zebra servers
 861 #
 862 # Revision 1.37  2006/05/13 19:51:39  tgarip1957
 863 # Now reads koha.xml rather than koha.conf.
 864 # koha.xml contains both the koha configuration and zebraserver configuration.
 865 # Zebra connection is modified to allow connection to authority zebra as well.
 866 # It will break head if koha.conf is not replaced with koha.xml
 867 #
 868 # Revision 1.36  2006/05/09 13:28:08  tipaul
 869 # adding the branchname and the librarian name in every page :
 870 # - modified userenv to add branchname
 871 # - modifier menus.inc to have the librarian name & userenv displayed on every page. they are in a librarian_information div.
 872 #
 873 # Revision 1.35  2006/04/13 08:40:11  plg
 874 # bug fixed: typo on Zconnauth name
 875 #
 876 # Revision 1.34  2006/04/10 21:40:23  tgarip1957
 877 # 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:
 878 # zebradb=localhost
 879 # zebraport=<your port>
 880 # zebrauser=<username>
 881 # zebrapass=<password>
 882 #
 883 # The zebra.cfg file should read:
 884 # perm.anonymous:r
 885 # perm.username:rw
 886 # passw.c:<yourpasswordfile>
 887 #
 888 # Password file should be prepared with Apaches htpasswd utility in encrypted mode and should exist in a folder zebra.cfg can read
 889 #
 890 # Revision 1.33  2006/03/15 11:21:56  plg
 891 # bug fixed: utf-8 data where not displayed correctly in screens. Supposing
 892 # your data are truely utf-8 encoded in your database, they should be
 893 # correctly displayed. "set names 'UTF8'" on mysql connection (C4/Context.pm)
 894 # is mandatory and "binmode" to utf8 (C4/Interface/CGI/Output.pm) seemed to
 895 # converted data twice, so it was removed.
 896 #
 897 # Revision 1.32  2006/03/03 17:25:01  hdl
 898 # Bug fixing : a line missed a comment sign.
 899 #
 900 # Revision 1.31  2006/03/03 16:45:36  kados
 901 # Remove the search that tests the Zconn -- warning, still no fault
 902 # tollerance
 903 #
 904 # Revision 1.30  2006/02/22 00:56:59  kados
 905 # First go at a connection object for Zebra. You can now get a
 906 # connection object by doing:
 907 #
 908 # my $Zconn = C4::Context->Zconn;
 909 #
 910 # My initial tests indicate that as soon as your funcion ends
 911 # (ie, when you're done doing something) the connection will be
 912 # closed automatically. There may be some other way to make the
 913 # connection more stateful, I'm not sure...
 914 #
 915 # Local Variables:
 916 # tab-width: 4
 917 # End: