version 1.618, 2005/03/31 15:55:47
|
version 1.619, 2005/04/05 20:43:27
|
Line 40 qw(%perlvar %hostname %badServerCache %i
|
Line 40 qw(%perlvar %hostname %badServerCache %i
|
%courselogs %accesshash %userrolehash $processmarker $dumpcount |
%courselogs %accesshash %userrolehash $processmarker $dumpcount |
%coursedombuf %coursenumbuf %coursehombuf %coursedescrbuf %courseinstcodebuf %courseownerbuf |
%coursedombuf %coursenumbuf %coursehombuf %coursedescrbuf %courseinstcodebuf %courseownerbuf |
%domaindescription %domain_auth_def %domain_auth_arg_def |
%domaindescription %domain_auth_def %domain_auth_arg_def |
%domain_lang_def %domain_city %domain_longi %domain_lati $tmpdir $_64bit); |
%domain_lang_def %domain_city %domain_longi %domain_lati $tmpdir $_64bit |
|
%env); |
|
|
use IO::Socket; |
use IO::Socket; |
use GDBM_File; |
use GDBM_File; |
Line 54 use Cache::Memcached;
|
Line 55 use Cache::Memcached;
|
my $readit; |
my $readit; |
my $max_connection_retries = 10; # Or some such value. |
my $max_connection_retries = 10; # Or some such value. |
|
|
|
require Exporter; |
|
|
|
our @ISA = qw (Exporter); |
|
our @EXPORT = qw(%env); |
|
|
=pod |
=pod |
|
|
=head1 Package Variables |
=head1 Package Variables |
Line 279 sub transfer_profile_to_env {
|
Line 285 sub transfer_profile_to_env {
|
chomp($profile[$envi]); |
chomp($profile[$envi]); |
my ($envname,$envvalue)=split(/=/,$profile[$envi]); |
my ($envname,$envvalue)=split(/=/,$profile[$envi]); |
$ENV{$envname} = $envvalue; |
$ENV{$envname} = $envvalue; |
|
$env{$envname} = $envvalue; |
if (my ($key,$time) = ($envname =~ /^(cgi\.(\d+)_\d+\.)/)) { |
if (my ($key,$time) = ($envname =~ /^(cgi\.(\d+)_\d+\.)/)) { |
if ($time < time-300) { |
if ($time < time-300) { |
$Remove{$key}++; |
$Remove{$key}++; |
Line 286 sub transfer_profile_to_env {
|
Line 293 sub transfer_profile_to_env {
|
} |
} |
} |
} |
$ENV{'user.environment'} = "$lonidsdir/$handle.id"; |
$ENV{'user.environment'} = "$lonidsdir/$handle.id"; |
|
$env{'user.environment'} = "$lonidsdir/$handle.id"; |
foreach my $expired_key (keys(%Remove)) { |
foreach my $expired_key (keys(%Remove)) { |
&delenv($expired_key); |
&delenv($expired_key); |
} |
} |
Line 303 sub appenv {
|
Line 311 sub appenv {
|
delete($newenv{$_}); |
delete($newenv{$_}); |
} else { |
} else { |
$ENV{$_}=$newenv{$_}; |
$ENV{$_}=$newenv{$_}; |
|
$env{$_}=$newenv{$_}; |
} |
} |
} |
} |
|
|
Line 390 sub delenv {
|
Line 399 sub delenv {
|
if ($_=~/^$delthis/) { |
if ($_=~/^$delthis/) { |
my ($key,undef) = split('=',$_); |
my ($key,undef) = split('=',$_); |
delete($ENV{$key}); |
delete($ENV{$key}); |
|
delete($env{$key}); |
} else { |
} else { |
print $fh $_; |
print $fh $_; |
} |
} |
Line 5653 BEGIN {
|
Line 5663 BEGIN {
|
} |
} |
} |
} |
close($config); |
close($config); |
|
# FIXME: dev server don't want this, production servers _do_ want this |
|
#&get_iphost(); |
} |
} |
|
|
sub get_iphost { |
sub get_iphost { |