--- loncom/enrollment/Enrollment.pm 2016/06/03 01:22:36 1.48
+++ loncom/enrollment/Enrollment.pm 2017/09/18 14:21:45 1.51
@@ -1,5 +1,5 @@
# Automated Enrollment manager
-# $Id: Enrollment.pm,v 1.48 2016/06/03 01:22:36 raeburn Exp $
+# $Id: Enrollment.pm,v 1.51 2017/09/18 14:21:45 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -39,8 +39,8 @@ use strict;
sub update_LC {
my ($dom,$crs,$adds,$drops,$startdate,$enddate,$authtype,$autharg,
- $showcredits,$defaultcredits,$classesref,$groupref,$logmsg,$newusermsg,
- $context,$phototypes) = @_;
+ $showcredits,$defaultcredits,$autofailsafe,$classesref,$groupref,
+ $logmsg,$newusermsg,$context,$phototypes) = @_;
# Get institutional code and title of this class
my %courseinfo = ();
&get_courseinfo($dom,$crs,\%courseinfo);
@@ -56,6 +56,7 @@ sub update_LC {
my $type=&Apache::loncoursedata::CL_TYPE;
my $lockedtype=&Apache::loncoursedata::CL_LOCKEDTYPE;
my $credidx=&Apache::loncoursedata::CL_CREDITS;
+ my $instidx = &Apache::loncoursedata::CL_INSTSEC;
my @localstudents = ();
my @futurestudents = ();
my @activestudents = ();
@@ -130,9 +131,11 @@ sub update_LC {
my %place = &place_hash();
my %ucount = ();
my %enrollinfo = ();
+ my %classcount;
foreach my $class (@{$classesref}) {
my %enrolled = ();
&parse_classlist($$configvars{'lonDaemons'},$dom,$crs,$class,\%place,$$groupref{$class},\%enrolled);
+ $classcount{$class} = scalar(keys(%enrolled));
foreach my $uname (sort keys %enrolled ) {
if (!grep/^$uname$/,@reg_students) {
push @reg_students,$uname;
@@ -209,7 +212,7 @@ sub update_LC {
unless ($uname eq '') {
my %uidhash=&Apache::lonnet::idrget($dom,$uname);
my @stuinfo = @{$enrollinfo{$uname}};
- my ($access,$added,$inststatus);
+ my ($access,$added,$inststatus,$instsec);
my $credits;
if ($showcredits) {
$credits = $stuinfo[$place{'credits'}];
@@ -219,6 +222,7 @@ sub update_LC {
}
}
$inststatus = $stuinfo[$place{inststatus}];
+ $instsec = $stuinfo[$place{instsec}];
if (grep/^$uname$/,@localstudents) {
# Check for studentID changes
if ( ($uidhash{$uname}) && ($uidhash{$uname} !~ /error\:/) ) {
@@ -255,7 +259,7 @@ sub update_LC {
&execute_add($context,'switchtype',$uname,$dom,$auth,
$authparam,$first,$middle,$last,$gene,
$pid,$usec,$end,$start,$emailenc,
- $credits,$cid,\$addresult,\$enrollcount,
+ $credits,$instsec,$cid,\$addresult,\$enrollcount,
$linefeed,$logmsg);
$added = 1;
}
@@ -266,7 +270,7 @@ sub update_LC {
if ( (grep/^$uname$/,@futurestudents) && ($$currlist{$uname}[$type] eq "auto") && ($adds == 1) ) {
my $datechange = &datechange_check($$currlist{$uname}[$cstart],$$currlist{$uname}[$cend],$startdate,$enddate);
if ($datechange) {
- my $modify_access_result = &Apache::lonnet::modify_student_enrollment($dom,$uname,undef,undef,undef,undef,undef,$stuinfo[ $place{groupID} ],$enddate,$startdate,'auto','',$cid,'',$context,$credits);
+ my $modify_access_result = &Apache::lonnet::modify_student_enrollment($dom,$uname,undef,undef,undef,undef,undef,$stuinfo[ $place{groupID} ],$enddate,$startdate,'auto','',$cid,'',$context,$credits,$instsec);
$access = &showaccess($enddate,$startdate);
if ($modify_access_result =~ /^ok/) {
$$logmsg .= &mt('Change in access dates for [_1].',$uname).$access.$linefeed;
@@ -289,9 +293,9 @@ sub update_LC {
if ($expire_role_result eq 'ok') {
my $modify_section_result;
if (grep/^$uname$/,@activestudents) {
- $modify_section_result = &Apache::lonnet::modify_student_enrollment($dom,$uname,undef,undef,undef,undef,undef,$stuinfo[ $place{groupID} ],$$currlist{$uname}[$cend],$$currlist{$uname}[$cstart],'auto','',$cid,'',$context,$credits);
+ $modify_section_result = &Apache::lonnet::modify_student_enrollment($dom,$uname,undef,undef,undef,undef,undef,$stuinfo[ $place{groupID} ],$$currlist{$uname}[$cend],$$currlist{$uname}[$cstart],'auto','',$cid,'',$context,$credits,$instsec);
} else {
- $modify_section_result = &Apache::lonnet::modify_student_enrollment($dom,$uname,undef,undef,undef,undef,undef,$stuinfo[ $place{groupID} ],$enddate,$startdate,'auto','',$cid,'',$context,$credits);
+ $modify_section_result = &Apache::lonnet::modify_student_enrollment($dom,$uname,undef,undef,undef,undef,undef,$stuinfo[ $place{groupID} ],$enddate,$startdate,'auto','',$cid,'',$context,$credits,$instsec);
$access = &showaccess($enddate,$startdate);
}
if ($modify_section_result =~ /^ok/) {
@@ -313,7 +317,7 @@ sub update_LC {
if (($showcredits) &&
($$currlist{$uname}[$credidx] ne $credits) && (!$added)) {
my $modify_credits_result =
- &Apache::lonnet::modify_student_enrollment($dom,$uname,undef,undef,undef,undef,undef,$stuinfo[ $place{groupID} ],$enddate,$startdate,'auto','',$cid,'',$context,$credits);
+ &Apache::lonnet::modify_student_enrollment($dom,$uname,undef,undef,undef,undef,undef,$stuinfo[ $place{groupID} ],$enddate,$startdate,'auto','',$cid,'',$context,$credits,$instsec);
if ($modify_credits_result =~ /^ok/) {
if ($credits ne '') {
$$logmsg .= &mt('Credits change for [_1] from [_2] to [_3].',$uname,$$currlist{$uname}[$credidx],$credits).$linefeed;
@@ -324,6 +328,16 @@ sub update_LC {
$$logmsg .= &mt('Error when attempting to change credits for [_1] in section: [_2] -error [_3].',$uname,$stuinfo[$place{groupID}],$modify_credits_result).$linefeed;
}
}
+# Check for institutional section change
+ if (($$currlist{$uname}[$instidx] ne $instsec) && (!$added)) {
+ my $modify_instsec_result =
+ &Apache::lonnet::modify_student_enrollment($dom,$uname,undef,undef,undef,undef,undef,$stuinfo[ $place{groupID} ],$enddate,$startdate,'auto','',$cid,'',$context,$credits,$instsec);
+ if ($modify_instsec_result =~ /^ok/) {
+ $$logmsg .= &mt('Institutional section change for [_1] from [_2] to [_3].',$uname,$$currlist{$uname}[$instidx],$instsec).$linefeed;
+ } else {
+ $$logmsg .= &mt('Error when attempting to change institutional section for [_1] in section: [_2] -error [_3].',$uname,$stuinfo[$place{groupID}],$modify_instsec_result).$linefeed;
+ }
+ }
} else {
# Check for changed usernames by checking studentIDs
if ( ($stuinfo[ $place{studentID} ] ne '') && (grep/^$stuinfo[ $place{studentID} ]$/,@LCids) ) {
@@ -365,6 +379,7 @@ sub update_LC {
'context' => $context,
'linefeed' => $linefeed,
'inststatus' => $inststatus,
+ 'instsec' => $instsec,
'role' => 'st',
};
if ($credits) {
@@ -374,7 +389,7 @@ sub update_LC {
} else {
&execute_add($context,'newstudent',$uname,$dom,$auth,
$authparam,$first,$middle,$last,$gene,$pid,
- $usec,$end,$start,$emailenc,$credits,
+ $usec,$end,$start,$emailenc,$credits,$instsec,
$cid,\$addresult,\$enrollcount,$linefeed,
$logmsg);
}
@@ -420,6 +435,7 @@ sub update_LC {
# Do drops
if ( ($drops == 1) && (@reg_students > 0) ) {
+ my %delaydrops;
foreach my $uname (@localstudents) {
if ($$currlist{$uname}[$type] eq "auto") {
my @saved = ();
@@ -431,6 +447,17 @@ sub update_LC {
push @saved,$uname;
}
} elsif (@saved == 0) {
+# Check enrollment count for institutional section of student to be dropped
+ if ($$currlist{$uname}[$instidx]) {
+ if (exists($classcount{$$currlist{$uname}[$instidx]})) {
+ if ($classcount{$$currlist{$uname}[$instidx]} == 0) {
+ if ($autofailsafe) {
+ push(@{$delaydrops{$$currlist{$uname}[$instidx]}},$uname);
+ next;
+ }
+ }
+ }
+ }
my $drop_reply = &Apache::lonnet::modifystudent($dom,$uname,'','','',undef,undef,undef,undef,$$currlist{$uname}[$sec],time,undef,undef,undef,undef,'auto','',$cid,'',$context);
if ($drop_reply !~ /^ok/) {
$$logmsg .= &mt('An error occurred during the attempt to expire the [_1] from the old section [_2] - [_3].',$uname,$$currlist{$uname}[$sec],$drop_reply).$linefeed;
@@ -446,6 +473,34 @@ sub update_LC {
}
}
}
+ if (scalar(keys(%delaydrops)) > 0) {
+ foreach my $class (keys(%delaydrops)) {
+ if (ref($delaydrops{$class}) eq 'ARRAY') {
+ if ($autofailsafe < scalar(@{$delaydrops{$class}})) {
+ $$logmsg .= &mt('The following students were not expired from the old section [_1] because the enrollment count retrieved for that institutional section was zero, and the number of students with roles to expire exceeded the failsafe threshold of [_2]:',$class,$autofailsafe);
+ if ($context eq "updatenow") {
+ $$logmsg .= '
'.join('
',@{$delaydrops{$class}}).$linefeed;
+ } elsif ($context eq "automated") {
+ $$logmsg .= $linefeed.join($linefeed,@{$delaydrops{$class}}).$linefeed;
+ }
+ } else {
+ foreach my $uname (@{$delaydrops{$class}}) {
+ my $drop_reply = &Apache::lonnet::modifystudent($dom,$uname,'','','',undef,undef,undef,undef,$$currlist{$uname}[$sec],time,undef,undef,undef,undef,'auto','',$cid,'',$context);
+ if ($drop_reply !~ /^ok/) {
+ $$logmsg .= &mt('An error occurred during the attempt to expire the [_1] from the old section [_2] - [_3].',$uname,$$currlist{$uname}[$sec],$drop_reply).$linefeed;
+ } else {
+ $dropcount ++;
+ my %userenv = &Apache::lonnet::get('environment',['firstname','lastname','id'],$dom,$uname);
+ $dropresult .= $userenv{'firstname'}." ".$userenv{'lastname'}." (".$userenv{'id'}.") - ".$uname.' '.&mt("dropped from section: '[_1]'.",$$currlist{$uname}[$sec]).$linefeed;
+ if ($context eq 'automated') {
+ $$logmsg .= &mt('User [_1] student role expired from course.',$uname).$linefeed;
+ }
+ }
+ }
+ }
+ }
+ }
+ }
}
# Terminated explictly allowed access to student creation/modification
@@ -523,6 +578,7 @@ sub create_newuser {
my $role = $args->{'role'};
my $inststatus = $args->{'inststatus'};
my $credits = $args->{'credits'};
+ my $instsec = $args->{'instsec'};
my $create_passwd = 0;
my $authchk = '';
my $outcome;
@@ -567,7 +623,7 @@ sub create_newuser {
$outcome = $result;
}
} else {
- $outcome=&Apache::lonnet::modifystudent($udom,$uname,$pid,$auth,$authparam,$first,$middle,$last,$gene,$usec,$end,$start,'',undef,$emailaddr,'auto','',$cid,'',$called_context,$inststatus,$credits);
+ $outcome=&Apache::lonnet::modifystudent($udom,$uname,$pid,$auth,$authparam,$first,$middle,$last,$gene,$usec,$end,$start,'',undef,$emailaddr,'auto','',$cid,'',$called_context,$inststatus,$credits,$instsec);
}
if ($outcome eq 'ok') {
my $access = &showaccess($end,$start);
@@ -686,7 +742,7 @@ sub prepare_add {
sub execute_add {
my ($context,$caller,$uname,$dom,$auth,$authparam,$first,$middle,$last,
- $gene,$pid,$usec,$end,$start,$emailenc,$credits,$cid,$addresult,
+ $gene,$pid,$usec,$end,$start,$emailenc,$credits,$instsec,$cid,$addresult,
$enrollcount,$linefeed,$logmsg) = @_;
# Get the user's information and authentication
my %userenv = &Apache::lonnet::get('environment',['firstname','middlename','lastname','generation','id','critnotification','notification','permanentemail','inststatus'],$dom,$uname);
@@ -762,7 +818,7 @@ sub execute_add {
&Apache::lonnet::modify_student_enrollment($dom,$uname,$pid,$first,$middle,
$last,$gene,$usec,$end,$start,
'auto','',$cid,'',$context,
- $credits);
+ $credits,$instsec);
if ($classlist_reply eq 'ok') {
my $access = &showaccess($end,$start);
my $showsec = $usec;
@@ -836,6 +892,7 @@ sub parse_classlist {
if ("@state" eq "students student") {
$uname = $attr->{username};
$$studentsref{$uname}[ $$placeref{'groupID'} ] = $groupID;
+ $$studentsref{$uname}[ $$placeref{'instsec'} ] = $class;
}
}, "tagname, attr"],
text_h =>
@@ -948,6 +1005,7 @@ sub place_hash {
studentID => 10,
credits => 11,
inststatus => 12,
+ instsec => 13,
);
return %place;
}