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 C4::UTF8DBI;
  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->{"attrfromkohafield"} = undef; # the hash with relations between koha table fields and Bib1-attributes
 204         $self->{"userenv"} = undef;             # User env
 205         $self->{"activeuser"} = undef;          # current active user
 206
 207         bless $self, $class;
 208         return $self;
 209 }
 210
 211 =item set_context
 212
 213   $context = new C4::Context;
 214   $context->set_context();
 215 or
 216   set_context C4::Context $context;
 217
 218   ...
 219   restore_context C4::Context;
 220
 221 In some cases, it might be necessary for a script to use multiple
 222 contexts. C<&set_context> saves the current context on a stack, then
 223 sets the context to C<$context>, which will be used in future
 224 operations. To restore the previous context, use C<&restore_context>.
 225
 226 =cut
 227
 228 #'
 229 sub set_context
 230 {
 231         my $self = shift;
 232         my $new_context;        # The context to set
 233
 234         # Figure out whether this is a class or instance method call.
 235         #
 236         # We're going to make the assumption that control got here
 237         # through valid means, i.e., that the caller used an instance
 238         # or class method call, and that control got here through the
 239         # usual inheritance mechanisms. The caller can, of course,
 240         # break this assumption by playing silly buggers, but that's
 241         # harder to do than doing it properly, and harder to check
 242         # for.
 243         if (ref($self) eq "")
 244         {
 245                 # Class method. The new context is the next argument.
 246                 $new_context = shift;
 247         } else {
 248                 # Instance method. The new context is $self.
 249                 $new_context = $self;
 250         }
 251
 252         # Save the old context, if any, on the stack
 253         push @context_stack, $context if defined($context);
 254
 255         # Set the new context
 256         $context = $new_context;
 257 }
 258
 259 =item restore_context
 260
 261   &restore_context;
 262
 263 Restores the context set by C<&set_context>.
 264
 265 =cut
 266
 267 #'
 268 sub restore_context
 269 {
 270         my $self = shift;
 271
 272         if ($#context_stack < 0)
 273         {
 274                 # Stack underflow.
 275                 die "Context stack underflow";
 276         }
 277
 278         # Pop the old context and set it.
 279         $context = pop @context_stack;
 280
 281         # FIXME - Should this return something, like maybe the context
 282         # that was current when this was called?
 283 }
 284
 285 =item config
 286
 287   $value = C4::Context->config("config_variable");
 288
 289   $value = C4::Context->config_variable;
 290
 291 Returns the value of a variable specified in the configuration file
 292 from which the current context was created.
 293
 294 The second form is more compact, but of course may conflict with
 295 method names. If there is a configuration variable called "new", then
 296 C<C4::Config-E<gt>new> will not return it.
 297
 298 =cut
 299
 300 #'
 301 sub config
 302 {
 303         my $self = shift;
 304         my $var = shift;                # The config variable to return
 305
 306         return undef if !defined($context->{"config"});
 307                         # Presumably $self->{config} might be
 308                         # undefined if the config file given to &new
 309                         # didn't exist, and the caller didn't bother
 310                         # to check the return value.
 311
 312         # Return the value of the requested config variable
 313         return $context->{"config"}->{$var};
 314 }
 315 =item zebraconfig
 316 $serverdir=C4::Context->zebraconfig("biblioserver")->{directory};
 317
 318 returns the zebra server specific details for different zebra servers
 319 similar to C4:Context->config
 320 =cut
 321
 322 sub zebraconfig
 323 {
 324         my $self = shift;
 325         my $var = shift;                # The config variable to return
 326
 327         return undef if !defined($context->{"server"});
 328         # Return the value of the requested config variable
 329         return $context->{"server"}->{$var};
 330 }
 331 =item preference
 332
 333   $sys_preference = C4::Context->preference("some_variable");
 334
 335 Looks up the value of the given system preference in the
 336 systempreferences table of the Koha database, and returns it. If the
 337 variable is not set, or in case of error, returns the undefined value.
 338
 339 =cut
 340
 341 #'
 342 # FIXME - The preferences aren't likely to change over the lifetime of
 343 # the script (and things might break if they did change), so perhaps
 344 # this function should cache the results it finds.
 345 sub preference
 346 {
 347         my $self = shift;
 348         my $var = shift;                # The system preference to return
 349         my $retval;                     # Return value
 350         my $dbh = C4::Context->dbh;     # Database handle
 351         my $sth;                        # Database query handle
 352
 353         # Look up systempreferences.variable==$var
 354         $retval = $dbh->selectrow_array(<<EOT);
 355                 SELECT  value
 356                 FROM    systempreferences
 357                 WHERE   variable='$var'
 358                 LIMIT   1
 359 EOT
 360         return $retval;
 361 }
 362
 363 sub boolean_preference ($) {
 364         my $self = shift;
 365         my $var = shift;                # The system preference to return
 366         my $it = preference($self, $var);
 367         return defined($it)? C4::Boolean::true_p($it): undef;
 368 }
 369
 370 # AUTOLOAD
 371 # This implements C4::Config->foo, and simply returns
 372 # C4::Context->config("foo"), as described in the documentation for
 373 # &config, above.
 374
 375 # FIXME - Perhaps this should be extended to check &config first, and
 376 # then &preference if that fails. OTOH, AUTOLOAD could lead to crappy
 377 # code, so it'd probably be best to delete it altogether so as not to
 378 # encourage people to use it.
 379 sub AUTOLOAD
 380 {
 381         my $self = shift;
 382
 383         $AUTOLOAD =~ s/.*:://;          # Chop off the package name,
 384                                         # leaving only the function name.
 385         return $self->config($AUTOLOAD);
 386 }
 387
 388 =item Zconn
 389
 390 $Zconn = C4::Context->Zconn
 391 $Zconnauth = C4::Context->Zconnauth
 392 Returns a connection to the Zebra database for the current
 393 context. If no connection has yet been made, this method
 394 creates one and connects.
 395
 396 =cut
 397
 398 sub Zconn {
 399         my $self = shift;
 400 my $server=shift;
 401 my $syntax=shift;
 402         my $Zconn;
 403         $context->{"Zconn"} = &new_Zconn($server,$syntax);
 404         return $context->{"Zconn"};
 405
 406 }
 407
 408 sub Zconnauth {
 409         my $self = shift;
 410 my $server=shift;
 411 my $syntax=shift;
 412         my $Zconnauth;
 413 ##We destroy each connection made so create a new one
 414                 $context->{"Zconnauth"} = &new_Zconnauth($server,$syntax);
 415                 return $context->{"Zconnauth"};
 416
 417 }
 418
 419
 420
 421 =item new_Zconn
 422
 423 Internal helper function. creates a new database connection from
 424 the data given in the current context and returns it.
 425
 426 =cut
 427
 428 sub new_Zconn {
 429 use ZOOM;
 430 my $server=shift;
 431 my $syntax=shift;
 432 $syntax="xml" unless $syntax;
 433 my $Zconn;
 434 my ($tcp,$host,$port)=split /:/,$context->{"listen"}->{$server}->{"content"};
 435 my $o = new ZOOM::Options();
 436 $o->option(async => 1);
 437 $o->option(preferredRecordSyntax => $syntax); ## Authorities use marc while biblioserver is xml
 438 $o->option(databaseName=>$context->{"config"}->{$server});
 439 #$o->option(proxy=>$context->{"config"}->{"proxy"});## if proxyserver provided will route searches to proxy
 440 my $o2= new ZOOM::Options();
 441
 442  $Zconn=create ZOOM::Connection($o);
 443         $Zconn->connect($context->{"config"}->{"hostname"},$port);
 444
 445         return $Zconn;
 446 }
 447
 448 ## Zebra handler with write permission
 449 sub new_Zconnauth {
 450 use ZOOM;
 451 my $server=shift;
 452 my $syntax=shift;
 453 $syntax="xml" unless $syntax;
 454 my $Zconnauth;
 455 my ($tcp,$host,$port)=split /:/,$context->{"listen"}->{$server}->{"content"};
 456 my $o = new ZOOM::Options();
 457 #$o->option(async => 1);
 458 $o->option(preferredRecordSyntax => $syntax);
 459 $o->option(user=>$context->{"config"}->{"zebrauser"});
 460 $o->option(password=>$context->{"config"}->{"zebrapass"});
 461 $o->option(databaseName=>$context->{"config"}->{$server});
 462  $o->option(charset=>"UTF8");
 463  $Zconnauth=create ZOOM::Connection($o);
 464 $Zconnauth->connect($context->config("hostname"),$port);
 465 return $Zconnauth;
 466 }
 467
 468
 469 # _new_dbh
 470 # Internal helper function (not a method!). This creates a new
 471 # database connection from the data given in the current context, and
 472 # returns it.
 473 sub _new_dbh
 474 {
 475         ##correct name for db_schme
 476         my $db_driver;
 477         if ($context->config("db_scheme")){
 478         $db_driver=db_scheme2dbi($context->config("db_scheme"));
 479         }else{
 480         $db_driver="mysql";
 481         }
 482
 483         my $db_name   = $context->config("database");
 484         my $db_host   = $context->config("hostname");
 485         my $db_user   = $context->config("user");
 486         my $db_passwd = $context->config("pass");
 487         my $dbh= UTF8DBI->connect("DBI:$db_driver:$db_name:$db_host",
 488                             $db_user, $db_passwd);
 489         # Koha 3.0 is utf-8, so force utf8 communication between mySQL and koha, whatever the mysql default config.
 490         # this is better than modifying my.cnf (and forcing all communications to be in utf8)
 491 #       $dbh->do("set NAMES 'utf8'");
 492 #       $dbh->do("SET character_set_client=utf8");
 493 #       $dbh->do("SET character_set_connection=utf8");
 494 #       $dbh->do("SET character_set_results=utf8");
 495         return $dbh;
 496 }
 497
 498 =item dbh
 499
 500   $dbh = C4::Context->dbh;
 501
 502 Returns a database handle connected to the Koha database for the
 503 current context. If no connection has yet been made, this method
 504 creates one, and connects to the database.
 505
 506 This database handle is cached for future use: if you call
 507 C<C4::Context-E<gt>dbh> twice, you will get the same handle both
 508 times. If you need a second database handle, use C<&new_dbh> and
 509 possibly C<&set_dbh>.
 510
 511 =cut
 512
 513 #'
 514 sub dbh
 515 {
 516         my $self = shift;
 517         my $sth;
 518
 519         if (defined($context->{"dbh"})) {
 520             $sth=$context->{"dbh"}->prepare("select 1");
 521             return $context->{"dbh"} if (defined($sth->execute));
 522         }
 523
 524         # No database handle or it died . Create one.
 525         $context->{"dbh"} = &_new_dbh();
 526
 527         return $context->{"dbh"};
 528 }
 529
 530 =item new_dbh
 531
 532   $dbh = C4::Context->new_dbh;
 533
 534 Creates a new connection to the Koha database for the current context,
 535 and returns the database handle (a C<DBI::db> object).
 536
 537 The handle is not saved anywhere: this method is strictly a
 538 convenience function; the point is that it knows which database to
 539 connect to so that the caller doesn't have to know.
 540
 541 =cut
 542
 543 #'
 544 sub new_dbh
 545 {
 546         my $self = shift;
 547
 548         return &_new_dbh();
 549 }
 550
 551 =item set_dbh
 552
 553   $my_dbh = C4::Connect->new_dbh;
 554   C4::Connect->set_dbh($my_dbh);
 555   ...
 556   C4::Connect->restore_dbh;
 557
 558 C<&set_dbh> and C<&restore_dbh> work in a manner analogous to
 559 C<&set_context> and C<&restore_context>.
 560
 561 C<&set_dbh> saves the current database handle on a stack, then sets
 562 the current database handle to C<$my_dbh>.
 563
 564 C<$my_dbh> is assumed to be a good database handle.
 565
 566 =cut
 567
 568 #'
 569 sub set_dbh
 570 {
 571         my $self = shift;
 572         my $new_dbh = shift;
 573
 574         # Save the current database handle on the handle stack.
 575         # We assume that $new_dbh is all good: if the caller wants to
 576         # screw himself by passing an invalid handle, that's fine by
 577         # us.
 578         push @{$context->{"dbh_stack"}}, $context->{"dbh"};
 579         $context->{"dbh"} = $new_dbh;
 580 }
 581
 582 =item restore_dbh
 583
 584   C4::Context->restore_dbh;
 585
 586 Restores the database handle saved by an earlier call to
 587 C<C4::Context-E<gt>set_dbh>.
 588
 589 =cut
 590
 591 #'
 592 sub restore_dbh
 593 {
 594         my $self = shift;
 595
 596         if ($#{$context->{"dbh_stack"}} < 0)
 597         {
 598                 # Stack underflow
 599                 die "DBH stack underflow";
 600         }
 601
 602         # Pop the old database handle and set it.
 603         $context->{"dbh"} = pop @{$context->{"dbh_stack"}};
 604
 605         # FIXME - If it is determined that restore_context should
 606         # return something, then this function should, too.
 607 }
 608
 609 =item marcfromkohafield
 610
 611   $dbh = C4::Context->marcfromkohafield;
 612
 613 Returns a hash with marcfromkohafield.
 614
 615 This hash is cached for future use: if you call
 616 C<C4::Context-E<gt>marcfromkohafield> twice, you will get the same hash without real DB access
 617
 618 =cut
 619
 620 #'
 621 sub marcfromkohafield
 622 {
 623         my $retval = {};
 624
 625         # If the hash already exists, return it.
 626         return $context->{"marcfromkohafield"} if defined($context->{"marcfromkohafield"});
 627
 628         # No hash. Create one.
 629         $context->{"marcfromkohafield"} = &_new_marcfromkohafield();
 630
 631         return $context->{"marcfromkohafield"};
 632 }
 633
 634
 635 # _new_marcfromkohafield
 636 # Internal helper function (not a method!).
 637 sub _new_marcfromkohafield
 638 {
 639         my $dbh = C4::Context->dbh;
 640         my $marcfromkohafield;
 641         my $sth = $dbh->prepare("select marctokoha,tagfield,tagsubfield,recordtype from koha_attr where tagfield is not null  ");
 642         $sth->execute;
 643         while (my ($kohafield,$tagfield,$tagsubfield,$recordtype) = $sth->fetchrow) {
 644                 my $retval = {};
 645                 $marcfromkohafield->{$recordtype}->{$kohafield} = [$tagfield,$tagsubfield];
 646         }
 647
 648         return $marcfromkohafield;
 649 }
 650
 651
 652 #item attrfromkohafield
 653 #To use as a hash of koha to z3950 attributes
 654 sub _new_attrfromkohafield
 655 {
 656         my $dbh = C4::Context->dbh;
 657         my $attrfromkohafield;
 658         my $sth2 = $dbh->prepare("select marctokoha,attr from koha_attr" );
 659         $sth2->execute;
 660         while (my ($marctokoha,$attr) = $sth2->fetchrow) {
 661                 my $retval = {};
 662                 $attrfromkohafield->{$marctokoha} = $attr;
 663         }
 664         return $attrfromkohafield;
 665 }
 666 sub attrfromkohafield
 667 {
 668         my $retval = {};
 669
 670         # If the hash already exists, return it.
 671         return $context->{"attrfromkohafield"} if defined($context->{"attrfromkohafield"});
 672
 673         # No hash. Create one.
 674         $context->{"attrfromkohafield"} = &_new_attrfromkohafield();
 675
 676         return $context->{"attrfromkohafield"};
 677 }
 678 =item stopwords
 679
 680   $dbh = C4::Context->stopwords;
 681
 682 Returns a hash with stopwords.
 683
 684 This hash is cached for future use: if you call
 685 C<C4::Context-E<gt>stopwords> twice, you will get the same hash without real DB access
 686
 687 =cut
 688
 689 #'
 690 sub stopwords
 691 {
 692         my $retval = {};
 693
 694         # If the hash already exists, return it.
 695         return $context->{"stopwords"} if defined($context->{"stopwords"});
 696
 697         # No hash. Create one.
 698         $context->{"stopwords"} = &_new_stopwords();
 699
 700         return $context->{"stopwords"};
 701 }
 702
 703 # _new_stopwords
 704 # Internal helper function (not a method!). This creates a new
 705 # hash with stopwords
 706 sub _new_stopwords
 707 {
 708         my $dbh = C4::Context->dbh;
 709         my $stopwordlist;
 710         my $sth = $dbh->prepare("select word from stopwords");
 711         $sth->execute;
 712         while (my $stopword = $sth->fetchrow_array) {
 713                 my $retval = {};
 714                 $stopwordlist->{$stopword} = uc($stopword);
 715         }
 716         $stopwordlist->{A} = "A" unless $stopwordlist;
 717         return $stopwordlist;
 718 }
 719
 720 =item userenv
 721
 722   C4::Context->userenv;
 723
 724 Builds a hash for user environment variables.
 725
 726 This hash shall be cached for future use: if you call
 727 C<C4::Context-E<gt>userenv> twice, you will get the same hash without real DB access
 728
 729 set_userenv is called in Auth.pm
 730
 731 =cut
 732
 733 #'
 734 sub userenv
 735 {
 736         my $var = $context->{"activeuser"};
 737         return $context->{"userenv"}->{$var} if (defined $context->{"userenv"}->{$var});
 738         return 0;
 739         warn "NO CONTEXT for $var";
 740 }
 741
 742 =item set_userenv
 743
 744   C4::Context->set_userenv($usernum, $userid, $usercnum, $userfirstname, $usersurname, $userbranch, $userflags, $emailaddress);
 745
 746 Informs a hash for user environment variables.
 747
 748 This hash shall be cached for future use: if you call
 749 C<C4::Context-E<gt>userenv> twice, you will get the same hash without real DB access
 750
 751 set_userenv is called in Auth.pm
 752
 753 =cut
 754 #'
 755 sub set_userenv{
 756         my ($usernum, $userid, $usercnum, $userfirstname, $usersurname, $userbranch, $branchname, $userflags, $emailaddress,$branchprinter)= @_;
 757         my $var=$context->{"activeuser"};
 758         my $cell = {
 759                 "number"     => $usernum,
 760                 "id"         => $userid,
 761                 "cardnumber" => $usercnum,
 762 #               "firstname"  => $userfirstname,
 763 #               "surname"    => $usersurname,
 764 #possibly a law problem
 765                 "branch"     => $userbranch,
 766                 "branchname" => $branchname,
 767                 "flags"      => $userflags,
 768                 "emailaddress"  => $emailaddress,
 769                 "branchprinter" => $branchprinter,
 770         };
 771         $context->{userenv}->{$var} = $cell;
 772         return $cell;
 773 }
 774
 775 =item _new_userenv
 776
 777   C4::Context->_new_userenv($session);
 778
 779 Builds a hash for user environment variables.
 780
 781 This hash shall be cached for future use: if you call
 782 C<C4::Context-E<gt>userenv> twice, you will get the same hash without real DB access
 783
 784 _new_userenv is called in Auth.pm
 785
 786 =cut
 787
 788 #'
 789 sub _new_userenv
 790 {
 791         shift;
 792         my ($sessionID)= @_;
 793         $context->{"activeuser"}=$sessionID;
 794 }
 795
 796 =item _unset_userenv
 797
 798   C4::Context->_unset_userenv;
 799
 800 Destroys the hash for activeuser user environment variables.
 801
 802 =cut
 803 #'
 804
 805 sub _unset_userenv
 806 {
 807         my ($sessionID)= @_;
 808         undef $context->{"activeuser"} if ($context->{"activeuser"} eq $sessionID);
 809 }
 810
 811
 812
 813 1;
 814 __END__
 815
 816 =back
 817
 818 =head1 ENVIRONMENT
 819
 820 =over 4
 821
 822 =item C<KOHA_CONF>
 823
 824 Specifies the configuration file to read.
 825
 826 =back
 827
 828 =head1 SEE ALSO
 829
 830 DBI(3)
 831
 832 =head1 AUTHOR
 833
 834 Andrew Arensburger <arensb at ooblick dot com>
 835
 836 =cut
 837 # $Log$
 838 # Revision 1.44  2006/08/25 21:07:08  tgarip1957
 839 # New set of routines for HEAD.
 840 # Uses a complete new ZEBRA Indexing.
 841 # ZEBRA is now XML and comprises of a KOHA meta record. Explanatory notes will be on koha-devel
 842 # Fixes UTF8 problems
 843 # Fixes bug with authorities
 844 # SQL database major changes.
 845 # Separate biblioograaphic and holdings records. Biblioitems table depreceated
 846 # etc. etc.
 847 # Wait for explanatory document on koha-devel
 848 #
 849 # Revision 1.43  2006/08/10 12:49:37  toins
 850 # sync with dev_week.
 851 #
 852 # Revision 1.42  2006/07/04 14:36:51  toins
 853 # Head & rel_2_2 merged
 854 #
 855 # Revision 1.41  2006/05/20 14:36:09  tgarip1957
 856 # Typo error. Missing '>'
 857 #
 858 # Revision 1.40  2006/05/20 14:28:02  tgarip1957
 859 # Adding support to read zebra database name from config files
 860 #
 861 # Revision 1.39  2006/05/19 09:52:54  alaurin
 862 # committing new feature ip and printer management
 863 # adding two fields in branches table (branchip,branchprinter)
 864 #
 865 # 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 .
 866 #
 867 # branchprinter : the library  can select a default printer for a branch
 868 #
 869 # Revision 1.38  2006/05/14 00:22:31  tgarip1957
 870 # Adding support for getting details of different zebra servers
 871 #
 872 # Revision 1.37  2006/05/13 19:51:39  tgarip1957
 873 # Now reads koha.xml rather than koha.conf.
 874 # koha.xml contains both the koha configuration and zebraserver configuration.
 875 # Zebra connection is modified to allow connection to authority zebra as well.
 876 # It will break head if koha.conf is not replaced with koha.xml
 877 #
 878 # Revision 1.36  2006/05/09 13:28:08  tipaul
 879 # adding the branchname and the librarian name in every page :
 880 # - modified userenv to add branchname
 881 # - modifier menus.inc to have the librarian name & userenv displayed on every page. they are in a librarian_information div.
 882 #
 883 # Revision 1.35  2006/04/13 08:40:11  plg
 884 # bug fixed: typo on Zconnauth name
 885 #
 886 # Revision 1.34  2006/04/10 21:40:23  tgarip1957
 887 # 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:
 888 # zebradb=localhost
 889 # zebraport=<your port>
 890 # zebrauser=<username>
 891 # zebrapass=<password>
 892 #
 893 # The zebra.cfg file should read:
 894 # perm.anonymous:r
 895 # perm.username:rw
 896 # passw.c:<yourpasswordfile>
 897 #
 898 # Password file should be prepared with Apaches htpasswd utility in encrypted mode and should exist in a folder zebra.cfg can read
 899 #
 900 # Revision 1.33  2006/03/15 11:21:56  plg
 901 # bug fixed: utf-8 data where not displayed correctly in screens. Supposing
 902 # your data are truely utf-8 encoded in your database, they should be
 903 # correctly displayed. "set names 'UTF8'" on mysql connection (C4/Context.pm)
 904 # is mandatory and "binmode" to utf8 (C4/Interface/CGI/Output.pm) seemed to
 905 # converted data twice, so it was removed.
 906 #
 907 # Revision 1.32  2006/03/03 17:25:01  hdl
 908 # Bug fixing : a line missed a comment sign.
 909 #
 910 # Revision 1.31  2006/03/03 16:45:36  kados
 911 # Remove the search that tests the Zconn -- warning, still no fault
 912 # tollerance
 913 #
 914 # Revision 1.30  2006/02/22 00:56:59  kados
 915 # First go at a connection object for Zebra. You can now get a
 916 # connection object by doing:
 917 #
 918 # my $Zconn = C4::Context->Zconn;
 919 #
 920 # My initial tests indicate that as soon as your funcion ends
 921 # (ie, when you're done doing something) the connection will be
 922 # closed automatically. There may be some other way to make the
 923 # connection more stateful, I'm not sure...
 924 #
 925 # Local Variables:
 926 # tab-width: 4
 927 # End: