| Lines 31-37
          BEGIN {
      
      
        Link Here | 
        
          | 31 | 			    eval {C4::Context->dbh();}; | 31 | 			    eval {C4::Context->dbh();}; | 
        
          | 32 | 			    if ($@){ | 32 | 			    if ($@){ | 
        
          | 33 | 				$debug_level = 1; | 33 | 				$debug_level = 1; | 
          
            
              | 34 | 			    }  | 34 | 			    } | 
        
          | 35 | 			    else { | 35 | 			    else { | 
        
          | 36 | 				$debug_level =  C4::Context->preference("DebugLevel"); | 36 | 				$debug_level =  C4::Context->preference("DebugLevel"); | 
        
          | 37 | 			    } | 37 | 			    } | 
  
    | Lines 49-55
          BEGIN {
      
      
        Link Here | 
        
          | 49 | 		# a little example table with various version info"; | 49 | 		# a little example table with various version info"; | 
        
          | 50 | 					print " | 50 | 					print " | 
        
          | 51 | 						<h1>Koha error</h1> | 51 | 						<h1>Koha error</h1> | 
          
            
              | 52 | 						<p>The following fatal error has occurred:</p>  | 52 | 						<p>The following fatal error has occurred:</p> | 
        
          | 53 |                         <pre><code>$msg</code></pre> | 53 |                         <pre><code>$msg</code></pre> | 
        
          | 54 | 						<table> | 54 | 						<table> | 
        
          | 55 | 						<tr><th>Apache</th><td>  $versions{apacheVersion}</td></tr> | 55 | 						<tr><th>Apache</th><td>  $versions{apacheVersion}</td></tr> | 
  
    | Lines 63-73
          BEGIN {
      
      
        Link Here | 
        
          | 63 | 				} elsif ($debug_level eq "1"){ | 63 | 				} elsif ($debug_level eq "1"){ | 
        
          | 64 | 					print " | 64 | 					print " | 
        
          | 65 | 						<h1>Koha error</h1> | 65 | 						<h1>Koha error</h1> | 
          
            
              | 66 | 						<p>The following fatal error has occurred:</p>  | 66 | 						<p>The following fatal error has occurred:</p> | 
        
          | 67 |                         <pre><code>$msg</code></pre>"; | 67 |                         <pre><code>$msg</code></pre>"; | 
        
          | 68 | 				} else { | 68 | 				} else { | 
        
          | 69 | 					print "<p>production mode - trapped fatal error</p>"; | 69 | 					print "<p>production mode - trapped fatal error</p>"; | 
          
            
              | 70 | 				}        | 70 | 				} | 
        
          | 71 |                 print "</body></html>"; | 71 |                 print "</body></html>"; | 
        
          | 72 | 			} | 72 | 			} | 
        
          | 73 | 		#CGI::Carp::set_message(\&handle_errors); | 73 | 		#CGI::Carp::set_message(\&handle_errors); | 
  
    | Lines 103-108
          use XML::Simple;
      
      
        Link Here | 
        
          | 103 | use POSIX (); | 103 | use POSIX (); | 
        
          | 104 | use DateTime::TimeZone; | 104 | use DateTime::TimeZone; | 
        
          | 105 | use Module::Load::Conditional qw(can_load); | 105 | use Module::Load::Conditional qw(can_load); | 
            
              |  |  | 106 | use Data::Dumper; | 
        
          | 106 | use Carp; | 107 | use Carp; | 
        
          | 107 |  | 108 |  | 
        
          | 108 | use C4::Boolean; | 109 | use C4::Boolean; | 
  
    | Lines 169-178
          environment variable to the pathname of a configuration file to use.
      
      
        Link Here | 
        
          | 169 | #    file (/etc/koha/koha-conf.xml). | 170 | #    file (/etc/koha/koha-conf.xml). | 
        
          | 170 | # dbh | 171 | # dbh | 
        
          | 171 | #    A handle to the appropriate database for this context. | 172 | #    A handle to the appropriate database for this context. | 
            
              | 172 | # dbh_stack |  |  | 
            
              | 173 | #    Used by &set_dbh and &restore_dbh to hold other database | 
            
              | 174 | #    handles for this context. | 
            
              | 175 | # Zconn | 
        
          | 176 | #     A connection object for the Zebra server | 173 | #     A connection object for the Zebra server | 
        
          | 177 |  | 174 |  | 
        
          | 178 | # Koha's main configuration file koha-conf.xml | 175 | # Koha's main configuration file koha-conf.xml | 
  
    | Lines 181-187
          environment variable to the pathname of a configuration file to use.
      
      
        Link Here | 
        
          | 181 | # 1. Path supplied via use C4::Context '/path/to/koha-conf.xml' | 178 | # 1. Path supplied via use C4::Context '/path/to/koha-conf.xml' | 
        
          | 182 | # 2. Path supplied in KOHA_CONF environment variable. | 179 | # 2. Path supplied in KOHA_CONF environment variable. | 
        
          | 183 | # 3. Path supplied in INSTALLED_CONFIG_FNAME, as long | 180 | # 3. Path supplied in INSTALLED_CONFIG_FNAME, as long | 
          
            
              | 184 | #    as value has changed from its default of  | 181 | #    as value has changed from its default of | 
        
          | 185 | #    '__KOHA_CONF_DIR__/koha-conf.xml', as happens | 182 | #    '__KOHA_CONF_DIR__/koha-conf.xml', as happens | 
        
          | 186 | #    when Koha is installed in 'standard' or 'single' | 183 | #    when Koha is installed in 'standard' or 'single' | 
        
          | 187 | #    mode. | 184 | #    mode. | 
  
    | Lines 191-242
          environment variable to the pathname of a configuration file to use.
      
      
        Link Here | 
        
          | 191 |  | 188 |  | 
        
          | 192 | use constant CONFIG_FNAME => "/etc/koha/koha-conf.xml"; | 189 | use constant CONFIG_FNAME => "/etc/koha/koha-conf.xml"; | 
        
          | 193 |                 # Default config file, if none is specified | 190 |                 # Default config file, if none is specified | 
          
            
              | 194 |                  | 191 |  | 
        
          | 195 | my $INSTALLED_CONFIG_FNAME = '__KOHA_CONF_DIR__/koha-conf.xml'; | 192 | my $INSTALLED_CONFIG_FNAME = '__KOHA_CONF_DIR__/koha-conf.xml'; | 
        
          | 196 |                 # path to config file set by installer | 193 |                 # path to config file set by installer | 
        
          | 197 |                 # __KOHA_CONF_DIR__ is set by rewrite-confg.PL | 194 |                 # __KOHA_CONF_DIR__ is set by rewrite-confg.PL | 
        
          | 198 |                 # when Koha is installed in 'standard' or 'single' | 195 |                 # when Koha is installed in 'standard' or 'single' | 
          
            
              | 199 |                 # mode.  If Koha was installed in 'dev' mode,  | 196 |                 # mode.  If Koha was installed in 'dev' mode, | 
        
          | 200 |                 # __KOHA_CONF_DIR__ is *not* rewritten; instead | 197 |                 # __KOHA_CONF_DIR__ is *not* rewritten; instead | 
          
            
              | 201 |                 # developers should set the KOHA_CONF environment variable  | 198 |                 # developers should set the KOHA_CONF environment variable | 
            
              | 202 |  |  |  | 
            
              | 203 | $context = undef;        # Initially, no context is set | 
            
              | 204 | @context_stack = ();        # Initially, no saved contexts | 
            
              | 205 |  | 
            
              | 206 |  | 
            
              | 207 | =head2 read_config_file | 
            
              | 208 |  | 
            
              | 209 | Reads the specified Koha config file.  | 
            
              | 210 |  | 
            
              | 211 | Returns an object containing the configuration variables. The object's | 
            
              | 212 | structure is a bit complex to the uninitiated ... take a look at the | 
            
              | 213 | koha-conf.xml file as well as the XML::Simple documentation for details. Or, | 
            
              | 214 | here are a few examples that may give you what you need: | 
        
          | 215 |  | 199 |  | 
          
            
              | 216 | The simple elements nested within the <config> element: | 200 | @context_stack = ();     # Initially, no saved contexts | 
        
          | 217 |  | 201 |  | 
          
            
              | 218 |     my $pass = $koha->{'config'}->{'pass'}; | 202 | =head2 current | 
        
          | 219 |  | 203 |  | 
          
            
              | 220 | The <listen> elements: | 204 | Returns the current context | 
            
              | 221 |  |  |  | 
            
              | 222 |     my $listen = $koha->{'listen'}->{'biblioserver'}->{'content'}; | 
            
              | 223 |  | 
            
              | 224 | The elements nested within the <server> element: | 
            
              | 225 |  | 
            
              | 226 |     my $ccl2rpn = $koha->{'server'}->{'biblioserver'}->{'cql2rpn'}; | 
            
              | 227 |  | 
            
              | 228 | Returns undef in case of error. | 
        
          | 229 |  | 205 |  | 
        
          | 230 | =cut | 206 | =cut | 
        
          | 231 |  | 207 |  | 
          
            
              | 232 | sub read_config_file {		# Pass argument naming config file to read | 208 | sub current { | 
            
              | 233 |     my $koha = XMLin(shift, keyattr => ['id'], forcearray => ['listen', 'server', 'serverinfo'], suppressempty => ''); | 209 |     return $context; | 
            
              | 234 |  |  |  | 
            
              | 235 |     if ($ismemcached) { | 
            
              | 236 |       $memcached->set('kohaconf',$koha); | 
            
              | 237 |     } | 
            
              | 238 |  | 
            
              | 239 |     return $koha;			# Return value: ref-to-hash holding the configuration | 
        
          | 240 | } | 210 | } | 
        
          | 241 |  | 211 |  | 
        
          | 242 | =head2 ismemcached | 212 | =head2 ismemcached | 
  
    | Lines 264-269
          sub memcached {
      
      
        Link Here | 
        
          | 264 |     } | 234 |     } | 
        
          | 265 | } | 235 | } | 
        
          | 266 |  | 236 |  | 
            
              |  |  | 237 | sub db_driver { | 
            
              | 238 |     my $self = shift; | 
            
              | 239 |  | 
            
              | 240 |     $self = $context unless ref ($self); | 
            
              | 241 |     return unless $self; | 
            
              | 242 |  | 
            
              | 243 |     return $self->{db_driver}; | 
            
              | 244 | } | 
            
              | 245 |  | 
        
          | 267 | =head2 db_scheme2dbi | 246 | =head2 db_scheme2dbi | 
        
          | 268 |  | 247 |  | 
        
          | 269 |     my $dbd_driver_name = C4::Context::db_schema2dbi($scheme); | 248 |     my $dbd_driver_name = C4::Context::db_schema2dbi($scheme); | 
  
    | Lines 284-303
          sub import {
      
      
        Link Here | 
        
          | 284 |     # Create the default context ($C4::Context::Context) | 263 |     # Create the default context ($C4::Context::Context) | 
        
          | 285 |     # the first time the module is called | 264 |     # the first time the module is called | 
        
          | 286 |     # (a config file can be optionaly passed) | 265 |     # (a config file can be optionaly passed) | 
            
              |  |  | 266 |     # If ":no_config" is passed, no config load will be attempted | 
            
              | 267 |     # It saves the context values in the declared memcached server(s) | 
            
              | 268 |     # if currently available and uses those values until them expire and | 
            
              | 269 |     # re-reads them. | 
            
              | 270 |  | 
            
              | 271 |     my ($pkg,$config_file) = @_ ; | 
        
          | 287 |  | 272 |  | 
        
          | 288 |     # default context already exists? | 273 |     # default context already exists? | 
        
          | 289 |     return if $context; | 274 |     return if $context; | 
        
          | 290 |  | 275 |  | 
            
              |  |  | 276 |     if ($ismemcached) { | 
            
              | 277 |         # retrieve from memcached | 
            
              | 278 |         if (my $self = $memcached->get('kohaconf')) { | 
            
              | 279 |             $context = $self; | 
            
              | 280 |             return; | 
            
              | 281 |         } | 
            
              | 282 |     } | 
            
              | 283 |  | 
            
              | 284 |     # check that the specified config file exists and is not empty | 
            
              | 285 |     undef $config_file if defined $config_file && | 
            
              | 286 |         !( ref($config_file) || openhandle($config_file) || -s $config_file ); | 
            
              | 287 |     # Figure out a good config file to load if none was specified. | 
            
              | 288 |     if (!defined($config_file)) | 
            
              | 289 |     { | 
            
              | 290 |         # If the $KOHA_CONF environment variable is set, use | 
            
              | 291 |         # that. Otherwise, use the built-in default. | 
            
              | 292 |         if ($ENV{'KOHA_CONF'} and ref($ENV{'KOHA_CONF'}) || -s  $ENV{"KOHA_CONF"}) { | 
            
              | 293 |             $config_file = $ENV{"KOHA_CONF"}; | 
            
              | 294 |         } elsif ($INSTALLED_CONFIG_FNAME !~ /__KOHA_CONF_DIR/ and -s $INSTALLED_CONFIG_FNAME) { | 
            
              | 295 |             # NOTE: be careful -- don't change __KOHA_CONF_DIR in the above | 
            
              | 296 |             # regex to anything else -- don't want installer to rewrite it | 
            
              | 297 |             $config_file = $INSTALLED_CONFIG_FNAME; | 
            
              | 298 |         } elsif (-s CONFIG_FNAME) { | 
            
              | 299 |             $config_file = CONFIG_FNAME; | 
            
              | 300 |         } else { | 
            
              | 301 |             die "unable to locate Koha configuration file koha-conf.xml"; | 
            
              | 302 |         } | 
            
              | 303 |     } | 
            
              | 304 |  | 
        
          | 291 |     # no ? so load it! | 305 |     # no ? so load it! | 
          
            
              | 292 |     my ($pkg,$config_file) = @_ ; | 306 |     return if $config_file && $config_file eq ":no_config"; | 
        
          | 293 |     my $new_ctx = __PACKAGE__->new($config_file); | 307 |     my $new_ctx = __PACKAGE__->new($config_file); | 
        
          | 294 |     return unless $new_ctx; | 308 |     return unless $new_ctx; | 
        
          | 295 |  | 309 |  | 
        
          | 296 |     # if successfully loaded, use it by default | 310 |     # if successfully loaded, use it by default | 
          
            
              | 297 |     $new_ctx->set_context; | 311 |     $context = $new_ctx; | 
            
              | 298 |     1; | 312 |  | 
            
              |  |  | 313 |     if ($ismemcached) { | 
            
              | 314 |       $memcached->set('kohaconf',$new_ctx); | 
            
              | 315 |     } | 
        
          | 299 | } | 316 | } | 
        
          | 300 |  | 317 |  | 
            
              |  |  | 318 | use Scalar::Util qw(openhandle); | 
        
          | 301 | =head2 new | 319 | =head2 new | 
        
          | 302 |  | 320 |  | 
        
          | 303 |   $context = new C4::Context; | 321 |   $context = new C4::Context; | 
  
    | Lines 307-315
          Allocates a new context. Initializes the context from the specified
      
      
        Link Here | 
        
          | 307 | file, which defaults to either the file given by the C<$KOHA_CONF> | 325 | file, which defaults to either the file given by the C<$KOHA_CONF> | 
        
          | 308 | environment variable, or F</etc/koha/koha-conf.xml>. | 326 | environment variable, or F</etc/koha/koha-conf.xml>. | 
        
          | 309 |  | 327 |  | 
          
            
              | 310 | It saves the koha-conf.xml values in the declared memcached server(s) | 328 | XML structure is a bit complex to the uninitiated ... take a look at the | 
            
              | 311 | if currently available and uses those values until them expire and | 329 | koha-conf.xml file as well as the XML::Simple documentation for details. Or, | 
            
              | 312 | re-reads them. | 330 | here are a few examples that may give you what you need: | 
            
              |  |  | 331 |  | 
            
              | 332 | The simple elements nested within the <config> element: | 
            
              | 333 |  | 
            
              | 334 |     my $pass = $koha->{'config'}->{'pass'}; | 
            
              | 335 |  | 
            
              | 336 | The <listen> elements: | 
            
              | 337 |  | 
            
              | 338 |     my $listen = $koha->{'listen'}->{'biblioserver'}->{'content'}; | 
            
              | 339 |  | 
            
              | 340 | The elements nested within the <server> element: | 
            
              | 341 |  | 
            
              | 342 |     my $ccl2rpn = $koha->{'server'}->{'biblioserver'}->{'cql2rpn'}; | 
            
              | 343 |  | 
            
              | 344 | Returns undef in case of error. | 
        
          | 313 |  | 345 |  | 
        
          | 314 | C<&new> does not set this context as the new default context; for | 346 | C<&new> does not set this context as the new default context; for | 
        
          | 315 | that, use C<&set_context>. | 347 | that, use C<&set_context>. | 
  
    | Lines 321-366
          that, use C<&set_context>.
      
      
        Link Here | 
        
          | 321 | # 2004-08-10 A. Tarallo: Added check if the conf file is not empty | 353 | # 2004-08-10 A. Tarallo: Added check if the conf file is not empty | 
        
          | 322 | sub new { | 354 | sub new { | 
        
          | 323 |     my $class = shift; | 355 |     my $class = shift; | 
          
            
              | 324 |     my $conf_fname = shift;        # Config file to load | 356 |     my $conf_fname = shift or croak "No conf"; | 
            
              | 325 |     my $self = {}; |  |  | 
        
          | 326 |  | 357 |  | 
          
            
              | 327 |     # check that the specified config file exists and is not empty | 358 |     my $self = XMLin( | 
            
              | 328 |     undef $conf_fname unless  | 359 |         $conf_fname, | 
            
              | 329 |         (defined $conf_fname && -s $conf_fname); | 360 |         keyattr => ['id'], | 
            
              | 330 |     # Figure out a good config file to load if none was specified. | 361 |         forcearray => ['listen', 'server', 'serverinfo'], | 
            
              | 331 |     if (!defined($conf_fname)) | 362 |         suppressempty => '', | 
            
              | 332 |     { | 363 |     ); | 
            
              | 333 |         # If the $KOHA_CONF environment variable is set, use | 364 |     die "Invalid config ".(ref($conf_fname) ? $$conf_fname : $conf_fname).": ".Dumper($self) | 
            
              | 334 |         # that. Otherwise, use the built-in default. | 365 |       unless ref($self) && $self->{"config"}; | 
            
              | 335 |         if (exists $ENV{"KOHA_CONF"} and $ENV{'KOHA_CONF'} and -s  $ENV{"KOHA_CONF"}) { |  |  | 
            
              | 336 |             $conf_fname = $ENV{"KOHA_CONF"}; | 
            
              | 337 |         } elsif ($INSTALLED_CONFIG_FNAME !~ /__KOHA_CONF_DIR/ and -s $INSTALLED_CONFIG_FNAME) { | 
            
              | 338 |             # NOTE: be careful -- don't change __KOHA_CONF_DIR in the above | 
            
              | 339 |             # regex to anything else -- don't want installer to rewrite it | 
            
              | 340 |             $conf_fname = $INSTALLED_CONFIG_FNAME; | 
            
              | 341 |         } elsif (-s CONFIG_FNAME) { | 
            
              | 342 |             $conf_fname = CONFIG_FNAME; | 
            
              | 343 |         } else { | 
            
              | 344 |             warn "unable to locate Koha configuration file koha-conf.xml"; | 
            
              | 345 |             return; | 
            
              | 346 |         } | 
            
              | 347 |     } | 
            
              | 348 |      | 
            
              | 349 |     if ($ismemcached) { | 
            
              | 350 |         # retrieve from memcached | 
            
              | 351 |         $self = $memcached->get('kohaconf'); | 
            
              | 352 |         if (not defined $self) { | 
            
              | 353 |             # not in memcached yet | 
            
              | 354 |             $self = read_config_file($conf_fname); | 
            
              | 355 |         } | 
            
              | 356 |     } else { | 
            
              | 357 |         # non-memcached env, read from file | 
            
              | 358 |         $self = read_config_file($conf_fname); | 
            
              | 359 |     } | 
        
          | 360 |  | 366 |  | 
          
            
              | 361 |     $self->{"config_file"} = $conf_fname; | 367 |     $self->{"config_file"} = "$conf_fname"; | 
            
              | 362 |     warn "read_config_file($conf_fname) returned undef" if !defined($self->{"config"}); |  |  | 
            
              | 363 |     return if !defined($self->{"config"}); | 
        
          | 364 |  | 368 |  | 
        
          | 365 |     $self->{"Zconn"} = undef;    # Zebra Connections | 369 |     $self->{"Zconn"} = undef;    # Zebra Connections | 
        
          | 366 |     $self->{"marcfromkohafield"} = undef; # the hash with relations between koha table fields and MARC field/subfield | 370 |     $self->{"marcfromkohafield"} = undef; # the hash with relations between koha table fields and MARC field/subfield | 
  
    | Lines 407-419
          sub set_context
      
      
        Link Here | 
        
          | 407 |     # break this assumption by playing silly buggers, but that's | 411 |     # break this assumption by playing silly buggers, but that's | 
        
          | 408 |     # harder to do than doing it properly, and harder to check | 412 |     # harder to do than doing it properly, and harder to check | 
        
          | 409 |     # for. | 413 |     # for. | 
            
              |  |  | 414 |     my $schema; | 
        
          | 410 |     if (ref($self) eq "") | 415 |     if (ref($self) eq "") | 
        
          | 411 |     { | 416 |     { | 
        
          | 412 |         # Class method. The new context is the next argument. | 417 |         # Class method. The new context is the next argument. | 
          
            
              | 413 |         $new_context = shift; | 418 |         $new_context = shift or croak "No new context"; | 
            
              |  |  | 419 |         $schema = Koha::Database->new_schema($new_context); | 
        
          | 414 |     } else { | 420 |     } else { | 
        
          | 415 |         # Instance method. The new context is $self. | 421 |         # Instance method. The new context is $self. | 
        
          | 416 |         $new_context = $self; | 422 |         $new_context = $self; | 
            
              |  |  | 423 |  | 
            
              | 424 |         # undef $self->{schema} if $self->{schema} && !$self->{schema}->ping | 
            
              | 425 |         $schema = $self->{schema} ||= Koha::Database->new_schema($self); | 
        
          | 417 |     } | 426 |     } | 
        
          | 418 |  | 427 |  | 
        
          | 419 |     # Save the old context, if any, on the stack | 428 |     # Save the old context, if any, on the stack | 
  
    | Lines 421-426
          sub set_context
      
      
        Link Here | 
        
          | 421 |  | 430 |  | 
        
          | 422 |     # Set the new context | 431 |     # Set the new context | 
        
          | 423 |     $context = $new_context; | 432 |     $context = $new_context; | 
            
              |  |  | 433 |     Koha::Database->set_schema($schema); | 
        
          | 424 | } | 434 | } | 
        
          | 425 |  | 435 |  | 
        
          | 426 | =head2 restore_context | 436 | =head2 restore_context | 
  
    | Lines 436-454
          sub restore_context
      
      
        Link Here | 
        
          | 436 | { | 446 | { | 
        
          | 437 |     my $self = shift; | 447 |     my $self = shift; | 
        
          | 438 |  | 448 |  | 
            
              | 439 |     if ($#context_stack < 0) |  |  | 
            
              | 440 |     { | 
            
              | 441 |         # Stack underflow. | 
            
              | 442 |         die "Context stack underflow"; | 
            
              | 443 |     } | 
            
              | 444 |  | 
        
          | 445 |     # Pop the old context and set it. | 449 |     # Pop the old context and set it. | 
        
          | 446 |     $context = pop @context_stack; | 450 |     $context = pop @context_stack; | 
            
              |  |  | 451 |     Koha::Database->restore_schema(); | 
        
          | 447 |  | 452 |  | 
        
          | 448 |     # FIXME - Should this return something, like maybe the context | 453 |     # FIXME - Should this return something, like maybe the context | 
        
          | 449 |     # that was current when this was called? | 454 |     # that was current when this was called? | 
        
          | 450 | } | 455 | } | 
        
          | 451 |  | 456 |  | 
            
              |  |  | 457 | =head2 run_within_context | 
            
              | 458 |  | 
            
              | 459 |   $context->run_within_context(sub {...}); | 
            
              | 460 |  | 
            
              | 461 | Runs code within context | 
            
              | 462 |  | 
            
              | 463 | =cut | 
            
              | 464 |  | 
            
              | 465 | #' | 
            
              | 466 | sub run_within_context | 
            
              | 467 | { | 
            
              | 468 |     my $self = shift; | 
            
              | 469 |     my $code = shift or croak "No code"; | 
            
              | 470 |  | 
            
              | 471 |     $self->set_context; | 
            
              | 472 |  | 
            
              | 473 |     local $@; | 
            
              | 474 |     my $ret = eval { $code->(@_) }; | 
            
              | 475 |     my $died = $@; | 
            
              | 476 |     $self->restore_context; | 
            
              | 477 |     die $died if $died; | 
            
              | 478 |     return $ret; | 
            
              | 479 | } | 
            
              | 480 |  | 
        
          | 452 | =head2 config | 481 | =head2 config | 
        
          | 453 |  | 482 |  | 
        
          | 454 |   $value = C4::Context->config("config_variable"); | 483 |   $value = C4::Context->config("config_variable"); | 
  
    | Lines 465-490
          C<C4::Config-E<gt>new> will not return it.
      
      
        Link Here | 
        
          | 465 | =cut | 494 | =cut | 
        
          | 466 |  | 495 |  | 
        
          | 467 | sub _common_config { | 496 | sub _common_config { | 
          
            
              | 468 | 	my $var = shift; | 497 |     my $self = shift; | 
            
              | 469 | 	my $term = shift; | 498 |     my $var = shift; | 
            
              | 470 |     return if !defined($context->{$term}); | 499 |     my $term = shift; | 
            
              |  |  | 500 |  | 
            
              | 501 |     $self = $context unless ref $self; | 
            
              | 502 |     return if !defined($self->{$term}); | 
        
          | 471 |        # Presumably $self->{$term} might be | 503 |        # Presumably $self->{$term} might be | 
        
          | 472 |        # undefined if the config file given to &new | 504 |        # undefined if the config file given to &new | 
        
          | 473 |        # didn't exist, and the caller didn't bother | 505 |        # didn't exist, and the caller didn't bother | 
        
          | 474 |        # to check the return value. | 506 |        # to check the return value. | 
        
          | 475 |  | 507 |  | 
        
          | 476 |     # Return the value of the requested config variable | 508 |     # Return the value of the requested config variable | 
          
            
              | 477 |     return $context->{$term}->{$var}; | 509 |     return $self->{$term}->{$var}; | 
        
          | 478 | } | 510 | } | 
        
          | 479 |  | 511 |  | 
        
          | 480 | sub config { | 512 | sub config { | 
          
            
              | 481 | 	return _common_config($_[1],'config'); | 513 |     my $self = shift; | 
            
              |  |  | 514 |     return $self->_common_config($_[0],'config'); | 
        
          | 482 | } | 515 | } | 
        
          | 483 | sub zebraconfig { | 516 | sub zebraconfig { | 
          
            
              | 484 | 	return _common_config($_[1],'server'); | 517 |     my $self = shift; | 
            
              |  |  | 518 |     return $self->_common_config($_[0],'server'); | 
        
          | 485 | } | 519 | } | 
        
          | 486 | sub ModZebrations { | 520 | sub ModZebrations { | 
          
            
              | 487 | 	return _common_config($_[1],'serverinfo'); | 521 |     my $self = shift; | 
            
              |  |  | 522 |     return $self->_common_config($_[0],'serverinfo'); | 
        
          | 488 | } | 523 | } | 
        
          | 489 |  | 524 |  | 
        
          | 490 | =head2 preference | 525 | =head2 preference | 
  
    | Lines 517-524
          sub preference {
      
      
        Link Here | 
        
          | 517 |  | 552 |  | 
        
          | 518 |     return $self->{sysprefs}{$lc_var} if $use_syspref_cache && $self && exists $self->{sysprefs}{$lc_var}; | 553 |     return $self->{sysprefs}{$lc_var} if $use_syspref_cache && $self && exists $self->{sysprefs}{$lc_var}; | 
        
          | 519 |  | 554 |  | 
            
              | 520 |     my $dbh  = C4::Context->dbh or return 0; |  |  | 
            
              | 521 |  | 
        
          | 522 |     my $value; | 555 |     my $value; | 
        
          | 523 |     if ( defined $ENV{"OVERRIDE_SYSPREF_$var"} ) { | 556 |     if ( defined $ENV{"OVERRIDE_SYSPREF_$var"} ) { | 
        
          | 524 |         $value = $ENV{"OVERRIDE_SYSPREF_$var"}; | 557 |         $value = $ENV{"OVERRIDE_SYSPREF_$var"}; | 
  
    | Lines 626-632
          sub set_preference {
      
      
        Link Here | 
        
          | 626 |  | 659 |  | 
        
          | 627 | Returns a connection to the Zebra database | 660 | Returns a connection to the Zebra database | 
        
          | 628 |  | 661 |  | 
          
            
              | 629 | C<$self>  | 662 | C<$self> | 
        
          | 630 |  | 663 |  | 
        
          | 631 | C<$server> one of the servers defined in the koha-conf.xml file | 664 | C<$server> one of the servers defined in the koha-conf.xml file | 
        
          | 632 |  | 665 |  | 
  
    | Lines 737-744
          creates one, and connects to the database.
      
      
        Link Here | 
        
          | 737 |  | 770 |  | 
        
          | 738 | This database handle is cached for future use: if you call | 771 | This database handle is cached for future use: if you call | 
        
          | 739 | C<C4::Context-E<gt>dbh> twice, you will get the same handle both | 772 | C<C4::Context-E<gt>dbh> twice, you will get the same handle both | 
          
            
              | 740 | times. If you need a second database handle, use C<&new_dbh> and | 773 | times. If you need a second database handle, use C<&new_dbh>. | 
            
              | 741 | possibly C<&set_dbh>. |  |  | 
        
          | 742 |  | 774 |  | 
        
          | 743 | =cut | 775 | =cut | 
        
          | 744 |  | 776 |  | 
  
    | Lines 777-840
          sub new_dbh
      
      
        Link Here | 
        
          | 777 |     return &dbh({ new => 1 }); | 809 |     return &dbh({ new => 1 }); | 
        
          | 778 | } | 810 | } | 
        
          | 779 |  | 811 |  | 
            
              | 780 | =head2 set_dbh |  |  | 
            
              | 781 |  | 
            
              | 782 |   $my_dbh = C4::Connect->new_dbh; | 
            
              | 783 |   C4::Connect->set_dbh($my_dbh); | 
            
              | 784 |   ... | 
            
              | 785 |   C4::Connect->restore_dbh; | 
            
              | 786 |  | 
            
              | 787 | C<&set_dbh> and C<&restore_dbh> work in a manner analogous to | 
            
              | 788 | C<&set_context> and C<&restore_context>. | 
            
              | 789 |  | 
            
              | 790 | C<&set_dbh> saves the current database handle on a stack, then sets | 
            
              | 791 | the current database handle to C<$my_dbh>. | 
            
              | 792 |  | 
            
              | 793 | C<$my_dbh> is assumed to be a good database handle. | 
            
              | 794 |  | 
            
              | 795 | =cut | 
            
              | 796 |  | 
            
              | 797 | #' | 
            
              | 798 | sub set_dbh | 
            
              | 799 | { | 
            
              | 800 |     my $self = shift; | 
            
              | 801 |     my $new_dbh = shift; | 
            
              | 802 |  | 
            
              | 803 |     # Save the current database handle on the handle stack. | 
            
              | 804 |     # We assume that $new_dbh is all good: if the caller wants to | 
            
              | 805 |     # screw himself by passing an invalid handle, that's fine by | 
            
              | 806 |     # us. | 
            
              | 807 |     push @{$context->{"dbh_stack"}}, $context->{"dbh"}; | 
            
              | 808 |     $context->{"dbh"} = $new_dbh; | 
            
              | 809 | } | 
            
              | 810 |  | 
            
              | 811 | =head2 restore_dbh | 
            
              | 812 |  | 
            
              | 813 |   C4::Context->restore_dbh; | 
            
              | 814 |  | 
            
              | 815 | Restores the database handle saved by an earlier call to | 
            
              | 816 | C<C4::Context-E<gt>set_dbh>. | 
            
              | 817 |  | 
            
              | 818 | =cut | 
            
              | 819 |  | 
            
              | 820 | #' | 
            
              | 821 | sub restore_dbh | 
            
              | 822 | { | 
            
              | 823 |     my $self = shift; | 
            
              | 824 |  | 
            
              | 825 |     if ($#{$context->{"dbh_stack"}} < 0) | 
            
              | 826 |     { | 
            
              | 827 |         # Stack underflow | 
            
              | 828 |         die "DBH stack underflow"; | 
            
              | 829 |     } | 
            
              | 830 |  | 
            
              | 831 |     # Pop the old database handle and set it. | 
            
              | 832 |     $context->{"dbh"} = pop @{$context->{"dbh_stack"}}; | 
            
              | 833 |  | 
            
              | 834 |     # FIXME - If it is determined that restore_context should | 
            
              | 835 |     # return something, then this function should, too. | 
            
              | 836 | } | 
            
              | 837 |  | 
        
          | 838 | =head2 queryparser | 812 | =head2 queryparser | 
        
          | 839 |  | 813 |  | 
        
          | 840 |   $queryparser = C4::Context->queryparser | 814 |   $queryparser = C4::Context->queryparser |