--- loncom/lonnet/perl/lonnet.pm 2002/10/10 13:06:08 1.295
+++ 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.295 2002/10/10 13:06:08 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);
@@ -593,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;
@@ -1050,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'})
@@ -2320,26 +2373,51 @@ 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
- if ($first eq '' || $last eq '' || $uid eq '') {
+ #
+ # 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 = dump('environment',$udom,$uname,
+ 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{'genename'} if (!defined($gene) || $gene 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);
- $reply=critical('put:'.$ENV{'course.'.$cid.'.domain'}.':'.
+ my $reply=critical('put:'.$ENV{'course.'.$cid.'.domain'}.':'.
$ENV{'course.'.$cid.'.num'}.':classlist:'.
&escape($uname.':'.$udom).'='.
&escape(join(':',$end,$start,$uid,$usec,$fullname)),
@@ -2347,7 +2425,7 @@ sub modifystudent {
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) {
@@ -3370,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 {
@@ -3657,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:
@@ -3695,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