fixing permissions on scripts
[koha.git] / 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     retry:
479     eval {
480         # set options
481         my $o = new ZOOM::Options();
482         $o->option(async => 1) if $async;
483         $o->option(count => $piggyback) if $piggyback;
484         $o->option(cqlfile=> $context->{"server"}->{$server}->{"cql2rpn"});
485         $o->option(cclfile=> $context->{"serverinfo"}->{$server}->{"ccl2rpn"});
486         $o->option(preferredRecordSyntax => $syntax);
487         $o->option(elementSetName => "F"); # F for 'full' as opposed to B for 'brief'
488         $o->option(user=>$user) if $auth;
489         $o->option(password=>$password) if $auth;
490         $o->option(databaseName => ($servername?$servername:"biblios"));
491
492         # create a new connection object
493         $Zconn= create ZOOM::Connection($o);
494
495         # forge to server
496         $Zconn->connect($host, 0);
497
498         # check for errors and warn
499         if ($Zconn->errcode() !=0) {
500             warn "something wrong with the connection: ". $Zconn->errmsg();
501         }
502
503     };
504 #     if ($@) {
505 #         # Koha manages the Zebra server -- this doesn't work currently for me because of permissions issues
506 #         # Also, I'm skeptical about whether it's the best approach
507 #         warn "problem with Zebra";
508 #         if ( C4::Context->preference("ManageZebra") ) {
509 #             if ($@->code==10000 && $tried==0) { ##No connection try restarting Zebra
510 #                 $tried=1;
511 #                 warn "trying to restart Zebra";
512 #                 my $res=system("zebrasrv -f $ENV{'KOHA_CONF'} >/koha/log/zebra-error.log");
513 #                 goto "retry";
514 #             } else {
515 #                 warn "Error ", $@->code(), ": ", $@->message(), "\n";
516 #                 $Zconn="error";
517 #                 return $Zconn;
518 #             }
519 #         }
520 #     }
521     return $Zconn;
522 }
523
524 # _new_dbh
525 # Internal helper function (not a method!). This creates a new
526 # database connection from the data given in the current context, and
527 # returns it.
528 sub _new_dbh
529 {
530     ##correct name for db_schme        
531     my $db_driver;
532     if ($context->config("db_scheme")){
533     $db_driver=db_scheme2dbi($context->config("db_scheme"));
534     }else{
535     $db_driver="mysql";
536     }
537
538     my $db_name   = $context->config("database");
539     my $db_host   = $context->config("hostname");
540     my $db_user   = $context->config("user");
541     my $db_passwd = $context->config("pass");
542     my $dbh= DBI->connect("DBI:$db_driver:$db_name:$db_host",
543                 $db_user, $db_passwd);
544     # Koha 3.0 is utf-8, so force utf8 communication between mySQL and koha, whatever the mysql default config.
545     # this is better than modifying my.cnf (and forcing all communications to be in utf8)
546     $dbh->do("set NAMES 'utf8'") if ($dbh);
547     $dbh->{'mysql_enable_utf8'}=1; #enable
548     return $dbh;
549 }
550
551 =item dbh
552
553   $dbh = C4::Context->dbh;
554
555 Returns a database handle connected to the Koha database for the
556 current context. If no connection has yet been made, this method
557 creates one, and connects to the database.
558
559 This database handle is cached for future use: if you call
560 C<C4::Context-E<gt>dbh> twice, you will get the same handle both
561 times. If you need a second database handle, use C<&new_dbh> and
562 possibly C<&set_dbh>.
563
564 =cut
565
566 #'
567 sub dbh
568 {
569     my $self = shift;
570     my $sth;
571
572     if (defined($context->{"dbh"})) {
573         $sth=$context->{"dbh"}->prepare("select 1");
574         return $context->{"dbh"} if (defined($sth->execute));
575     }
576
577     # No database handle or it died . Create one.
578     $context->{"dbh"} = &_new_dbh();
579
580     return $context->{"dbh"};
581 }
582
583 =item new_dbh
584
585   $dbh = C4::Context->new_dbh;
586
587 Creates a new connection to the Koha database for the current context,
588 and returns the database handle (a C<DBI::db> object).
589
590 The handle is not saved anywhere: this method is strictly a
591 convenience function; the point is that it knows which database to
592 connect to so that the caller doesn't have to know.
593
594 =cut
595
596 #'
597 sub new_dbh
598 {
599     my $self = shift;
600
601     return &_new_dbh();
602 }
603
604 =item set_dbh
605
606   $my_dbh = C4::Connect->new_dbh;
607   C4::Connect->set_dbh($my_dbh);
608   ...
609   C4::Connect->restore_dbh;
610
611 C<&set_dbh> and C<&restore_dbh> work in a manner analogous to
612 C<&set_context> and C<&restore_context>.
613
614 C<&set_dbh> saves the current database handle on a stack, then sets
615 the current database handle to C<$my_dbh>.
616
617 C<$my_dbh> is assumed to be a good database handle.
618
619 =cut
620
621 #'
622 sub set_dbh
623 {
624     my $self = shift;
625     my $new_dbh = shift;
626
627     # Save the current database handle on the handle stack.
628     # We assume that $new_dbh is all good: if the caller wants to
629     # screw himself by passing an invalid handle, that's fine by
630     # us.
631     push @{$context->{"dbh_stack"}}, $context->{"dbh"};
632     $context->{"dbh"} = $new_dbh;
633 }
634
635 =item restore_dbh
636
637   C4::Context->restore_dbh;
638
639 Restores the database handle saved by an earlier call to
640 C<C4::Context-E<gt>set_dbh>.
641
642 =cut
643
644 #'
645 sub restore_dbh
646 {
647     my $self = shift;
648
649     if ($#{$context->{"dbh_stack"}} < 0)
650     {
651         # Stack underflow
652         die "DBH stack underflow";
653     }
654
655     # Pop the old database handle and set it.
656     $context->{"dbh"} = pop @{$context->{"dbh_stack"}};
657
658     # FIXME - If it is determined that restore_context should
659     # return something, then this function should, too.
660 }
661
662 =item marcfromkohafield
663
664   $dbh = C4::Context->marcfromkohafield;
665
666 Returns a hash with marcfromkohafield.
667
668 This hash is cached for future use: if you call
669 C<C4::Context-E<gt>marcfromkohafield> twice, you will get the same hash without real DB access
670
671 =cut
672
673 #'
674 sub marcfromkohafield
675 {
676     my $retval = {};
677
678     # If the hash already exists, return it.
679     return $context->{"marcfromkohafield"} if defined($context->{"marcfromkohafield"});
680
681     # No hash. Create one.
682     $context->{"marcfromkohafield"} = &_new_marcfromkohafield();
683
684     return $context->{"marcfromkohafield"};
685 }
686
687 # _new_marcfromkohafield
688 # Internal helper function (not a method!). This creates a new
689 # hash with stopwords
690 sub _new_marcfromkohafield
691 {
692     my $dbh = C4::Context->dbh;
693     my $marcfromkohafield;
694     my $sth = $dbh->prepare("select frameworkcode,kohafield,tagfield,tagsubfield from marc_subfield_structure where kohafield > ''");
695     $sth->execute;
696     while (my ($frameworkcode,$kohafield,$tagfield,$tagsubfield) = $sth->fetchrow) {
697         my $retval = {};
698         $marcfromkohafield->{$frameworkcode}->{$kohafield} = [$tagfield,$tagsubfield];
699     }
700     return $marcfromkohafield;
701 }
702
703 =item stopwords
704
705   $dbh = C4::Context->stopwords;
706
707 Returns a hash with stopwords.
708
709 This hash is cached for future use: if you call
710 C<C4::Context-E<gt>stopwords> twice, you will get the same hash without real DB access
711
712 =cut
713
714 #'
715 sub stopwords
716 {
717     my $retval = {};
718
719     # If the hash already exists, return it.
720     return $context->{"stopwords"} if defined($context->{"stopwords"});
721
722     # No hash. Create one.
723     $context->{"stopwords"} = &_new_stopwords();
724
725     return $context->{"stopwords"};
726 }
727
728 # _new_stopwords
729 # Internal helper function (not a method!). This creates a new
730 # hash with stopwords
731 sub _new_stopwords
732 {
733     my $dbh = C4::Context->dbh;
734     my $stopwordlist;
735     my $sth = $dbh->prepare("select word from stopwords");
736     $sth->execute;
737     while (my $stopword = $sth->fetchrow_array) {
738         my $retval = {};
739         $stopwordlist->{$stopword} = uc($stopword);
740     }
741     $stopwordlist->{A} = "A" unless $stopwordlist;
742     return $stopwordlist;
743 }
744
745 =item userenv
746
747   C4::Context->userenv;
748
749 Builds a hash for user environment variables.
750
751 This hash shall be cached for future use: if you call
752 C<C4::Context-E<gt>userenv> twice, you will get the same hash without real DB access
753
754 set_userenv is called in Auth.pm
755
756 =cut
757
758 #'
759 sub userenv
760 {
761     my $var = $context->{"activeuser"};
762     return $context->{"userenv"}->{$var} if (defined $context->{"userenv"}->{$var});
763     # insecure=1 management
764     if ($context->{"dbh"} && $context->preference('insecure')) {
765         my %insecure;
766         $insecure{flags} = '16382';
767         $insecure{branchname} ='Insecure',
768         $insecure{number} ='0';
769         $insecure{cardnumber} ='0';
770         $insecure{id} = 'insecure';
771         $insecure{branch} = 'INS';
772         $insecure{emailaddress} = 'test@mode.insecure.com';
773         return \%insecure;
774     } else {
775         return 0;
776     }
777 }
778
779 =item set_userenv
780
781   C4::Context->set_userenv($usernum, $userid, $usercnum, $userfirstname, $usersurname, $userbranch, $userflags, $emailaddress);
782
783 Informs a hash for user environment variables.
784
785 This hash shall be cached for future use: if you call
786 C<C4::Context-E<gt>userenv> twice, you will get the same hash without real DB access
787
788 set_userenv is called in Auth.pm
789
790 =cut
791
792 #'
793 sub set_userenv{
794     my ($usernum, $userid, $usercnum, $userfirstname, $usersurname, $userbranch, $branchname, $userflags, $emailaddress)= @_;
795     my $var=$context->{"activeuser"};
796     my $cell = {
797         "number"     => $usernum,
798         "id"         => $userid,
799         "cardnumber" => $usercnum,
800         "firstname"  => $userfirstname,
801         "surname"    => $usersurname,
802 #possibly a law problem
803         "branch"     => $userbranch,
804         "branchname" => $branchname,
805         "flags"      => $userflags,
806         "emailaddress"    => $emailaddress,
807     };
808     $context->{userenv}->{$var} = $cell;
809     return $cell;
810 }
811
812 =item _new_userenv
813
814   C4::Context->_new_userenv($session);
815
816 Builds a hash for user environment variables.
817
818 This hash shall be cached for future use: if you call
819 C<C4::Context-E<gt>userenv> twice, you will get the same hash without real DB access
820
821 _new_userenv is called in Auth.pm
822
823 =cut
824
825 #'
826 sub _new_userenv
827 {
828     shift;
829     my ($sessionID)= @_;
830      $context->{"activeuser"}=$sessionID;
831 }
832
833 =item _unset_userenv
834
835   C4::Context->_unset_userenv;
836
837 Destroys the hash for activeuser user environment variables.
838
839 =cut
840
841 #'
842
843 sub _unset_userenv
844 {
845     my ($sessionID)= @_;
846     undef $context->{"activeuser"} if ($context->{"activeuser"} eq $sessionID);
847 }
848
849
850
851 1;
852 __END__
853
854 =back
855
856 =head1 ENVIRONMENT
857
858 =over 4
859
860 =item C<KOHA_CONF>
861
862 Specifies the configuration file to read.
863
864 =back
865
866 =head1 SEE ALSO
867
868 =head1 AUTHORS
869
870 Andrew Arensburger <arensb at ooblick dot com>
871
872 Joshua Ferraro <jmf at liblime dot com>
873
874 =cut
875
876 # $Log$
877 # Revision 1.57  2007/05/22 09:13:55  tipaul
878 # Bugfixes & improvements (various and minor) :
879 # - updating templates to have tmpl_process3.pl running without any errors
880 # - adding a drupal-like css for prog templates (with 3 small images)
881 # - fixing some bugs in circulation & other scripts
882 # - updating french translation
883 # - fixing some typos in templates
884 #
885 # Revision 1.56  2007/04/23 15:21:17  tipaul
886 # renaming currenttransfers to transferstoreceive
887 #
888 # Revision 1.55  2007/04/17 08:48:00  tipaul
889 # circulation cleaning continued: bufixing
890 #
891 # Revision 1.54  2007/03/29 16:45:53  tipaul
892 # Code cleaning of Biblio.pm (continued)
893 #
894 # All subs have be cleaned :
895 # - removed useless
896 # - merged some
897 # - reordering Biblio.pm completly
898 # - using only naming conventions
899 #
900 # Seems to have broken nothing, but it still has to be heavily tested.
901 # Note that Biblio.pm is now much more efficient than previously & probably more reliable as well.
902 #
903 # Revision 1.53  2007/03/29 13:30:31  tipaul
904 # Code cleaning :
905 # == Biblio.pm cleaning (useless) ==
906 # * some sub declaration dropped
907 # * removed modbiblio sub
908 # * removed moditem sub
909 # * removed newitems. It was used only in finishrecieve. Replaced by a TransformKohaToMarc+AddItem, that is better.
910 # * removed MARCkoha2marcItem
911 # * removed MARCdelsubfield declaration
912 # * removed MARCkoha2marcBiblio
913 #
914 # == Biblio.pm cleaning (naming conventions) ==
915 # * MARCgettagslib renamed to GetMarcStructure
916 # * MARCgetitems renamed to GetMarcItem
917 # * MARCfind_frameworkcode renamed to GetFrameworkCode
918 # * MARCmarc2koha renamed to TransformMarcToKoha
919 # * MARChtml2marc renamed to TransformHtmlToMarc
920 # * MARChtml2xml renamed to TranformeHtmlToXml
921 # * zebraop renamed to ModZebra
922 #
923 # == MARC=OFF ==
924 # * removing MARC=OFF related scripts (in cataloguing directory)
925 # * removed checkitems (function related to MARC=off feature, that is completly broken in head. If someone want to reintroduce it, hard work coming...)
926 # * removed getitemsbybiblioitem (used only by MARC=OFF scripts, that is removed as well)
927 #
928 # Revision 1.52  2007/03/16 01:25:08  kados
929 # Using my precrash CVS copy I did the following:
930 #
931 # cvs -z3 -d:ext:kados@cvs.savannah.nongnu.org:/sources/koha co -P koha
932 # find koha.precrash -type d -name "CVS" -exec rm -v {} \;
933 # cp -r koha.precrash/* koha/
934 # cd koha/
935 # cvs commit
936 #
937 # This should in theory put us right back where we were before the crash
938 #
939 # Revision 1.52  2007/03/12 21:17:05  rych
940 # add server, serverinfo as arrays from config
941 #
942 # Revision 1.51  2007/03/09 14:31:47  tipaul
943 # rel_3_0 moved to HEAD
944 #
945 # Revision 1.43.2.10  2007/02/09 17:17:56  hdl
946 # Managing a little better database absence.
947 # (preventing from BIG 550)
948 #
949 # Revision 1.43.2.9  2006/12/20 16:50:48  tipaul
950 # improving "insecure" management
951 #
952 # WARNING KADOS :
953 # you told me that you had some libraries with insecure=ON (behind a firewall).
954 # 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.
955 #
956 # Revision 1.43.2.8  2006/12/19 16:48:16  alaurin
957 # reident programs, and adding branchcode value in reserves
958 #
959 # Revision 1.43.2.7  2006/12/06 21:55:38  hdl
960 # Adding ModZebrations for servers to get serverinfos in Context.pm
961 # Using this function in rebuild_zebra.pl
962 #
963 # Revision 1.43.2.6  2006/11/24 21:18:31  kados
964 # very minor changes, no functional ones, just comments, etc.
965 #
966 # Revision 1.43.2.5  2006/10/30 13:24:16  toins
967 # fix some minor POD error.
968 #
969 # Revision 1.43.2.4  2006/10/12 21:42:49  hdl
970 # Managing multiple zebra connections
971 #
972 # Revision 1.43.2.3  2006/10/11 14:27:26  tipaul
973 # removing a warning
974 #
975 # Revision 1.43.2.2  2006/10/10 15:28:16  hdl
976 # BUG FIXING : using database name in Zconn if defined and not hard coded value
977 #
978 # Revision 1.43.2.1  2006/10/06 13:47:28  toins
979 # Synch with dev_week.
980 #  /!\ WARNING :: Please now use the new version of koha.xml.
981 #
982 # Revision 1.18.2.5.2.14  2006/09/24 15:24:06  kados
983 # remove Zebraauth routine, fold the functionality into Zconn
984 # Zconn can now take several arguments ... this will probably
985 # change soon as I'm not completely happy with the readability
986 # of the current format ... see the POD for details.
987 #
988 # cleaning up Biblio.pm, removing unnecessary routines.
989 #
990 # DeleteBiblio - used to delete a biblio from zebra and koha tables
991 #     -- checks to make sure there are no existing issues
992 #     -- saves backups of biblio,biblioitems,items in deleted* tables
993 #     -- does commit operation
994 #
995 # getRecord - used to retrieve one record from zebra in piggyback mode using biblionumber
996 # brought back z3950_extended_services routine
997 #
998 # Lots of modifications to Context.pm, you can now store user and pass info for
999 # multiple servers (for federated searching) using the <serverinfo> element.
1000 # I'll commit my koha.xml to demonstrate this or you can refer to the POD in
1001 # Context.pm (which I also expanded on).
1002 #
1003 # Revision 1.18.2.5.2.13  2006/08/10 02:10:21  kados
1004 # Turned warnings on, and running a search turned up lots of warnings.
1005 # Cleaned up those ...
1006 #
1007 # removed getitemtypes from Koha.pm (one in Search.pm looks newer)
1008 # removed itemcount from Biblio.pm
1009 #
1010 # made some local subs local with a _ prefix (as they were redefined
1011 # elsewhere)
1012 #
1013 # Add two new search subs to Search.pm the start of a new search API
1014 # that's a bit more scalable
1015 #
1016 # Revision 1.18.2.5.2.10  2006/07/21 17:50:51  kados
1017 # moving the *.properties files to intranetdir/etc dir
1018 #
1019 # Revision 1.18.2.5.2.9  2006/07/17 08:05:20  tipaul
1020 # there was a hardcoded link to /koha/etc/ I replaced it with intranetdir config value
1021 #
1022 # Revision 1.18.2.5.2.8  2006/07/11 12:20:37  kados
1023 # adding ccl and cql files ... Tumer, if you want to fit these into the
1024 # config file by all means do.
1025 #
1026 # Revision 1.18.2.5.2.7  2006/06/04 22:50:33  tgarip1957
1027 # We do not hard code cql2rpn conversion file in context.pm our koha.xml configuration file already describes the path for this file.
1028 # At cql searching we use method CQL not CQL2RPN as the cql2rpn conversion file is defined at server level
1029 #
1030 # Revision 1.18.2.5.2.6  2006/06/02 23:11:24  kados
1031 # Committing my working dev_week. It's been tested only with
1032 # searching, and there's quite a lot of config stuff to set up
1033 # beforehand. As things get closer to a release, we'll be making
1034 # some scripts to do it for us
1035 #
1036 # Revision 1.18.2.5.2.5  2006/05/28 18:49:12  tgarip1957
1037 # This is an unusual commit. The main purpose is a working model of Zebra on a modified rel2_2.
1038 # Any questions regarding these commits should be asked to Joshua Ferraro unless you are Joshua whom I'll report to
1039 #
1040 # Revision 1.36  2006/05/09 13:28:08  tipaul
1041 # adding the branchname and the librarian name in every page :
1042 # - modified userenv to add branchname
1043 # - modifier menus.inc to have the librarian name & userenv displayed on every page. they are in a librarian_information div.
1044 #
1045 # Revision 1.35  2006/04/13 08:40:11  plg
1046 # bug fixed: typo on Zconnauth name
1047 #
1048 # Revision 1.34  2006/04/10 21:40:23  tgarip1957
1049 # 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:
1050 # zebradb=localhost
1051 # zebraport=<your port>
1052 # zebrauser=<username>
1053 # zebrapass=<password>
1054 #
1055 # The zebra.cfg file should read:
1056 # perm.anonymous:r
1057 # perm.username:rw
1058 # passw.c:<yourpasswordfile>
1059 #
1060 # Password file should be prepared with Apaches htpasswd utility in encrypted mode and should exist in a folder zebra.cfg can read
1061 #
1062 # Revision 1.33  2006/03/15 11:21:56  plg
1063 # bug fixed: utf-8 data where not displayed correctly in screens. Supposing
1064 # your data are truely utf-8 encoded in your database, they should be
1065 # correctly displayed. "set names 'UTF8'" on mysql connection (C4/Context.pm)
1066 # is mandatory and "binmode" to utf8 (C4/Interface/CGI/Output.pm) seemed to
1067 # converted data twice, so it was removed.
1068 #
1069 # Revision 1.32  2006/03/03 17:25:01  hdl
1070 # Bug fixing : a line missed a comment sign.
1071 #
1072 # Revision 1.31  2006/03/03 16:45:36  kados
1073 # Remove the search that tests the Zconn -- warning, still no fault
1074 # tollerance
1075 #
1076 # Revision 1.30  2006/02/22 00:56:59  kados
1077 # First go at a connection object for Zebra. You can now get a
1078 # connection object by doing:
1079 #
1080 # my $Zconn = C4::Context->Zconn;
1081 #
1082 # My initial tests indicate that as soon as your funcion ends
1083 # (ie, when you're done doing something) the connection will be
1084 # closed automatically. There may be some other way to make the
1085 # connection more stateful, I'm not sure...
1086 #
1087 # Local Variables:
1088 # tab-width: 4
1089 # End: