C4/Context.pm

   1 package C4::Context;
   2 # Copyright 2002 Katipo Communications
   3 #
   4 # This file is part of Koha.
   5 #
   6 # Koha is free software; you can redistribute it and/or modify it under the
   7 # terms of the GNU General Public License as published by the Free Software
   8 # Foundation; either version 2 of the License, or (at your option) any later
   9 # version.
  10 #
  11 # Koha is distributed in the hope that it will be useful, but WITHOUT ANY
  12 # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
  13 # A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
  14 #
  15 # You should have received a copy of the GNU General Public License along with
  16 # Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
  17 # Suite 330, Boston, MA  02111-1307 USA
  18
  19 # $Id$
  20 use strict;
  21 use DBI;
  22 use ZOOM;
  23 use XML::Simple;
  24
  25 use C4::Boolean;
  26
  27 use vars qw($VERSION $AUTOLOAD),
  28     qw($context),
  29     qw(@context_stack);
  30
  31 $VERSION = '3.00.00.002';
  32
  33 =head1 NAME
  34
  35 C4::Context - Maintain and manipulate the context of a Koha script
  36
  37 =head1 SYNOPSIS
  38
  39   use C4::Context;
  40
  41   use C4::Context("/path/to/koha.xml");
  42
  43   $config_value = C4::Context->config("config_variable");
  44
  45   $koha_preference = C4::Context->preference("preference");
  46
  47   $db_handle = C4::Context->dbh;
  48
  49   $Zconn = C4::Context->Zconn;
  50
  51   $stopwordhash = C4::Context->stopwords;
  52
  53 =head1 DESCRIPTION
  54
  55 When a Koha script runs, it makes use of a certain number of things:
  56 configuration settings in F</etc/koha.xml>, a connection to the Koha
  57 databases, and so forth. These things make up the I<context> in which
  58 the script runs.
  59
  60 This module takes care of setting up the context for a script:
  61 figuring out which configuration file to load, and loading it, opening
  62 a connection to the right database, and so forth.
  63
  64 Most scripts will only use one context. They can simply have
  65
  66   use C4::Context;
  67
  68 at the top.
  69
  70 Other scripts may need to use several contexts. For instance, if a
  71 library has two databases, one for a certain collection, and the other
  72 for everything else, it might be necessary for a script to use two
  73 different contexts to search both databases. Such scripts should use
  74 the C<&set_context> and C<&restore_context> functions, below.
  75
  76 By default, C4::Context reads the configuration from
  77 F</etc/koha.xml>. This may be overridden by setting the C<$KOHA_CONF>
  78 environment variable to the pathname of a configuration file to use.
  79
  80 =head1 METHODS
  81
  82 =over 2
  83
  84 =cut
  85
  86 #'
  87 # In addition to what is said in the POD above, a Context object is a
  88 # reference-to-hash with the following fields:
  89 #
  90 # config
  91 #    A reference-to-hash whose keys and values are the
  92 #    configuration variables and values specified in the config
  93 #    file (/etc/koha.xml).
  94 # dbh
  95 #    A handle to the appropriate database for this context.
  96 # dbh_stack
  97 #    Used by &set_dbh and &restore_dbh to hold other database
  98 #    handles for this context.
  99 # Zconn
 100 #     A connection object for the Zebra server
 101
 102 use constant CONFIG_FNAME => "/etc/koha.xml";
 103                 # Default config file, if none is specified
 104
 105 $context = undef;        # Initially, no context is set
 106 @context_stack = ();        # Initially, no saved contexts
 107
 108
 109 =item KOHAVERSION
 110     returns the kohaversion stored in kohaversion.pl file
 111 =cut
 112
 113 sub KOHAVERSION {
 114     my $cgidir = C4::Context->intranetdir ."/cgi-bin";
 115     unless (opendir(DIR, "$cgidir/cataloguing/value_builder")) {
 116             $cgidir = C4::Context->intranetdir;
 117     }
 118     do $cgidir."/kohaversion.pl" || die "NO $cgidir/kohaversion.pl";
 119     return kohaversion();
 120 }
 121 =item read_config_file
 122
 123 =over 4
 124
 125 Reads the specified Koha config file.
 126
 127 Returns an object containing the configuration variables. The object's
 128 structure is a bit complex to the uninitiated ... take a look at the
 129 koha.xml file as well as the XML::Simple documentation for details. Or,
 130 here are a few examples that may give you what you need:
 131
 132 The simple elements nested within the <config> element:
 133
 134     my $pass = $koha->{'config'}->{'pass'};
 135
 136 The <listen> elements:
 137
 138     my $listen = $koha->{'listen'}->{'biblioserver'}->{'content'};
 139
 140 The elements nested within the <server> element:
 141
 142     my $ccl2rpn = $koha->{'server'}->{'biblioserver'}->{'cql2rpn'};
 143
 144 Returns undef in case of error.
 145
 146 =back
 147
 148 =cut
 149
 150 sub read_config_file {
 151     my $fname = shift;    # Config file to read
 152     my $retval = {};    # Return value: ref-to-hash holding the configuration
 153     my $koha = XMLin($fname, keyattr => ['id'],forcearray => ['listen', 'server', 'serverinfo']);
 154     return $koha;
 155 }
 156
 157 # db_scheme2dbi
 158 # Translates the full text name of a database into de appropiate dbi name
 159 #
 160 sub db_scheme2dbi {
 161     my $name = shift;
 162
 163     for ($name) {
 164 # FIXME - Should have other databases.
 165         if (/mysql/i) { return("mysql"); }
 166         if (/Postgres|Pg|PostgresSQL/) { return("Pg"); }
 167         if (/oracle/i) { return("Oracle"); }
 168     }
 169     return undef;         # Just in case
 170 }
 171
 172 sub import {
 173     my $package = shift;
 174     my $conf_fname = shift;        # Config file name
 175     my $context;
 176
 177     # Create a new context from the given config file name, if
 178     # any, then set it as the current context.
 179     $context = new C4::Context($conf_fname);
 180     return undef if !defined($context);
 181     $context->set_context;
 182 }
 183
 184 =item new
 185
 186   $context = new C4::Context;
 187   $context = new C4::Context("/path/to/koha.xml");
 188
 189 Allocates a new context. Initializes the context from the specified
 190 file, which defaults to either the file given by the C<$KOHA_CONF>
 191 environment variable, or F</etc/koha.xml>.
 192
 193 C<&new> does not set this context as the new default context; for
 194 that, use C<&set_context>.
 195
 196 =cut
 197
 198 #'
 199 # Revision History:
 200 # 2004-08-10 A. Tarallo: Added check if the conf file is not empty
 201 sub new {
 202     my $class = shift;
 203     my $conf_fname = shift;        # Config file to load
 204     my $self = {};
 205
 206     # check that the specified config file exists and is not empty
 207     undef $conf_fname unless
 208         (defined $conf_fname && -e $conf_fname && -s $conf_fname);
 209     # Figure out a good config file to load if none was specified.
 210     if (!defined($conf_fname))
 211     {
 212         # If the $KOHA_CONF environment variable is set, use
 213         # that. Otherwise, use the built-in default.
 214         $conf_fname = $ENV{"KOHA_CONF"} || CONFIG_FNAME;
 215     }
 216         # Load the desired config file.
 217     $self = read_config_file($conf_fname);
 218     $self->{"config_file"} = $conf_fname;
 219
 220     warn "read_config_file($conf_fname) returned undef" if !defined($self->{"config"});
 221     return undef if !defined($self->{"config"});
 222
 223     $self->{"dbh"} = undef;        # Database handle
 224     $self->{"Zconn"} = undef;    # Zebra Connections
 225     $self->{"stopwords"} = undef; # stopwords list
 226     $self->{"marcfromkohafield"} = undef; # the hash with relations between koha table fields and MARC field/subfield
 227     $self->{"userenv"} = undef;        # User env
 228     $self->{"activeuser"} = undef;        # current active user
 229
 230     bless $self, $class;
 231     return $self;
 232 }
 233
 234 =item set_context
 235
 236   $context = new C4::Context;
 237   $context->set_context();
 238 or
 239   set_context C4::Context $context;
 240
 241   ...
 242   restore_context C4::Context;
 243
 244 In some cases, it might be necessary for a script to use multiple
 245 contexts. C<&set_context> saves the current context on a stack, then
 246 sets the context to C<$context>, which will be used in future
 247 operations. To restore the previous context, use C<&restore_context>.
 248
 249 =cut
 250
 251 #'
 252 sub set_context
 253 {
 254     my $self = shift;
 255     my $new_context;    # The context to set
 256
 257     # Figure out whether this is a class or instance method call.
 258     #
 259     # We're going to make the assumption that control got here
 260     # through valid means, i.e., that the caller used an instance
 261     # or class method call, and that control got here through the
 262     # usual inheritance mechanisms. The caller can, of course,
 263     # break this assumption by playing silly buggers, but that's
 264     # harder to do than doing it properly, and harder to check
 265     # for.
 266     if (ref($self) eq "")
 267     {
 268         # Class method. The new context is the next argument.
 269         $new_context = shift;
 270     } else {
 271         # Instance method. The new context is $self.
 272         $new_context = $self;
 273     }
 274
 275     # Save the old context, if any, on the stack
 276     push @context_stack, $context if defined($context);
 277
 278     # Set the new context
 279     $context = $new_context;
 280 }
 281
 282 =item restore_context
 283
 284   &restore_context;
 285
 286 Restores the context set by C<&set_context>.
 287
 288 =cut
 289
 290 #'
 291 sub restore_context
 292 {
 293     my $self = shift;
 294
 295     if ($#context_stack < 0)
 296     {
 297         # Stack underflow.
 298         die "Context stack underflow";
 299     }
 300
 301     # Pop the old context and set it.
 302     $context = pop @context_stack;
 303
 304     # FIXME - Should this return something, like maybe the context
 305     # that was current when this was called?
 306 }
 307
 308 =item config
 309
 310   $value = C4::Context->config("config_variable");
 311
 312   $value = C4::Context->config_variable;
 313
 314 Returns the value of a variable specified in the configuration file
 315 from which the current context was created.
 316
 317 The second form is more compact, but of course may conflict with
 318 method names. If there is a configuration variable called "new", then
 319 C<C4::Config-E<gt>new> will not return it.
 320
 321 =cut
 322
 323 #'
 324 sub config
 325 {
 326     my $self = shift;
 327     my $var = shift;        # The config variable to return
 328
 329     return undef if !defined($context->{"config"});
 330             # Presumably $self->{config} might be
 331             # undefined if the config file given to &new
 332             # didn't exist, and the caller didn't bother
 333             # to check the return value.
 334
 335     # Return the value of the requested config variable
 336     return $context->{"config"}->{$var};
 337 }
 338
 339 sub zebraconfig
 340 {
 341     my $self = shift;
 342     my $var = shift;        # The config variable to return
 343
 344     return undef if !defined($context->{"server"});
 345             # Presumably $self->{config} might be
 346             # undefined if the config file given to &new
 347             # didn't exist, and the caller didn't bother
 348             # to check the return value.
 349
 350     # Return the value of the requested config variable
 351     return $context->{"server"}->{$var};
 352 }
 353 sub ModZebrations
 354 {
 355     my $self = shift;
 356     my $var = shift;        # The config variable to return
 357
 358     return undef if !defined($context->{"serverinfo"});
 359             # Presumably $self->{config} might be
 360             # undefined if the config file given to &new
 361             # didn't exist, and the caller didn't bother
 362             # to check the return value.
 363
 364     # Return the value of the requested config variable
 365     return $context->{"serverinfo"}->{$var};
 366 }
 367 =item preference
 368
 369   $sys_preference = C4::Context->preference("some_variable");
 370
 371 Looks up the value of the given system preference in the
 372 systempreferences table of the Koha database, and returns it. If the
 373 variable is not set, or in case of error, returns the undefined value.
 374
 375 =cut
 376
 377 #'
 378 # FIXME - The preferences aren't likely to change over the lifetime of
 379 # the script (and things might break if they did change), so perhaps
 380 # this function should cache the results it finds.
 381 sub preference
 382 {
 383     my $self = shift;
 384     my $var = shift;        # The system preference to return
 385     my $retval;            # Return value
 386     my $dbh = C4::Context->dbh;    # Database handle
 387     if ($dbh){
 388     my $sth;            # Database query handle
 389
 390     # Look up systempreferences.variable==$var
 391     $retval = $dbh->selectrow_array(<<EOT);
 392         SELECT    value
 393         FROM    systempreferences
 394         WHERE    variable='$var'
 395         LIMIT    1
 396 EOT
 397     return $retval;
 398     } else {
 399       return 0
 400     }
 401 }
 402
 403 sub boolean_preference ($) {
 404     my $self = shift;
 405     my $var = shift;        # The system preference to return
 406     my $it = preference($self, $var);
 407     return defined($it)? C4::Boolean::true_p($it): undef;
 408 }
 409
 410 # AUTOLOAD
 411 # This implements C4::Config->foo, and simply returns
 412 # C4::Context->config("foo"), as described in the documentation for
 413 # &config, above.
 414
 415 # FIXME - Perhaps this should be extended to check &config first, and
 416 # then &preference if that fails. OTOH, AUTOLOAD could lead to crappy
 417 # code, so it'd probably be best to delete it altogether so as not to
 418 # encourage people to use it.
 419 sub AUTOLOAD
 420 {
 421     my $self = shift;
 422
 423     $AUTOLOAD =~ s/.*:://;        # Chop off the package name,
 424                     # leaving only the function name.
 425     return $self->config($AUTOLOAD);
 426 }
 427
 428 =item Zconn
 429
 430 $Zconn = C4::Context->Zconn
 431
 432 Returns a connection to the Zebra database for the current
 433 context. If no connection has yet been made, this method
 434 creates one and connects.
 435
 436 C<$self>
 437
 438 C<$server> one of the servers defined in the koha.xml file
 439
 440 C<$async> whether this is a asynchronous connection
 441
 442 C<$auth> whether this connection has rw access (1) or just r access (0 or NULL)
 443
 444
 445 =cut
 446
 447 sub Zconn {
 448     my $self=shift;
 449     my $server=shift;
 450     my $async=shift;
 451     my $auth=shift;
 452     my $piggyback=shift;
 453     my $syntax=shift;
 454     if ( defined($context->{"Zconn"}->{$server}) ) {
 455         return $context->{"Zconn"}->{$server};
 456
 457     # No connection object or it died. Create one.
 458     }else {
 459         $context->{"Zconn"}->{$server} = &_new_Zconn($server,$async,$auth,$piggyback,$syntax);
 460         return $context->{"Zconn"}->{$server};
 461     }
 462 }
 463
 464 =item _new_Zconn
 465
 466 $context->{"Zconn"} = &_new_Zconn($server,$async);
 467
 468 Internal function. Creates a new database connection from the data given in the current context and returns it.
 469
 470 C<$server> one of the servers defined in the koha.xml file
 471
 472 C<$async> whether this is a asynchronous connection
 473
 474 C<$auth> whether this connection has rw access (1) or just r access (0 or NULL)
 475
 476 =cut
 477
 478 sub _new_Zconn {
 479     my ($server,$async,$auth,$piggyback,$syntax) = @_;
 480
 481     my $tried=0; # first attempt
 482     my $Zconn; # connection object
 483     $server = "biblioserver" unless $server;
 484     $syntax = "usmarc" unless $syntax;
 485
 486     my $host = $context->{'listen'}->{$server}->{'content'};
 487     my $user = $context->{"serverinfo"}->{$server}->{"user"};
 488     my $servername = $context->{"config"}->{$server};
 489     my $password = $context->{"serverinfo"}->{$server}->{"password"};
 490     retry:
 491     eval {
 492         # set options
 493         my $o = new ZOOM::Options();
 494         $o->option(async => 1) if $async;
 495         $o->option(count => $piggyback) if $piggyback;
 496         $o->option(cqlfile=> $context->{"server"}->{$server}->{"cql2rpn"});
 497         $o->option(cclfile=> $context->{"serverinfo"}->{$server}->{"ccl2rpn"});
 498         $o->option(preferredRecordSyntax => $syntax);
 499         $o->option(elementSetName => "F"); # F for 'full' as opposed to B for 'brief'
 500         $o->option(user=>$user) if $auth;
 501         $o->option(password=>$password) if $auth;
 502         $o->option(databaseName => ($servername?$servername:"biblios"));
 503
 504         # create a new connection object
 505         $Zconn= create ZOOM::Connection($o);
 506
 507         # forge to server
 508         $Zconn->connect($host, 0);
 509
 510         # check for errors and warn
 511         if ($Zconn->errcode() !=0) {
 512             warn "something wrong with the connection: ". $Zconn->errmsg();
 513         }
 514
 515     };
 516 #     if ($@) {
 517 #         # Koha manages the Zebra server -- this doesn't work currently for me because of permissions issues
 518 #         # Also, I'm skeptical about whether it's the best approach
 519 #         warn "problem with Zebra";
 520 #         if ( C4::Context->preference("ManageZebra") ) {
 521 #             if ($@->code==10000 && $tried==0) { ##No connection try restarting Zebra
 522 #                 $tried=1;
 523 #                 warn "trying to restart Zebra";
 524 #                 my $res=system("zebrasrv -f $ENV{'KOHA_CONF'} >/koha/log/zebra-error.log");
 525 #                 goto "retry";
 526 #             } else {
 527 #                 warn "Error ", $@->code(), ": ", $@->message(), "\n";
 528 #                 $Zconn="error";
 529 #                 return $Zconn;
 530 #             }
 531 #         }
 532 #     }
 533     return $Zconn;
 534 }
 535
 536 # _new_dbh
 537 # Internal helper function (not a method!). This creates a new
 538 # database connection from the data given in the current context, and
 539 # returns it.
 540 sub _new_dbh
 541 {
 542     ##correct name for db_schme
 543     my $db_driver;
 544     if ($context->config("db_scheme")){
 545     $db_driver=db_scheme2dbi($context->config("db_scheme"));
 546     }else{
 547     $db_driver="mysql";
 548     }
 549
 550     my $db_name   = $context->config("database");
 551     my $db_host   = $context->config("hostname");
 552     my $db_user   = $context->config("user");
 553     my $db_passwd = $context->config("pass");
 554     my $dbh= DBI->connect("DBI:$db_driver:$db_name:$db_host",
 555                 $db_user, $db_passwd);
 556     # Koha 3.0 is utf-8, so force utf8 communication between mySQL and koha, whatever the mysql default config.
 557     # this is better than modifying my.cnf (and forcing all communications to be in utf8)
 558     $dbh->do("set NAMES 'utf8'") if ($dbh);
 559     $dbh->{'mysql_enable_utf8'}=1; #enable
 560     return $dbh;
 561 }
 562
 563 =item dbh
 564
 565   $dbh = C4::Context->dbh;
 566
 567 Returns a database handle connected to the Koha database for the
 568 current context. If no connection has yet been made, this method
 569 creates one, and connects to the database.
 570
 571 This database handle is cached for future use: if you call
 572 C<C4::Context-E<gt>dbh> twice, you will get the same handle both
 573 times. If you need a second database handle, use C<&new_dbh> and
 574 possibly C<&set_dbh>.
 575
 576 =cut
 577
 578 #'
 579 sub dbh
 580 {
 581     my $self = shift;
 582     my $sth;
 583
 584     if (defined($context->{"dbh"})) {
 585         $sth=$context->{"dbh"}->prepare("select 1");
 586         return $context->{"dbh"} if (defined($sth->execute));
 587     }
 588
 589     # No database handle or it died . Create one.
 590     $context->{"dbh"} = &_new_dbh();
 591
 592     return $context->{"dbh"};
 593 }
 594
 595 =item new_dbh
 596
 597   $dbh = C4::Context->new_dbh;
 598
 599 Creates a new connection to the Koha database for the current context,
 600 and returns the database handle (a C<DBI::db> object).
 601
 602 The handle is not saved anywhere: this method is strictly a
 603 convenience function; the point is that it knows which database to
 604 connect to so that the caller doesn't have to know.
 605
 606 =cut
 607
 608 #'
 609 sub new_dbh
 610 {
 611     my $self = shift;
 612
 613     return &_new_dbh();
 614 }
 615
 616 =item set_dbh
 617
 618   $my_dbh = C4::Connect->new_dbh;
 619   C4::Connect->set_dbh($my_dbh);
 620   ...
 621   C4::Connect->restore_dbh;
 622
 623 C<&set_dbh> and C<&restore_dbh> work in a manner analogous to
 624 C<&set_context> and C<&restore_context>.
 625
 626 C<&set_dbh> saves the current database handle on a stack, then sets
 627 the current database handle to C<$my_dbh>.
 628
 629 C<$my_dbh> is assumed to be a good database handle.
 630
 631 =cut
 632
 633 #'
 634 sub set_dbh
 635 {
 636     my $self = shift;
 637     my $new_dbh = shift;
 638
 639     # Save the current database handle on the handle stack.
 640     # We assume that $new_dbh is all good: if the caller wants to
 641     # screw himself by passing an invalid handle, that's fine by
 642     # us.
 643     push @{$context->{"dbh_stack"}}, $context->{"dbh"};
 644     $context->{"dbh"} = $new_dbh;
 645 }
 646
 647 =item restore_dbh
 648
 649   C4::Context->restore_dbh;
 650
 651 Restores the database handle saved by an earlier call to
 652 C<C4::Context-E<gt>set_dbh>.
 653
 654 =cut
 655
 656 #'
 657 sub restore_dbh
 658 {
 659     my $self = shift;
 660
 661     if ($#{$context->{"dbh_stack"}} < 0)
 662     {
 663         # Stack underflow
 664         die "DBH stack underflow";
 665     }
 666
 667     # Pop the old database handle and set it.
 668     $context->{"dbh"} = pop @{$context->{"dbh_stack"}};
 669
 670     # FIXME - If it is determined that restore_context should
 671     # return something, then this function should, too.
 672 }
 673
 674 =item marcfromkohafield
 675
 676   $dbh = C4::Context->marcfromkohafield;
 677
 678 Returns a hash with marcfromkohafield.
 679
 680 This hash is cached for future use: if you call
 681 C<C4::Context-E<gt>marcfromkohafield> twice, you will get the same hash without real DB access
 682
 683 =cut
 684
 685 #'
 686 sub marcfromkohafield
 687 {
 688     my $retval = {};
 689
 690     # If the hash already exists, return it.
 691     return $context->{"marcfromkohafield"} if defined($context->{"marcfromkohafield"});
 692
 693     # No hash. Create one.
 694     $context->{"marcfromkohafield"} = &_new_marcfromkohafield();
 695
 696     return $context->{"marcfromkohafield"};
 697 }
 698
 699 # _new_marcfromkohafield
 700 # Internal helper function (not a method!). This creates a new
 701 # hash with stopwords
 702 sub _new_marcfromkohafield
 703 {
 704     my $dbh = C4::Context->dbh;
 705     my $marcfromkohafield;
 706     my $sth = $dbh->prepare("select frameworkcode,kohafield,tagfield,tagsubfield from marc_subfield_structure where kohafield > ''");
 707     $sth->execute;
 708     while (my ($frameworkcode,$kohafield,$tagfield,$tagsubfield) = $sth->fetchrow) {
 709         my $retval = {};
 710         $marcfromkohafield->{$frameworkcode}->{$kohafield} = [$tagfield,$tagsubfield];
 711     }
 712     return $marcfromkohafield;
 713 }
 714
 715 =item stopwords
 716
 717   $dbh = C4::Context->stopwords;
 718
 719 Returns a hash with stopwords.
 720
 721 This hash is cached for future use: if you call
 722 C<C4::Context-E<gt>stopwords> twice, you will get the same hash without real DB access
 723
 724 =cut
 725
 726 #'
 727 sub stopwords
 728 {
 729     my $retval = {};
 730
 731     # If the hash already exists, return it.
 732     return $context->{"stopwords"} if defined($context->{"stopwords"});
 733
 734     # No hash. Create one.
 735     $context->{"stopwords"} = &_new_stopwords();
 736
 737     return $context->{"stopwords"};
 738 }
 739
 740 # _new_stopwords
 741 # Internal helper function (not a method!). This creates a new
 742 # hash with stopwords
 743 sub _new_stopwords
 744 {
 745     my $dbh = C4::Context->dbh;
 746     my $stopwordlist;
 747     my $sth = $dbh->prepare("select word from stopwords");
 748     $sth->execute;
 749     while (my $stopword = $sth->fetchrow_array) {
 750         my $retval = {};
 751         $stopwordlist->{$stopword} = uc($stopword);
 752     }
 753     $stopwordlist->{A} = "A" unless $stopwordlist;
 754     return $stopwordlist;
 755 }
 756
 757 =item userenv
 758
 759   C4::Context->userenv;
 760
 761 Builds a hash for user environment variables.
 762
 763 This hash shall be cached for future use: if you call
 764 C<C4::Context-E<gt>userenv> twice, you will get the same hash without real DB access
 765
 766 set_userenv is called in Auth.pm
 767
 768 =cut
 769
 770 #'
 771 sub userenv
 772 {
 773     my $var = $context->{"activeuser"};
 774     return $context->{"userenv"}->{$var} if (defined $context->{"userenv"}->{$var});
 775     # insecure=1 management
 776     if ($context->{"dbh"} && $context->preference('insecure')) {
 777         my %insecure;
 778         $insecure{flags} = '16382';
 779         $insecure{branchname} ='Insecure',
 780         $insecure{number} ='0';
 781         $insecure{cardnumber} ='0';
 782         $insecure{id} = 'insecure';
 783         $insecure{branch} = 'INS';
 784         $insecure{emailaddress} = 'test@mode.insecure.com';
 785         return \%insecure;
 786     } else {
 787         return 0;
 788     }
 789 }
 790
 791 =item set_userenv
 792
 793   C4::Context->set_userenv($usernum, $userid, $usercnum, $userfirstname, $usersurname, $userbranch, $userflags, $emailaddress);
 794
 795 Informs a hash for user environment variables.
 796
 797 This hash shall be cached for future use: if you call
 798 C<C4::Context-E<gt>userenv> twice, you will get the same hash without real DB access
 799
 800 set_userenv is called in Auth.pm
 801
 802 =cut
 803
 804 #'
 805 sub set_userenv{
 806     my ($usernum, $userid, $usercnum, $userfirstname, $usersurname, $userbranch, $branchname, $userflags, $emailaddress)= @_;
 807     my $var=$context->{"activeuser"};
 808     my $cell = {
 809         "number"     => $usernum,
 810         "id"         => $userid,
 811         "cardnumber" => $usercnum,
 812         "firstname"  => $userfirstname,
 813         "surname"    => $usersurname,
 814 #possibly a law problem
 815         "branch"     => $userbranch,
 816         "branchname" => $branchname,
 817         "flags"      => $userflags,
 818         "emailaddress"    => $emailaddress,
 819     };
 820     $context->{userenv}->{$var} = $cell;
 821     return $cell;
 822 }
 823
 824 =item _new_userenv
 825
 826   C4::Context->_new_userenv($session);
 827
 828 Builds a hash for user environment variables.
 829
 830 This hash shall be cached for future use: if you call
 831 C<C4::Context-E<gt>userenv> twice, you will get the same hash without real DB access
 832
 833 _new_userenv is called in Auth.pm
 834
 835 =cut
 836
 837 #'
 838 sub _new_userenv
 839 {
 840     shift;
 841     my ($sessionID)= @_;
 842      $context->{"activeuser"}=$sessionID;
 843 }
 844
 845 =item _unset_userenv
 846
 847   C4::Context->_unset_userenv;
 848
 849 Destroys the hash for activeuser user environment variables.
 850
 851 =cut
 852
 853 #'
 854
 855 sub _unset_userenv
 856 {
 857     my ($sessionID)= @_;
 858     undef $context->{"activeuser"} if ($context->{"activeuser"} eq $sessionID);
 859 }
 860
 861
 862
 863 1;
 864 __END__
 865
 866 =back
 867
 868 =head1 ENVIRONMENT
 869
 870 =over 4
 871
 872 =item C<KOHA_CONF>
 873
 874 Specifies the configuration file to read.
 875
 876 =back
 877
 878 =head1 SEE ALSO
 879
 880 =head1 AUTHORS
 881
 882 Andrew Arensburger <arensb at ooblick dot com>
 883
 884 Joshua Ferraro <jmf at liblime dot com>
 885
 886 =cut
 887
 888 # $Log$
 889 # Revision 1.57  2007/05/22 09:13:55  tipaul
 890 # Bugfixes & improvements (various and minor) :
 891 # - updating templates to have tmpl_process3.pl running without any errors
 892 # - adding a drupal-like css for prog templates (with 3 small images)
 893 # - fixing some bugs in circulation & other scripts
 894 # - updating french translation
 895 # - fixing some typos in templates
 896 #
 897 # Revision 1.56  2007/04/23 15:21:17  tipaul
 898 # renaming currenttransfers to transferstoreceive
 899 #
 900 # Revision 1.55  2007/04/17 08:48:00  tipaul
 901 # circulation cleaning continued: bufixing
 902 #
 903 # Revision 1.54  2007/03/29 16:45:53  tipaul
 904 # Code cleaning of Biblio.pm (continued)
 905 #
 906 # All subs have be cleaned :
 907 # - removed useless
 908 # - merged some
 909 # - reordering Biblio.pm completly
 910 # - using only naming conventions
 911 #
 912 # Seems to have broken nothing, but it still has to be heavily tested.
 913 # Note that Biblio.pm is now much more efficient than previously & probably more reliable as well.
 914 #
 915 # Revision 1.53  2007/03/29 13:30:31  tipaul
 916 # Code cleaning :
 917 # == Biblio.pm cleaning (useless) ==
 918 # * some sub declaration dropped
 919 # * removed modbiblio sub
 920 # * removed moditem sub
 921 # * removed newitems. It was used only in finishrecieve. Replaced by a TransformKohaToMarc+AddItem, that is better.
 922 # * removed MARCkoha2marcItem
 923 # * removed MARCdelsubfield declaration
 924 # * removed MARCkoha2marcBiblio
 925 #
 926 # == Biblio.pm cleaning (naming conventions) ==
 927 # * MARCgettagslib renamed to GetMarcStructure
 928 # * MARCgetitems renamed to GetMarcItem
 929 # * MARCfind_frameworkcode renamed to GetFrameworkCode
 930 # * MARCmarc2koha renamed to TransformMarcToKoha
 931 # * MARChtml2marc renamed to TransformHtmlToMarc
 932 # * MARChtml2xml renamed to TranformeHtmlToXml
 933 # * zebraop renamed to ModZebra
 934 #
 935 # == MARC=OFF ==
 936 # * removing MARC=OFF related scripts (in cataloguing directory)
 937 # * removed checkitems (function related to MARC=off feature, that is completly broken in head. If someone want to reintroduce it, hard work coming...)
 938 # * removed getitemsbybiblioitem (used only by MARC=OFF scripts, that is removed as well)
 939 #
 940 # Revision 1.52  2007/03/16 01:25:08  kados
 941 # Using my precrash CVS copy I did the following:
 942 #
 943 # cvs -z3 -d:ext:kados@cvs.savannah.nongnu.org:/sources/koha co -P koha
 944 # find koha.precrash -type d -name "CVS" -exec rm -v {} \;
 945 # cp -r koha.precrash/* koha/
 946 # cd koha/
 947 # cvs commit
 948 #
 949 # This should in theory put us right back where we were before the crash
 950 #
 951 # Revision 1.52  2007/03/12 21:17:05  rych
 952 # add server, serverinfo as arrays from config
 953 #
 954 # Revision 1.51  2007/03/09 14:31:47  tipaul
 955 # rel_3_0 moved to HEAD
 956 #
 957 # Revision 1.43.2.10  2007/02/09 17:17:56  hdl
 958 # Managing a little better database absence.
 959 # (preventing from BIG 550)
 960 #
 961 # Revision 1.43.2.9  2006/12/20 16:50:48  tipaul
 962 # improving "insecure" management
 963 #
 964 # WARNING KADOS :
 965 # you told me that you had some libraries with insecure=ON (behind a firewall).
 966 # In this commit, I created a "fake" user when insecure=ON. It has a fake branch. You may find better to have the 1st branch in branch table instead of a fake one.
 967 #
 968 # Revision 1.43.2.8  2006/12/19 16:48:16  alaurin
 969 # reident programs, and adding branchcode value in reserves
 970 #
 971 # Revision 1.43.2.7  2006/12/06 21:55:38  hdl
 972 # Adding ModZebrations for servers to get serverinfos in Context.pm
 973 # Using this function in rebuild_zebra.pl
 974 #
 975 # Revision 1.43.2.6  2006/11/24 21:18:31  kados
 976 # very minor changes, no functional ones, just comments, etc.
 977 #
 978 # Revision 1.43.2.5  2006/10/30 13:24:16  toins
 979 # fix some minor POD error.
 980 #
 981 # Revision 1.43.2.4  2006/10/12 21:42:49  hdl
 982 # Managing multiple zebra connections
 983 #
 984 # Revision 1.43.2.3  2006/10/11 14:27:26  tipaul
 985 # removing a warning
 986 #
 987 # Revision 1.43.2.2  2006/10/10 15:28:16  hdl
 988 # BUG FIXING : using database name in Zconn if defined and not hard coded value
 989 #
 990 # Revision 1.43.2.1  2006/10/06 13:47:28  toins
 991 # Synch with dev_week.
 992 #  /!\ WARNING :: Please now use the new version of koha.xml.
 993 #
 994 # Revision 1.18.2.5.2.14  2006/09/24 15:24:06  kados
 995 # remove Zebraauth routine, fold the functionality into Zconn
 996 # Zconn can now take several arguments ... this will probably
 997 # change soon as I'm not completely happy with the readability
 998 # of the current format ... see the POD for details.
 999 #
1000 # cleaning up Biblio.pm, removing unnecessary routines.
1001 #
1002 # DeleteBiblio - used to delete a biblio from zebra and koha tables
1003 #     -- checks to make sure there are no existing issues
1004 #     -- saves backups of biblio,biblioitems,items in deleted* tables
1005 #     -- does commit operation
1006 #
1007 # getRecord - used to retrieve one record from zebra in piggyback mode using biblionumber
1008 # brought back z3950_extended_services routine
1009 #
1010 # Lots of modifications to Context.pm, you can now store user and pass info for
1011 # multiple servers (for federated searching) using the <serverinfo> element.
1012 # I'll commit my koha.xml to demonstrate this or you can refer to the POD in
1013 # Context.pm (which I also expanded on).
1014 #
1015 # Revision 1.18.2.5.2.13  2006/08/10 02:10:21  kados
1016 # Turned warnings on, and running a search turned up lots of warnings.
1017 # Cleaned up those ...
1018 #
1019 # removed getitemtypes from Koha.pm (one in Search.pm looks newer)
1020 # removed itemcount from Biblio.pm
1021 #
1022 # made some local subs local with a _ prefix (as they were redefined
1023 # elsewhere)
1024 #
1025 # Add two new search subs to Search.pm the start of a new search API
1026 # that's a bit more scalable
1027 #
1028 # Revision 1.18.2.5.2.10  2006/07/21 17:50:51  kados
1029 # moving the *.properties files to intranetdir/etc dir
1030 #
1031 # Revision 1.18.2.5.2.9  2006/07/17 08:05:20  tipaul
1032 # there was a hardcoded link to /koha/etc/ I replaced it with intranetdir config value
1033 #
1034 # Revision 1.18.2.5.2.8  2006/07/11 12:20:37  kados
1035 # adding ccl and cql files ... Tumer, if you want to fit these into the
1036 # config file by all means do.
1037 #
1038 # Revision 1.18.2.5.2.7  2006/06/04 22:50:33  tgarip1957
1039 # We do not hard code cql2rpn conversion file in context.pm our koha.xml configuration file already describes the path for this file.
1040 # At cql searching we use method CQL not CQL2RPN as the cql2rpn conversion file is defined at server level
1041 #
1042 # Revision 1.18.2.5.2.6  2006/06/02 23:11:24  kados
1043 # Committing my working dev_week. It's been tested only with
1044 # searching, and there's quite a lot of config stuff to set up
1045 # beforehand. As things get closer to a release, we'll be making
1046 # some scripts to do it for us
1047 #
1048 # Revision 1.18.2.5.2.5  2006/05/28 18:49:12  tgarip1957
1049 # This is an unusual commit. The main purpose is a working model of Zebra on a modified rel2_2.
1050 # Any questions regarding these commits should be asked to Joshua Ferraro unless you are Joshua whom I'll report to
1051 #
1052 # Revision 1.36  2006/05/09 13:28:08  tipaul
1053 # adding the branchname and the librarian name in every page :
1054 # - modified userenv to add branchname
1055 # - modifier menus.inc to have the librarian name & userenv displayed on every page. they are in a librarian_information div.
1056 #
1057 # Revision 1.35  2006/04/13 08:40:11  plg
1058 # bug fixed: typo on Zconnauth name
1059 #
1060 # Revision 1.34  2006/04/10 21:40:23  tgarip1957
1061 # 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:
1062 # zebradb=localhost
1063 # zebraport=<your port>
1064 # zebrauser=<username>
1065 # zebrapass=<password>
1066 #
1067 # The zebra.cfg file should read:
1068 # perm.anonymous:r
1069 # perm.username:rw
1070 # passw.c:<yourpasswordfile>
1071 #
1072 # Password file should be prepared with Apaches htpasswd utility in encrypted mode and should exist in a folder zebra.cfg can read
1073 #
1074 # Revision 1.33  2006/03/15 11:21:56  plg
1075 # bug fixed: utf-8 data where not displayed correctly in screens. Supposing
1076 # your data are truely utf-8 encoded in your database, they should be
1077 # correctly displayed. "set names 'UTF8'" on mysql connection (C4/Context.pm)
1078 # is mandatory and "binmode" to utf8 (C4/Interface/CGI/Output.pm) seemed to
1079 # converted data twice, so it was removed.
1080 #
1081 # Revision 1.32  2006/03/03 17:25:01  hdl
1082 # Bug fixing : a line missed a comment sign.
1083 #
1084 # Revision 1.31  2006/03/03 16:45:36  kados
1085 # Remove the search that tests the Zconn -- warning, still no fault
1086 # tollerance
1087 #
1088 # Revision 1.30  2006/02/22 00:56:59  kados
1089 # First go at a connection object for Zebra. You can now get a
1090 # connection object by doing:
1091 #
1092 # my $Zconn = C4::Context->Zconn;
1093 #
1094 # My initial tests indicate that as soon as your funcion ends
1095 # (ie, when you're done doing something) the connection will be
1096 # closed automatically. There may be some other way to make the
1097 # connection more stateful, I'm not sure...
1098 #
1099 # Local Variables:
1100 # tab-width: 4
1101 # End: