version 1.957, 2008/04/30 22:42:59
|
version 1.958, 2008/05/12 20:59:15
|
Line 39 use vars qw(%perlvar %spareid %pr %prp $
|
Line 39 use vars qw(%perlvar %spareid %pr %prp $
|
my (%badServerCache, $memcache, %courselogs, %accesshash, %domainrolehash, |
my (%badServerCache, $memcache, %courselogs, %accesshash, %domainrolehash, |
%userrolehash, $processmarker, $dumpcount, %coursedombuf, |
%userrolehash, $processmarker, $dumpcount, %coursedombuf, |
%coursenumbuf, %coursehombuf, %coursedescrbuf, %courseinstcodebuf, |
%coursenumbuf, %coursehombuf, %coursedescrbuf, %courseinstcodebuf, |
%courseownerbuf, %coursetypebuf); |
%courseownerbuf, %coursetypebuf,$locknum); |
|
|
use IO::Socket; |
use IO::Socket; |
use GDBM_File; |
use GDBM_File; |
Line 526 sub get_env_multiple {
|
Line 526 sub get_env_multiple {
|
return(@values); |
return(@values); |
} |
} |
|
|
|
# ------------------------------------------------------------------- Locking |
|
|
|
sub set_lock { |
|
my ($text)=@_; |
|
$locknum++; |
|
my $id=$$.'-'.$locknum; |
|
&appenv({'session.locks' => $env{'session.locks'}.','.$id, |
|
'session.lock.'.$id => $text}); |
|
return $id; |
|
} |
|
|
|
sub get_locks { |
|
my $num=0; |
|
my %texts=(); |
|
foreach my $lock (split(/\,/,$env{'session.locks'})) { |
|
if ($lock=~/\w/) { |
|
$num++; |
|
$texts{$lock}=$env{'session.lock.'.$lock}; |
|
} |
|
} |
|
return ($num,%texts); |
|
} |
|
|
|
sub remove_lock { |
|
my ($id)=@_; |
|
my $newlocks=''; |
|
foreach my $lock (split(/\,/,$env{'session.locks'})) { |
|
if (($lock=~/\w/) && ($lock ne $id)) { |
|
$newlocks.=','.$lock; |
|
} |
|
} |
|
&appenv({'session.locks' => $newlocks}); |
|
&delenv('session.lock.'.$id); |
|
} |
|
|
|
sub remove_all_locks { |
|
my $activelocks=$env{'session.locks'}; |
|
foreach my $lock (split(/\,/,$env{'session.locks'})) { |
|
if ($lock=~/\w/) { |
|
&remove_lock($lock); |
|
} |
|
} |
|
} |
|
|
|
|
# ------------------------------------------ Find out current server userload |
# ------------------------------------------ Find out current server userload |
sub userload { |
sub userload { |
my $numusers=0; |
my $numusers=0; |
Line 8763 $memcache=new Cache::Memcached({'servers
|
Line 8808 $memcache=new Cache::Memcached({'servers
|
|
|
$processmarker='_'.time.'_'.$perlvar{'lonHostID'}; |
$processmarker='_'.time.'_'.$perlvar{'lonHostID'}; |
$dumpcount=0; |
$dumpcount=0; |
|
$locknum=0; |
|
|
&logtouch(); |
&logtouch(); |
&logthis('<font color="yellow">INFO: Read configuration</font>'); |
&logthis('<font color="yellow">INFO: Read configuration</font>'); |