version 1.275, 2002/08/28 21:50:27
|
version 1.299, 2002/10/22 21:49:10
|
Line 86 use GDBM_File;
|
Line 86 use GDBM_File;
|
use Apache::Constants qw(:common :http); |
use Apache::Constants qw(:common :http); |
use HTML::LCParser; |
use HTML::LCParser; |
use Fcntl qw(:flock); |
use Fcntl qw(:flock); |
|
use Apache::loncoursedata; |
|
|
my $readit; |
my $readit; |
|
|
# --------------------------------------------------------------------- Logging |
# --------------------------------------------------------------------- Logging |
Line 348 sub delenv {
|
Line 350 sub delenv {
|
return 'ok'; |
return 'ok'; |
} |
} |
|
|
|
# ------------------------------------------ Fight off request when overloaded |
|
|
|
sub overloaderror { |
|
my ($r,$checkserver)=@_; |
|
unless ($checkserver) { $checkserver=$perlvar{'lonHostID'}; } |
|
my $loadavg; |
|
if ($checkserver eq $perlvar{'lonHostID'}) { |
|
my $loadfile=Apache::File->new('/proc/loadavg'); |
|
$loadavg=<$loadfile>; |
|
$loadavg =~ s/\s.*//g; |
|
$loadavg = 100*$loadavg/$perlvar{'lonLoadLim'}; |
|
} else { |
|
$loadavg=&reply('load',$checkserver); |
|
} |
|
my $overload=$loadavg-100; |
|
if ($overload>0) { |
|
$r->err_headers_out->{'Retry-After'}=$overload; |
|
$r->log_error('Overload of '.$overload.' on '.$checkserver); |
|
return 413; |
|
} |
|
return ''; |
|
} |
|
|
# ------------------------------ Find server with least workload from spare.tab |
# ------------------------------ Find server with least workload from spare.tab |
|
|
sub spareserver { |
sub spareserver { |
|
my $loadpercent = shift; |
my $tryserver; |
my $tryserver; |
my $spareserver=''; |
my $spareserver=''; |
my $lowestserver=100; |
my $lowestserver=$loadpercent; |
foreach $tryserver (keys %spareid) { |
foreach $tryserver (keys %spareid) { |
my $answer=reply('load',$tryserver); |
my $answer=reply('load',$tryserver); |
if (($answer =~ /\d/) && ($answer<$lowestserver)) { |
if (($answer =~ /\d/) && ($answer<$lowestserver)) { |
Line 567 sub idput {
|
Line 593 sub idput {
|
|
|
# ------------------------------------- Find the section of student in a course |
# ------------------------------------- Find the section of student in a course |
|
|
|
sub getsection { |
|
my ($udom,$unam,$courseid)=@_; |
|
$courseid=~s/\_/\//g; |
|
$courseid=~s/^(\w)/\/$1/; |
|
my %Pending; |
|
my %Expired; |
|
# |
|
# Each role can either have not started yet (pending), be active, |
|
# or have expired. |
|
# |
|
# If there is an active role, we are done. |
|
# |
|
# If there is more than one role which has not started yet, |
|
# choose the one which will start sooner |
|
# If there is one role which has not started yet, return it. |
|
# |
|
# If there is more than one expired role, choose the one which ended last. |
|
# If there is a role which has expired, return it. |
|
# |
|
foreach (split(/\&/,&reply('dump:'.$udom.':'.$unam.':roles', |
|
&homeserver($unam,$udom)))) { |
|
my ($key,$value)=split(/\=/,$_); |
|
$key=&unescape($key); |
|
next if ($key !~/^$courseid(?:\/)*(\w+)*\_st$/); |
|
my $section=$1; |
|
if ($key eq $courseid.'_st') { $section=''; } |
|
my ($dummy,$end,$start)=split(/\_/,&unescape($value)); |
|
my $now=time; |
|
if (defined($end) && ($now > $end)) { |
|
$Expired{$end}=$section; |
|
next; |
|
} |
|
if (defined($start) && ($now < $start)) { |
|
$Pending{$start}=$section; |
|
next; |
|
} |
|
return $section; |
|
} |
|
# |
|
# Presumedly there will be few matching roles from the above |
|
# loop and the sorting time will be negligible. |
|
if (scalar(keys(%Pending))) { |
|
my ($time) = sort {$a <=> $b} keys(%Pending); |
|
return $Pending{$time}; |
|
} |
|
if (scalar(keys(%Expired))) { |
|
my @sorted = sort {$a <=> $b} keys(%Expired); |
|
my $time = pop(@sorted); |
|
return $Expired{$time}; |
|
} |
|
return '-1'; |
|
} |
|
|
sub usection { |
sub usection { |
my ($udom,$unam,$courseid)=@_; |
my ($udom,$unam,$courseid)=@_; |
$courseid=~s/\_/\//g; |
$courseid=~s/\_/\//g; |
Line 620 sub chatsend {
|
Line 699 sub chatsend {
|
&escape($newentry)),$chome); |
&escape($newentry)),$chome); |
} |
} |
|
|
|
# ------------------------------------------ Find current version of a resource |
|
|
|
sub getversion { |
|
my $fname=&clutter(shift); |
|
unless ($fname=~/^\/res\//) { return -1; } |
|
return ¤tversion(&filelocation('',$fname)); |
|
} |
|
|
|
sub currentversion { |
|
my $fname=shift; |
|
my $author=$fname; |
|
$author=~s/\/home\/httpd\/html\/res\/([^\/]*)\/([^\/]*).*/$1\/$2/; |
|
my ($udom,$uname)=split(/\//,$author); |
|
my $home=homeserver($uname,$udom); |
|
if ($home eq 'no_host') { |
|
return -1; |
|
} |
|
my $answer=reply("currentversion:$fname",$home); |
|
if (($answer eq 'con_lost') || ($answer eq 'rejected')) { |
|
return -1; |
|
} |
|
return $answer; |
|
} |
|
|
# ----------------------------- Subscribe to a resource, return URL if possible |
# ----------------------------- Subscribe to a resource, return URL if possible |
|
|
sub subscribe { |
sub subscribe { |
Line 628 sub subscribe {
|
Line 731 sub subscribe {
|
$author=~s/\/home\/httpd\/html\/res\/([^\/]*)\/([^\/]*).*/$1\/$2/; |
$author=~s/\/home\/httpd\/html\/res\/([^\/]*)\/([^\/]*).*/$1\/$2/; |
my ($udom,$uname)=split(/\//,$author); |
my ($udom,$uname)=split(/\//,$author); |
my $home=homeserver($uname,$udom); |
my $home=homeserver($uname,$udom); |
if (($home eq 'no_host') || ($home eq $perlvar{'lonHostID'})) { |
if ($home eq 'no_host') { |
return 'not_found'; |
return 'not_found'; |
} |
} |
my $answer=reply("sub:$fname",$home); |
my $answer=reply("sub:$fname",$home); |
Line 659 sub repcopy {
|
Line 762 sub repcopy {
|
} elsif ($remoteurl eq 'directory') { |
} elsif ($remoteurl eq 'directory') { |
return OK; |
return OK; |
} else { |
} else { |
|
my $author=$filename; |
|
$author=~s/\/home\/httpd\/html\/res\/([^\/]*)\/([^\/]*).*/$1\/$2/; |
|
my ($udom,$uname)=split(/\//,$author); |
|
my $home=homeserver($uname,$udom); |
|
unless ($home eq $perlvar{'lonHostID'}) { |
my @parts=split(/\//,$filename); |
my @parts=split(/\//,$filename); |
my $path="/$parts[1]/$parts[2]/$parts[3]/$parts[4]"; |
my $path="/$parts[1]/$parts[2]/$parts[3]/$parts[4]"; |
if ($path ne "$perlvar{'lonDocRoot'}/res") { |
if ($path ne "$perlvar{'lonDocRoot'}/res") { |
Line 694 sub repcopy {
|
Line 802 sub repcopy {
|
rename($transname,$filename); |
rename($transname,$filename); |
return OK; |
return OK; |
} |
} |
|
} |
} |
} |
} |
} |
|
|
Line 784 sub finishuserfileupload {
|
Line 893 sub finishuserfileupload {
|
} |
} |
# Notify homeserver to grep it |
# Notify homeserver to grep it |
# |
# |
if |
|
(&reply('fetchuserfile:'.$docudom.'/'.$docuname.'/'.$fname,$docuhome) eq 'ok') |
my $fetchresult= |
{ |
&reply('fetchuserfile:'.$docudom.'/'.$docuname.'/'.$fname,$docuhome); |
|
if ($fetchresult eq 'ok') { |
# |
# |
# Return the URL to it |
# Return the URL to it |
return '/uploaded/'.$path.$fname; |
return '/uploaded/'.$path.$fname; |
} else { |
} else { |
|
&logthis('Failed to transfer '.$docudom.'/'.$docuname.'/'.$fname. |
|
' to host '.$docuhome.': '.$fetchresult); |
return '/adm/notfound.html'; |
return '/adm/notfound.html'; |
} |
} |
} |
} |
Line 871 sub countacc {
|
Line 983 sub countacc {
|
my $url=&declutter(shift); |
my $url=&declutter(shift); |
unless ($ENV{'request.course.id'}) { return ''; } |
unless ($ENV{'request.course.id'}) { return ''; } |
$accesshash{$ENV{'request.course.id'}.'___'.$url.'___course'}=1; |
$accesshash{$ENV{'request.course.id'}.'___'.$url.'___course'}=1; |
my $key=$processmarker.'_'.$dumpcount.'___'.$url.'___count'; |
my $key=$$.$processmarker.'_'.$dumpcount.'___'.$url.'___count'; |
if (defined($accesshash{$key})) { |
if (defined($accesshash{$key})) { |
$accesshash{$key}++; |
$accesshash{$key}++; |
} else { |
} else { |
Line 991 sub devalidate {
|
Line 1103 sub devalidate {
|
if ($cid) { |
if ($cid) { |
my $key=$ENV{'user.name'}.':'.$ENV{'user.domain'}.':'; |
my $key=$ENV{'user.name'}.':'.$ENV{'user.domain'}.':'; |
my $status= |
my $status= |
&del('nohist_calculatedsheet', |
&del('nohist_calculatedsheets', |
[$key.'studentcalc'], |
[$key.'studentcalc'], |
$ENV{'course.'.$cid.'.domain'}, |
$ENV{'course.'.$cid.'.domain'}, |
$ENV{'course.'.$cid.'.num'}) |
$ENV{'course.'.$cid.'.num'}) |
Line 1962 sub is_on_map {
|
Line 2074 sub is_on_map {
|
my @uriparts=split(/\//,$uri); |
my @uriparts=split(/\//,$uri); |
my $filename=$uriparts[$#uriparts]; |
my $filename=$uriparts[$#uriparts]; |
my $pathname=$uri; |
my $pathname=$uri; |
$pathname=~s/\/$filename$//; |
$pathname=~s|/\Q$filename\E$||; |
|
#Trying to find the conditional for the file |
my $match=($ENV{'acc.res.'.$ENV{'request.course.id'}.'.'.$pathname}=~ |
my $match=($ENV{'acc.res.'.$ENV{'request.course.id'}.'.'.$pathname}=~ |
/\&$filename\:([\d\|]+)\&/); |
/\&\Q$filename\E\:([\d\|]+)\&/); |
if ($match) { |
if ($match) { |
return (1,$1); |
return (1,$1); |
} else { |
} else { |
return (0,0); |
return (0,0); |
} |
} |
} |
} |
|
|
# ----------------------------------------------------------------- Define Role |
# ----------------------------------------------------------------- Define Role |
Line 2260 sub modifystudent {
|
Line 2373 sub modifystudent {
|
($udom,$uname,$uid,$umode,$upass,$first,$middle,$last,$gene,$forceid, |
($udom,$uname,$uid,$umode,$upass,$first,$middle,$last,$gene,$forceid, |
$desiredhome); |
$desiredhome); |
unless ($reply eq 'ok') { return $reply; } |
unless ($reply eq 'ok') { return $reply; } |
|
# This will cause &modify_student_enrollment to get the uid from the |
|
# students environment |
|
$uid = undef if (!$forceid); |
|
$reply = &modify_student_enrollment($udom,$uname,$uid,$first,$middle, |
|
$last,$gene,$usec,$end,$start); |
|
return $reply; |
|
} |
|
|
|
sub modify_student_enrollment { |
|
my ($udom,$uname,$uid,$first,$middle,$last,$gene,$usec,$end,$start) = @_; |
|
# Get the course id from the environment |
|
my $cid=''; |
|
unless ($cid=$ENV{'request.course.id'}) { |
|
return 'not_in_class'; |
|
} |
|
# Make sure the user exists |
my $uhome=&homeserver($uname,$udom); |
my $uhome=&homeserver($uname,$udom); |
if (($uhome eq '') || ($uhome eq 'no_host')) { |
if (($uhome eq '') || ($uhome eq 'no_host')) { |
return 'error: no such user'; |
return 'error: no such user'; |
} |
} |
# -------------------------------------------------- Add student to course list |
# |
$reply=critical('put:'.$ENV{'course.'.$cid.'.domain'}.':'. |
# Get student data if we were not given enough information |
|
if (!defined($first) || $first eq '' || |
|
!defined($last) || $last eq '' || |
|
!defined($uid) || $uid eq '' || |
|
!defined($middle) || $middle eq '' || |
|
!defined($gene) || $gene eq '') { |
|
# They did not supply us with enough data to enroll the student, so |
|
# we need to pick up more information. |
|
my %tmp = &get('environment', |
|
['firstname','middlename','lastname', 'generation','id'] |
|
,$udom,$uname); |
|
|
|
foreach (keys(%tmp)) { |
|
&logthis("key $_ = ".$tmp{$_}); |
|
} |
|
$first = $tmp{'firstname'} if (!defined($first) || $first eq ''); |
|
$middle = $tmp{'middlename'} if (!defined($middle) || $middle eq ''); |
|
$last = $tmp{'lastname'} if (!defined($last) || $last eq ''); |
|
$gene = $tmp{'generation'} if (!defined($gene) || $gene eq ''); |
|
$uid = $tmp{'id'} if (!defined($uid) || $uid eq ''); |
|
} |
|
my $fullname = &Apache::loncoursedata::ProcessFullName($last,$gene, |
|
$first,$middle); |
|
my $reply=critical('put:'.$ENV{'course.'.$cid.'.domain'}.':'. |
$ENV{'course.'.$cid.'.num'}.':classlist:'. |
$ENV{'course.'.$cid.'.num'}.':classlist:'. |
&escape($uname.':'.$udom).'='. |
&escape($uname.':'.$udom).'='. |
&escape($end.':'.$start), |
&escape(join(':',$end,$start,$uid,$usec,$fullname)), |
$ENV{'course.'.$cid.'.home'}); |
$ENV{'course.'.$cid.'.home'}); |
unless (($reply eq 'ok') || ($reply eq 'delayed')) { |
unless (($reply eq 'ok') || ($reply eq 'delayed')) { |
return 'error: '.$reply; |
return 'error: '.$reply; |
} |
} |
# ---------------------------------------------------- Add student role to user |
# Add student role to user |
my $uurl='/'.$cid; |
my $uurl='/'.$cid; |
$uurl=~s/\_/\//g; |
$uurl=~s/\_/\//g; |
if ($usec) { |
if ($usec) { |
Line 2341 sub createcourse {
|
Line 2493 sub createcourse {
|
unless ($nonstandard) { |
unless ($nonstandard) { |
# ------------------------------------------ For standard courses, make top url |
# ------------------------------------------ For standard courses, make top url |
my $mapurl=&clutter($url); |
my $mapurl=&clutter($url); |
|
if ($mapurl eq '/res/') { $mapurl=''; } |
$ENV{'form.initmap'}=(<<ENDINITMAP); |
$ENV{'form.initmap'}=(<<ENDINITMAP); |
<map> |
<map> |
<resource id="1" type="start"></resource> |
<resource id="1" type="start"></resource> |
Line 2534 sub condval {
|
Line 2687 sub condval {
|
return $result; |
return $result; |
} |
} |
|
|
|
# ---------------------------------------------------- Devalidate courseresdata |
|
|
|
sub devalidatecourseresdata { |
|
my ($coursenum,$coursedomain)=@_; |
|
my $hashid=$coursenum.':'.$coursedomain; |
|
delete $courseresdatacache{$hashid.'.time'}; |
|
} |
|
|
# --------------------------------------------------- Course Resourcedata Query |
# --------------------------------------------------- Course Resourcedata Query |
|
|
sub courseresdata { |
sub courseresdata { |
Line 2555 sub courseresdata {
|
Line 2716 sub courseresdata {
|
} |
} |
} |
} |
foreach my $item (@which) { |
foreach my $item (@which) { |
if ($courseresdatacache{$hashid}->{$item}) { |
if (defined($courseresdatacache{$hashid}->{$item})) { |
return $courseresdatacache{$hashid}->{$item}; |
return $courseresdatacache{$hashid}->{$item}; |
} |
} |
} |
} |
return ''; |
return undef; |
} |
} |
|
|
# --------------------------------------------------------- Value of a Variable |
# --------------------------------------------------------- Value of a Variable |
|
|
sub EXT { |
sub EXT { |
my ($varname,$symbparm,$udom,$uname)=@_; |
my ($varname,$symbparm,$udom,$uname,)=@_; |
|
|
unless ($varname) { return ''; } |
unless ($varname) { return ''; } |
|
|
Line 2706 sub EXT {
|
Line 2867 sub EXT {
|
($seclevelr,$seclevelm,$seclevel, |
($seclevelr,$seclevelm,$seclevel, |
$courselevelr,$courselevelm, |
$courselevelr,$courselevelm, |
$courselevel)); |
$courselevel)); |
if ($coursereply) { return $coursereply; } |
if (defined($coursereply)) { return $coursereply; } |
|
|
# ------------------------------------------------------ third, check map parms |
# ------------------------------------------------------ third, check map parms |
my %parmhash=(); |
my %parmhash=(); |
Line 2722 sub EXT {
|
Line 2883 sub EXT {
|
# --------------------------------------------- last, look in resource metadata |
# --------------------------------------------- last, look in resource metadata |
|
|
$spacequalifierrest=~s/\./\_/; |
$spacequalifierrest=~s/\./\_/; |
my $metadata=&metadata($ENV{'request.filename'},$spacequalifierrest); |
my $filename; |
if ($metadata) { return $metadata; } |
if (!$symbparm) { $symbparm=&symbread(); } |
$metadata=&metadata($ENV{'request.filename'}, |
if ($symbparm) { |
'parameter_'.$spacequalifierrest); |
$filename=(split(/\_\_\_/,$symbparm))[2]; |
if ($metadata) { return $metadata; } |
} else { |
|
$filename=$ENV{'request.filename'}; |
|
} |
|
my $metadata=&metadata($filename,$spacequalifierrest); |
|
if (defined($metadata)) { return $metadata; } |
|
$metadata=&metadata($filename,'parameter_'.$spacequalifierrest); |
|
if (defined($metadata)) { return $metadata; } |
|
|
# ------------------------------------------------------------------ Cascade up |
# ------------------------------------------------------------------ Cascade up |
unless ($space eq '0') { |
unless ($space eq '0') { |
Line 2734 sub EXT {
|
Line 2901 sub EXT {
|
if ($id) { |
if ($id) { |
my $partgeneral=&EXT('resource.'.$part.'.'.$qualifierrest, |
my $partgeneral=&EXT('resource.'.$part.'.'.$qualifierrest, |
$symbparm,$udom,$uname); |
$symbparm,$udom,$uname); |
if ($partgeneral) { return $partgeneral; } |
if (defined($partgeneral)) { return $partgeneral; } |
} else { |
} else { |
my $resourcegeneral=&EXT('resource.0.'.$qualifierrest, |
my $resourcegeneral=&EXT('resource.0.'.$qualifierrest, |
$symbparm,$udom,$uname); |
$symbparm,$udom,$uname); |
if ($resourcegeneral) { return $resourcegeneral; } |
if (defined($resourcegeneral)) { return $resourcegeneral; } |
} |
} |
} |
} |
|
|
Line 2767 sub metadata {
|
Line 2934 sub metadata {
|
my ($uri,$what,$liburi,$prefix,$depthcount)=@_; |
my ($uri,$what,$liburi,$prefix,$depthcount)=@_; |
|
|
$uri=&declutter($uri); |
$uri=&declutter($uri); |
|
# if it is a non metadata possible uri return quickly |
|
if (($uri eq '') || (($uri =~ m|^/*adm/|) && ($uri !~ m|^adm/includes|)) || |
|
($uri =~ m|/$|) || ($uri =~ m|/.meta$|)) { |
|
return ''; |
|
} |
my $filename=$uri; |
my $filename=$uri; |
$uri=~s/\.meta$//; |
$uri=~s/\.meta$//; |
# |
# |
Line 2774 sub metadata {
|
Line 2946 sub metadata {
|
# Look at timestamp of caching |
# Look at timestamp of caching |
# Everything is cached by the main uri, libraries are never directly cached |
# Everything is cached by the main uri, libraries are never directly cached |
# |
# |
unless (abs($metacache{$uri.':cachedtimestamp'}-time)<600) { |
unless (abs($metacache{$uri.':cachedtimestamp'}-time)<600 && !defined($liburi)) { |
# |
# |
# Is this a recursive call for a library? |
# Is this a recursive call for a library? |
# |
# |
Line 2797 sub metadata {
|
Line 2969 sub metadata {
|
my $package=$token->[2]->{'package'}; |
my $package=$token->[2]->{'package'}; |
my $keyroot=''; |
my $keyroot=''; |
if ($prefix) { |
if ($prefix) { |
$keyroot.='_'.$prefix; |
$keyroot.=$prefix; |
} else { |
} else { |
if (defined($token->[2]->{'part'})) { |
if (defined($token->[2]->{'part'})) { |
$keyroot.='_'.$token->[2]->{'part'}; |
$keyroot.='_'.$token->[2]->{'part'}; |
Line 2855 sub metadata {
|
Line 3027 sub metadata {
|
# |
# |
# Importing a library here |
# Importing a library here |
# |
# |
if (defined($depthcount)) { $depthcount++; } else |
|
{ $depthcount=0; } |
|
if ($depthcount<20) { |
if ($depthcount<20) { |
foreach (split(/\,/,&metadata($uri,'keys', |
my $location=$parser->get_text('/import'); |
$parser->get_text('/import'),$unikey, |
my $dir=$filename; |
$depthcount))) { |
$dir=~s|[^/]*$||; |
|
$location=&filelocation($dir,$location); |
|
foreach (sort(split(/\,/,&metadata($uri,'keys', |
|
$location,$unikey, |
|
$depthcount+1)))) { |
$metathesekeys{$_}=1; |
$metathesekeys{$_}=1; |
} |
} |
} |
} |
Line 2959 sub symbverify {
|
Line 3133 sub symbverify {
|
my $okay=0; |
my $okay=0; |
if (tie(%bighash,'GDBM_File',$ENV{'request.course.fn'}.'.db', |
if (tie(%bighash,'GDBM_File',$ENV{'request.course.fn'}.'.db', |
&GDBM_READER(),0640)) { |
&GDBM_READER(),0640)) { |
my $ids=$bighash{'ids_/res/'.$thisfn}; |
my $ids=$bighash{'ids_'.&clutter($thisfn)}; |
unless ($ids) { |
unless ($ids) { |
$ids=$bighash{'ids_/'.$thisfn}; |
$ids=$bighash{'ids_/'.$thisfn}; |
} |
} |
Line 3030 sub symbread {
|
Line 3204 sub symbread {
|
if (tie(%bighash,'GDBM_File',$ENV{'request.course.fn'}.'.db', |
if (tie(%bighash,'GDBM_File',$ENV{'request.course.fn'}.'.db', |
&GDBM_READER(),0640)) { |
&GDBM_READER(),0640)) { |
# ---------------------------------------------- Get ID(s) for current resource |
# ---------------------------------------------- Get ID(s) for current resource |
my $ids=$bighash{'ids_/res/'.$thisfn}; |
my $ids=$bighash{'ids_'.&clutter($thisfn)}; |
unless ($ids) { |
unless ($ids) { |
$ids=$bighash{'ids_/'.$thisfn}; |
$ids=$bighash{'ids_/'.$thisfn}; |
} |
} |
Line 3290 BEGIN {
|
Line 3464 BEGIN {
|
|
|
while (my $configline=<$config>) { |
while (my $configline=<$config>) { |
chomp($configline); |
chomp($configline); |
if (($configline) && ($configline ne $perlvar{'lonHostID'})) { |
if ($configline) { |
$spareid{$configline}=1; |
$spareid{$configline}=1; |
} |
} |
} |
} |
Line 3338 BEGIN {
|
Line 3512 BEGIN {
|
|
|
%metacache=(); |
%metacache=(); |
|
|
$processmarker=$$.'_'.time.'_'.$perlvar{'lonHostID'}; |
$processmarker='_'.time.'_'.$perlvar{'lonHostID'}; |
$dumpcount=0; |
$dumpcount=0; |
|
|
&logtouch(); |
&logtouch(); |
Line 3554 modify user
|
Line 3728 modify user
|
|
|
=item * |
=item * |
|
|
modifystudent($udom,$uname,$uid,$umode,$upass,$first,$middle,$last,$gene,$usec,$end,$start) : modify student |
modifystudent |
|
|
|
modify a students enrollment and identification information. |
|
The course id is resolved based on the current users environment. |
|
This means the envoking user must be a course coordinator or otherwise |
|
associated with a course. |
|
|
|
This call is essentially a wrapper for lonnet::modifyuser and |
|
lonnet::modify_student_enrollment |
|
|
|
Inputs: |
|
|
|
=over 4 |
|
|
|
=item B<$udom> Students loncapa domain |
|
|
|
=item B<$uname> Students loncapa login name |
|
|
|
=item B<$uid> Students id/student number |
|
|
|
=item B<$umode> Students authentication mode |
|
|
|
=item B<$upass> Students password |
|
|
|
=item B<$first> Students first name |
|
|
|
=item B<$middle> Students middle name |
|
|
|
=item B<$last> Students last name |
|
|
|
=item B<$gene> Students generation |
|
|
|
=item B<$usec> Students section in course |
|
|
|
=item B<$end> Unix time of the roles expiration |
|
|
|
=item B<$start> Unix time of the roles start date |
|
|
|
=item B<$forceid> If defined, allow $uid to be changed |
|
|
|
=item B<$desiredhome> server to use as home server for student |
|
|
|
=back |
|
|
|
=item * |
|
|
|
modify_student_enrollment |
|
|
|
Change a students enrollment status in a class. The environment variable |
|
'role.request.course' must be defined for this function to proceed. |
|
|
|
Inputs: |
|
|
|
=over 4 |
|
|
|
=item $udom, students domain |
|
|
|
=item $uname, students name |
|
|
|
=item $uid, students user id |
|
|
|
=item $first, students first name |
|
|
|
=item $middle |
|
|
|
=item $last |
|
|
|
=item $gene |
|
|
|
=item $usec |
|
|
|
=item $end |
|
|
|
=item $start |
|
|
|
=back |
|
|
|
|
=item * |
=item * |
|
|