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