version 1.957, 2008/04/30 22:42:59
|
version 1.960, 2008/06/06 04:53:51
|
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 913 sub retrieve_inst_usertypes {
|
Line 958 sub retrieve_inst_usertypes {
|
if (defined(&domain($udom,'primary'))) { |
if (defined(&domain($udom,'primary'))) { |
my $uhome=&domain($udom,'primary'); |
my $uhome=&domain($udom,'primary'); |
my $rep=&reply("inst_usertypes:$udom",$uhome); |
my $rep=&reply("inst_usertypes:$udom",$uhome); |
|
if ($rep =~ /^(con_lost|error|no_such_host|refused)/) { |
|
&logthis("get_dom failed - $rep returned from $uhome in domain: $udom"); |
|
return (\%returnhash,\@order); |
|
} |
my ($hashitems,$orderitems) = split(/:/,$rep); |
my ($hashitems,$orderitems) = split(/:/,$rep); |
my @pairs=split(/\&/,$hashitems); |
my @pairs=split(/\&/,$hashitems); |
foreach my $item (@pairs) { |
foreach my $item (@pairs) { |
Line 2717 sub courseidput {
|
Line 2766 sub courseidput {
|
sub courseiddump { |
sub courseiddump { |
my ($domfilter,$descfilter,$sincefilter,$instcodefilter,$ownerfilter, |
my ($domfilter,$descfilter,$sincefilter,$instcodefilter,$ownerfilter, |
$coursefilter,$hostidflag,$hostidref,$typefilter,$regexp_ok, |
$coursefilter,$hostidflag,$hostidref,$typefilter,$regexp_ok, |
$selfenrollonly)=@_; |
$selfenrollonly,$catfilter)=@_; |
my $as_hash = 1; |
my $as_hash = 1; |
my %returnhash; |
my %returnhash; |
if (!$domfilter) { $domfilter=''; } |
if (!$domfilter) { $domfilter=''; } |
Line 2735 sub courseiddump {
|
Line 2784 sub courseiddump {
|
&escape($instcodefilter).':'.&escape($ownerfilter). |
&escape($instcodefilter).':'.&escape($ownerfilter). |
':'.&escape($coursefilter).':'.&escape($typefilter). |
':'.&escape($coursefilter).':'.&escape($typefilter). |
':'.&escape($regexp_ok).':'.$as_hash.':'. |
':'.&escape($regexp_ok).':'.$as_hash.':'. |
&escape($selfenrollonly),$tryserver); |
&escape($selfenrollonly).':'.&escape($catfilter),$tryserver); |
my @pairs=split(/\&/,$rep); |
my @pairs=split(/\&/,$rep); |
foreach my $item (@pairs) { |
foreach my $item (@pairs) { |
my ($key,$value)=split(/\=/,$item,2); |
my ($key,$value)=split(/\=/,$item,2); |
Line 4489 sub allowed {
|
Line 4538 sub allowed {
|
} |
} |
|
|
# Full access at system, domain or course-wide level? Exit. |
# Full access at system, domain or course-wide level? Exit. |
|
|
if ($thisallowed=~/F/) { |
if ($thisallowed=~/F/) { |
return 'F'; |
return 'F'; |
} |
} |
Line 8763 $memcache=new Cache::Memcached({'servers
|
Line 8811 $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>'); |