[BACK]Return to Enrollment.pm CVS log [TXT] [DIR] Up to [LON-CAPA] / loncom / enrollment

Diff for /loncom/enrollment/Enrollment.pm between versions 1.4 and 1.12

version 1.4, 2003/12/05 19:07:19 version 1.12, 2004/03/18 16:46:28
Line 1 Line 1
   # Automated Enrollment manager
   # $Id$
   #
   # Copyright Michigan State University Board of Trustees
   #
   # This file is part of the LearningOnline Network with CAPA (LON-CAPA).
   #
   # LON-CAPA is free software; you can redistribute it and/or modify
   # it under the terms of the GNU General Public License as published by
   # the Free Software Foundation; either version 2 of the License, or
   # (at your option) any later version.
   #
   # LON-CAPA is distributed in the hope that it will be useful,
   # but WITHOUT ANY WARRANTY; without even the implied warranty of
   # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
   # GNU General Public License for more details.
   #
   # You should have received a copy of the GNU General Public License
   # along with LON-CAPA; if not, write to the Free Software
   # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
   #
   # /home/httpd/html/adm/gpl.txt
   #
   # http://www.lon-capa.org/
   #
 package LONCAPA::Enrollment;  package LONCAPA::Enrollment;
   
 use Apache::loncoursedata;  use Apache::loncoursedata;
 use Apache::lonnet;  use Apache::lonnet;
   use Apache::lonmsg;
 use HTML::Entities;  use HTML::Entities;
 use XML::Simple;  
 use LONCAPA::Configuration;  use LONCAPA::Configuration;
   use Time::Local;
   use lib '/home/httpd/lib/perl';
   use localenroll;
   
 use strict;  use strict;
   
 sub update_LC {  sub update_LC {
     my ($dom,$crs,$adds,$drops,$startdate,$enddate,$authtype,$autharg,$classesref,$groupref,$logmsg,$context) = @_;       my ($dom,$crs,$adds,$drops,$startdate,$enddate,$authtype,$autharg,$classesref,$groupref,$logmsg,$newusermsg,$context) = @_; 
 # Get current LON-CAPA student enrollment for this class  # Get current LON-CAPA student enrollment for this class
     my $configvars = &LONCAPA::Configuration::read_conf('loncapa.conf');      my $configvars = &LONCAPA::Configuration::read_conf('loncapa.conf');
     my $cid = $dom."_".$crs;      my $cid = $dom."_".$crs;
Line 41  sub update_LC { Line 69  sub update_LC {
     my $enrollcount = 0;      my $enrollcount = 0;
     my $dropcount = 0;      my $dropcount = 0;
   
       srand( time() ^ ($$ + ($$ << 15))  ); # Seed rand in case initial passwords have to be generated for new users.
   
 # Get mapping of IDs to usernames for current LON-CAPA student enrollment for this class   # Get mapping of IDs to usernames for current LON-CAPA student enrollment for this class 
     my @LCids = ();      my @LCids = ();
     my %unameFromLCid = ();      my %unameFromLCid = ();
Line 109  sub update_LC { Line 139  sub update_LC {
                 push @okusers, $uname;                  push @okusers, $uname;
             }              }
             elsif (@sections > 1) {              elsif (@sections > 1) {
                 $logmsg =  "$uname appears in classlists for multiple sections of $crs -";                  $$logmsg =  "$uname appears in classlists for the more than one section of this course, i.e. in sections: ";
                 foreach (@sections) {                  foreach (@sections) {
                     $logmsg .= " $_,";                      $$logmsg .= " $_,";
                 }                  }
                 chop($logmsg);                  chop($$logmsg);
                 $logmsg .= " No automated enrollment action taken for this student.\n";                  $$logmsg .= ". Because of this ambiguity, no enrollment action was taken for this student.".$linefeed;
             }              }
         } else {          } else {
             @{$enrollinfo{$uname}} = @{$allenrolled{$uname}[0]};              @{$enrollinfo{$uname}} = @{$allenrolled{$uname}[0]};
Line 134  sub update_LC { Line 164  sub update_LC {
             @{$unameFromINid{$stuID}} = $uname;               @{$unameFromINid{$stuID}} = $uname; 
         }          }
     }      }
   # Explicitly allow access to creation/modification of students if called as an automated process.
       if ($context eq 'automated') {
           $ENV{'allowed.cst'}='F';
       }
   
 # Compare IDs with existing LON-CAPA enrollment for this class  # Compare IDs with existing LON-CAPA enrollment for this class
     foreach my $uname (@okusers) {      foreach my $uname (@okusers) {
         my %uidhash=&Apache::lonnet::idrget($dom,$uname);          unless ($uname eq '') {
         my @stuinfo = @{$enrollinfo{$uname}};              my %uidhash=&Apache::lonnet::idrget($dom,$uname);
         if (grep/^$uname$/,@localstudents) {              my @stuinfo = @{$enrollinfo{$uname}};
               if (grep/^$uname$/,@localstudents) {
 # Check for studentID changes  # Check for studentID changes
             if ( ($uidhash{$uname}) && ($uidhash{$uname} !~ /error\:/) )  {                  if ( ($uidhash{$uname}) && ($uidhash{$uname} !~ /error\:/) )  {
                 unless ( ($uidhash{$uname}) eq ($stuinfo[ $place{studentID} ]) ) {                      unless ( ($uidhash{$uname}) eq ($stuinfo[ $place{studentID} ]) ) {
                     $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";                           $$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 section changes  # Check for section changes
             unless ($$currlist{$uname}[$sec] eq $stuinfo[ $place{groupID} ]) {                  unless ($$currlist{$uname}[$sec] eq $stuinfo[ $place{groupID} ]) {
                 $logmsg .= "Found a section difference for $uname - ".$$currlist{$uname}[$sec] ."versus ".$stuinfo[ $place{groupID} ]." in class $crs\n";                      if ( ($$currlist{$uname}[$type] eq "auto") && ($adds == 1) ) {
                 if ( ($$currlist{$uname}[$type] eq "auto") && ($adds == 1) ) {  # Delete from roles.db for current section
                     my $modify_section_result = &Apache::lonnet::modifystudent($dom,$uname,'','','',undef,undef,undef,undef,$$currlist{$uname}[$sec],time,undef,undef,undef,undef,'auto',$cid);                          my $expiretime = time;
                     if ($modify_section_result !~ /^ok/) {                          my $uurl='/'.$cid;
                         $logmsg .= "An error occured during the attempt to expire the $uname from the old section $$currlist{$uname}[$sec] - $modify_section_result\n";                          $uurl=~s/\_/\//g;
                     }                          if ($$currlist{$uname}[$sec]) {
                               $uurl.='/'.$$currlist{$uname}[$sec];
 # Assign the role of student in the new section                          }
                     my $uurl='/'.$cid;                          my $expire_role_result = &Apache::lonnet::assignrole($dom,$uname,$uurl,'st',$expiretime);
                     $uurl=~s/\_/\//g;                          if ($expire_role_result eq 'ok') {
                     if ($stuinfo[ $place{groupID} ]) {                              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);
                         $uurl.='/'.$stuinfo[ $place{groupID} ];                              if ($modify_section_result =~ /^ok/) {
                     }                                  $$logmsg .= "Section for $uname switched from old section: ".$$currlist{$uname}[$sec] ." to new section: ".$stuinfo[ $place{groupID} ].".".$linefeed;
                     my $newend = $stuinfo[ $place{enddate} ];                              } else {
                     my $newstart = $stuinfo[ $place{startdate} ];                                  $$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;
                     if ($newend eq '') {                              }
                         $newend = $enddate;                          } else {
                     }                              $$logmsg .= "Error when attempting to expire role for $uname in old section" .$$currlist{$uname}[$sec]." -error: $expire_role_result".$linefeed;
                     if ($newstart eq '') {                          }
                         $newstart = $startdate;                      }
                     }  
     #explicitly allow acces to creating students  
     $ENV{'allowed.cst'}='F';  
                     &Apache::lonnet::assignrole($dom,$uname,$uurl,"st",$newend,$newstart);   
     delete($ENV{'allowed.cst'});  
                 }                  }
             }              } else {
         }  
         elsif ($uname ne '') {  
 # Check for changed usernames by checking studentIDs  # Check for changed usernames by checking studentIDs
             if ( ($stuinfo[ $place{studentID} ] ne '') && (grep/^$stuinfo[ $place{studentID} ]$/,@LCids) ) {                  if ( ($stuinfo[ $place{studentID} ] ne '') && (grep/^$stuinfo[ $place{studentID} ]$/,@LCids) ) {
                 if (grep/^$$currlist{$uname}[ $place{'studentID'} ]$/,@allINids) {                      if (grep/^$$currlist{$uname}[ $place{'studentID'} ]$/,@allINids) {
                     foreach my $match ( @{ $unameFromLCid{ $stuinfo[ $place{studentID} ] } }  ) {                          foreach my $match ( @{ $unameFromLCid{ $stuinfo[ $place{studentID} ] } }  ) {
                         if (grep/^$match$/,@okusers) {                              if (grep/^$match$/,@okusers) {
                             $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";                                  $$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 contact your Domain Coordinator to request a move of the student data files for user: $uname to $match".$linefeed;
                               }
                         }                          }
                     }                      }
                 }                  } elsif ($adds == 1) {
             } elsif ($adds == 1) {  
 # Add student to LON-CAPA classlist  # Add student to LON-CAPA classlist
                 my $auth = $stuinfo[ $place{'authtype'} ];                      my $auth = $stuinfo[ $place{'authtype'} ];
                 my $authparam = $stuinfo[ $place{'autharg'} ];                      my $authparam = $stuinfo[ $place{'autharg'} ];
                 my $first = $stuinfo[ $place{'firstname'} ];                      my $first = $stuinfo[ $place{'firstname'} ];
                 my $middle = $stuinfo[ $place{'middlename'} ];                      my $middle = $stuinfo[ $place{'middlename'} ];
                 my $last = $stuinfo[ $place{'lastname'} ];                      my $last = $stuinfo[ $place{'lastname'} ];
                 my $gene = $stuinfo[ $place{'generation'} ];                      my $gene = $stuinfo[ $place{'generation'} ];
                 my $usec = $stuinfo[ $place{'groupID'} ];                      my $usec = $stuinfo[ $place{'groupID'} ];
                 my $end = $stuinfo[ $place{'enddate'} ];                      my $end = $stuinfo[ $place{'enddate'} ];
                 my $start = $stuinfo[ $place{'startdate'} ];                      my $start = $stuinfo[ $place{'startdate'} ];
                 my $emailaddr = $stuinfo[ $place{'email'} ];                      my $emailaddr = $stuinfo[ $place{'email'} ];
                 my $pid = $stuinfo[ $place{'studentID'} ];                      my $pid = $stuinfo[ $place{'studentID'} ];
   
 # remove non alphanumeric values from section  # remove non alphanumeric values from section
                 $usec =~ s/\W//g;                      $usec =~ s/\W//g;
   
                 unless ($emailaddr =~/^[^\@]+\@[^\@]+$/) { $emailaddr =''; }                      unless ($emailaddr =~/^[^\@]+\@[^\@]+$/) { $emailaddr =''; }
                 my $emailenc = &HTML::Entities::encode($emailaddr);                       my $emailenc = &HTML::Entities::encode($emailaddr); 
   
 # Use course defaults where entry is absent  # Use course defaults where entry is absent
                 if ($auth eq '') {                      if ( ($auth eq '') || (!defined($auth)) ) {
                     $auth =  $authtype;                          $auth =  $authtype;
                 }                      }
                 if ($authparam eq '') {                      if ( ($authparam eq '')  || (!defined($authparam)) )  {
                     $authparam = $autharg;                          $authparam = $autharg;
                 }                      }
                 if ($auth =~ m/^krb/) {                      if ( ($end eq '') || (!defined($end)) )  {
                     $auth .= ":".$authparam;                           $end = $enddate;
                 }                      }
                 if ($end eq '') {                      if ( ($start eq '')  || (!defined($start)) )  {
                     $end = $enddate;                           $start = $startdate;
                 }                      }
                 if ($start eq '') {  
                     $start = $startdate;  
                 }  
 # Clean up whitespace  # Clean up whitespace
                 foreach (\$dom,\$uname,\$pid,\$first,\$middle,\$last,\$gene,\$usec) {                      foreach (\$dom,\$uname,\$pid,\$first,\$middle,\$last,\$gene,\$usec) {
                     $$_ =~ s/(\s+$|^\s+)//g;                           $$_ =~ s/(\s+$|^\s+)//g;
                 }                      }
   
 # Check for existing account in this LON-CAPA domain for this username  # Check for existing account in this LON-CAPA domain for this username
                 my $uhome=&Apache::lonnet::homeserver($uname,$dom);                      my $uhome=&Apache::lonnet::homeserver($uname,$dom);
                 if ($uhome eq 'no_host') { # User does not exist                      if ($uhome eq 'no_host') { # User does not exist
                     my $create_passwd = 0;                          my $create_passwd = 0;
                     my $authchk = '';                          my $authchk = '';
                     unless ($authparam eq '') { $authchk = 'ok'; };                          unless ($authparam eq '') { $authchk = 'ok'; };
 # If no account exists and passwords should be generated  # If no account exists and passwords should be generated
                     if ($authtype eq "int") {                          if ($auth eq "internal") {
                         if ($authparam eq '') {                              if ($authparam eq '') {
                             ($authparam,$create_passwd,$authchk) = &create_password();                                  ($authparam) = &create_password();
                         }                                  if ($authparam eq '') {
                     } elsif ($authtype eq "local") {                                      $authchk = '';
                         if ($authparam eq '') {                                  } else {
                             ($authparam,$create_passwd,$authchk) = &create_password();                                      $create_passwd = 1;
                         }                                      $authchk = 'ok';
                     } elsif ($authtype =~ m/^krb/) {                                  }        
                         if ($authparam eq '') {                              }
                             $logmsg .= "No Kerberos domain available for the new user - $uname in course $crs - no enrollment occurred.\n";                          } 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';                              $authchk = 'invalid';
                               $$logmsg .= "An invalid authentication type was provided for the new user - $uname, so the student was not enrolled in the course.".$linefeed;
                         }                          }
                     } else {                          if ($authchk eq 'ok') { 
                         $authchk = 'invalid';  
                         $logmsg .= "Invalid authentication type for new user - $uname in course $crs - no enrollment occurred.\n";  
                     }    
                     unless ($authchk eq 'ok') {   
 # Now create user.  # Now create user.
                         my $reply=&Apache::lonnet::modifystudent($dom,$uname,$pid,$auth,$authparam,$first,$middle,$last,$gene,$usec,$end,$start,'',undef,$emailaddr,'auto',$cid);                              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') {                              if ($reply eq 'ok') {
                             $enrollcount ++;                                  $enrollcount ++;
                             $addresult .= "$first $last ($pid) - $uname enrolled in section/group $usec.".$linefeed;                                  $addresult .= "$first $last ($pid) - $uname enrolled in section/group $usec.".$linefeed;
                             $logmsg .= "New user $uname added successfully. ";                                  if ($context eq 'automated') {
                             unless ($emailenc eq '') {                                      $$logmsg .= "New $dom user $uname added successfully.";
                                 my %emailHash;                                  }
                                 $emailHash{'critnotification'}  = $emailenc;                                  unless ($emailenc eq '') {
                                 $emailHash{'notification'} = $emailenc;                                      my %emailHash;
                                 my $putresult = &Apache::lonnet::put('environment',\%emailHash,$dom,$uname);                                      $emailHash{'critnotification'}  = $emailenc;
                             }                                      $emailHash{'notification'} = $emailenc;
                             if ($create_passwd) {                                      my $putresult = &Apache::lonnet::put('environment',\%emailHash,$dom,$uname);
 # Send e-mail with inital password to new user at $emailaddr                                  }
                                 $logmsg .= "Initial password -  - sent to $emailaddr\n";                                  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 {                              } else {
                                 $logmsg .= "\n";                                  $$logmsg .= "An error occurred adding new user $uname - ".$reply.$linefeed;
                             }                              }
                         } else {  
                             $logmsg .= "An error occurred adding new user $uname - $reply\n";  
                         }                          }
                     }                      } else {
                 } else {  
 # Get the user's information and authentication  # Get the user's information and authentication
                     my %userenv = &Apache::lonnet::get('environment',['firstname','middlename','lastname','generation','id','critnotification','notification'],$dom,$uname);                          my %userenv = &Apache::lonnet::get('environment',['firstname','middlename','lastname','generation','id','critnotification','notification'],$dom,$uname);
                     my ($tmp) = keys(%userenv);                          my ($tmp) = keys(%userenv);
                     if ($tmp =~ /^(con_lost|error)/i) {                          if ($tmp =~ /^(con_lost|error)/i) {
                         %userenv = ();                              %userenv = ();
                     }                          }
 # Get the user's e-mail address  # Get the user's e-mail address
                     if ($userenv{critnotification} =~ m/%40/) {                          if ($userenv{critnotification} =~ m/%40/) {
                         unless ($emailenc eq $userenv{critnotification}) {                              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\n";                                  $$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/) {                          if ($userenv{notification} =~ m/%40/) {
                         unless ($emailenc eq $userenv{critnotification}) {                              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\n";                                  $$logmsg .= "Current standard notification e-mail - ".$userenv{notification}." for $uname is different to e-mail address in institutional classlist - ".$emailenc.$linefeed;
                         }                              }
                     }                                                      }                            
                     my $krbdefdom = '';                          my $krbdefdom = '';
                     my $currentauth=&Apache::lonnet::queryauthenticate($uname,$dom);                          my $currentauth=&Apache::lonnet::queryauthenticate($uname,$dom);
                     if ($currentauth=~/^krb(4|5):/) {                          if ($currentauth=~/^(krb[45]):(.*)/) {
                         $currentauth=~/^krb(4|5):(.*)/;                              $currentauth = $1;
                         $krbdefdom=$1;                              $krbdefdom = $2;
                     }                          } elsif ($currentauth=~ /^(unix|internal|localauth):/) {
                     if ($currentauth=~/^krb(4|5):/ ||                               $currentauth = $1;
                         $currentauth=~/^unix:/ ||                          } else {
                         $currentauth=~/^internal:/ ||                              $$logmsg .= "Invalid authentication method $currentauth for $uname.".$linefeed;  
                         $currentauth=~/^localauth:/) {                          }
                                  
                     } else {  
                         $logmsg .= "Invalid authentication method $currentauth for $uname.\n";    
                     }  
 # Report if authentication methods are different.  # Report if authentication methods are different.
                     if ($currentauth ne $auth ) {                          if ($currentauth ne $auth) {
                          $logmsg .= "Authentication mismatch for $uname - $currentauth in system, $auth for class $crs\n";                              $$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  # Check user data
                     if ($first  ne $userenv{'firstname'}  ||                          if ($first  ne $userenv{'firstname'}  ||
                         $middle ne $userenv{'middlename'} ||                              $middle ne $userenv{'middlename'} ||
                         $last   ne $userenv{'lastname'}   ||                              $last   ne $userenv{'lastname'}   ||
                         $gene   ne $userenv{'generation'} ||                              $gene   ne $userenv{'generation'} ||
                         $pid    ne $userenv{'id'} ) {                                       $pid    ne $userenv{'id'} ) {         
 # Make the change(s)  # Make the change(s)
                         my %changeHash;                              my %changeHash;
                         $changeHash{'firstname'}  = $first;                              $changeHash{'firstname'}  = $first;
                         $changeHash{'middlename'} = $middle;                              $changeHash{'middlename'} = $middle;
                         $changeHash{'lastname'}   = $last;                              $changeHash{'lastname'}   = $last;
                         $changeHash{'generation'} = $gene;                              $changeHash{'generation'} = $gene;
                         $changeHash{'id'} = $pid;                              $changeHash{'id'} = $pid;
                         my $putresult = &Apache::lonnet::put('environment',\%changeHash,$dom,$uname);                              my $putresult = &Apache::lonnet::put('environment',\%changeHash,$dom,$uname);
                         if ($putresult eq 'ok') {                              if ($putresult eq 'ok') {
                             $logmsg .= "User information updated for user: $uname prior to enrollment in $crs\n";                                  $$logmsg .= "User information updated for user: $uname prior to enrollment.".$linefeed;
                         } else {                              } else {
                             $logmsg .= "There was a problem modifying user data for existing user - $uname, enrollment will still be attempted for user in $crs.\n";                                  $$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.  # Assign the role of student in the course.
                     my $classlist_reply = &Apache::lonnet::modify_student_enrollment($dom,$uname,$pid,$first,$middle,$last,$gene,$usec,$end,$start,'auto',$cid);                          my $classlist_reply = &Apache::lonnet::modify_student_enrollment($dom,$uname,$pid,$first,$middle,$last,$gene,$usec,$end,$start,'auto',$cid);
                     if ($classlist_reply eq 'ok') {                          if ($classlist_reply eq 'ok') {
                         $enrollcount ++;                              $enrollcount ++;
                         $addresult .= "$first $last ($pid) - $uname enrolled in section/group $usec.".$linefeed;                              $addresult .= "$first $last ($pid) - $uname enrolled in section/group $usec.".$linefeed;
                         $logmsg .= "Existing user $uname enrolled successfully in $crs\n";                              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, so no enrollment occurred for this user in $crs\n";                          } 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;
                           }
                     }                      }
                 }                  }
             }              }
Line 354  sub update_LC { Line 401  sub update_LC {
 # Check for changed usernames by checking studentIDs  # Check for changed usernames by checking studentIDs
                     if (grep/^$$currlist{$uname}[ $stuid ]$/,@allINids) {                      if (grep/^$$currlist{$uname}[ $stuid ]$/,@allINids) {
                         foreach my $match (@{$unameFromINid{$$currlist{$uname}[ $stuid ]}} ) {                          foreach my $match (@{$unameFromINid{$$currlist{$uname}[ $stuid ]}} ) {
                             $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";                              $$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.".$linefeed;
                             push @saved,$uname;                              push @saved,$uname;
                         }                          }
                     } elsif (@saved == 0) {                      } 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,undef,$cid);
                         if ($drop_reply !~ /^ok/) {                          if ($drop_reply !~ /^ok/) {
                             $logmsg .= "An error occured during the attempt to expire the $uname from the old section $$currlist{$uname}[$sec] - $drop_reply\n";                              $$logmsg .= "An error occured during the attempt to expire the $uname from the old section $$currlist{$uname}[$sec] - $drop_reply.".$linefeed;
                         } else {                          } else {
                             $dropcount ++;                              $dropcount ++;
                             my %userenv = &Apache::lonnet::get('environment',['firstname','lastname','id'],$dom,$uname);                              my %userenv = &Apache::lonnet::get('environment',['firstname','lastname','id'],$dom,$uname);
                             $dropresult .= $userenv{'firstname'}." ".$userenv{'lastname'}." (".$userenv{'id'}.") - ".$uname." dropped from section/group ".$$currlist{$uname}[$sec].$linefeed;                               $dropresult .= $userenv{'firstname'}." ".$userenv{'lastname'}." (".$userenv{'id'}.") - ".$uname." dropped from section/group ".$$currlist{$uname}[$sec].$linefeed; 
                               if ($context eq 'automated') {
                                   $$logmsg .= "User $uname student role expired from course.".$linefeed;
                               }
                         }                          }
                     }                      }
                 }                  }
             }              }
         }          }
     }      }
   
   # Terminated explictly allowed access to student creation/modification
       if ($context eq 'automated') {
           delete($ENV{'allowed.cst'});
       }
     if ($enrollcount > 0) {      if ($enrollcount > 0) {
         if ($context eq "updatenow") {          if ($context eq "updatenow") {
               $addresult = substr($addresult,0,rindex($addresult,"<li>"));
             $addresult = "The following $enrollcount student(s) was/were added to this LON-CAPA course:<br/><ul><li>".$addresult."</li></ul><br/><br/>";              $addresult = "The following $enrollcount student(s) was/were added to this LON-CAPA course:<br/><ul><li>".$addresult."</li></ul><br/><br/>";
         } else {          } 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";    
Line 380  sub update_LC { Line 436  sub update_LC {
     }      }
     if ($dropcount > 0) {      if ($dropcount > 0) {
         if ($context eq "updatenow") {          if ($context eq "updatenow") {
               $dropresult = substr($dropresult,0,rindex($dropresult,"<li>"));
             $dropresult = "The following $dropcount student(s) was/were expired from this LON-CAPA course:<br/><ul><li>".$dropresult."</li></ul><br/><br/>";              $dropresult = "The following $dropcount student(s) was/were expired from this LON-CAPA course:<br/><ul><li>".$dropresult."</li></ul><br/><br/>";
         } else {          } else {
             $dropresult = "The following $dropcount student(s) was/were expired from this LON-CAPA course:\n\n".$dropresult."\n\n";              $dropresult = "The following $dropcount student(s) was/were expired from this LON-CAPA course:\n\n".$dropresult."\n\n";
Line 401  sub update_LC { Line 458  sub update_LC {
             $dropresult .="\n";              $dropresult .="\n";
         }          }
     }      }
     print STDERR $logmsg;      my $changecount = $enrollcount + $dropcount;
     return $addresult.$dropresult;       return ($changecount,$addresult.$dropresult); 
 }   }
   
 sub parse_classlist {  sub parse_classlist {
     my ($tmpdir,$dom,$crs,$class,$placeref,$groupID,$studentsref) = @_;                  my ($tmpdir,$dom,$crs,$class,$placeref,$groupID,$studentsref) = @_;
     my $configvars = &LONCAPA::Configuration::read_conf();      my $xmlfile = $tmpdir."/tmp/".$dom."_".$crs."_".$class."_classlist.xml";
     my $xmlfile = $tmpdir."/tmp/".$dom."_".$crs."_classlist.xml";      my $uname = '';
     my $enrolled = XMLin( $xmlfile, KeyAttr => ['username'] );      my @state;
     foreach my $uname ( sort keys %{$$enrolled{'student'}} ) {      my @items = ('autharg','authtype','email','firstname','generation','lastname','middlename','studentID');
         @{ $$studentsref{$uname} } = ();      my $p = HTML::Parser->new
         foreach my $key (sort keys %{$$enrolled{'student'}{$uname}} ) {      (
             my $value = $$enrolled{'student'}{$uname}{$key};          xml_mode => 1,
             if (ref($value)) {          start_h =>
                 $$studentsref{$uname}[ $$placeref{$key} ] = '';              [sub {
             } else {                   my ($tagname, $attr) = @_;
                 if ($key eq 'groupID') {                   push @state, $tagname;
                     $$studentsref{$uname}[ $$placeref{$key} ] = $groupID;                   if ("@state" eq "students student") {
                 } else {                       $uname = $attr->{username};
                     $$studentsref{$uname}[ $$placeref{$key} ] = $value;                   }
                 }              }, "tagname, attr"],
            text_h =>
                [sub {
                    my ($text) = @_;
                    if ("@state" eq "students student groupID") {
                        $$studentsref{$uname}[ $$placeref{'groupID'} ] = $groupID;
                    } elsif ("@state" eq "students student startdate") {
                        my $start = $text;
                        unless ($text eq '') {
                            $start = &process_date($text);
                        }
                        $$studentsref{$uname}[ $$placeref{'startdate'} ] = $start; 
                    } elsif ("@state" eq "students student enddate") {
                        my $end = $text;
                        unless ($text eq '') {
                            $end = &process_date($text);
                        }
                        $$studentsref{$uname}[ $$placeref{'enddate'} ] = $end;
                    } else {
                        foreach my $item (@items) {
                            if ("@state" eq "students student $item") {
                                $$studentsref{$uname}[ $$placeref{$item} ] = $text;
                            }
                        }
                    }
                  }, "dtext"],
            end_h =>
                  [sub {
                      my ($tagname) = @_;
                      pop @state;
                   }, "tagname"],
       );
                                                                                                                
       $p->parse_file($xmlfile);
       $p->eof;
       if (-e "$xmlfile") {
           unlink $xmlfile;
       }
       return;
   }
   
   sub process_date {
       my $timestr = shift;
       my $timestamp = '';
       if ($timestr =~ m/^\d{4}:\d{2}:\d{2}/) {
           my @entries = split/:/,$timestr;
           for (my $j=0; $j<@entries; $j++) {
               if ( length($entries[$j]) > 1 ) {
                   $entries[$j] =~ s/^0//;
             }              }
         }          }
           $entries[1] = $entries[1] - 1;
           $timestamp =  timelocal($entries[5],$entries[4],$entries[3],$entries[2],$entries[1],$entries[0]);
     }      }
 #    if (-e "$xmlfile") {      return $timestamp;
 #        unlink $xmlfile;  
 #    }  
     return;  
 }  }
   
 sub create_password {  sub create_password {
     my ($authparam,$create_passwd,$authreply);      my $passwd = '';
     return ($authparam,$create_passwd,$authreply);      my @letts = ("a","b","c","d","e","f","g","h","i","j","k","l","m","n","o","p","q","r","s","t","u","v","w","x","y","z");
       for (my $i=0; $i<8; $i++) {
           my $lettnum = int (rand 2);
           my $item = '';
           if ($lettnum) {
               $item = $letts[int( rand(26) )];
               my $uppercase = int(rand 2);
               if ($uppercase) {
                   $item =~ tr/a-z/A-Z/;
               }
           } else {
               $item = int( rand(10) );
           } 
           $passwd .= $item;
       }
       return ($passwd);
   }
   
   sub check_user_status {
       my ($udom,$uname,$cdom,$crs,$role,$secgrp) = @_;
       my %userinfo = &Apache::lonnet::dump('roles',$udom,$uname);
       my @uroles = keys %userinfo;
       my $srchstr;
       my $active_chk = 'none';
       if (@uroles > 0) {
           if ( ($role eq 'cc') || ($secgrp eq '') || ( !defined($secgrp) ) ) {
               $srchstr = '/'.$cdom.'/'.$crs.'_'.$role;
           } else {
               $srchstr = '/'.$cdom.'/'.$crs.'/'.$secgrp.'_'.$role;
           }
           if (grep/^$srchstr$/,@uroles) {
               my $role_end = 0;
               my $role_start = 0;
               $active_chk = 'ok';
               if ( $userinfo{$srchstr} =~ m/^($role)_(\d+)/ ) {
                   $role_end = $2;
                   if ( $userinfo{$srchstr} =~ m/^($role)_($role_end)_(\d+)$/ )
                   {
                       $role_start = $3;
                   }
               }   
               if ($role_start > 0) {
                   if (time < $role_start) {
                       $active_chk = 'expired';
                   }
               }
               if ($role_end > 0) {
                   if (time > $role_end) {
                       $active_chk = 'expired';
                   }
               }
           }
       }
       return $active_chk;
 }  }
   
 sub CL_autharg { return 0; }  sub CL_autharg { return 0; }
Removed from v.1.4  
changed lines
  Added in v.1.12

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
500 Internal Server Error

Internal Server Error

The server encountered an internal error or misconfiguration and was unable to complete your request.

Please contact the server administrator at root@localhost to inform them of the time this error occurred, and the actions you performed just before this error.

More information about this error may be available in the server error log.