Return to Enrollment.pm CVS log

Up to [LON-CAPA] / loncom / enrollment

Module - LONCAPA::Enrollment used by the automated enrollment script - Autoenroll.pl and the "update roster now" routine in Apache::lonpopulate to perform adds and drops from a LON-CAPA course.  Includes support for multiple sections, and crosslistings, with section/groupID in LON-CAPA set via options in Apache::loncreatecourse (Domain Coordinator) or Apache::lonpopulate (Course Coordinator).  Includes a routine to pass the classlist data (in XML format) generated by localenroll.pm.  Separation of retrieval of institutional data (localenroll.pm) and LON-CAPA course enrollment routines (included in this module - LONCAPA::Enrollment) allows different domains to create their own localenroll.pm code to generate classlists in specified XML format from their institutional data sources.

    1: package LONCAPA::Enrollment;
    2: 
    3: use Apache::loncoursedata;
    4: use Apache::lonnet;
    5: use HTML::Entities;
    6: use XML::Simple;
    7: use LONCAPA::Configuration;
    8: 
    9: use strict;
   10: 
   11: sub update_LC {
   12:     my ($dom,$crs,$adds,$drops,$startdate,$enddate,$authtype,$autharg,$classesref,$groupref,$logmsg,$context) = @_; 
   13: # Get current LON-CAPA student enrollment for this class
   14:     my $configvars = &LONCAPA::Configuration::read_conf('loncapa.conf');
   15:     my $cid = $dom."_".$crs;
   16:     my $roster = &Apache::loncoursedata::get_classlist($cid,$dom,$crs);
   17:     my $cend = &Apache::loncoursedata::CL_END;
   18:     my $cstart = &Apache::loncoursedata::CL_START; 
   19:     my $stuid=&Apache::loncoursedata::CL_ID;
   20:     my $sec=&Apache::loncoursedata::CL_SECTION;
   21:     my $status=&Apache::loncoursedata::CL_STATUS;
   22:     my $type=&Apache::loncoursedata::CL_TYPE;
   23:     my @localstudents = ();
   24:     my $currlist;
   25:     foreach my $uname (keys %{$roster} ) {
   26:         if ($uname =~ m/^(.+):$dom$/) {
   27:             if ($$roster{$uname}[$status] eq "Active") {
   28:                 push @localstudents, $1;
   29:                 @{$$currlist{$1}} = @{$$roster{$uname}};
   30:             }
   31:         }
   32:     }
   33:     my $linefeed = '';
   34:     my $addresult = '';
   35:     my $dropresult = '';
   36:     if ($context eq "updatenow") {
   37:         $linefeed = "</li>\n<li>"; 
   38:     } elsif ($context eq "automated") {
   39:         $linefeed = "\n";
   40:     }
   41:     my $enrollcount = 0;
   42:     my $dropcount = 0;
   43: 
   44: # Get mapping of IDs to usernames for current LON-CAPA student enrollment for this class 
   45:     my @LCids = ();
   46:     my %unameFromLCid = ();
   47:     foreach my $uname (sort keys %{$currlist}) {
   48:         my $stuID = $$currlist{$uname}[$stuid];
   49:         if (!grep/^$stuID$/,@LCids) {
   50:             push @LCids, $stuID;
   51:             @{$unameFromLCid{$stuID}} = ();
   52:         }
   53:         push @{$unameFromLCid{$stuID}},$uname;
   54:     }
   55:  
   56: # Get latest institutional enrollment for this class.
   57:     my %allenrolled = ();
   58:     my @reg_students = ();
   59:     my %place = ();
   60:     $place{'autharg'} = &CL_autharg();
   61:     $place{'authtype'} = &CL_authtype();
   62:     $place{'email'} = &CL_email();
   63:     $place{'enddate'} = &CL_enddate();
   64:     $place{'firstname'} = &CL_firstname();
   65:     $place{'generation'} = &CL_generation();
   66:     $place{'groupID'} = &CL_groupID();
   67:     $place{'lastname'} = &CL_lastname();
   68:     $place{'middlename'} = &CL_middlename();
   69:     $place{'startdate'} = &CL_startdate();
   70:     $place{'studentID'} = &CL_studentID();
   71:     my %ucount = ();
   72:     my %enrollinfo = ();
   73:     foreach my $class (@{$classesref}) {
   74:         my %enrolled = ();
   75:         &parse_classlist($$configvars{'lonDaemons'},$dom,$crs,$class,\%place,$$groupref{$class},\%enrolled);
   76:         foreach my $uname (sort keys %enrolled ) {
   77:             if (!grep/^$uname$/,@reg_students) {
   78:                 push @reg_students,$uname;
   79:                 $ucount{$uname} = 0;
   80:                 @{$allenrolled{$uname}} = ();
   81:             }
   82:             @{$allenrolled{$uname}[$ucount{$uname}]} = @{$enrolled{$uname}};
   83:             $ucount{$uname} ++;
   84:         }
   85:     }
   86: 
   87: # Check for multiple sections for a single student 
   88:     my @okusers = ();
   89:     foreach my $uname (@reg_students)  {
   90:         if (@{$allenrolled{$uname}} > 1) {
   91:             my @sections = ();
   92:             my $saved;
   93:             for (my $i=0; $i<@{$allenrolled{$uname}}; $i++) {
   94:                 my @stuinfo = @{$allenrolled{$uname}[$i]};
   95:                 my $secnum = $stuinfo[ $place{'groupID'} ];
   96:                 unless ($secnum eq '') {
   97:                     unless (grep/^$secnum$/,@sections) {
   98:                         $saved = $i; 
   99:                         push @sections,$secnum;
  100:                     }
  101:                 }
  102:             }
  103:             if (@sections == 0) {
  104:                 @{$enrollinfo{$uname}} = @{$allenrolled{$uname}[0]};
  105:                 push @okusers, $uname;
  106:             }
  107:             elsif (@sections == 1) {
  108:                 @{$enrollinfo{$uname}} = @{$allenrolled{$uname}[$saved]};
  109:                 push @okusers, $uname;
  110:             }
  111:             elsif (@sections > 1) {
  112:                 $logmsg =  "$uname appears in classlists for multiple sections of $crs -";
  113:                 foreach (@sections) {
  114:                     $logmsg .= " $_,";
  115:                 }
  116:                 chop($logmsg);
  117:                 $logmsg .= " No automated enrollment action taken for this student.\n";
  118:             }
  119:         } else {
  120:             @{$enrollinfo{$uname}} = @{$allenrolled{$uname}[0]};
  121:             push @okusers, $uname;
  122:         }
  123:     }
  124: # Get mapping of student IDs to usernames for users in institutional data for this class  
  125:     my @allINids = ();
  126:     foreach my $uname (@okusers) {
  127:         $enrollinfo{$uname}[ $place{'studentID'} ] =~ tr/A-Z/a-z/;
  128:         my $stuID = $enrollinfo{$uname}[ $place{'studentID'} ];
  129:         if (grep/^$stuID$/,@allINids)  {
  130:             push @{$unameFromINid{$stuID}},$uname;
  131:         } else {
  132:             push @allINids, $stuID;
  133:             @{$unameFromINid{$stuID}} = $uname; 
  134:         }
  135:     }
  136: # Compare IDs with existing LON-CAPA enrollment for this class
  137:     foreach my $uname (@okusers) {
  138:         my %uidhash=&Apache::lonnet::idrget($dom,$uname);
  139:         my @stuinfo = @{$enrollinfo{$uname}};
  140:         if (grep/^$uname$/,@localstudents) {
  141: # Check for studentID changes
  142:             if ( ($uidhash{$uname}) && ($uidhash{$uname} !~ /error\:/) )  {
  143:                 unless ( ($uidhash{$uname}) eq ($stuinfo[ $place{studentID} ]) ) {
  144:                     $logmsg .= "Change in ID for $uname in class: $crs. StudentID in LON-CAPA system is $uidhash{$uname}, StudentID in institutional data is $stuinfo[ $place{studentID} ]\n"; 
  145:                 }
  146:             }
  147: 
  148: # Check for section changes
  149:             unless ($$currlist{$uname}[$sec] eq $stuinfo[ $place{groupID} ]) {
  150:                 $logmsg .= "Found a section difference for $uname - ".$$currlist{$uname}[$sec] ."versus ".$stuinfo[ $place{groupID} ]." in class $crs\n";
  151:                 if ($$currlist{$uname}[$type] eq "auto") {
  152:                     my $modify_section_result = &Apache::lonnet::modifystudent($dom,$uname,'','','',undef,undef,undef,undef,$$currlist{$uname}[$sec],$nowtime,undef,undef,undef,undef,'auto',$cid);
  153:                     if ($modify_section_result !~ /^ok/) {
  154:                         $logmsg .= "An error occured during the attempt to expire the $uname from the old section $$currlist{$uname}[$sec] - $modify_section_result\n";
  155:                     }
  156: 
  157: # Assign the role of student in the new section
  158:                     my $uurl='/'.$cid;
  159:                     $uurl=~s/\_/\//g;
  160:                     if ($stuinfo[ $place{groupID} ]) {
  161:                         $uurl.='/'.$stuinfo[ $place{groupID} ];
  162:                     }
  163:                     my $newend = $stuinfo[ $place{enddate} ];
  164:                     my $newstart = $stuinfo[ $place{startdate} ]);
  165:                     if ($newend eq '') {
  166:                         $end = $enddate;
  167:                     }
  168:                     if ($newstart eq '') {
  169:                         $start = $startdate;
  170:                     }
  171:                     &Apache::lonnet::assignrole($dom,$uname,$uurl,"st",$newend,$newstart); 
  172:                 }
  173:             }
  174:         }
  175:         elsif ($uname ne '') {
  176: # Check for changed usernames by checking studentIDs
  177:             if ( ($stuinfo[ $place{studentID} ] ne '') && (grep/^$stuinfo[ $place{studentID} ]$/,@LCids) ) {
  178:                 if (grep/^$$currlist{$uname}[ $place{'studentID'} ]$/,@allINids) {
  179:                     foreach my $match ( @{ $unameFromLCid{ $stuinfo[ $place{studentID} ] } }  ) {
  180:                         if (grep/^$match$/,@okusers) {
  181:                             $logmsg .= "A possible change in username has been detected for a student enrolled in $crs. 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\n";
  182:                         }
  183:                     }
  184:                 }
  185:             } elsif ($adds == 1) {
  186: # Add student to LON-CAPA classlist
  187:                 my $auth = $stuinfo[ $place{'authtype'} ];
  188:                 my $authparam = $stuinfo[ $place{'autharg'} ];
  189:                 my $first = $stuinfo[ $place{'firstname'} ];
  190:                 my $middle = $stuinfo[ $place{'middlename'} ];
  191:                 my $last = $stuinfo[ $place{'lastname'} ];
  192:                 my $gene = $stuinfo[ $place{'generation'} ];
  193:                 my $usec = $stuinfo[ $place{'groupID'} ];
  194:                 my $end = $stuinfo[ $place{'enddate'} ];
  195:                 my $start = $stuinfo[ $place{'startdate'} ];
  196:                 my $emailaddr = $stuinfo[ $place{'email'} ];
  197:                 my $pid = $stuinfo[ $place{'studentID'} ];
  198: 
  199: # remove non alphanumeric values from section
  200:                 $usec =~ s/\W//g;
  201: 
  202:                 unless ($emailaddr =~/^[^\@]+\@[^\@]+$/) { $emailaddr =''; }
  203:                 my $emailenc = &HTML::Entities::encode($emailaddr); 
  204: 
  205: # Use course defaults where entry is absent
  206:                 if ($auth eq '') {
  207:                     $auth =  $authtype;
  208:                 }
  209:                 if ($authparam eq '') {
  210:                     $authparam = $autharg;
  211:                 }
  212:                 if ($end eq '') {
  213:                     $end = $enddate;
  214:                 }
  215:                 if ($start eq '') {
  216:                     $start = $startdate;
  217:                 }
  218: # Clean up whitespace
  219:                 foreach (\$dom,\$uname,\$pid,\$first,\$middle,\$last,\$gene,\$usec) {
  220:                     $$_ =~ s/(\s+$|^\s+)//g;
  221:                 }
  222: 
  223: # Check for existing account in this LON-CAPA domain for this username
  224:                 my $uhome=&Apache::lonnet::homeserver($uname,$dom);
  225:                 if ($uhome eq 'no_host') { # User does not exist
  226:                     $create_passwd = 0;
  227:                     if ($passwd eq '') {
  228: # If no account exists and passwords should be generated
  229:                         if (($authtype eq "int") || ($authtype eq "loc")) {
  230:                             ($passwd,$create_passwd) = &create_password($authtype); }
  231:                         } elsif ($authtype =~ m/^krb/) {
  232:                             $passwd = $autharg;
  233:                         } else {
  234:                             $logmsg .= "Invalid authentication type for $uname in $crs\n";
  235:                         }  
  236:                     }
  237: # Now create user.
  238:                     my $reply=&Apache::lonnet::modifystudent($dom,$uname,$pid,$auth,$authparam,$first,$middle,$last,$gene,$usec,$end,$start,'',undef,$emailaddr,'auto',$cid);
  239:                     if ($reply eq 'ok') {
  240:                         $enrollcount ++;
  241:                         $addresult .= "$first $last ($pid) - $uname enrolled in section/group $usec.".$linefeed;
  242:                         $logmsg .= "New user $uname added successfully. ";
  243:                         unless ($emailenc eq '') {
  244:                             my %emailHash;
  245:                             $emailHash{'critnotification'}  = $emailenc;
  246:                             $emailHash{'notification'} = $emailenc;
  247:                             my $putresult = &Apache::lonnet::put('environment',\%emailHash,$dom,$uname);
  248:                         }
  249:                         if ($create_passwd) {
  250: # Send e-mail with inital password to new user at $emailaddr
  251:                             $logmsg .= "Initial password -  - sent to $emailaddr\n";
  252:                         } else {
  253:                             $logmsg .= "\n";
  254:                         }
  255:                     } else {
  256:                        $logmsg .= "An error occurred adding new user $uname - $reply\n";
  257:                     }
  258:                 } else {
  259: # Get the user's information and authentication
  260:                     my %userenv = &Apache::lonnet::get('environment',['firstname','middlename','lastname','generation','id','critnotification','notification'],$dom,$uname);
  261:                     my ($tmp) = keys(%userenv);
  262:                     if ($tmp =~ /^(con_lost|error)/i) {
  263:                         %userenv = ();
  264:                     }
  265: # Get the user's e-mail address
  266:                     if ($userenv{critnotification} =~ m/%40/) {
  267:                         unless ($emailenc eq $userenv{critnotification}) {
  268:                         $logmsg .= "Current critical notification e-mail - ".$userenv{critnotification}." for $uname is different to e-mail address in Institutional classlist - $emailenc\n";
  269:                     }
  270:                     if ($userenv{notification} =~ m/%40/) {
  271:                         unless ($emailenc eq $userenv{critnotification}) {
  272:                             $logmsg .= "Current standard notification e-mail - ".$userenv{notification}." for $uname is different to e-mail address in Institutional classlist - $emailenc\n";
  273:                         }
  274:                     }                            
  275:                     my $krbdefdom = '';
  276:                     my $currentauth=&Apache::lonnet::queryauthenticate($uname,$dom);
  277:                     if ($currentauth=~/^krb(4|5):/) {
  278:                         $currentauth=~/^krb(4|5):(.*)/;
  279:                         $krbdefdom=$1;
  280:                     }
  281:                     if ($currentauth=~/^krb(4|5):/ || 
  282:                         $currentauth=~/^unix:/ ||
  283:                         $currentauth=~/^internal:/ ||
  284:                         $currentauth=~/^localauth:/) {
  285:                                
  286:                     } else {
  287:                         $logmsg .= "Invalid authentication method $currentauth for $uname.\n";  
  288:                     }
  289: # Report if authentication methods are different.
  290:                     if ($currentauth ne $auth ) {
  291:                          $logmsg .= "Authentication mismatch for $uname - $currentauth in system, $auth for class $crs\n";
  292:                     }
  293: # Check user data
  294:                     if ($first  ne $userenv{'firstname'}  ||
  295:                         $middle ne $userenv{'middlename'} ||
  296:                         $last   ne $userenv{'lastname'}   ||
  297:                         $gene   ne $userenv{'generation'} ||
  298:                         $pid    ne $userenv{'id'} ) {         
  299: # Make the change(s)
  300:                         my %changeHash;
  301:                         $changeHash{'firstname'}  = $first;
  302:                         $changeHash{'middlename'} = $middle;
  303:                         $changeHash{'lastname'}   = $last;
  304:                         $changeHash{'generation'} = $gene;
  305:                         $changeHash{'id'} = $pid;
  306:                         my $putresult = &Apache::lonnet::put('environment',\%changeHash,$dom,$uname);
  307:                         if ($putresult eq 'ok') {
  308:                             $logmsg .= "User: $uname enrolled in $crs\n"; 
  309: # Assign the role of student
  310:                             $classlist_reply = &modify_student_enrollment($$configvars{'lonHostID'},$dom,$cid,$crs,$uname,$pid,$first,$middle,$last,$gene,$usec,$end,$start,'auto');
  311:                             if ($classlist_reply eq 'ok') {
  312:                                 my $uurl='/'.$cid;
  313:                                 $uurl=~s/\_/\//g;
  314:                                 if ($usec) {
  315:                                     $uurl.='/'.$usec;
  316:                                 }
  317:                                 &Apache::lonnet::assignrole($dom,$uname,$uurl,"st",$enddate,$startdate);
  318:                                 $addresult .=  "$first $last ($pid) - $uname enrolled in section/group $usec.".$linefeed;
  319:                                 $enrollcount ++;
  320:                                 $addresult .= "$first $last ($pid) - $uname enrolled in section/group $usec.".$linefeed;
  321:                                 $logmsg .= "Existing user $uname enrolled successfully in $crs\n";
  322: 
  323:                             } else {
  324:                                 $logmsg .= "There was a problem updating the classlist db file for user $uname to show the new enrollment, so no enrollment occurred in $crs\n";
  325:                             }
  326:                         } else {
  327:                             $logmsg .= "There was a problem modifying user data for existing user - $uname, so no enrollment occurred in $crs.\n";
  328:                         }
  329:                     }
  330:                 }
  331:             }
  332:         }
  333:     }
  334: # Do drops
  335:     if ( ($drops == 1) && (@reg_students > 0) ) {
  336:         foreach my $uname (@localstudents) {
  337:             if ($$currlist{$uname}[$type] eq "auto") {
  338:                 my @saved = ();
  339:                 if (!grep/^$uname$/,@reg_students) {
  340: # Check for changed usernames by checking studentIDs
  341:                     if (grep/^$$currlist{$uname}[ $stuid ]$/,@allINids) {
  342:                         foreach my $match (@{$unameFromINid{$$currlist{$uname}[ $stuid ]}} ) {
  343:                             $logmsg .= "A possible change in username has been detected for a student enrolled in $crs. 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\n";
  344:                             push @saved,$uname;
  345:                         }
  346:                     } elsif (@saved == 0) {
  347:                         my $drop_reply = &Apache::lonnet::modifystudent($dom,$uname,'','','',undef,undef,undef,undef,$$currlist{$uname}[$sec],time,undef,undef,undef,undef,undef,$cid);
  348:                         if ($drop_reply !~ /^ok/) {
  349:                             $logmsg .= "An error occured during the attempt to expire the $uname from the old section $$currlist{$uname}[$sec] - $drop_reply\n";
  350:                         } else {
  351:                             $dropcount ++;
  352:                             my %userenv = &Apache::lonnet::get('environment',['firstname','lastname','id'],$dom,$uname);
  353:                             $dropresult .= $userenv{'firstname'}." ".$userenv{'lastname'}." (".$userenv{'id'}.") - ".$uname." dropped from section/group ".$$currlist{$uname}[$sec].$linefeed; 
  354:                         }
  355:                     }
  356:                 }
  357:             }
  358:         }
  359:     }
  360:     if ($enrollcount > 0) {
  361:         if ($context eq "updatenow") {
  362:             $addresult = "The following $enrollcount student(s) was/were added to this LON-CAPA course:<br/><ul><li>".$addresult."</li></ul><br/><br/>";
  363:         } else {
  364:             $addresult = "The following $enrollcount student(s) was/were added to this LON-CAPA course:\n\n".$addresult."\n\n";    
  365:         }      
  366:     }
  367:     if ($dropcount > 0) {
  368:         if ($context eq "updatenow") {
  369:             $dropresult = "The following $dropcount student(s) was/were expired from this LON-CAPA course:<br/><ul><li>".$dropresult."</li></ul><br/><br/>";
  370:         } else {
  371:             $dropresult = "The following $dropcount student(s) was/were expired from this LON-CAPA course:\n\n".$dropresult."\n\n";
  372:         }
  373:     }
  374:     if ( ($adds) && ($enrollcount == 0) ) {
  375:         $addresult = "There were no new students to add to the course.";
  376:         if ($context eq "updatenow") {
  377:             $addresult .="<br/><br/>";
  378:         } else {
  379:             $addresult .="\n";
  380:         }
  381:     }
  382:     if ( ($drops) && ($dropcount == 0) ) {
  383:         $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.";
  384:         if ($context eq "updatenow") {
  385:             $dropresult .="<br/>";
  386:         } else {
  387:             $dropresult .="\n";
  388:         }
  389:     }
  390:     print STDERR $logmsg;
  391:     return $addresult.$dropresult; 
  392: } 
  393: 
  394: sub parse_classlist {
  395:   my ($tmpdir,$dom,$crs,$class,$placeref,$groupID,$studentsref) = @_;            
  396:   my $configvars = &LONCAPA::Configuration::read_conf();
  397:   my $xmlfile = $tmpdir."/tmp/".$dom."_".$crs."_classlist.xml";
  398:   my $enrolled = XMLin( $xmlfile, KeyAttr => ['username'] );
  399:   foreach my $uname ( sort keys %{$$enrolled{'student'}} ) {
  400:       @{ $$studentsref{$uname} } = ();
  401:       foreach my $key (sort keys %{$$enrolled{'student'}{$uname}} ) {
  402:           my $value = $$enrolled{'student'}{$uname}{$key};
  403:           if (ref($value)) {
  404:               $$studentsref{$uname}[ $$placeref{$key} ] = '';
  405:           } else {
  406:               if ($key eq 'groupID') {
  407:                   $$studentsref{$uname}[ $$placeref{$key} ] = $groupID;
  408:               } else {
  409:                   $$studentsref{$uname}[ $$placeref{$key} ] = $value;
  410:               }
  411:           }
  412:       }
  413:   }
  414: #  if (-e "$xmlfile") {
  415: #      unlink $xmlfile;
  416: #  }
  417:   return;
  418: }
  419: 
  420: sub create_password {
  421: 
  422: 
  423: }
  424: 
  425: sub CL_autharg { return 0; }
  426: sub CL_authtype { return 1;}
  427: sub CL_email { return 2;}
  428: sub CL_enddate { return 3;}
  429: sub CL_firstname { return 4;}
  430: sub CL_generation { return 5;}
  431: sub CL_groupID { return 6;}
  432: sub CL_lastname { return 7;}
  433: sub CL_middlename { return 8;}
  434: sub CL_startdate { return 9; }
  435: sub CL_studentID { return 10; }
  436: 
  437: 1;