--- loncom/enrollment/Enrollment.pm 2008/04/30 23:59:13 1.38
+++ loncom/enrollment/Enrollment.pm 2022/02/03 17:37:57 1.58
@@ -1,5 +1,5 @@
# Automated Enrollment manager
-# $Id: Enrollment.pm,v 1.38 2008/04/30 23:59:13 raeburn Exp $
+# $Id: Enrollment.pm,v 1.58 2022/02/03 17:37:57 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -25,20 +25,24 @@
#
package LONCAPA::Enrollment;
+use lib '/home/httpd/lib/perl';
use Apache::loncoursedata;
use Apache::lonnet;
use Apache::loncommon();
use Apache::lonmsg;
use Apache::lonlocal;
use HTML::Entities;
+use HTML::Parser;
use LONCAPA::Configuration;
+use Math::Random;
use Time::Local;
-use lib '/home/httpd/lib/perl';
use strict;
sub update_LC {
- my ($dom,$crs,$adds,$drops,$startdate,$enddate,$authtype,$autharg,$classesref,$groupref,$logmsg,$newusermsg,$context,$phototypes) = @_;
+ my ($dom,$crs,$adds,$drops,$startdate,$enddate,$authtype,$autharg,
+ $showcredits,$defaultcredits,$autofailsafe,$failsafe,$classesref,
+ $groupref,$logmsg,$newusermsg,$context,$phototypes) = @_;
# Get institutional code and title of this class
my %courseinfo = ();
&get_courseinfo($dom,$crs,\%courseinfo);
@@ -53,11 +57,14 @@ sub update_LC {
my $status=&Apache::loncoursedata::CL_STATUS;
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 = ();
my @excludedstudents = ();
my $currlist;
+ my $now = time;
foreach my $uname (keys %{$roster} ) {
if ($uname =~ m/^(.+):$dom$/) {
if ($$roster{$uname}[$status] eq "Active") {
@@ -92,9 +99,17 @@ sub update_LC {
open(FILE,"<$$configvars{'lonTabDir'}.'/rolesplain.tab");
my @rolesplain = <FILE>;
close(FILE);
- foreach (@rolesplain) {
- if ($_ =~ /^(st|ta|ex|ad|in|cc):([\w\s]+)$/) {
- $longroles{$1} = $2;
+ foreach my $item (@rolesplain) {
+ if ($_ =~ /^(st|ta|ex|ad|in|cc|co):([\w\s]+):?([\w\s]*)/) {
+ if ($courseinfo{'type'} eq 'Community') {
+ unless($1 eq 'cc') {
+ $longroles{$1} = $3;
+ }
+ } else {
+ unless($1 eq 'co') {
+ $longroles{$1} = $2;
+ }
+ }
}
}
@@ -118,9 +133,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;
@@ -171,7 +188,7 @@ sub update_LC {
push @okusers, $uname;
}
}
-# Get mapping of student IDs to usernames for users in institutional data for this class
+# Get mapping of student/employee IDs to usernames for users in institutional data for this class
my @allINids = ();
my %unameFromINid = ();
foreach my $uname (@okusers) {
@@ -185,9 +202,11 @@ sub update_LC {
}
}
-# Explicitly allow access to creation/modification of students if called as an automated process.
+# Explicitly allow access to creation/modification of students and group membership changes
+# when called as an automated process.
if ($context eq 'automated') {
$env{'allowed.cst'}='F';
+ $env{'allowed.mdg'}='F';
}
# Compare IDs with existing LON-CAPA enrollment for this class
@@ -195,7 +214,17 @@ sub update_LC {
unless ($uname eq '') {
my %uidhash=&Apache::lonnet::idrget($dom,$uname);
my @stuinfo = @{$enrollinfo{$uname}};
- my $access = '';
+ my ($access,$added,$inststatus,$instsec);
+ my $credits;
+ if ($showcredits) {
+ $credits = $stuinfo[$place{'credits'}];
+ $credits =~ s/[^\d\.]//g;
+ if ($credits eq $defaultcredits) {
+ undef($credits);
+ }
+ }
+ $inststatus = $stuinfo[$place{inststatus}];
+ $instsec = $stuinfo[$place{instsec}];
if (grep/^$uname$/,@localstudents) {
# Check for studentID changes
if ( ($uidhash{$uname}) && ($uidhash{$uname} !~ /error\:/) ) {
@@ -209,7 +238,7 @@ sub update_LC {
my $drop_reply = &Apache::lonnet::modifystudent($dom,$uname,'','','',undef,undef,undef,undef,$$currlist{$uname}[$sec],time,undef,undef,undef,undef,'auto','',$cid,'',$context);
# re-enroll as auto student
if ($drop_reply !~ /^ok/) {
- $$logmsg .= &mt('An error occured during the attempt to convert [_1] from a manual type to an auto type student - [_2].',$uname,$drop_reply).$linefeed;
+ $$logmsg .= &mt('An error occurred during the attempt to convert [_1] from a manual type to an auto type student - [_2].',$uname,$drop_reply).$linefeed;
} else {
# re-enroll as auto student
my ($auth,$authparam,$first,$middle,$last,$gene,$usec,$end,$start,$emailaddr,$pid,$emailenc);
@@ -223,25 +252,31 @@ sub update_LC {
if ($usec eq '') {
$showsec = &mt('none');
}
- $switchresult .= &mt("Section for [_1] switched from '[_2]' to '[_3]'.",$uname,$showoldsec,$showsec).$linefeed;
+ $switchresult .= &mt('Section for [_1] switched from [_2] to [_3].',$uname,$showoldsec,$showsec).$linefeed;
if ($context eq 'automated') {
- $$logmsg .= &mt("Section switch for [_1] from '[_2]' to '[_3]'.",$uname,$showoldsec,$usec).$linefeed;
+ $$logmsg .= &mt('Section switch for [_1] from [_2] to [_3].',$uname,$showoldsec,$usec).$linefeed;
}
$switchcount ++;
}
- &execute_add($context,'switchtype',$uname,$dom,$auth,$authparam,$first,$middle,$last,$gene,$pid,$usec,$end,$start,$emailenc,$cid,\$addresult,\$enrollcount,$linefeed,$logmsg);
+ &execute_add($context,'switchtype',$uname,$dom,$auth,
+ $authparam,$first,$middle,$last,$gene,
+ $pid,$usec,$end,$start,$emailenc,
+ $credits,$instsec,$cid,\$addresult,\$enrollcount,
+ $linefeed,$logmsg);
+ $added = 1;
}
- }
+ }
# Check for section changes
if ($$currlist{$uname}[$sec] eq $stuinfo[ $place{groupID} ]) {
# Check for access date changes for students with access starting in the future.
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);
+ 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;
+ $added = 1;
} else {
$$logmsg .= &mt('Error when attempting to change start and/or end access dates for [_1] in section: [_2] -error [_3].',$uname,$stuinfo[$place{groupID}],$modify_access_result).$linefeed;
}
@@ -260,15 +295,16 @@ 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);
+ $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);
+ $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/) {
- $switchresult .= &mt("Section for [_1] switched from old section: '[_2]' to new section: '[_3]'.",$uname,$$currlist{$uname}[$sec],$stuinfo[ $place{groupID} ]).$access.$linefeed;
+ $switchresult .= &mt('Section for [_1] switched from old section: [_2] to new section: [_3].',$uname,$$currlist{$uname}[$sec],$stuinfo[ $place{groupID} ]).$access.$linefeed;
+ $added = 1;
if ($context eq 'automated') {
- $$logmsg .= &mt('Section switch for [_1] from [_2] to [_3]',$uname,$$currlist{$uname}[$sec],$stuinfo[ $place{groupID} ]).$linefeed;
+ $$logmsg .= &mt('Section switch for [_1] from [_2] to [_3].',$uname,$$currlist{$uname}[$sec],$stuinfo[ $place{groupID} ]).$linefeed;
}
$switchcount ++;
} else {
@@ -279,24 +315,50 @@ sub update_LC {
}
}
}
+# Check for credits changes
+ 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,$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;
+ } else {
+ $$logmsg .= &mt('Credits change for [_1] from [_2] to course default [_3].',$uname,$$currlist{$uname}[$credidx],$defaultcredits).$linefeed;
+ }
+ } else {
+ $$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) && ($$currlist{$uname}[$type] eq "auto")) {
+ 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) ) {
foreach my $match ( @{ $unameFromLCid{ $stuinfo[ $place{studentID} ] } } ) {
- $$logmsg .= &mt('A possible change in username has been detected for a student enrolled in this course.').' '.&mt('The existing LON-CAPA classlist contains user: [_1] and student ID: [_2].',$match,$stuinfo[ $place{studentID} ]);
+ $$logmsg .= &mt('A possible change in username has been detected for a student enrolled in this course.').' '.&mt('The existing LON-CAPA classlist contains user: [_1] and student/employee ID: [_2].',$match,$stuinfo[ $place{studentID} ]);
if (grep/^$match$/,@okusers) {
- $$logmsg .= &mt('The username [_1] remains in the institutional classlist, but the same student ID is used for new user: [_2] now found in the institutional classlist.',$match,$uname).' '.&mt('You may need to contact your Domain Coordinator to determine how to resolve this issue and whether to move student data files for user: [_1] to [_2].',$match,$uname).' ';
+ $$logmsg .= &mt('The username [_1] remains in the institutional classlist, but the same student/employee ID is used for new user: [_2] now found in the institutional classlist.',$match,$uname).' '.&mt('You may need to contact your Domain Coordinator to determine how to resolve this issue and whether to move student data files for user: [_1] to [_2].',$match,$uname).' ';
} else {
unless ($drops == 1) {
- $$logmsg .= &mt('This username - [_1] - has been dropped from the institutional classlist, but the student ID of this user is also used by [_2] who now appears in the institutional classlist.',$match,$uname).' '.&mt('You may need to contact your Domain Coordinator to request a move of the student data files for user: [_1] to [_2].',$match,$uname).' ';
+ $$logmsg .= &mt('This username - [_1] - has been dropped from the institutional classlist, but the student/employee ID of this user is also used by [_2] who now appears in the institutional classlist.',$match,$uname).' '.&mt('You may need to contact your Domain Coordinator to request a move of the student data files for user: [_1] to [_2].',$match,$uname).' ';
}
}
- $$logmsg .= &mt('Because of this student ID conflict, the new username - [_1] - has not been added to the LON-CAPA classlist',$uname).$linefeed;
+ $$logmsg .= &mt('Because of this student/employee ID conflict, the new username - [_1] - has not been added to the LON-CAPA classlist',$uname).$linefeed;
}
} elsif ($adds == 1) {
- my ($auth,$authparam,$first,$middle,$last,$gene,$usec,$end,$start,$emailaddr,$pid,$emailenc);
+ my ($auth,$authparam,$first,$middle,$last,$gene,$usec,$end,$start,$emailaddr,$pid,$emailenc,$credithours);
&prepare_add($authtype,$autharg,$enddate,$startdate,\@stuinfo,\%place,\$dom,\$uname,\$auth,\$authparam,\$first,\$middle,\$last,\$gene,\$usec,\$end,\$start,\$emailaddr,\$pid,\$emailenc);
# Check for existing account in this LON-CAPA domain for this username
+ next if (($end) && ($end < $now));
my $uhome=&Apache::lonnet::homeserver($uname,$dom);
if ($uhome eq 'no_host') { # User does not exist
my $args = {'auth' => $auth,
@@ -318,11 +380,20 @@ sub update_LC {
'cdom' => $dom,
'context' => $context,
'linefeed' => $linefeed,
- 'role' => 'st'
+ 'inststatus' => $inststatus,
+ 'instsec' => $instsec,
+ 'role' => 'st',
};
+ if ($credits) {
+ $args->{'credits'} = $credits;
+ }
my $outcome = &create_newuser($args,$logmsg,$newusermsg,\$enrollcount,\$addresult,\%longroles,\%courseinfo,$context);
} else {
- &execute_add($context,'newstudent',$uname,$dom,$auth,$authparam,$first,$middle,$last,$gene,$pid,$usec,$end,$start,$emailenc,$cid,\$addresult,\$enrollcount,$linefeed,$logmsg);
+ &execute_add($context,'newstudent',$uname,$dom,$auth,
+ $authparam,$first,$middle,$last,$gene,$pid,
+ $usec,$end,$start,$emailenc,$credits,$instsec,
+ $cid,\$addresult,\$enrollcount,$linefeed,
+ $logmsg);
}
if ($courseinfo{'showphoto'}) {
my ($result,$resulttype) =
@@ -366,6 +437,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 = ();
@@ -373,13 +445,33 @@ sub update_LC {
# Check for changed usernames by checking studentIDs
if (grep/^$$currlist{$uname}[ $stuid ]$/,@allINids) {
foreach my $match (@{$unameFromINid{$$currlist{$uname}[ $stuid ]}} ) {
- $$logmsg .= &mt('A possible change in username has been detected for a student enrolled in this course.').' '.&mt('The existing LON-CAPA classlist contains user: [_1] and student ID: [_2].',$uname,$$currlist{$uname}[ $place{studentID} ]).' '.&mt('This username has been dropped from the institutional classlist, but the same student ID is used for user: [_1] who still appears in the institutional classlist.',$match).' '.&mt('You may need to move the student data files for user: [_1] to [_2]',$uname,$match).' '.&mt('Because of this, user [_1] has not been dropped from the course.',$uname).$linefeed;
+ $$logmsg .= &mt('A possible change in username has been detected for a student enrolled in this course.').' '.&mt('The existing LON-CAPA classlist contains user: [_1] and student/employee ID: [_2].',$uname,$$currlist{$uname}[ $stuid ]).' '.&mt('This username has been dropped from the institutional classlist, but the same student/employee ID is used for user: [_1] who still appears in the institutional classlist.',$match).' '.&mt('You may need to move the student data files for user: [_1] to [_2]',$uname,$match).' '.&mt('Because of this, user [_1] has not been dropped from the course.',$uname).$linefeed;
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 ($failsafe eq 'any') {
+ if ($autofailsafe) {
+ push(@{$delaydrops{$$currlist{$uname}[$instidx]}},$uname);
+ next;
+ }
+ } else {
+ unless ($failsafe eq 'off') {
+ 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 occured during the attempt to expire the [_1] from the old section [_2] - [_3].',$uname,$$currlist{$uname}[$sec],$drop_reply).$linefeed;
+ $$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);
@@ -392,11 +484,45 @@ sub update_LC {
}
}
}
+ if (scalar(keys(%delaydrops)) > 0) {
+ foreach my $class (keys(%delaydrops)) {
+ if (ref($delaydrops{$class}) eq 'ARRAY') {
+ if ($autofailsafe < scalar(@{$delaydrops{$class}})) {
+ if ($failsafe eq 'any') {
+ $$logmsg .= &mt('The following students were not expired from the old section [_1] because the number of students with roles to expire exceeded the failsafe threshold of [_2], set to apply when the enrollment retrieved for an institutional section is zero or greater:',$class,$autofailsafe);
+ } else {
+ $$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 .= '<br />'.join('<br />',@{$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
+# Terminated explictly allowed access to student creation/modification
+# and group membership changes
if ($context eq 'automated') {
delete($env{'allowed.cst'});
+ delete($env{'allowed.mdg'});
}
if ($enrollcount > 0) {
if ($context eq "updatenow") {
@@ -453,7 +579,7 @@ sub create_newuser {
my $pid = $args->{'pid'};
my $first = $args->{'first'};
my $middle = $args->{'middle'};
- my $last = $args->{'last'} ;
+ my $last = $args->{'last'};
my $gene = $args->{'gene'};
my $usec = $args->{'usec'};
my $end = $args->{'end'};
@@ -465,6 +591,9 @@ sub create_newuser {
my $context = $args->{'context'};
my $linefeed = $args->{'linefeed'};
my $role = $args->{'role'};
+ my $inststatus = $args->{'inststatus'};
+ my $credits = $args->{'credits'};
+ my $instsec = $args->{'instsec'};
my $create_passwd = 0;
my $authchk = '';
my $outcome;
@@ -472,7 +601,7 @@ sub create_newuser {
# If no account exists and passwords should be generated
if ($auth eq "internal") {
if ($authparam eq '') {
- $authparam = &create_password();
+ $authparam = &create_password($udom);
if ($authparam eq '') {
$authchk = '';
} else {
@@ -509,7 +638,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);
+ $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);
@@ -540,16 +669,32 @@ sub create_newuser {
} else {
my $subject = &mt('New LON-CAPA account');
my $body;
+ my $portalurl = 'http://'.$ENV{'SERVER_NAME'};
+ my $protocol = 'http';
+ my $lonhost=&Apache::lonnet::domain($udom,'primary');
+ if ($lonhost ne '') {
+ my $ip = &Apache::lonnet::get_host_ip($lonhost);
+ if ($Apache::lonnet::protocol{$lonhost} eq 'https') {
+ $protocol = 'https';
+ }
+ if ($ip ne '') {
+ $portalurl = $protocol.'://'.$ip
+ }
+ }
if ($context eq 'createowner') {
- $body = &mt('A user account has been created for you while creating your new course in the LON-CAPA course management and online homework system.')."\n\n".&mt('You should log-in to the system using the following credentials:')."\n".&mt('username: ').$uname."\n".&mt('password: ').$authparam."\n\n".&mt('The URL you should use to access the LON-CAPA system at your school is: ').'http://'.$ENV{'SERVER_NAME'}."\n\n";
+ $body = &mt('A user account has been created for you while creating your new course in the LON-CAPA course management and online homework system.')."\n\n".&mt('You should log-in to the system using the following credentials:')."\n".&mt('username: ').$uname."\n".&mt('password: ').$authparam."\n\n".&mt('The URL you should use to access the LON-CAPA system at your institution is: ').$portalurl."\n\n";
} elsif ($context eq 'createcourse') {
- $body = &mt('You have been assigned the role of [_1] in a new course: [_2] - [_3] in the LON-CAPA course management and online homework system.',$$longroles{$role},$$courseinfo{'description'},$$courseinfo{'inst_code'}).' '.&mt('As you did not have an existing user account in the system, one has been created for you.')."\n\n".&mt("You should log-in to the system using the following credentials:\nusername: [_1]\npassword: [_2]",$uname,$authparam)."\n\n".&mt('The URL you should use to access the LON-CAPA system at your school is: '),'http://'.$ENV{'SERVER_NAME'}."\n\n";
+ $body = &mt('You have been assigned the role of [_1] in a new course: [_2] - [_3] in the LON-CAPA course management and online homework system.',$$longroles{$role},$$courseinfo{'description'},$$courseinfo{'inst_code'}).' '.&mt('As you did not have an existing user account in the system, one has been created for you.')."\n\n".&mt("You should log-in to the system using the following credentials:\nusername: [_1]\npassword: [_2]",$uname,$authparam)."\n\n".&mt('The URL you should use to access the LON-CAPA system at your institution is: ').$portalurl."\n\n";
} else {
my $access_start = 'immediately';
if ($start > 0) {
$access_start = localtime($start)
}
- $body = &mt('You have been enrolled in the LON-CAPA system at your school, because you are a registered student in a class that is using the LON-CAPA couse management and online homework system.')."\n\n".&mt("You should log-in to the system using the following credentials:\nusername: [_1]\npassword: [_2]",$uname,$authparam)."\n\n".&mt('The URL you should use to access the LON-CAPA system at your school is: ').'http://'.$ENV{'SERVER_NAME'}."\n\n".&mt('When you log-in you will be able to access the LON-CAPA course for [_1] - [_2] starting [_3].',$$courseinfo{'description'},$$courseinfo{'inst_code'},$access_start)."\n";
+ $body =
+ &mt('You have been enrolled in the LON-CAPA system at your institution, because you are a registered student in a class which is using the LON-CAPA course management and online homework system.')."\n\n"
+ .&mt("You should log-in to the system using the following credentials:\nusername: [_1]\npassword: [_2]",$uname,$authparam)."\n\n"
+ .&mt('The URL you should use to access the LON-CAPA system at your institution is: ').$portalurl."\n\n"
+ .&mt('When you log-in you will be able to access the LON-CAPA course for [_1] - [_2] starting [_3].',$$courseinfo{'description'},$$courseinfo{'inst_code'},$access_start)."\n";
}
&Apache::lonmsg::sendemail($emailaddr,$subject,$body);
}
@@ -583,7 +728,7 @@ sub prepare_add {
$$start = $$stuinfo[ $$place{'startdate'} ];
$$emailaddr = $$stuinfo[ $$place{'email'} ];
$$pid = $$stuinfo[ $$place{'studentID'} ];
-
+
# remove non alphanumeric values from section
$$usec =~ s/\W//g;
@@ -611,9 +756,11 @@ sub prepare_add {
}
sub execute_add {
- my ($context,$caller,$uname,$dom,$auth,$authparam,$first,$middle,$last,$gene,$pid,$usec,$end,$start,$emailenc,$cid,$addresult,$enrollcount,$linefeed,$logmsg) = @_;
+ my ($context,$caller,$uname,$dom,$auth,$authparam,$first,$middle,$last,
+ $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'],$dom,$uname);
+ my %userenv = &Apache::lonnet::get('environment',['firstname','middlename','lastname','generation','id','critnotification','notification','permanentemail','inststatus'],$dom,$uname);
my ($tmp) = keys(%userenv);
if ($tmp =~ /^(con_lost|error)/i) {
%userenv = ();
@@ -621,14 +768,16 @@ sub execute_add {
# Get the user's e-mail address
if ($userenv{critnotification} =~ m/%40/) {
unless ($emailenc eq $userenv{critnotification}) {
- $$logmsg .= &mt('Current critical notification e-mail
-- [_1] for [_2] is different to e-mail address in institutional classlist - [_3].',$userenv{critnotification},$uname,$emailenc).$linefeed;
+ $$logmsg .= &mt('Current critical notification e-mail - [_1] for [_2] is different to e-mail address in institutional classlist - [_3].',
+ $userenv{critnotification},$uname,$emailenc).
+ $linefeed;
}
}
if ($userenv{notification} =~ m/%40/) {
unless ($emailenc eq $userenv{notification}) {
- $$logmsg .= &mt('Current standard notification e-mail
-- [_1] for [_2] is different to e-mail address in institutional classlist - [_3]',$userenv{notification},$uname,$emailenc).$linefeed;
+ $$logmsg .= &mt('Current standard notification e-mail - [_1] for [_2] is different to e-mail address in institutional classlist - [_3].',
+ $userenv{notification},$uname,$emailenc).
+ $linefeed;
}
}
if ($userenv{permanentemail} =~ m/%40/) {
@@ -680,7 +829,11 @@ sub execute_add {
}
# Assign the role of student in the course.
- my $classlist_reply = &Apache::lonnet::modify_student_enrollment($dom,$uname,$pid,$first,$middle,$last,$gene,$usec,$end,$start,'auto','',$cid);
+ my $classlist_reply =
+ &Apache::lonnet::modify_student_enrollment($dom,$uname,$pid,$first,$middle,
+ $last,$gene,$usec,$end,$start,
+ 'auto','',$cid,'',$context,
+ $credits,$instsec);
if ($classlist_reply eq 'ok') {
my $access = &showaccess($end,$start);
my $showsec = $usec;
@@ -743,7 +896,7 @@ sub parse_classlist {
my $xmlfile = $tmpdir."/tmp/".$dom."_".$crs."_".$class."_classlist.xml";
my $uname = '';
my @state;
- my @items = ('autharg','authtype','email','firstname','generation','lastname','middlename','studentID');
+ my @items = ('autharg','authtype','email','firstname','generation','lastname','middlename','studentID','credits','inststatus');
my $p = HTML::Parser->new
(
xml_mode => 1,
@@ -753,14 +906,14 @@ sub parse_classlist {
push @state, $tagname;
if ("@state" eq "students student") {
$uname = $attr->{username};
+ $$studentsref{$uname}[ $$placeref{'groupID'} ] = $groupID;
+ $$studentsref{$uname}[ $$placeref{'instsec'} ] = $class;
}
}, "tagname, attr"],
text_h =>
[sub {
my ($text) = @_;
- if ("@state" eq "students student groupID") {
- $$studentsref{$uname}[ $$placeref{'groupID'} ] = $groupID;
- } elsif ("@state" eq "students student startdate") {
+ if ("@state" eq "students student startdate") {
my $start = $text;
unless ($text eq '') {
$start = &process_date($text);
@@ -812,30 +965,87 @@ sub process_date {
}
sub create_password {
- my $passwd = '';
- my @letts = ("a","b","c","d","e","f","g","h","i","j","k","l","m","n","o","p","q","r","s","t","u","v","w","x","y","z");
- for (my $i=0; $i<8; $i++) {
+ my ($udom) = @_;
+ my %passwdconf = &Apache::lonnet::get_passwdconf($udom);
+ my ($min,$max,@chars);
+ $min = $Apache::lonnet::passwdmin;
+ if (ref($passwdconf{'chars'}) eq 'ARRAY') {
+ if ($passwdconf{'min'} =~ /^\d+$/) {
+ if ($passwdconf{'min'} > $min) {
+ $min = $passwdconf{'min'};
+ }
+ }
+ if ($passwdconf{'max'} =~ /^\d+$/) {
+ $max = $passwdconf{'max'};
+ }
+ @chars = @{$passwdconf{'chars'}};
+ }
+ my @letts = qw(b c d f g h j k l m n p q r s t v w x y z);
+ my (@included,%reqd);
+ if (@chars) {
+ map { $reqd{$_} = 1; } @chars;
+ }
+ if ($reqd{'uc'}) {
+ my $letter = $letts[int( rand(21) )];
+ $letter =~ tr/a-z/A-Z/;
+ if ($letter ne '') {
+ push(@included,$letter);
+ }
+ }
+ if ($reqd{'lc'}) {
+ my $letter = $letts[int( rand(21) )];
+ if ($letter ne '') {
+ push(@included,$letter);
+ }
+ }
+ if ($reqd{'num'}) {
+ my $number = int( rand(10) );
+ if ($number ne '') {
+ push(@included,$number);
+ }
+ }
+ if ($reqd{'spec'}) {
+ my @specs = qw(! # * & _ - + $);
+ my $special = $specs[int( rand(8) )];
+ if ($special ne '') {
+ push(@included,$special);
+ }
+ }
+ my $start = 0;
+ if (scalar(@included) > 0) {
+ $start = scalar(@included);
+ }
+ my $end = 8;
+ if ($min =~ /^\d+$/) {
+ if ($min > $end) {
+ $end = $min;
+ }
+ }
+ for (my $i=$start; $i<$end; $i++) {
my $lettnum = int (rand 2);
my $item = '';
if ($lettnum) {
- $item = $letts[int( rand(26) )];
+ $item = $letts[int( rand(21) )];
my $uppercase = int(rand 2);
if ($uppercase) {
$item =~ tr/a-z/A-Z/;
}
} else {
$item = int( rand(10) );
- }
- $passwd .= $item;
+ }
+ if ($item ne '') {
+ push(@included,$item);
+ }
}
- return ($passwd);
+ my $passwd = join('',&Math::Random::random_permutation(@included));
+ return $passwd;
}
sub get_courseinfo {
my ($dom,$crs,$courseinfo) = @_;
my $owner;
if (defined($dom) && defined($crs)) {
- my %settings = &Apache::lonnet::get('environment',['internal.coursecode','internal.showphoto','description'],$dom,$crs);
+ my %settings = &Apache::lonnet::get('environment',['internal.coursecode','internal.showphoto','description','internal.defaultcredits'],$dom,$crs);
if ( defined($settings{'internal.coursecode'}) ) {
$$courseinfo{'inst_code'} = $settings{'internal.coursecode'};
}
@@ -845,6 +1055,9 @@ sub get_courseinfo {
if ( defined($settings{'internal.showphoto'}) ) {
$$courseinfo{'showphoto'} = $settings{'internal.showphoto'};
}
+ if ( defined($settings{'internal.credithours'}) ) {
+ $$courseinfo{'defaultcredits'} = $settings{'internal.defaultcredits'};
+ }
}
return;
}
@@ -862,6 +1075,9 @@ sub place_hash {
middlename => 8,
startdate => 9,
studentID => 10,
+ credits => 11,
+ inststatus => 12,
+ instsec => 13,
);
return %place;
}
@@ -874,7 +1090,7 @@ sub photo_response_types {
'missing' => 'were missing',
'error' => 'were not imported because an error occurred',
'nouser' => 'were for users without accounts',
- 'noid' => 'were for users without student IDs',
+ 'noid' => 'were for users without student/employee IDs',
);
return %lt;
}