Annotation of loncom/enrollment/Enrollment.pm, revision 1.29
1.7 albertel 1: # Automated Enrollment manager
1.29 ! albertel 2: # $Id: Enrollment.pm,v 1.28 2006/02/07 05:08:21 raeburn Exp $
1.7 albertel 3: #
4: # Copyright Michigan State University Board of Trustees
5: #
6: # This file is part of the LearningOnline Network with CAPA (LON-CAPA).
7: #
8: # LON-CAPA is free software; you can redistribute it and/or modify
9: # it under the terms of the GNU General Public License as published by
10: # the Free Software Foundation; either version 2 of the License, or
11: # (at your option) any later version.
12: #
13: # LON-CAPA is distributed in the hope that it will be useful,
14: # but WITHOUT ANY WARRANTY; without even the implied warranty of
15: # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16: # GNU General Public License for more details.
17: #
18: # You should have received a copy of the GNU General Public License
19: # along with LON-CAPA; if not, write to the Free Software
20: # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
21: #
22: # /home/httpd/html/adm/gpl.txt
23: #
24: # http://www.lon-capa.org/
25: #
1.1 raeburn 26: package LONCAPA::Enrollment;
27:
28: use Apache::loncoursedata;
29: use Apache::lonnet;
1.8 raeburn 30: use Apache::lonmsg;
1.28 raeburn 31: use Apache::lonlocal;
1.1 raeburn 32: use HTML::Entities;
33: use LONCAPA::Configuration;
1.8 raeburn 34: use Time::Local;
35: use lib '/home/httpd/lib/perl';
1.1 raeburn 36:
37: use strict;
38:
39: sub update_LC {
1.28 raeburn 40: my ($dom,$crs,$adds,$drops,$startdate,$enddate,$authtype,$autharg,$classesref,$groupref,$logmsg,$newusermsg,$context,$phototypes) = @_;
1.19 raeburn 41: # Get institutional code and title of this class
42: my %courseinfo = ();
43: &get_courseinfo($dom,$crs,\%courseinfo);
1.1 raeburn 44: # Get current LON-CAPA student enrollment for this class
45: my $configvars = &LONCAPA::Configuration::read_conf('loncapa.conf');
46: my $cid = $dom."_".$crs;
1.26 raeburn 47: my $roster = &Apache::loncoursedata::get_classlist($dom,$crs);
1.1 raeburn 48: my $cend = &Apache::loncoursedata::CL_END;
49: my $cstart = &Apache::loncoursedata::CL_START;
50: my $stuid=&Apache::loncoursedata::CL_ID;
51: my $sec=&Apache::loncoursedata::CL_SECTION;
52: my $status=&Apache::loncoursedata::CL_STATUS;
53: my $type=&Apache::loncoursedata::CL_TYPE;
1.16 raeburn 54: my $lockedtype=&Apache::loncoursedata::CL_LOCKEDTYPE;
1.1 raeburn 55: my @localstudents = ();
1.15 raeburn 56: my @futurestudents = ();
57: my @activestudents = ();
1.18 raeburn 58: my @excludedstudents = ();
1.1 raeburn 59: my $currlist;
60: foreach my $uname (keys %{$roster} ) {
61: if ($uname =~ m/^(.+):$dom$/) {
62: if ($$roster{$uname}[$status] eq "Active") {
1.15 raeburn 63: push @activestudents, $1;
64: @{$$currlist{$1}} = @{$$roster{$uname}};
1.1 raeburn 65: push @localstudents, $1;
1.15 raeburn 66: } elsif ( ($$roster{$uname}[$cstart] > time) && ($$roster{$uname}[$cend] > time || $$roster{$uname}[$cend] == 0 || $$roster{$uname}[$cend] eq '') ) {
67: push @futurestudents, $1;
1.1 raeburn 68: @{$$currlist{$1}} = @{$$roster{$uname}};
1.15 raeburn 69: push @localstudents, $1;
1.18 raeburn 70: } elsif ($$roster{$uname}[$lockedtype] == 1) {
71: push @excludedstudents, $1;
1.1 raeburn 72: }
73: }
74: }
75: my $linefeed = '';
76: my $addresult = '';
77: my $dropresult = '';
1.21 raeburn 78: my $switchresult = '';
1.28 raeburn 79: my $photoresult = '';
1.1 raeburn 80: if ($context eq "updatenow") {
81: $linefeed = "</li>\n<li>";
82: } elsif ($context eq "automated") {
83: $linefeed = "\n";
84: }
85: my $enrollcount = 0;
86: my $dropcount = 0;
1.21 raeburn 87: my $switchcount = 0;
1.1 raeburn 88:
1.19 raeburn 89: # Get role names
90: my %longroles = ();
91: open(FILE,"<$$configvars{'lonTabDir'}.'/rolesplain.tab");
92: my @rolesplain = <FILE>;
93: close(FILE);
94: foreach (@rolesplain) {
95: if ($_ =~ /^(st|ta|ex|ad|in|cc):([\w\s]+)$/) {
96: $longroles{$1} = $2;
97: }
98: }
99:
1.8 raeburn 100: srand( time() ^ ($$ + ($$ << 15)) ); # Seed rand in case initial passwords have to be generated for new users.
101:
1.1 raeburn 102: # Get mapping of IDs to usernames for current LON-CAPA student enrollment for this class
103: my @LCids = ();
104: my %unameFromLCid = ();
105: foreach my $uname (sort keys %{$currlist}) {
106: my $stuID = $$currlist{$uname}[$stuid];
107: if (!grep/^$stuID$/,@LCids) {
108: push @LCids, $stuID;
109: @{$unameFromLCid{$stuID}} = ();
110: }
111: push @{$unameFromLCid{$stuID}},$uname;
112: }
113:
114: # Get latest institutional enrollment for this class.
115: my %allenrolled = ();
116: my @reg_students = ();
117: my %place = ();
118: $place{'autharg'} = &CL_autharg();
119: $place{'authtype'} = &CL_authtype();
120: $place{'email'} = &CL_email();
121: $place{'enddate'} = &CL_enddate();
122: $place{'firstname'} = &CL_firstname();
123: $place{'generation'} = &CL_generation();
124: $place{'groupID'} = &CL_groupID();
125: $place{'lastname'} = &CL_lastname();
126: $place{'middlename'} = &CL_middlename();
127: $place{'startdate'} = &CL_startdate();
128: $place{'studentID'} = &CL_studentID();
129: my %ucount = ();
130: my %enrollinfo = ();
131: foreach my $class (@{$classesref}) {
132: my %enrolled = ();
133: &parse_classlist($$configvars{'lonDaemons'},$dom,$crs,$class,\%place,$$groupref{$class},\%enrolled);
134: foreach my $uname (sort keys %enrolled ) {
135: if (!grep/^$uname$/,@reg_students) {
136: push @reg_students,$uname;
137: $ucount{$uname} = 0;
138: @{$allenrolled{$uname}} = ();
139: }
140: @{$allenrolled{$uname}[$ucount{$uname}]} = @{$enrolled{$uname}};
141: $ucount{$uname} ++;
142: }
143: }
144:
145: # Check for multiple sections for a single student
146: my @okusers = ();
147: foreach my $uname (@reg_students) {
1.18 raeburn 148: if (grep/^$uname$/,@excludedstudents) {
149: $$logmsg .= "No re-enrollment for $uname - user was previously manually unenrolled and locked.".$linefeed;
150: } elsif (@{$allenrolled{$uname}} > 1) {
1.1 raeburn 151: my @sections = ();
152: my $saved;
153: for (my $i=0; $i<@{$allenrolled{$uname}}; $i++) {
154: my @stuinfo = @{$allenrolled{$uname}[$i]};
155: my $secnum = $stuinfo[ $place{'groupID'} ];
156: unless ($secnum eq '') {
157: unless (grep/^$secnum$/,@sections) {
158: $saved = $i;
159: push @sections,$secnum;
160: }
161: }
162: }
163: if (@sections == 0) {
164: @{$enrollinfo{$uname}} = @{$allenrolled{$uname}[0]};
165: push @okusers, $uname;
166: }
167: elsif (@sections == 1) {
168: @{$enrollinfo{$uname}} = @{$allenrolled{$uname}[$saved]};
169: push @okusers, $uname;
170: }
171: elsif (@sections > 1) {
1.27 raeburn 172: $$logmsg .= "$uname appears in classlists for more than one section of this course, i.e. in sections: ";
1.1 raeburn 173: foreach (@sections) {
1.5 raeburn 174: $$logmsg .= " $_,";
1.1 raeburn 175: }
1.5 raeburn 176: chop($$logmsg);
1.6 raeburn 177: $$logmsg .= ". Because of this ambiguity, no enrollment action was taken for this student.".$linefeed;
1.1 raeburn 178: }
179: } else {
180: @{$enrollinfo{$uname}} = @{$allenrolled{$uname}[0]};
181: push @okusers, $uname;
182: }
183: }
184: # Get mapping of student IDs to usernames for users in institutional data for this class
185: my @allINids = ();
1.3 raeburn 186: my %unameFromINid = ();
1.1 raeburn 187: foreach my $uname (@okusers) {
188: $enrollinfo{$uname}[ $place{'studentID'} ] =~ tr/A-Z/a-z/;
189: my $stuID = $enrollinfo{$uname}[ $place{'studentID'} ];
190: if (grep/^$stuID$/,@allINids) {
191: push @{$unameFromINid{$stuID}},$uname;
192: } else {
193: push @allINids, $stuID;
194: @{$unameFromINid{$stuID}} = $uname;
195: }
196: }
1.28 raeburn 197:
1.5 raeburn 198: # Explicitly allow access to creation/modification of students if called as an automated process.
199: if ($context eq 'automated') {
1.22 albertel 200: $env{'allowed.cst'}='F';
1.5 raeburn 201: }
202:
1.1 raeburn 203: # Compare IDs with existing LON-CAPA enrollment for this class
204: foreach my $uname (@okusers) {
1.5 raeburn 205: unless ($uname eq '') {
206: my %uidhash=&Apache::lonnet::idrget($dom,$uname);
207: my @stuinfo = @{$enrollinfo{$uname}};
1.15 raeburn 208: my $access = '';
1.5 raeburn 209: if (grep/^$uname$/,@localstudents) {
1.1 raeburn 210: # Check for studentID changes
1.5 raeburn 211: if ( ($uidhash{$uname}) && ($uidhash{$uname} !~ /error\:/) ) {
212: unless ( ($uidhash{$uname}) eq ($stuinfo[ $place{studentID} ]) ) {
1.6 raeburn 213: $$logmsg .= "Change in ID for $uname. StudentID in LON-CAPA system is $uidhash{$uname}; StudentID in institutional data is $stuinfo[ $place{studentID} ]".$linefeed;
1.5 raeburn 214: }
1.1 raeburn 215: }
1.16 raeburn 216: # Check for switch from manual to auto
217: unless (($$currlist{$uname}[$type] eq "auto") || ($$currlist{$uname}[$lockedtype] eq "1") || (!$adds) ) {
218: # drop manually added student
219: my $drop_reply = &Apache::lonnet::modifystudent($dom,$uname,'','','',undef,undef,undef,undef,$$currlist{$uname}[$sec],time,undef,undef,undef,undef,'auto','',$cid);
220: # re-enroll as auto student
221: if ($drop_reply !~ /^ok/) {
222: $$logmsg .= "An error occured during the attempt to convert $uname from a manual type to an auto type student - $drop_reply.".$linefeed;
223: } else {
224: # re-enroll as auto student
225: my ($auth,$authparam,$first,$middle,$last,$gene,$usec,$end,$start,$emailaddr,$pid,$emailenc);
226: &prepare_add($authtype,$autharg,$enddate,$startdate,\@stuinfo,\%place,\$dom,\$uname,\$auth,\$authparam,\$first,\$middle,\$last,\$gene,\$usec,\$end,\$start,\$emailaddr,\$pid,\$emailenc);
227: if ($$currlist{$uname}[$sec] ne $usec) {
1.21 raeburn 228: $switchresult .= "Section for $uname switched from $$currlist{$uname}[$sec] to ".$usec.$linefeed;
229: if ($context eq 'automated') {
230: $$logmsg .= "Section switch for $uname from $$currlist{$uname}[$sec] to ".$usec.$linefeed; ;
231: }
232: $switchcount ++;
1.16 raeburn 233: }
234: &execute_add($context,'switchtype',$uname,$dom,$auth,$authparam,$first,$middle,$last,$gene,$pid,$usec,$end,$start,$emailenc,$cid,\$addresult,\$enrollcount,$linefeed,$logmsg);
235: }
236: }
1.1 raeburn 237: # Check for section changes
1.15 raeburn 238: if ($$currlist{$uname}[$sec] eq $stuinfo[ $place{groupID} ]) {
239: # Check for access date changes for students with access starting in the future.
240: if ( (grep/^$uname$/,@futurestudents) && ($$currlist{$uname}[$type] eq "auto") && ($adds == 1) ) {
1.16 raeburn 241: my $datechange = &datechange_check($$currlist{$uname}[$cstart],$$currlist{$uname}[$cend],$startdate,$enddate);
1.15 raeburn 242: if ($datechange) {
1.16 raeburn 243: my $modify_access_result = &Apache::lonnet::modify_student_enrollment($dom,$uname,undef,undef,undef,undef,undef,$stuinfo[ $place{groupID} ],$enddate,$startdate,'auto','',$cid);
1.15 raeburn 244: $access = &showaccess($enddate,$startdate);
245: if ($modify_access_result =~ /^ok/) {
246: $$logmsg .= "Change in access dates for $uname.".$access.$linefeed;
247: } else {
248: $$logmsg .= "Error when attempting to change start and/or end access dates for $uname in section: ".$stuinfo[ $place{groupID} ]." -error $modify_access_result".$linefeed;
249: }
250: }
251: }
252: } else {
1.5 raeburn 253: if ( ($$currlist{$uname}[$type] eq "auto") && ($adds == 1) ) {
1.10 raeburn 254: # Delete from roles.db for current section
255: my $expiretime = time;
256: my $uurl='/'.$cid;
257: $uurl=~s/\_/\//g;
258: if ($$currlist{$uname}[$sec]) {
259: $uurl.='/'.$$currlist{$uname}[$sec];
260: }
261: my $expire_role_result = &Apache::lonnet::assignrole($dom,$uname,$uurl,'st',$expiretime);
262: if ($expire_role_result eq 'ok') {
1.15 raeburn 263: my $modify_section_result;
264: if (grep/^$uname$/,@activestudents) {
1.16 raeburn 265: $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);
1.15 raeburn 266: } else {
1.16 raeburn 267: $modify_section_result = &Apache::lonnet::modify_student_enrollment($dom,$uname,undef,undef,undef,undef,undef,$stuinfo[ $place{groupID} ],$enddate,$startdate,'auto','',$cid);
1.15 raeburn 268: $access = &showaccess($enddate,$startdate);
269: }
1.10 raeburn 270: if ($modify_section_result =~ /^ok/) {
1.21 raeburn 271: $switchresult .= "Section for $uname switched from old section: ".$$currlist{$uname}[$sec] ." to new section: ".$stuinfo[ $place{groupID} ].".".$access.$linefeed;
272: if ($context eq 'automated') {
273: $$logmsg .= "Section switch for $uname from $$currlist{$uname}[$sec] to $stuinfo[ $place{groupID} ]".$linefeed;
274: }
275: $switchcount ++;
1.10 raeburn 276: } else {
277: $$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;
278: }
1.5 raeburn 279: } else {
1.10 raeburn 280: $$logmsg .= "Error when attempting to expire role for $uname in old section" .$$currlist{$uname}[$sec]." -error: $expire_role_result".$linefeed;
1.5 raeburn 281: }
1.1 raeburn 282: }
283: }
1.5 raeburn 284: } else {
1.1 raeburn 285: # Check for changed usernames by checking studentIDs
1.5 raeburn 286: if ( ($stuinfo[ $place{studentID} ] ne '') && (grep/^$stuinfo[ $place{studentID} ]$/,@LCids) ) {
1.27 raeburn 287: foreach my $match ( @{ $unameFromLCid{ $stuinfo[ $place{studentID} ] } } ) {
288: $$logmsg .= "A possible change in username has been detected for a student enrolled in this course. The existing LON-CAPA classlist contains user: $match and student ID: ".$stuinfo[ $place{studentID} ].". ";
289: if (grep/^$match$/,@okusers) {
290: $$logmsg .= "The username $match remains in the institutional classlist, but the same student ID is used for new user: $uname now found in the institutional classlist. You may need to contact your Domain Coordinator to determine how to reolve this issue and whether to move student data files for user: $match to $uname. ";
291: } else {
292: unless ($drops == 1) {
293: $$logmsg .= "This username - $match - has been dropped from the institutional classlist, but the student ID of this user is also used by $uname who now appears in the institutional classlist. You may need to contact your Domain Coordinator to request a move of the student data files for user: $match to $uname. ";
1.5 raeburn 294: }
1.1 raeburn 295: }
1.27 raeburn 296: $$logmsg .= "Because of this student ID conflict, the new username - $uname - has not been added to the LON-CAPA classlist.".$linefeed;
1.1 raeburn 297: }
1.5 raeburn 298: } elsif ($adds == 1) {
1.16 raeburn 299: my ($auth,$authparam,$first,$middle,$last,$gene,$usec,$end,$start,$emailaddr,$pid,$emailenc);
300: &prepare_add($authtype,$autharg,$enddate,$startdate,\@stuinfo,\%place,\$dom,\$uname,\$auth,\$authparam,\$first,\$middle,\$last,\$gene,\$usec,\$end,\$start,\$emailaddr,\$pid,\$emailenc);
1.1 raeburn 301: # Check for existing account in this LON-CAPA domain for this username
1.5 raeburn 302: my $uhome=&Apache::lonnet::homeserver($uname,$dom);
303: if ($uhome eq 'no_host') { # User does not exist
1.19 raeburn 304: my $args = {'auth' => $auth,
305: 'authparam' => $authparam,
306: 'emailenc' => $emailenc,
307: 'udom' => $dom,
308: 'uname' => $uname,
309: 'pid' => $pid,
310: 'first' => $first,
311: 'middle' => $middle,
312: 'last' => $last,
313: 'gene' => $gene,
314: 'usec' => $usec,
315: 'end' => $end,
316: 'start' => $start,
317: 'emailaddr' => $emailaddr,
318: 'cid' => $cid,
319: 'crs' => $crs,
320: 'cdom' => $dom,
321: 'context' => $context,
322: 'linefeed' => $linefeed,
323: 'role' => 'st'
324: };
1.20 raeburn 325: my $outcome = &create_newuser($args,$logmsg,$newusermsg,\$enrollcount,\$addresult,\%longroles,\%courseinfo);
1.5 raeburn 326: } else {
1.16 raeburn 327: &execute_add($context,'newstudent',$uname,$dom,$auth,$authparam,$first,$middle,$last,$gene,$pid,$usec,$end,$start,$emailenc,$cid,\$addresult,\$enrollcount,$linefeed,$logmsg);
1.3 raeburn 328: }
1.28 raeburn 329: if ($courseinfo{'showphotos'}) {
330: my ($result,$resulttype) =
331: &Apache::lonnet::auto_checkphotos($uname,$dom,$pid);
332: if ($resulttype) {
333: push(@{$$phototypes{$resulttype}},$uname);
334: }
335: }
1.1 raeburn 336: }
337: }
338: }
339: }
1.28 raeburn 340: if ($courseinfo{'showphotos'}) {
341: if (keys(%{$phototypes})>0) {
342: my %lt = &photo_response_types();
343: foreach my $type (sort(keys(%{$phototypes}))) {
344: my $numphoto = @{$$phototypes{$type}};
345: if ($numphoto > 0) {
346: if ($context eq 'updatenow') {
347: $photoresult .= '<br /><b>'.
1.29 ! albertel 348: &mt('For [_1] students, photos ',$numphoto).
! 349: $lt{$type}.'</b><ul><li>';
1.28 raeburn 350: } else {
351: $photoresult .= "\nFor $numphoto students, photos ".
1.29 ! albertel 352: $lt{$type}."\n";
1.28 raeburn 353: }
354: foreach my $user (@{$$phototypes{$type}}) {
355: $photoresult .= $user.$linefeed;
356: }
357: if ($context eq 'updatenow') {
358: $photoresult = substr($photoresult,0,
1.29 ! albertel 359: rindex($photoresult,"<li>"));
1.28 raeburn 360: $photoresult .= '</ul><br />';
361: } else {
362: $photoresult .= "\n";
363: }
364: }
365: }
366: }
367: }
368:
1.1 raeburn 369: # Do drops
370: if ( ($drops == 1) && (@reg_students > 0) ) {
371: foreach my $uname (@localstudents) {
372: if ($$currlist{$uname}[$type] eq "auto") {
373: my @saved = ();
374: if (!grep/^$uname$/,@reg_students) {
375: # Check for changed usernames by checking studentIDs
376: if (grep/^$$currlist{$uname}[ $stuid ]$/,@allINids) {
377: foreach my $match (@{$unameFromINid{$$currlist{$uname}[ $stuid ]}} ) {
1.27 raeburn 378: $$logmsg .= "A possible change in username has been detected for a student enrolled in this course. The existing LON-CAPA classlist contains user: $uname and student ID: $$currlist{$uname}[ $place{studentID} ]. This username has been dropped from the institutional classlist, but the same student ID is used for user: $match who still appears in the institutional classlist. You may need to move the student data files for user: $uname to $match. Because of this, user $uname has not been dropped from the course.".$linefeed;
1.1 raeburn 379: push @saved,$uname;
380: }
381: } elsif (@saved == 0) {
1.16 raeburn 382: my $drop_reply = &Apache::lonnet::modifystudent($dom,$uname,'','','',undef,undef,undef,undef,$$currlist{$uname}[$sec],time,undef,undef,undef,undef,'auto','',$cid);
1.1 raeburn 383: if ($drop_reply !~ /^ok/) {
1.5 raeburn 384: $$logmsg .= "An error occured during the attempt to expire the $uname from the old section $$currlist{$uname}[$sec] - $drop_reply.".$linefeed;
1.1 raeburn 385: } else {
386: $dropcount ++;
387: my %userenv = &Apache::lonnet::get('environment',['firstname','lastname','id'],$dom,$uname);
388: $dropresult .= $userenv{'firstname'}." ".$userenv{'lastname'}." (".$userenv{'id'}.") - ".$uname." dropped from section/group ".$$currlist{$uname}[$sec].$linefeed;
1.8 raeburn 389: if ($context eq 'automated') {
390: $$logmsg .= "User $uname student role expired from course.".$linefeed;
391: }
1.1 raeburn 392: }
393: }
394: }
395: }
396: }
397: }
1.5 raeburn 398:
399: # Terminated explictly allowed access to student creation/modification
400: if ($context eq 'automated') {
1.22 albertel 401: delete($env{'allowed.cst'});
1.5 raeburn 402: }
1.1 raeburn 403: if ($enrollcount > 0) {
404: if ($context eq "updatenow") {
1.6 raeburn 405: $addresult = substr($addresult,0,rindex($addresult,"<li>"));
1.21 raeburn 406: $addresult = "The following $enrollcount student(s) was/were added to this LON-CAPA course:<br/><ul><li>".$addresult."</ul><br/><br/>";
1.28 raeburn 407: if ($courseinfo{'showphotos'}) {
408:
409: }
1.1 raeburn 410: } else {
1.21 raeburn 411: $addresult = "The following $enrollcount student(s) was/were added to this LON-CAPA course:\n\n".$addresult."\n\n";
412: }
1.1 raeburn 413: }
414: if ($dropcount > 0) {
415: if ($context eq "updatenow") {
1.6 raeburn 416: $dropresult = substr($dropresult,0,rindex($dropresult,"<li>"));
1.21 raeburn 417: $dropresult = "The following $dropcount student(s) was/were expired from this LON-CAPA course:<br/><ul><li>".$dropresult."</ul><br/><br/>";
1.1 raeburn 418: } else {
419: $dropresult = "The following $dropcount student(s) was/were expired from this LON-CAPA course:\n\n".$dropresult."\n\n";
420: }
421: }
1.21 raeburn 422: if ($switchcount > 0) {
423: if ($context eq "updatenow") {
424: $switchresult = substr($switchresult,0,rindex($switchresult,"<li>"));
425: $switchresult = "The following $switchcount student(s) switched sections in this LON-CAPA course:<br/><ul><li>".$switchresult."</ul><br/><br/>";
426: } else {
427: $switchresult = "The following $switchcount student(s) switched sections in this LON-CAPA course:\n\n".$switchresult."\n\n";
428: }
429: }
1.1 raeburn 430: if ( ($adds) && ($enrollcount == 0) ) {
431: $addresult = "There were no new students to add to the course.";
432: if ($context eq "updatenow") {
433: $addresult .="<br/><br/>";
434: } else {
435: $addresult .="\n";
436: }
437: }
438: if ( ($drops) && ($dropcount == 0) ) {
439: $dropresult = "There were no students with roles to expire because all active students previously added to the course from institutional classlist(s) are still officially registered.";
440: if ($context eq "updatenow") {
441: $dropresult .="<br/>";
442: } else {
443: $dropresult .="\n";
444: }
445: }
1.21 raeburn 446: my $changecount = $enrollcount + $dropcount + $switchcount;
1.28 raeburn 447: return ($changecount,$addresult.$photoresult.$dropresult.$switchresult);
1.6 raeburn 448: }
1.1 raeburn 449:
1.19 raeburn 450: sub create_newuser {
451: my ($args,$logmsg,$newusermsg,$enrollcount,$addresult,$longroles,$courseinfo) = @_;
452: my $auth = $args->{'auth'};
453: my $authparam = $args->{'authparam'};
454: my $emailenc = $args->{'emailenc'};
455: my $udom = $args->{'udom'};
456: my $uname = $args->{'uname'};
457: my $pid = $args->{'pid'};
458: my $first = $args->{'first'};
459: my $middle = $args->{'middle'};
460: my $last = $args->{'last'} ;
461: my $gene = $args->{'gene'};
462: my $usec = $args->{'usec'};
463: my $end = $args->{'end'};
464: my $start = $args->{'start'};
465: my $emailaddr = $args->{'emailaddr'};
466: my $cid = $args->{'cid'};
467: my $crs = $args->{'crs'};
468: my $cdom = $args->{'cdom'};
469: my $context = $args->{'context'};
470: my $linefeed = $args->{'linefeed'};
471: my $role = $args->{'role'};
472: my $create_passwd = 0;
473: my $authchk = '';
474: my $outcome;
475: unless ($authparam eq '') { $authchk = 'ok'; };
476: # If no account exists and passwords should be generated
477: if ($auth eq "internal") {
478: if ($authparam eq '') {
479: $authparam = &create_password();
480: if ($authparam eq '') {
481: $authchk = '';
482: } else {
483: $create_passwd = 1;
484: $authchk = 'ok';
485: }
486: }
487: } elsif ($auth eq "localauth") {
488: ($authparam,$create_passwd,$authchk) = &Apache::lonnet::auto_create_password($crs,$cdom,$authparam);
489: } elsif ($auth =~ m/^krb/) {
490: if ($authparam eq '') {
491: $$logmsg .= "No Kerberos domain was provided for the new user - $uname, so the new user was not enrolled in the course.".$linefeed;
492: $authchk = 'invalid';
493: }
494: } else {
495: $authchk = 'invalid';
496: $$logmsg .= "An invalid authentication type was provided for the new user - $uname, so the user was not enrolled in the course.".$linefeed;
497: }
498: if ($authchk eq 'ok') {
499: # Now create user.
500: my $type = 'auto';
501: my $userurl = '/'.$cdom.'/'.$crs;
502: if ($usec ne '') {
503: $userurl .= '/'.$usec;
504: }
505: if ($context eq 'createowner' || $context eq 'createcourse') {
506: my $result = &Apache::lonnet::modifyuser($udom,$uname,$pid,$auth,$authparam,$first,$middle,$last,$gene,'1',undef,$emailaddr);
507: if ($result eq 'ok' && $context eq 'createcourse') {
1.24 raeburn 508: $outcome = &Apache::loncreateuser::commit_standardrole($udom,$uname,$userurl,$role,$start,$end,$cdom,$crs,$usec);
1.19 raeburn 509: unless ($outcome =~ /^Error:/) {
510: $outcome = 'ok';
511: }
512: } else {
513: $outcome = $result;
514: }
515: } else {
516: $outcome=&Apache::lonnet::modifystudent($udom,$uname,$pid,$auth,$authparam,$first,$middle,$last,$gene,$usec,$end,$start,'',undef,$emailaddr,'auto','',$cid);
517: }
518: if ($outcome eq 'ok') {
519: my $access = &showaccess($end,$start);
520: $$addresult .= "$first $last ($pid) - $uname enrolled in section/group $usec.".$access.$linefeed;
521: unless ($context eq 'createowner' || $context eq 'createcourse') {
522: $$enrollcount ++;
523: }
524: if ($context eq 'automated') {
525: $$logmsg .= "New $udom user $uname added successfully.";
526: }
527: unless ($emailenc eq '' || $context eq 'createowner' || $context eq 'createcourse') {
528: my %emailHash;
529: $emailHash{'critnotification'} = $emailenc;
530: $emailHash{'notification'} = $emailenc;
1.23 raeburn 531: $emailHash{'permanentemail'} = $emailenc;
1.19 raeburn 532: my $putresult = &Apache::lonnet::put('environment',\%emailHash,$udom,$uname);
533: }
534: if ($create_passwd) {
535: # Send e-mail with initial password to new user at $emailaddr.
536: # If e-mail address is invalid, send password via message to courseowner i
537: # (if automated call) or to user if roster update.
538: if ($emailaddr eq '') {
539: $$newusermsg .= " username: $uname, password: ".$authparam.$linefeed."\n";
540: } else {
541: my $subject = "New LON-CAPA account";
542: my $body;
543: if ($context eq 'createowner') {
544: $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";
545: } elsif ($context eq 'createcourse') {
546: $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";
547: } else {
548: my $access_start = 'immediately';
549: if ($start > 0) {
550: $access_start = localtime($start)
551: }
552: $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";
553: }
554: &Apache::lonmsg::sendemail($emailaddr,$subject,$body);
555: }
556: if ($context eq 'automated') {
557: $$logmsg .= " Initial password - - sent to ".$emailaddr.$linefeed;
558: }
559: } else {
560: if ($context eq 'automated') {
561: $$logmsg .= $linefeed;
562: }
563: }
564: } else {
565: $$logmsg .= "An error occurred adding new user $uname - ".$outcome.$linefeed;
566: }
567: }
568: return $outcome;
569: }
570:
1.16 raeburn 571: sub prepare_add {
572: my ($authtype,$autharg,$enddate,$startdate,$stuinfo,$place,$dom,$uname,$auth,$authparam,$first,$middle,$last,$gene,$usec,$end,$start,$emailaddr,$pid,$emailenc) = @_;
573: $$auth = $$stuinfo[ $$place{'authtype'} ];
574: $$authparam = $$stuinfo[ $$place{'autharg'} ];
575: $$first = $$stuinfo[ $$place{'firstname'} ];
576: $$middle = $$stuinfo[ $$place{'middlename'} ];
577: $$last = $$stuinfo[ $$place{'lastname'} ];
578: $$gene = $$stuinfo[ $$place{'generation'} ];
579: $$usec = $$stuinfo[ $$place{'groupID'} ];
580: $$end = $$stuinfo[ $$place{'enddate'} ];
581: $$start = $$stuinfo[ $$place{'startdate'} ];
582: $$emailaddr = $$stuinfo[ $$place{'email'} ];
583: $$pid = $$stuinfo[ $$place{'studentID'} ];
584:
585: # remove non alphanumeric values from section
586: $$usec =~ s/\W//g;
587:
588: unless ($$emailaddr =~/^[^\@]+\@[^\@]+$/) { $$emailaddr =''; }
589: $$emailenc = &HTML::Entities::encode($$emailaddr,'<>&"');
590:
591: # Use course defaults where entry is absent
592: if ( ($$auth eq '') || (!defined($$auth)) ) {
593: $$auth = $authtype;
594: }
595: if ( ($$authparam eq '') || (!defined($$authparam)) ) {
596: $$authparam = $autharg;
597: }
598: if ( ($$end eq '') || (!defined($$end)) ) {
599: $$end = $enddate;
600: }
601: if ( ($$start eq '') || (!defined($$start)) ) {
602: $$start = $startdate;
603: }
604: # Clean up whitespace
605: foreach ($dom,$uname,$pid,$first,$middle,$last,$gene,$usec) {
606: $$_ =~ s/(\s+$|^\s+)//g;
607: }
608: return;
609: }
610:
611: sub execute_add {
612: my ($context,$caller,$uname,$dom,$auth,$authparam,$first,$middle,$last,$gene,$pid,$usec,$end,$start,$emailenc,$cid,$addresult,$enrollcount,$linefeed,$logmsg) = @_;
613: # Get the user's information and authentication
1.23 raeburn 614: my %userenv = &Apache::lonnet::get('environment',['firstname','middlename','lastname','generation','id','critnotification','notification','permanentemail'],$dom,$uname);
1.16 raeburn 615: my ($tmp) = keys(%userenv);
616: if ($tmp =~ /^(con_lost|error)/i) {
617: %userenv = ();
618: }
619: # Get the user's e-mail address
620: if ($userenv{critnotification} =~ m/%40/) {
621: unless ($emailenc eq $userenv{critnotification}) {
622: $$logmsg .= "Current critical notification e-mail
623: - ".$userenv{critnotification}." for $uname is different to e-mail address in institutional classlist - ".$emailenc.$linefeed;
624: }
625: }
626: if ($userenv{notification} =~ m/%40/) {
1.23 raeburn 627: unless ($emailenc eq $userenv{notification}) {
1.16 raeburn 628: $$logmsg .= "Current standard notification e-mail
629: - ".$userenv{notification}." for $uname is different to e-mail address in institutional classlist - ".$emailenc.$linefeed;
630: }
631: }
1.23 raeburn 632: if ($userenv{permanentemail} =~ m/%40/) {
633: unless ($emailenc eq $userenv{permanentemail}) {
634: $$logmsg .= "Current permanent e-mail
635: - ".$userenv{permanentemail}." for $uname is different to e-mail address in institutional classlist - ".$emailenc.$linefeed;
636: }
637: }
1.16 raeburn 638: my $krbdefdom = '';
639: my $currentauth=&Apache::lonnet::queryauthenticate($uname,$dom);
640: if ($currentauth=~/^(krb[45]):(.*)/) {
641: $currentauth = $1;
642: $krbdefdom = $2;
643: } elsif ($currentauth=~ /^(unix|internal|localauth):/) {
644: $currentauth = $1;
645: } else {
646: $$logmsg .= "Invalid authentication method $currentauth for $uname.".$linefeed;
647: }
648: # Report if authentication methods are different.
649: if ($currentauth ne $auth) {
650: $$logmsg .= "Authentication type mismatch for $uname - '$currentauth' in system, '$auth' based on information in classlist or default for this course.".$linefeed;
651: } elsif ($auth =~ m/^krb/) {
652: if ($krbdefdom ne $authparam) {
653: $$logmsg .= "Kerberos domain mismatch for $uname - '$krbdefdom' in system, '$authparam' based on information in classlist or default for this course.".$linefeed;
654: }
655: }
656:
657: # Check user data
658: if ($first ne $userenv{'firstname'} ||
659: $middle ne $userenv{'middlename'} ||
660: $last ne $userenv{'lastname'} ||
661: $gene ne $userenv{'generation'} ||
1.23 raeburn 662: $pid ne $userenv{'id'} ||
663: $emailenc ne $userenv{'permanentemail'} ) {
1.16 raeburn 664: # Make the change(s)
665: my %changeHash;
666: $changeHash{'firstname'} = $first;
667: $changeHash{'middlename'} = $middle;
668: $changeHash{'lastname'} = $last;
669: $changeHash{'generation'} = $gene;
670: $changeHash{'id'} = $pid;
1.23 raeburn 671: $changeHash{'permanentemail'} = $emailenc;
1.16 raeburn 672: my $putresult = &Apache::lonnet::put('environment',\%changeHash,$dom,$uname);
673: if ($putresult eq 'ok') {
674: $$logmsg .= "User information updated for user: $uname prior to enrollment.".$linefeed;
675: } else {
676: $$logmsg .= "There was a problem modifying user data for existing user - $uname -error: $putresult, enrollment will still be attempted.".$linefeed;
677: }
678: }
679:
680: # Assign the role of student in the course.
681: my $classlist_reply = &Apache::lonnet::modify_student_enrollment($dom,$uname,$pid,$first,$middle,$last,$gene,$usec,$end,$start,'auto','',$cid);
682: if ($classlist_reply eq 'ok') {
683: my $access = &showaccess($end,$start);
684: if ($caller eq 'switchtype') {
685: $$logmsg .= "Existing user $uname detected in institutional classlist - switched from 'manual' to 'auto' enrollment in section/group $usec.".$access.$linefeed;
686: } elsif ($caller eq 'newstudent') {
687: $$enrollcount ++;
688: $$addresult .= "$first $last ($pid) - $uname enrolled in section/group $usec.".$access.$linefeed;
689: }
690: if ($context eq 'automated') {
691: $$logmsg .= "Existing $dom user $uname enrolled successfully.".$linefeed;
692: }
693: } else {
694: $$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;
695: }
696: return;
697: }
698:
699: sub datechange_check {
700: my ($oldstart,$oldend,$startdate,$enddate) = @_;
701: my $datechange = 0;
702: unless ($oldstart eq $startdate) {
703: $datechange = 1;
704: }
705: if (!$datechange) {
706: if (!$oldend) {
707: if ($enddate) {
708: $datechange = 1;
709: }
710: } elsif ($oldend ne $enddate) {
711: $datechange = 1;
712: }
713: }
714: return $datechange;
715: }
716:
1.15 raeburn 717: sub showaccess {
718: my ($end,$start) = @_;
719: my $showstart;
720: my $showend;
721: if ( (!$start) || ($start <= time) ) {
722: $showstart = 'immediately';
723: } else {
724: $showstart = &Apache::lonlocal::locallocaltime($start);
725: }
726: if (!$end) {
727: $showend = 'no end date';
728: } else {
729: $showend = &Apache::lonlocal::locallocaltime($end);
730: }
731: my $access_msg = " Access starts: ".$showstart.", ends: ".$showend.".";
732: return $access_msg;
733: }
734:
1.1 raeburn 735: sub parse_classlist {
1.6 raeburn 736: my ($tmpdir,$dom,$crs,$class,$placeref,$groupID,$studentsref) = @_;
1.5 raeburn 737: my $xmlfile = $tmpdir."/tmp/".$dom."_".$crs."_".$class."_classlist.xml";
1.6 raeburn 738: my $uname = '';
739: my @state;
1.8 raeburn 740: my @items = ('autharg','authtype','email','firstname','generation','lastname','middlename','studentID');
1.6 raeburn 741: my $p = HTML::Parser->new
742: (
743: xml_mode => 1,
744: start_h =>
745: [sub {
746: my ($tagname, $attr) = @_;
747: push @state, $tagname;
748: if ("@state" eq "students student") {
749: $uname = $attr->{username};
750: }
751: }, "tagname, attr"],
752: text_h =>
753: [sub {
754: my ($text) = @_;
755: if ("@state" eq "students student groupID") {
756: $$studentsref{$uname}[ $$placeref{'groupID'} ] = $groupID;
1.8 raeburn 757: } elsif ("@state" eq "students student startdate") {
758: my $start = $text;
759: unless ($text eq '') {
760: $start = &process_date($text);
761: }
762: $$studentsref{$uname}[ $$placeref{'startdate'} ] = $start;
763: } elsif ("@state" eq "students student enddate") {
764: my $end = $text;
765: unless ($text eq '') {
766: $end = &process_date($text);
767: }
768: $$studentsref{$uname}[ $$placeref{'enddate'} ] = $end;
1.6 raeburn 769: } else {
770: foreach my $item (@items) {
771: if ("@state" eq "students student $item") {
772: $$studentsref{$uname}[ $$placeref{$item} ] = $text;
773: }
774: }
775: }
776: }, "dtext"],
777: end_h =>
778: [sub {
779: my ($tagname) = @_;
780: pop @state;
781: }, "tagname"],
782: );
783:
784: $p->parse_file($xmlfile);
785: $p->eof;
1.8 raeburn 786: if (-e "$xmlfile") {
787: unlink $xmlfile;
788: }
1.3 raeburn 789: return;
1.1 raeburn 790: }
791:
1.8 raeburn 792: sub process_date {
793: my $timestr = shift;
794: my $timestamp = '';
795: if ($timestr =~ m/^\d{4}:\d{2}:\d{2}/) {
796: my @entries = split/:/,$timestr;
797: for (my $j=0; $j<@entries; $j++) {
798: if ( length($entries[$j]) > 1 ) {
799: $entries[$j] =~ s/^0//;
800: }
801: }
802: $entries[1] = $entries[1] - 1;
803: $timestamp = timelocal($entries[5],$entries[4],$entries[3],$entries[2],$entries[1],$entries[0]);
804: }
805: return $timestamp;
806: }
807:
1.1 raeburn 808: sub create_password {
1.8 raeburn 809: my $passwd = '';
1.11 raeburn 810: 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");
1.8 raeburn 811: for (my $i=0; $i<8; $i++) {
812: my $lettnum = int (rand 2);
813: my $item = '';
814: if ($lettnum) {
815: $item = $letts[int( rand(26) )];
816: my $uppercase = int(rand 2);
817: if ($uppercase) {
818: $item =~ tr/a-z/A-Z/;
819: }
820: } else {
821: $item = int( rand(10) );
822: }
823: $passwd .= $item;
824: }
825: return ($passwd);
1.9 raeburn 826: }
827:
1.19 raeburn 828: sub get_courseinfo {
829: my ($dom,$crs,$courseinfo) = @_;
830: my $owner;
831: if (defined($dom) && defined($crs)) {
1.28 raeburn 832: my %settings = &Apache::lonnet::get('environment',['internal.coursecode','internal.showphotos','description'],$dom,$crs);
1.19 raeburn 833: if ( defined($settings{'internal.coursecode'}) ) {
834: $$courseinfo{'inst_code'} = $settings{'internal.coursecode'};
835: }
836: if ( defined($settings{'description'}) ) {
837: $$courseinfo{'description'} = $settings{'description'};
838: }
1.28 raeburn 839: if ( defined($settings{'internal.showphotos'}) ) {
840: $$courseinfo{'showphotos'} = $settings{'internal.showphotos'};
841: }
1.19 raeburn 842: }
843: return;
844: }
845:
1.1 raeburn 846: sub CL_autharg { return 0; }
847: sub CL_authtype { return 1;}
848: sub CL_email { return 2;}
849: sub CL_enddate { return 3;}
850: sub CL_firstname { return 4;}
851: sub CL_generation { return 5;}
852: sub CL_groupID { return 6;}
853: sub CL_lastname { return 7;}
854: sub CL_middlename { return 8;}
855: sub CL_startdate { return 9; }
856: sub CL_studentID { return 10; }
857:
1.28 raeburn 858: sub photo_response_types {
1.29 ! albertel 859: my %lt = &Apache::lonlocal::texthash(
1.28 raeburn 860: 'same' => 'remained unchanged',
861: 'update' => 'were updated',
862: 'new' => 'were added',
863: 'missing' => 'were missing',
864: 'error' => 'were not imported because an error occurred',
865: 'nouser' => 'were for users without accounts',
866: 'noid' => 'were for users without student IDs',
1.29 ! albertel 867: );
1.28 raeburn 868: return %lt;
869: }
870:
871:
1.1 raeburn 872: 1;
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/back.gif){kind=icon}
Return to Enrollment.pm CVS log ![[TXT]](/icons/text.gif){kind=icon}
![[DIR]](/icons/dir.gif){kind=icon}
Up to [LON-CAPA] / loncom / enrollment