--- loncom/enrollment/Enrollment.pm 2004/03/18 00:24:57 1.11
+++ loncom/enrollment/Enrollment.pm 2005/08/31 06:21:58 1.24
@@ -1,5 +1,5 @@
# Automated Enrollment manager
-# $Id: Enrollment.pm,v 1.11 2004/03/18 00:24:57 raeburn Exp $
+# $Id: Enrollment.pm,v 1.24 2005/08/31 06:21:58 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -32,12 +32,14 @@ use HTML::Entities;
use LONCAPA::Configuration;
use Time::Local;
use lib '/home/httpd/lib/perl';
-use localenroll;
use strict;
sub update_LC {
my ($dom,$crs,$adds,$drops,$startdate,$enddate,$authtype,$autharg,$classesref,$groupref,$logmsg,$newusermsg,$context) = @_;
+# Get institutional code and title of this class
+ my %courseinfo = ();
+ &get_courseinfo($dom,$crs,\%courseinfo);
# Get current LON-CAPA student enrollment for this class
my $configvars = &LONCAPA::Configuration::read_conf('loncapa.conf');
my $cid = $dom."_".$crs;
@@ -48,19 +50,31 @@ sub update_LC {
my $sec=&Apache::loncoursedata::CL_SECTION;
my $status=&Apache::loncoursedata::CL_STATUS;
my $type=&Apache::loncoursedata::CL_TYPE;
+ my $lockedtype=&Apache::loncoursedata::CL_LOCKEDTYPE;
my @localstudents = ();
+ my @futurestudents = ();
+ my @activestudents = ();
+ my @excludedstudents = ();
my $currlist;
foreach my $uname (keys %{$roster} ) {
if ($uname =~ m/^(.+):$dom$/) {
if ($$roster{$uname}[$status] eq "Active") {
+ push @activestudents, $1;
+ @{$$currlist{$1}} = @{$$roster{$uname}};
push @localstudents, $1;
+ } elsif ( ($$roster{$uname}[$cstart] > time) && ($$roster{$uname}[$cend] > time || $$roster{$uname}[$cend] == 0 || $$roster{$uname}[$cend] eq '') ) {
+ push @futurestudents, $1;
@{$$currlist{$1}} = @{$$roster{$uname}};
+ push @localstudents, $1;
+ } elsif ($$roster{$uname}[$lockedtype] == 1) {
+ push @excludedstudents, $1;
}
}
}
my $linefeed = '';
my $addresult = '';
my $dropresult = '';
+ my $switchresult = '';
if ($context eq "updatenow") {
$linefeed = "\n
";
} elsif ($context eq "automated") {
@@ -68,6 +82,18 @@ sub update_LC {
}
my $enrollcount = 0;
my $dropcount = 0;
+ my $switchcount = 0;
+
+# Get role names
+ my %longroles = ();
+ open(FILE,"<$$configvars{'lonTabDir'}.'/rolesplain.tab");
+ my @rolesplain = ;
+ close(FILE);
+ foreach (@rolesplain) {
+ if ($_ =~ /^(st|ta|ex|ad|in|cc):([\w\s]+)$/) {
+ $longroles{$1} = $2;
+ }
+ }
srand( time() ^ ($$ + ($$ << 15)) ); # Seed rand in case initial passwords have to be generated for new users.
@@ -117,7 +143,9 @@ sub update_LC {
# Check for multiple sections for a single student
my @okusers = ();
foreach my $uname (@reg_students) {
- if (@{$allenrolled{$uname}} > 1) {
+ if (grep/^$uname$/,@excludedstudents) {
+ $$logmsg .= "No re-enrollment for $uname - user was previously manually unenrolled and locked.".$linefeed;
+ } elsif (@{$allenrolled{$uname}} > 1) {
my @sections = ();
my $saved;
for (my $i=0; $i<@{$allenrolled{$uname}}; $i++) {
@@ -166,7 +194,7 @@ sub update_LC {
}
# Explicitly allow access to creation/modification of students if called as an automated process.
if ($context eq 'automated') {
- $ENV{'allowed.cst'}='F';
+ $env{'allowed.cst'}='F';
}
# Compare IDs with existing LON-CAPA enrollment for this class
@@ -174,6 +202,7 @@ sub update_LC {
unless ($uname eq '') {
my %uidhash=&Apache::lonnet::idrget($dom,$uname);
my @stuinfo = @{$enrollinfo{$uname}};
+ my $access = '';
if (grep/^$uname$/,@localstudents) {
# Check for studentID changes
if ( ($uidhash{$uname}) && ($uidhash{$uname} !~ /error\:/) ) {
@@ -181,9 +210,43 @@ sub update_LC {
$$logmsg .= "Change in ID for $uname. StudentID in LON-CAPA system is $uidhash{$uname}; StudentID in institutional data is $stuinfo[ $place{studentID} ]".$linefeed;
}
}
-
+# Check for switch from manual to auto
+ unless (($$currlist{$uname}[$type] eq "auto") || ($$currlist{$uname}[$lockedtype] eq "1") || (!$adds) ) {
+# drop manually added student
+ my $drop_reply = &Apache::lonnet::modifystudent($dom,$uname,'','','',undef,undef,undef,undef,$$currlist{$uname}[$sec],time,undef,undef,undef,undef,'auto','',$cid);
+# re-enroll as auto student
+ if ($drop_reply !~ /^ok/) {
+ $$logmsg .= "An error occured during the attempt to convert $uname from a manual type to an auto type student - $drop_reply.".$linefeed;
+ } else {
+# re-enroll as auto student
+ my ($auth,$authparam,$first,$middle,$last,$gene,$usec,$end,$start,$emailaddr,$pid,$emailenc);
+ &prepare_add($authtype,$autharg,$enddate,$startdate,\@stuinfo,\%place,\$dom,\$uname,\$auth,\$authparam,\$first,\$middle,\$last,\$gene,\$usec,\$end,\$start,\$emailaddr,\$pid,\$emailenc);
+ if ($$currlist{$uname}[$sec] ne $usec) {
+ $switchresult .= "Section for $uname switched from $$currlist{$uname}[$sec] to ".$usec.$linefeed;
+ if ($context eq 'automated') {
+ $$logmsg .= "Section switch for $uname from $$currlist{$uname}[$sec] to ".$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);
+ }
+ }
# Check for section changes
- unless ($$currlist{$uname}[$sec] eq $stuinfo[ $place{groupID} ]) {
+ 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);
+ $access = &showaccess($enddate,$startdate);
+ if ($modify_access_result =~ /^ok/) {
+ $$logmsg .= "Change in access dates for $uname.".$access.$linefeed;
+ } else {
+ $$logmsg .= "Error when attempting to change start and/or end access dates for $uname in section: ".$stuinfo[ $place{groupID} ]." -error $modify_access_result".$linefeed;
+ }
+ }
+ }
+ } else {
if ( ($$currlist{$uname}[$type] eq "auto") && ($adds == 1) ) {
# Delete from roles.db for current section
my $expiretime = time;
@@ -194,9 +257,19 @@ sub update_LC {
}
my $expire_role_result = &Apache::lonnet::assignrole($dom,$uname,$uurl,'st',$expiretime);
if ($expire_role_result eq 'ok') {
- my $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);
+ 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);
+ } else {
+ $modify_section_result = &Apache::lonnet::modify_student_enrollment($dom,$uname,undef,undef,undef,undef,undef,$stuinfo[ $place{groupID} ],$enddate,$startdate,'auto','',$cid);
+ $access = &showaccess($enddate,$startdate);
+ }
if ($modify_section_result =~ /^ok/) {
- $$logmsg .= "Section for $uname switched from old section: ".$$currlist{$uname}[$sec] ." to new section: ".$stuinfo[ $place{groupID} ].".".$linefeed;
+ $switchresult .= "Section for $uname switched from old section: ".$$currlist{$uname}[$sec] ." to new section: ".$stuinfo[ $place{groupID} ].".".$access.$linefeed;
+ if ($context eq 'automated') {
+ $$logmsg .= "Section switch for $uname from $$currlist{$uname}[$sec] to $stuinfo[ $place{groupID} ]".$linefeed;
+ }
+ $switchcount ++;
} else {
$$logmsg .= "Error when attempting section change for $uname from old section ".$$currlist{$uname}[$sec]." to new section: ".$stuinfo[ $place{groupID} ]." -error: $modify_section_result".$linefeed;
}
@@ -216,176 +289,35 @@ sub update_LC {
}
}
} elsif ($adds == 1) {
-# Add student to LON-CAPA classlist
- my $auth = $stuinfo[ $place{'authtype'} ];
- my $authparam = $stuinfo[ $place{'autharg'} ];
- my $first = $stuinfo[ $place{'firstname'} ];
- my $middle = $stuinfo[ $place{'middlename'} ];
- my $last = $stuinfo[ $place{'lastname'} ];
- my $gene = $stuinfo[ $place{'generation'} ];
- my $usec = $stuinfo[ $place{'groupID'} ];
- my $end = $stuinfo[ $place{'enddate'} ];
- my $start = $stuinfo[ $place{'startdate'} ];
- my $emailaddr = $stuinfo[ $place{'email'} ];
- my $pid = $stuinfo[ $place{'studentID'} ];
-
-# remove non alphanumeric values from section
- $usec =~ s/\W//g;
-
- unless ($emailaddr =~/^[^\@]+\@[^\@]+$/) { $emailaddr =''; }
- my $emailenc = &HTML::Entities::encode($emailaddr);
-
-# Use course defaults where entry is absent
- if ( ($auth eq '') || (!defined($auth)) ) {
- $auth = $authtype;
- }
- if ( ($authparam eq '') || (!defined($authparam)) ) {
- $authparam = $autharg;
- }
- if ($auth =~ m/^krb/) {
- $auth .= ':'.$authparam;
- }
- if ( ($end eq '') || (!defined($end)) ) {
- $end = $enddate;
- }
- if ( ($start eq '') || (!defined($start)) ) {
- $start = $startdate;
- }
-# Clean up whitespace
- foreach (\$dom,\$uname,\$pid,\$first,\$middle,\$last,\$gene,\$usec) {
- $$_ =~ s/(\s+$|^\s+)//g;
- }
-
+ my ($auth,$authparam,$first,$middle,$last,$gene,$usec,$end,$start,$emailaddr,$pid,$emailenc);
+ &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
my $uhome=&Apache::lonnet::homeserver($uname,$dom);
if ($uhome eq 'no_host') { # User does not exist
- my $create_passwd = 0;
- my $authchk = '';
- unless ($authparam eq '') { $authchk = 'ok'; };
-# If no account exists and passwords should be generated
- if ($auth eq "internal") {
- if ($authparam eq '') {
- ($authparam) = &create_password();
- if ($authparam eq '') {
- $authchk = '';
- } else {
- $create_passwd = 1;
- $authchk = 'ok';
- }
- }
- } elsif ($auth eq "localauth") {
- ($authparam,$create_passwd,$authchk) = &localenroll::create_password($authparam);
- } elsif ($auth =~ m/^krb/) {
- if ($authparam eq '') {
- $$logmsg .= "No Kerberos domain was provided for the new user - $uname, so the new student was not enrolled in the course.".$linefeed;
- $authchk = 'invalid';
- }
- } else {
- $authchk = 'invalid';
- $$logmsg .= "An invalid authentication type was provided for the new user - $uname, so the student was not enrolled in the course.".$linefeed;
- }
- if ($authchk eq 'ok') {
-# Now create user.
- my $reply=&Apache::lonnet::modifystudent($dom,$uname,$pid,$auth,$authparam,$first,$middle,$last,$gene,$usec,$end,$start,'',undef,$emailaddr,'auto',$cid);
- if ($reply eq 'ok') {
- $enrollcount ++;
- $addresult .= "$first $last ($pid) - $uname enrolled in section/group $usec.".$linefeed;
- if ($context eq 'automated') {
- $$logmsg .= "New $dom user $uname added successfully.";
- }
- unless ($emailenc eq '') {
- my %emailHash;
- $emailHash{'critnotification'} = $emailenc;
- $emailHash{'notification'} = $emailenc;
- my $putresult = &Apache::lonnet::put('environment',\%emailHash,$dom,$uname);
- }
- if ($create_passwd) {
-# Send e-mail with initial password to new user at $emailaddr.
-# If e-mail address is invalid, send password via message to courseowner i
-# (if automated call) or to user if roster update.
- if ($emailaddr eq '') {
- $$newusermsg .= " username: $uname, password: ".$authparam.$linefeed."\n";
- } else {
- my $subject = "New LON-CAPA account";
- my $body = "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 course management and online homework system.\n\nYou should log-in to the system using the following credentials:\nusername: $uname\npassword: $authparam\n\nThe URL you should use to access the LON-CAPA system at your school is: http://".$ENV{'SERVER_NAME'};
- &Apache::lonmsg::sendemail($emailaddr,$subject,$body);
- }
- if ($context eq 'automated') {
- $$logmsg .= " Initial password - - sent to ".$emailaddr.$linefeed;
- }
- } else {
- if ($context eq 'automated') {
- $$logmsg .= $linefeed;
- }
- }
- } else {
- $$logmsg .= "An error occurred adding new user $uname - ".$reply.$linefeed;
- }
- }
+ my $args = {'auth' => $auth,
+ 'authparam' => $authparam,
+ 'emailenc' => $emailenc,
+ 'udom' => $dom,
+ 'uname' => $uname,
+ 'pid' => $pid,
+ 'first' => $first,
+ 'middle' => $middle,
+ 'last' => $last,
+ 'gene' => $gene,
+ 'usec' => $usec,
+ 'end' => $end,
+ 'start' => $start,
+ 'emailaddr' => $emailaddr,
+ 'cid' => $cid,
+ 'crs' => $crs,
+ 'cdom' => $dom,
+ 'context' => $context,
+ 'linefeed' => $linefeed,
+ 'role' => 'st'
+ };
+ my $outcome = &create_newuser($args,$logmsg,$newusermsg,\$enrollcount,\$addresult,\%longroles,\%courseinfo);
} else {
-# Get the user's information and authentication
- my %userenv = &Apache::lonnet::get('environment',['firstname','middlename','lastname','generation','id','critnotification','notification'],$dom,$uname);
- my ($tmp) = keys(%userenv);
- if ($tmp =~ /^(con_lost|error)/i) {
- %userenv = ();
- }
-# Get the user's e-mail address
- if ($userenv{critnotification} =~ m/%40/) {
- unless ($emailenc eq $userenv{critnotification}) {
- $$logmsg .= "Current critical notification e-mail - ".$userenv{critnotification}." for $uname is different to e-mail address in Institutional classlist - ".$emailenc.$linefeed;
- }
- }
- if ($userenv{notification} =~ m/%40/) {
- unless ($emailenc eq $userenv{critnotification}) {
- $$logmsg .= "Current standard notification e-mail - ".$userenv{notification}." for $uname is different to e-mail address in institutional classlist - ".$emailenc.$linefeed;
- }
- }
- my $krbdefdom = '';
- my $currentauth=&Apache::lonnet::queryauthenticate($uname,$dom);
- if ($currentauth=~/^krb(4|5):/) {
- $currentauth=~/^krb(4|5):(.*)/;
- $krbdefdom=$1;
- } elsif ($currentauth=~ /^(unix|internal|localauth):/) {
- $currentauth = $1;
- } else {
- $$logmsg .= "Invalid authentication method $currentauth for $uname.".$linefeed;
- }
-# Report if authentication methods are different.
- if ($currentauth ne $auth ) {
- $$logmsg .= "Authentication mismatch for $uname - $currentauth in system, $auth based on information in classlist or default for this course.".$linefeed;
- }
-# Check user data
- if ($first ne $userenv{'firstname'} ||
- $middle ne $userenv{'middlename'} ||
- $last ne $userenv{'lastname'} ||
- $gene ne $userenv{'generation'} ||
- $pid ne $userenv{'id'} ) {
-# Make the change(s)
- my %changeHash;
- $changeHash{'firstname'} = $first;
- $changeHash{'middlename'} = $middle;
- $changeHash{'lastname'} = $last;
- $changeHash{'generation'} = $gene;
- $changeHash{'id'} = $pid;
- my $putresult = &Apache::lonnet::put('environment',\%changeHash,$dom,$uname);
- if ($putresult eq 'ok') {
- $$logmsg .= "User information updated for user: $uname prior to enrollment.".$linefeed;
- } else {
- $$logmsg .= "There was a problem modifying user data for existing user - $uname -error: $putresult, enrollment will still be attempted.".$linefeed;
- }
- }
-
-# 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);
- if ($classlist_reply eq 'ok') {
- $enrollcount ++;
- $addresult .= "$first $last ($pid) - $uname enrolled in section/group $usec.".$linefeed;
- if ($context eq 'automated') {
- $$logmsg .= "Existing $dom user $uname enrolled successfully.".$linefeed;
- }
- } else {
- $$logmsg .= "There was a problem updating the classlist db file for user $uname to show the new enrollment -error: $classlist_reply, so no enrollment occurred for this user.".$linefeed;
- }
+ &execute_add($context,'newstudent',$uname,$dom,$auth,$authparam,$first,$middle,$last,$gene,$pid,$usec,$end,$start,$emailenc,$cid,\$addresult,\$enrollcount,$linefeed,$logmsg);
}
}
}
@@ -404,7 +336,7 @@ sub update_LC {
push @saved,$uname;
}
} elsif (@saved == 0) {
- my $drop_reply = &Apache::lonnet::modifystudent($dom,$uname,'','','',undef,undef,undef,undef,$$currlist{$uname}[$sec],time,undef,undef,undef,undef,undef,$cid);
+ my $drop_reply = &Apache::lonnet::modifystudent($dom,$uname,'','','',undef,undef,undef,undef,$$currlist{$uname}[$sec],time,undef,undef,undef,undef,'auto','',$cid);
if ($drop_reply !~ /^ok/) {
$$logmsg .= "An error occured during the attempt to expire the $uname from the old section $$currlist{$uname}[$sec] - $drop_reply.".$linefeed;
} else {
@@ -423,24 +355,32 @@ sub update_LC {
# Terminated explictly allowed access to student creation/modification
if ($context eq 'automated') {
- delete($ENV{'allowed.cst'});
+ delete($env{'allowed.cst'});
}
if ($enrollcount > 0) {
if ($context eq "updatenow") {
$addresult = substr($addresult,0,rindex($addresult,""));
- $addresult = "The following $enrollcount student(s) was/were added to this LON-CAPA course:
";
+ $addresult = "The following $enrollcount student(s) was/were added to this LON-CAPA course:
";
} else {
- $addresult = "The following $enrollcount student(s) was/were added to this LON-CAPA course:\n\n".$addresult."\n\n";
- }
+ $addresult = "The following $enrollcount student(s) was/were added to this LON-CAPA course:\n\n".$addresult."\n\n";
+ }
}
if ($dropcount > 0) {
if ($context eq "updatenow") {
$dropresult = substr($dropresult,0,rindex($dropresult,""));
- $dropresult = "The following $dropcount student(s) was/were expired from this LON-CAPA course:
";
+ $dropresult = "The following $dropcount student(s) was/were expired from this LON-CAPA course:
";
} else {
$dropresult = "The following $dropcount student(s) was/were expired from this LON-CAPA course:\n\n".$dropresult."\n\n";
}
}
+ if ($switchcount > 0) {
+ if ($context eq "updatenow") {
+ $switchresult = substr($switchresult,0,rindex($switchresult,""));
+ $switchresult = "The following $switchcount student(s) switched sections in this LON-CAPA course:
";
+ } else {
+ $switchresult = "The following $switchcount student(s) switched sections in this LON-CAPA course:\n\n".$switchresult."\n\n";
+ }
+ }
if ( ($adds) && ($enrollcount == 0) ) {
$addresult = "There were no new students to add to the course.";
if ($context eq "updatenow") {
@@ -457,8 +397,293 @@ sub update_LC {
$dropresult .="\n";
}
}
- my $changecount = $enrollcount + $dropcount;
- return ($changecount,$addresult.$dropresult);
+ my $changecount = $enrollcount + $dropcount + $switchcount;
+ return ($changecount,$addresult.$dropresult.$switchresult);
+}
+
+sub create_newuser {
+ my ($args,$logmsg,$newusermsg,$enrollcount,$addresult,$longroles,$courseinfo) = @_;
+ my $auth = $args->{'auth'};
+ my $authparam = $args->{'authparam'};
+ my $emailenc = $args->{'emailenc'};
+ my $udom = $args->{'udom'};
+ my $uname = $args->{'uname'};
+ my $pid = $args->{'pid'};
+ my $first = $args->{'first'};
+ my $middle = $args->{'middle'};
+ my $last = $args->{'last'} ;
+ my $gene = $args->{'gene'};
+ my $usec = $args->{'usec'};
+ my $end = $args->{'end'};
+ my $start = $args->{'start'};
+ my $emailaddr = $args->{'emailaddr'};
+ my $cid = $args->{'cid'};
+ my $crs = $args->{'crs'};
+ my $cdom = $args->{'cdom'};
+ my $context = $args->{'context'};
+ my $linefeed = $args->{'linefeed'};
+ my $role = $args->{'role'};
+ my $create_passwd = 0;
+ my $authchk = '';
+ my $outcome;
+ unless ($authparam eq '') { $authchk = 'ok'; };
+# If no account exists and passwords should be generated
+ if ($auth eq "internal") {
+ if ($authparam eq '') {
+ $authparam = &create_password();
+ if ($authparam eq '') {
+ $authchk = '';
+ } else {
+ $create_passwd = 1;
+ $authchk = 'ok';
+ }
+ }
+ } elsif ($auth eq "localauth") {
+ ($authparam,$create_passwd,$authchk) = &Apache::lonnet::auto_create_password($crs,$cdom,$authparam);
+ } elsif ($auth =~ m/^krb/) {
+ if ($authparam eq '') {
+ $$logmsg .= "No Kerberos domain was provided for the new user - $uname, so the new user was not enrolled in the course.".$linefeed;
+ $authchk = 'invalid';
+ }
+ } else {
+ $authchk = 'invalid';
+ $$logmsg .= "An invalid authentication type was provided for the new user - $uname, so the user was not enrolled in the course.".$linefeed;
+ }
+ if ($authchk eq 'ok') {
+# Now create user.
+ my $type = 'auto';
+ my $userurl = '/'.$cdom.'/'.$crs;
+ if ($usec ne '') {
+ $userurl .= '/'.$usec;
+ }
+ if ($context eq 'createowner' || $context eq 'createcourse') {
+ my $result = &Apache::lonnet::modifyuser($udom,$uname,$pid,$auth,$authparam,$first,$middle,$last,$gene,'1',undef,$emailaddr);
+ if ($result eq 'ok' && $context eq 'createcourse') {
+ $outcome = &Apache::loncreateuser::commit_standardrole($udom,$uname,$userurl,$role,$start,$end,$cdom,$crs,$usec);
+ unless ($outcome =~ /^Error:/) {
+ $outcome = 'ok';
+ }
+ } else {
+ $outcome = $result;
+ }
+ } else {
+ $outcome=&Apache::lonnet::modifystudent($udom,$uname,$pid,$auth,$authparam,$first,$middle,$last,$gene,$usec,$end,$start,'',undef,$emailaddr,'auto','',$cid);
+ }
+ if ($outcome eq 'ok') {
+ my $access = &showaccess($end,$start);
+ $$addresult .= "$first $last ($pid) - $uname enrolled in section/group $usec.".$access.$linefeed;
+ unless ($context eq 'createowner' || $context eq 'createcourse') {
+ $$enrollcount ++;
+ }
+ if ($context eq 'automated') {
+ $$logmsg .= "New $udom user $uname added successfully.";
+ }
+ unless ($emailenc eq '' || $context eq 'createowner' || $context eq 'createcourse') {
+ my %emailHash;
+ $emailHash{'critnotification'} = $emailenc;
+ $emailHash{'notification'} = $emailenc;
+ $emailHash{'permanentemail'} = $emailenc;
+ my $putresult = &Apache::lonnet::put('environment',\%emailHash,$udom,$uname);
+ }
+ if ($create_passwd) {
+# Send e-mail with initial password to new user at $emailaddr.
+# If e-mail address is invalid, send password via message to courseowner i
+# (if automated call) or to user if roster update.
+ if ($emailaddr eq '') {
+ $$newusermsg .= " username: $uname, password: ".$authparam.$linefeed."\n";
+ } else {
+ my $subject = "New LON-CAPA account";
+ my $body;
+ if ($context eq 'createowner') {
+ $body = "A user account has been created for you while creating your new course in the LON-CAPA course management and online homework system.\n\nYou should log-in to the system using the following credentials:\nusername: $uname\npassword: $authparam\n\nThe URL you should use to access the LON-CAPA system at your school is: http://".$ENV{'SERVER_NAME'}."\n\n";
+ } elsif ($context eq 'createcourse') {
+ $body = "You have been assigned the role of $$longroles{$role} in a new course: $$courseinfo{'description'} - $$courseinfo{'inst_code'} in the LON-CAPA course management and online homework system. As you did not have an existing user account in the system, one has been created for you.\n\nYou should log-in to the system using the following credentials:\nusername: $uname\npassword: $authparam\n\nThe URL you should use to access the LON-CAPA system at your school is: http://".$ENV{'SERVER_NAME'}."\n\n";
+ } else {
+ my $access_start = 'immediately';
+ if ($start > 0) {
+ $access_start = localtime($start)
+ }
+ $body = "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\nYou should log-in to the system using the following credentials:\nusername: $uname\npassword: $authparam\n\nThe URL you should use to access the LON-CAPA system at your school is: http://".$ENV{'SERVER_NAME'}."\n\n.When you log-in you will be able to access the LON-CAPA course for $$courseinfo{'description'} - $$courseinfo{'inst_code'} starting $access_start.\n";
+ }
+ &Apache::lonmsg::sendemail($emailaddr,$subject,$body);
+ }
+ if ($context eq 'automated') {
+ $$logmsg .= " Initial password - - sent to ".$emailaddr.$linefeed;
+ }
+ } else {
+ if ($context eq 'automated') {
+ $$logmsg .= $linefeed;
+ }
+ }
+ } else {
+ $$logmsg .= "An error occurred adding new user $uname - ".$outcome.$linefeed;
+ }
+ }
+ return $outcome;
+}
+
+sub prepare_add {
+ my ($authtype,$autharg,$enddate,$startdate,$stuinfo,$place,$dom,$uname,$auth,$authparam,$first,$middle,$last,$gene,$usec,$end,$start,$emailaddr,$pid,$emailenc) = @_;
+ $$auth = $$stuinfo[ $$place{'authtype'} ];
+ $$authparam = $$stuinfo[ $$place{'autharg'} ];
+ $$first = $$stuinfo[ $$place{'firstname'} ];
+ $$middle = $$stuinfo[ $$place{'middlename'} ];
+ $$last = $$stuinfo[ $$place{'lastname'} ];
+ $$gene = $$stuinfo[ $$place{'generation'} ];
+ $$usec = $$stuinfo[ $$place{'groupID'} ];
+ $$end = $$stuinfo[ $$place{'enddate'} ];
+ $$start = $$stuinfo[ $$place{'startdate'} ];
+ $$emailaddr = $$stuinfo[ $$place{'email'} ];
+ $$pid = $$stuinfo[ $$place{'studentID'} ];
+
+# remove non alphanumeric values from section
+ $$usec =~ s/\W//g;
+
+ unless ($$emailaddr =~/^[^\@]+\@[^\@]+$/) { $$emailaddr =''; }
+ $$emailenc = &HTML::Entities::encode($$emailaddr,'<>&"');
+
+# Use course defaults where entry is absent
+ if ( ($$auth eq '') || (!defined($$auth)) ) {
+ $$auth = $authtype;
+ }
+ if ( ($$authparam eq '') || (!defined($$authparam)) ) {
+ $$authparam = $autharg;
+ }
+ if ( ($$end eq '') || (!defined($$end)) ) {
+ $$end = $enddate;
+ }
+ if ( ($$start eq '') || (!defined($$start)) ) {
+ $$start = $startdate;
+ }
+# Clean up whitespace
+ foreach ($dom,$uname,$pid,$first,$middle,$last,$gene,$usec) {
+ $$_ =~ s/(\s+$|^\s+)//g;
+ }
+ return;
+}
+
+sub execute_add {
+ my ($context,$caller,$uname,$dom,$auth,$authparam,$first,$middle,$last,$gene,$pid,$usec,$end,$start,$emailenc,$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 ($tmp) = keys(%userenv);
+ if ($tmp =~ /^(con_lost|error)/i) {
+ %userenv = ();
+ }
+# Get the user's e-mail address
+ if ($userenv{critnotification} =~ m/%40/) {
+ unless ($emailenc eq $userenv{critnotification}) {
+ $$logmsg .= "Current critical notification e-mail
+- ".$userenv{critnotification}." for $uname is different to e-mail address in institutional classlist - ".$emailenc.$linefeed;
+ }
+ }
+ if ($userenv{notification} =~ m/%40/) {
+ unless ($emailenc eq $userenv{notification}) {
+ $$logmsg .= "Current standard notification e-mail
+- ".$userenv{notification}." for $uname is different to e-mail address in institutional classlist - ".$emailenc.$linefeed;
+ }
+ }
+ if ($userenv{permanentemail} =~ m/%40/) {
+ unless ($emailenc eq $userenv{permanentemail}) {
+ $$logmsg .= "Current permanent e-mail
+- ".$userenv{permanentemail}." for $uname is different to e-mail address in institutional classlist - ".$emailenc.$linefeed;
+ }
+ }
+ my $krbdefdom = '';
+ my $currentauth=&Apache::lonnet::queryauthenticate($uname,$dom);
+ if ($currentauth=~/^(krb[45]):(.*)/) {
+ $currentauth = $1;
+ $krbdefdom = $2;
+ } elsif ($currentauth=~ /^(unix|internal|localauth):/) {
+ $currentauth = $1;
+ } else {
+ $$logmsg .= "Invalid authentication method $currentauth for $uname.".$linefeed;
+ }
+# Report if authentication methods are different.
+ if ($currentauth ne $auth) {
+ $$logmsg .= "Authentication type mismatch for $uname - '$currentauth' in system, '$auth' based on information in classlist or default for this course.".$linefeed;
+ } elsif ($auth =~ m/^krb/) {
+ if ($krbdefdom ne $authparam) {
+ $$logmsg .= "Kerberos domain mismatch for $uname - '$krbdefdom' in system, '$authparam' based on information in classlist or default for this course.".$linefeed;
+ }
+ }
+
+# Check user data
+ if ($first ne $userenv{'firstname'} ||
+ $middle ne $userenv{'middlename'} ||
+ $last ne $userenv{'lastname'} ||
+ $gene ne $userenv{'generation'} ||
+ $pid ne $userenv{'id'} ||
+ $emailenc ne $userenv{'permanentemail'} ) {
+# Make the change(s)
+ my %changeHash;
+ $changeHash{'firstname'} = $first;
+ $changeHash{'middlename'} = $middle;
+ $changeHash{'lastname'} = $last;
+ $changeHash{'generation'} = $gene;
+ $changeHash{'id'} = $pid;
+ $changeHash{'permanentemail'} = $emailenc;
+ my $putresult = &Apache::lonnet::put('environment',\%changeHash,$dom,$uname);
+ if ($putresult eq 'ok') {
+ $$logmsg .= "User information updated for user: $uname prior to enrollment.".$linefeed;
+ } else {
+ $$logmsg .= "There was a problem modifying user data for existing user - $uname -error: $putresult, enrollment will still be attempted.".$linefeed;
+ }
+ }
+
+# 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);
+ if ($classlist_reply eq 'ok') {
+ my $access = &showaccess($end,$start);
+ if ($caller eq 'switchtype') {
+ $$logmsg .= "Existing user $uname detected in institutional classlist - switched from 'manual' to 'auto' enrollment in section/group $usec.".$access.$linefeed;
+ } elsif ($caller eq 'newstudent') {
+ $$enrollcount ++;
+ $$addresult .= "$first $last ($pid) - $uname enrolled in section/group $usec.".$access.$linefeed;
+ }
+ if ($context eq 'automated') {
+ $$logmsg .= "Existing $dom user $uname enrolled successfully.".$linefeed;
+ }
+ } else {
+ $$logmsg .= "There was a problem updating the classlist db file for user $uname to show the new enrollment -error: $classlist_reply, so no enrollment occurred for this user.".$linefeed;
+ }
+ return;
+}
+
+sub datechange_check {
+ my ($oldstart,$oldend,$startdate,$enddate) = @_;
+ my $datechange = 0;
+ unless ($oldstart eq $startdate) {
+ $datechange = 1;
+ }
+ if (!$datechange) {
+ if (!$oldend) {
+ if ($enddate) {
+ $datechange = 1;
+ }
+ } elsif ($oldend ne $enddate) {
+ $datechange = 1;
+ }
+ }
+ return $datechange;
+}
+
+sub showaccess {
+ my ($end,$start) = @_;
+ my $showstart;
+ my $showend;
+ if ( (!$start) || ($start <= time) ) {
+ $showstart = 'immediately';
+ } else {
+ $showstart = &Apache::lonlocal::locallocaltime($start);
+ }
+ if (!$end) {
+ $showend = 'no end date';
+ } else {
+ $showend = &Apache::lonlocal::locallocaltime($end);
+ }
+ my $access_msg = " Access starts: ".$showstart.", ends: ".$showend.".";
+ return $access_msg;
}
sub parse_classlist {
@@ -592,6 +817,22 @@ sub check_user_status {
return $active_chk;
}
+sub get_courseinfo {
+ my ($dom,$crs,$courseinfo) = @_;
+ my $owner;
+ if (defined($dom) && defined($crs)) {
+ my %settings = &Apache::lonnet::get('environment',['internal.coursecode','description'],$dom,$crs);
+ if ( defined($settings{'internal.coursecode'}) ) {
+ $$courseinfo{'inst_code'} = $settings{'internal.coursecode'};
+
+ }
+ if ( defined($settings{'description'}) ) {
+ $$courseinfo{'description'} = $settings{'description'};
+ }
+ }
+ return;
+}
+
sub CL_autharg { return 0; }
sub CL_authtype { return 1;}
sub CL_email { return 2;}