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