--- loncom/lonnet/perl/lonnet.pm 2002/10/07 13:50:36 1.292 +++ loncom/lonnet/perl/lonnet.pm 2002/11/12 22:23:37 1.300 @@ -1,7 +1,7 @@ # The LearningOnline Network # TCP networking package # -# $Id: lonnet.pm,v 1.292 2002/10/07 13:50:36 www Exp $ +# $Id: lonnet.pm,v 1.300 2002/11/12 22:23:37 albertel Exp $ # # Copyright Michigan State University Board of Trustees # @@ -77,7 +77,7 @@ use Apache::File; use LWP::UserAgent(); use HTTP::Headers; use vars -qw(%perlvar %hostname %homecache %badServerCache %hostip %spareid %hostdom +qw(%perlvar %hostname %homecache %badServerCache %hostip %iphost %spareid %hostdom %libserv %pr %prp %metacache %packagetab %courselogs %accesshash $processmarker $dumpcount %coursedombuf %coursehombuf %courseresdatacache %domaindescription); @@ -86,6 +86,8 @@ use GDBM_File; use Apache::Constants qw(:common :http); use HTML::LCParser; use Fcntl qw(:flock); +use Apache::loncoursedata; + my $readit; # --------------------------------------------------------------------- Logging @@ -591,6 +593,59 @@ sub idput { # ------------------------------------- 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 { my ($udom,$unam,$courseid)=@_; $courseid=~s/\_/\//g; @@ -838,13 +893,16 @@ sub finishuserfileupload { } # 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 '/uploaded/'.$path.$fname; } else { + &logthis('Failed to transfer '.$docudom.'/'.$docuname.'/'.$fname. + ' to host '.$docuhome.': '.$fetchresult); return '/adm/notfound.html'; } } @@ -1045,7 +1103,7 @@ sub devalidate { if ($cid) { my $key=$ENV{'user.name'}.':'.$ENV{'user.domain'}.':'; my $status= - &del('nohist_calculatedsheet', + &del('nohist_calculatedsheets', [$key.'studentcalc'], $ENV{'course.'.$cid.'.domain'}, $ENV{'course.'.$cid.'.num'}) @@ -2315,20 +2373,59 @@ sub modifystudent { ($udom,$uname,$uid,$umode,$upass,$first,$middle,$last,$gene,$forceid, $desiredhome); 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); if (($uhome eq '') || ($uhome eq 'no_host')) { 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:'. &escape($uname.':'.$udom).'='. - &escape($end.':'.$start), + &escape(join(':',$end,$start,$uid,$usec,$fullname)), $ENV{'course.'.$cid.'.home'}); unless (($reply eq 'ok') || ($reply eq 'delayed')) { return 'error: '.$reply; } -# ---------------------------------------------------- Add student role to user + # Add student role to user my $uurl='/'.$cid; $uurl=~s/\_/\//g; if ($usec) { @@ -2838,8 +2935,8 @@ sub metadata { $uri=&declutter($uri); # if it is a non metadata possible uri return quickly - if (($uri eq '') || ($uri =~ m|^/*adm/|) || ($uri =~ m|/$|) || - ($uri =~ m|/.meta$|)) { + if (($uri eq '') || (($uri =~ m|^/*adm/|) && ($uri !~ m|^adm/includes|)) || + ($uri =~ m|/$|) || ($uri =~ m|/.meta$|)) { return ''; } my $filename=$uri; @@ -3351,6 +3448,7 @@ BEGIN { $hostname{$id}=$name; $hostdom{$id}=$domain; $hostip{$id}=$ip; + $iphost{$ip}=$id; if ($domdescr) { $domaindescription{$domain}=$domdescr; } if ($role eq 'library') { $libserv{$id}=$name; } } else { @@ -3638,7 +3736,8 @@ The course id is resolved based on the c 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 +This call is essentially a wrapper for lonnet::modifyuser and +lonnet::modify_student_enrollment Inputs: @@ -3676,6 +3775,40 @@ Inputs: =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 * + assigncustomrole($udom,$uname,$url,$rdom,$rnam,$rolename,$end,$start) : assign custom role; give a custom role to a user for the level given by URL. Specify name and domain of role author, and role name