version 1.370, 2003/05/08 21:50:54
|
version 1.381, 2003/06/18 19:10:23
|
Line 243 sub critical {
|
Line 243 sub critical {
|
} |
} |
return $answer; |
return $answer; |
} |
} |
|
|
|
# ------------------------------------------- Transfer profile into environment |
|
|
|
sub transfer_profile_to_env { |
|
my ($lonidsdir,$handle)=@_; |
|
my @profile; |
|
{ |
|
my $idf=Apache::File->new("$lonidsdir/$handle.id"); |
|
flock($idf,LOCK_SH); |
|
@profile=<$idf>; |
|
$idf->close(); |
|
} |
|
my $envi; |
|
for ($envi=0;$envi<=$#profile;$envi++) { |
|
chomp($profile[$envi]); |
|
my ($envname,$envvalue)=split(/=/,$profile[$envi]); |
|
$ENV{$envname} = $envvalue; |
|
} |
|
$ENV{'user.environment'} = "$lonidsdir/$handle.id"; |
|
} |
|
|
# ---------------------------------------------------------- Append Environment |
# ---------------------------------------------------------- Append Environment |
|
|
Line 358 sub userload {
|
Line 378 sub userload {
|
while ($filename=readdir(LONIDS)) { |
while ($filename=readdir(LONIDS)) { |
if ($filename eq '.' || $filename eq '..') {next;} |
if ($filename eq '.' || $filename eq '..') {next;} |
my ($atime)=(stat($perlvar{'lonIDsDir'}.'/'.$filename))[8]; |
my ($atime)=(stat($perlvar{'lonIDsDir'}.'/'.$filename))[8]; |
if ($curtime-$atime < 3600) { $num_users++; } |
if ($curtime-$atime < 3600) { $numusers++; } |
} |
} |
closedir(LONIDS); |
closedir(LONIDS); |
} |
} |
my $userloadpercent=0; |
my $userloadpercent=0; |
my $maxuserload=$perlvar{'lonUserLoadLim'}; |
my $maxuserload=$perlvar{'lonUserLoadLim'}; |
if ($maxuserload) { |
if ($maxuserload) { |
$userloadpercent=100*$num_users/$maxuserload; |
$userloadpercent=100*$numusers/$maxuserload; |
} |
} |
|
$userloadpercent=sprintf("%.2f",$userloadpercent); |
return $userloadpercent; |
return $userloadpercent; |
} |
} |
|
|
Line 961 sub repcopy {
|
Line 982 sub repcopy {
|
|
|
# ------------------------------------------------ Get server side include body |
# ------------------------------------------------ Get server side include body |
sub ssi_body { |
sub ssi_body { |
my $filelink=shift; |
my ($filelink,%form)=@_; |
my $output=($filelink=~/^http\:/?&externalssi($filelink): |
my $output=($filelink=~/^http\:/?&externalssi($filelink): |
&ssi($filelink)); |
&ssi($filelink,%form)); |
$output=~s/^.*\<body[^\>]*\>//si; |
$output=~s/^.*\<body[^\>]*\>//si; |
$output=~s/\<\/body\s*\>.*$//si; |
$output=~s/\<\/body\s*\>.*$//si; |
$output=~ |
$output=~ |
Line 1259 sub get_course_adv_roles {
|
Line 1280 sub get_course_adv_roles {
|
} else { |
} else { |
$returnhash{$key}=$username.':'.$domain; |
$returnhash{$key}=$username.':'.$domain; |
} |
} |
} |
} |
return sort %returnhash; |
return %returnhash; |
} |
} |
|
|
# ---------------------------------------------------------- Course ID routines |
# ---------------------------------------------------------- Course ID routines |
Line 1622 sub tmpreset {
|
Line 1643 sub tmpreset {
|
my ($symb,$namespace,$domain,$stuname) = @_; |
my ($symb,$namespace,$domain,$stuname) = @_; |
if (!$symb) { |
if (!$symb) { |
$symb=&symbread(); |
$symb=&symbread(); |
if (!$symb) { $symb= $ENV{'REQUEST_URI'}; } |
if (!$symb) { $symb= $ENV{'request.url'}; } |
} |
} |
$symb=escape($symb); |
$symb=escape($symb); |
|
|
Line 2640 sub assignrole {
|
Line 2661 sub assignrole {
|
} else { |
} else { |
my $cwosec=$url; |
my $cwosec=$url; |
$cwosec=~s/^\/(\w+)\/(\w+)\/.*/$1\/$2/; |
$cwosec=~s/^\/(\w+)\/(\w+)\/.*/$1\/$2/; |
unless (&allowed('c'.$role,$cwosec)) { |
unless ((&allowed('c'.$role,$cwosec)) || &allowed('c'.$role,$udom)) { |
&logthis('Refused assignrole: '. |
&logthis('Refused assignrole: '. |
$udom.' '.$uname.' '.$url.' '.$role.' '.$end.' '.$start.' by '. |
$udom.' '.$uname.' '.$url.' '.$role.' '.$end.' '.$start.' by '. |
$ENV{'user.name'}.' at '.$ENV{'user.domain'}); |
$ENV{'user.name'}.' at '.$ENV{'user.domain'}); |
Line 2660 sub assignrole {
|
Line 2681 sub assignrole {
|
} |
} |
# actually delete |
# actually delete |
if ($deleteflag) { |
if ($deleteflag) { |
if (&allowed('dro',$udom)) { |
if ((&allowed('dro',$udom)) || (&allowed('dro',$url))) { |
# modify command to delete the role |
# modify command to delete the role |
$command="encrypt:rolesdel:$ENV{'user.domain'}:$ENV{'user.name'}:". |
$command="encrypt:rolesdel:$ENV{'user.domain'}:$ENV{'user.name'}:". |
"$udom:$uname:$url".'_'."$mrole"; |
"$udom:$uname:$url".'_'."$mrole"; |
|
&logthis("$ENV{'user.name'} at $ENV{'user.domain'} deletes $mrole in $url for $uname at $udom"); |
# set start and finish to negative values for userrolelog |
# set start and finish to negative values for userrolelog |
$start=-1; |
$start=-1; |
$end=-1; |
$end=-1; |
Line 3062 sub GetFileTimestamp {
|
Line 3084 sub GetFileTimestamp {
|
$subdir =~ s/(.)(.)(.).*/$1\/$2\/$3/; |
$subdir =~ s/(.)(.)(.).*/$1\/$2\/$3/; |
my $proname="$studentDomain/$subdir/$studentName"; |
my $proname="$studentDomain/$subdir/$studentName"; |
$proname .= '/'.$filename; |
$proname .= '/'.$filename; |
my @dir = &Apache::lonnet::dirlist($proname, $studentDomain, $studentName, |
my ($fileStat) = &Apache::lonnet::dirlist($proname, $studentDomain, |
$root); |
$studentName, $root); |
my $fileStat = $dir[0]; |
|
my @stats = split('&', $fileStat); |
my @stats = split('&', $fileStat); |
if($stats[0] ne 'empty' && $stats[0] ne 'no_such_dir') { |
if($stats[0] ne 'empty' && $stats[0] ne 'no_such_dir') { |
return $stats[9]; |
# @stats contains first the filename, then the stat output |
|
return $stats[10]; # so this is 10 instead of 9. |
} else { |
} else { |
return -1; |
return -1; |
} |
} |
Line 3163 sub courseresdata {
|
Line 3185 sub courseresdata {
|
return undef; |
return undef; |
} |
} |
|
|
# --------------------------------------------------------- Value of a Variable |
# |
|
# EXT resource caching routines |
|
# |
|
|
|
sub clear_EXT_cache_status { |
|
&delenv('cache.'); |
|
} |
|
|
|
sub EXT_cache_status { |
|
my ($target_domain,$target_user) = @_; |
|
my $cachename = 'cache.'.$target_user.'.'.$target_domain; |
|
if (exists($ENV{$cachename}) && ($ENV{$cachename}+1800) > time) { |
|
# We know already the user has no data |
|
return 1; |
|
} else { |
|
return 0; |
|
} |
|
} |
|
|
|
sub EXT_cache_set { |
|
my ($target_domain,$target_user) = @_; |
|
my $cachename = 'cache.'.$target_user.'.'.$target_domain; |
|
&appenv($cachename => time); |
|
} |
|
|
|
# --------------------------------------------------------- Value of a Variable |
sub EXT { |
sub EXT { |
my ($varname,$symbparm,$udom,$uname,)=@_; |
my ($varname,$symbparm,$udom,$uname,$usection)=@_; |
|
|
unless ($varname) { return ''; } |
unless ($varname) { return ''; } |
#get real user name/domain, courseid and symb |
#get real user name/domain, courseid and symb |
Line 3174 sub EXT {
|
Line 3220 sub EXT {
|
my $publicuser; |
my $publicuser; |
if (!($uname && $udom)) { |
if (!($uname && $udom)) { |
(my $cursymb,$courseid,$udom,$uname,$publicuser)= |
(my $cursymb,$courseid,$udom,$uname,$publicuser)= |
&Apache::lonxml::whichuser(); |
&Apache::lonxml::whichuser($symbparm); |
if (!$symbparm) { $symbparm=$cursymb; } |
if (!$symbparm) { $symbparm=$cursymb; } |
} else { |
} else { |
$courseid=$ENV{'request.course.id'}; |
$courseid=$ENV{'request.course.id'}; |
Line 3252 sub EXT {
|
Line 3298 sub EXT {
|
} elsif ($realm eq 'query') { |
} elsif ($realm eq 'query') { |
# ---------------------------------------------- pull stuff out of query string |
# ---------------------------------------------- pull stuff out of query string |
&Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},[$space]); |
&Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},[$space]); |
return $ENV{'form.'.$space}; |
return $ENV{'form.'.$spacequalifierrest}; |
} elsif ($realm eq 'request') { |
} elsif ($realm eq 'request') { |
# ------------------------------------------------------------- request.browser |
# ------------------------------------------------------------- request.browser |
if ($space eq 'browser') { |
if ($space eq 'browser') { |
Line 3283 sub EXT {
|
Line 3329 sub EXT {
|
($ENV{'user.domain'} eq $udom)) { |
($ENV{'user.domain'} eq $udom)) { |
$section=$ENV{'request.course.sec'}; |
$section=$ENV{'request.course.sec'}; |
} else { |
} else { |
$section=&usection($udom,$uname,$courseid); |
if (! defined($usection)) { |
|
$section=&usection($udom,$uname,$courseid); |
|
} else { |
|
$section = $usection; |
|
} |
} |
} |
|
|
my $seclevel=$courseid.'.['.$section.'].'.$spacequalifierrest; |
my $seclevel=$courseid.'.['.$section.'].'.$spacequalifierrest; |
Line 3295 sub EXT {
|
Line 3345 sub EXT {
|
my $courselevelm=$courseid.'.'.$mapparm; |
my $courselevelm=$courseid.'.'.$mapparm; |
|
|
# ----------------------------------------------------------- first, check user |
# ----------------------------------------------------------- first, check user |
#most student don't have any data set, check if there is some data |
#most student don\'t have any data set, check if there is some data |
#every thirty minutes |
#every thirty minutes |
if (! |
if (! &EXT_cache_status($udom,$uname)) { |
(exists($ENV{'cache.studentresdata'}) |
|
&& (($ENV{'cache.studentresdata'}+1800) > time))) { |
|
my %resourcedata=&get('resourcedata', |
my %resourcedata=&get('resourcedata', |
[$courselevelr,$courselevelm,$courselevel], |
[$courselevelr,$courselevelm,$courselevel], |
$udom,$uname); |
$udom,$uname); |
Line 3318 sub EXT {
|
Line 3366 sub EXT {
|
$uname." at ".$udom.": ". |
$uname." at ".$udom.": ". |
$tmp."</font>"); |
$tmp."</font>"); |
} elsif ($tmp=~/error:No such file/) { |
} elsif ($tmp=~/error:No such file/) { |
$ENV{'cache.studentresdata'}=time; |
&EXT_cache_set($udom,$uname); |
&appenv(('cache.studentresdata'=> |
|
$ENV{'cache.studentresdata'})); |
|
} elsif ($tmp =~ /^(con_lost|no_such_host)/) { |
} elsif ($tmp =~ /^(con_lost|no_such_host)/) { |
return $tmp; |
return $tmp; |
} |
} |