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

Diff for /loncom/enrollment/Enrollment.pm between versions 1.6 and 1.43

version 1.6, 2003/12/09 00:31:51 version 1.43, 2010/08/20 21:44:59
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::loncommon();
   use Apache::lonmsg;
   use Apache::lonlocal;
 use HTML::Entities;  use HTML::Entities;
 use LONCAPA::Configuration;  use LONCAPA::Configuration;
   use Time::Local;
   use lib '/home/httpd/lib/perl';
   
 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,$phototypes) = @_; 
   # Get institutional code and title of this class
       my %courseinfo = ();
       &get_courseinfo($dom,$crs,\%courseinfo);
 # 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;
     my $roster = &Apache::loncoursedata::get_classlist($cid,$dom,$crs);      my $roster = &Apache::loncoursedata::get_classlist($dom,$crs);
     my $cend = &Apache::loncoursedata::CL_END;      my $cend = &Apache::loncoursedata::CL_END;
     my $cstart = &Apache::loncoursedata::CL_START;       my $cstart = &Apache::loncoursedata::CL_START; 
     my $stuid=&Apache::loncoursedata::CL_ID;      my $stuid=&Apache::loncoursedata::CL_ID;
     my $sec=&Apache::loncoursedata::CL_SECTION;      my $sec=&Apache::loncoursedata::CL_SECTION;
     my $status=&Apache::loncoursedata::CL_STATUS;      my $status=&Apache::loncoursedata::CL_STATUS;
     my $type=&Apache::loncoursedata::CL_TYPE;      my $type=&Apache::loncoursedata::CL_TYPE;
       my $lockedtype=&Apache::loncoursedata::CL_LOCKEDTYPE;
     my @localstudents = ();      my @localstudents = ();
       my @futurestudents = ();
       my @activestudents = ();
       my @excludedstudents = ();
     my $currlist;      my $currlist;
     foreach my $uname (keys %{$roster} ) {      foreach my $uname (keys %{$roster} ) {
         if ($uname =~ m/^(.+):$dom$/) {          if ($uname =~ m/^(.+):$dom$/) {
             if ($$roster{$uname}[$status] eq "Active") {              if ($$roster{$uname}[$status] eq "Active") {
                   push @activestudents, $1;
                   @{$$currlist{$1}} = @{$$roster{$uname}};
                 push @localstudents, $1;                  push @localstudents, $1;
               } elsif ( ($$roster{$uname}[$cstart] > time)  && ($$roster{$uname}[$cend] > time || $$roster{$uname}[$cend] == 0 || $$roster{$uname}[$cend] eq '') ) {
                   push @futurestudents, $1;
                 @{$$currlist{$1}} = @{$$roster{$uname}};                  @{$$currlist{$1}} = @{$$roster{$uname}};
                   push @localstudents, $1;
               } elsif ($$roster{$uname}[$lockedtype] == 1) {
                   push @excludedstudents, $1;
             }              }
         }          }
     }      }
     my $linefeed = '';      my $linefeed = '';
     my $addresult = '';      my $addresult = '';
     my $dropresult = '';      my $dropresult = '';
       my $switchresult = '';
       my $photoresult = '';
     if ($context eq "updatenow") {      if ($context eq "updatenow") {
         $linefeed = "</li>\n<li>";           $linefeed = "</li>\n<li>"; 
     } elsif ($context eq "automated") {      } elsif ($context eq "automated") {
Line 39  sub update_LC { Line 85  sub update_LC {
     }      }
     my $enrollcount = 0;      my $enrollcount = 0;
     my $dropcount = 0;      my $dropcount = 0;
       my $switchcount = 0;
   
   # Get role names
       my %longroles = ();
       open(FILE,"<$$configvars{'lonTabDir'}.'/rolesplain.tab");
       my @rolesplain = <FILE>;
       close(FILE);
       foreach my $item (@rolesplain) {
           if ($_ =~ /^(st|ta|ex|ad|in|cc|co):([\w\s]+):?([\w\s]*)/) {
               if ($courseinfo{'type'} eq 'Community') {
                   unless($1 eq 'cc') {
                       $longroles{$1} = $3;
                   }
               } else {
                   unless($1 eq 'co') { 
                       $longroles{$1} = $2;
                   }
               }
           }
       }
   
       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 = ();
Line 55  sub update_LC { Line 123  sub update_LC {
 # Get latest institutional enrollment for this class.  # Get latest institutional enrollment for this class.
     my %allenrolled = ();      my %allenrolled = ();
     my @reg_students = ();      my @reg_students = ();
     my %place = ();      my %place = &place_hash(); 
     $place{'autharg'} = &CL_autharg();  
     $place{'authtype'} = &CL_authtype();  
     $place{'email'} = &CL_email();  
     $place{'enddate'} = &CL_enddate();  
     $place{'firstname'} = &CL_firstname();  
     $place{'generation'} = &CL_generation();  
     $place{'groupID'} = &CL_groupID();  
     $place{'lastname'} = &CL_lastname();  
     $place{'middlename'} = &CL_middlename();  
     $place{'startdate'} = &CL_startdate();  
     $place{'studentID'} = &CL_studentID();  
     my %ucount = ();      my %ucount = ();
     my %enrollinfo = ();      my %enrollinfo = ();
     foreach my $class (@{$classesref}) {      foreach my $class (@{$classesref}) {
Line 86  sub update_LC { Line 143  sub update_LC {
 # Check for multiple sections for a single student   # Check for multiple sections for a single student 
     my @okusers = ();      my @okusers = ();
     foreach my $uname (@reg_students)  {      foreach my $uname (@reg_students)  {
         if (@{$allenrolled{$uname}} > 1) {          if (grep/^$uname$/,@excludedstudents) {
               $$logmsg .= &mt('No re-enrollment for [_1] - user was previously manually unenrolled and locked.',$uname).$linefeed;
           } elsif (@{$allenrolled{$uname}} > 1) {
             my @sections = ();              my @sections = ();
             my $saved;              my $saved;
             for (my $i=0; $i<@{$allenrolled{$uname}}; $i++) {              for (my $i=0; $i<@{$allenrolled{$uname}}; $i++) {
Line 108  sub update_LC { Line 167  sub update_LC {
                 push @okusers, $uname;                  push @okusers, $uname;
             }              }
             elsif (@sections > 1) {              elsif (@sections > 1) {
                 $$logmsg =  "$uname appears in classlists for the more than one section of this course, i.e. in sections: ";                  $$logmsg .=  &mt('[_1] appears in classlists for more than one section of this course, i.e. in sections: ',$uname);
                 foreach (@sections) {                  foreach (@sections) {
                     $$logmsg .= " $_,";                      $$logmsg .= " $_,";
                 }                  }
                 chop($$logmsg);                  chop($$logmsg);
                 $$logmsg .= ". Because of this ambiguity, no enrollment action was taken for this student.".$linefeed;                  $$logmsg .= '. '.&mt('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]};
             push @okusers, $uname;              push @okusers, $uname;
         }          }
     }      }
 # Get mapping of student IDs to usernames for users in institutional data for this class    # Get mapping of student/employee IDs to usernames for users in institutional data for this class  
     my @allINids = ();      my @allINids = ();
     my %unameFromINid = ();      my %unameFromINid = ();
     foreach my $uname (@okusers) {      foreach my $uname (@okusers) {
Line 133  sub update_LC { Line 192  sub update_LC {
             @{$unameFromINid{$stuID}} = $uname;               @{$unameFromINid{$stuID}} = $uname; 
         }          }
     }      }
   
 # Explicitly allow access to creation/modification of students if called as an automated process.  # Explicitly allow access to creation/modification of students if called as an automated process.
     if ($context eq 'automated') {      if ($context eq 'automated') {
         $ENV{'allowed.cst'}='F';          $env{'allowed.cst'}='F';
     }      }
   
 # Compare IDs with existing LON-CAPA enrollment for this class  # Compare IDs with existing LON-CAPA enrollment for this class
Line 143  sub update_LC { Line 203  sub update_LC {
         unless ($uname eq '') {          unless ($uname eq '') {
             my %uidhash=&Apache::lonnet::idrget($dom,$uname);              my %uidhash=&Apache::lonnet::idrget($dom,$uname);
             my @stuinfo = @{$enrollinfo{$uname}};              my @stuinfo = @{$enrollinfo{$uname}};
               my $access = '';
             if (grep/^$uname$/,@localstudents) {              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. StudentID in LON-CAPA system is $uidhash{$uname}; StudentID in institutional data is $stuinfo[ $place{studentID} ]".$linefeed;                           $$logmsg .= &mt('Change in ID for [_1]. StudentID in LON-CAPA system is [_2]; StudentID in institutional data is [_3].',$uname,$uidhash{$uname},$stuinfo[ $place{studentID} ]).$linefeed; 
                     }                      }
                 }                  }
   # Check for switch from manual to auto
                   unless (($$currlist{$uname}[$type] eq "auto") || ($$currlist{$uname}[$lockedtype] eq "1") || (!$adds) ) {
   # drop manually added student
                       my $drop_reply = &Apache::lonnet::modifystudent($dom,$uname,'','','',undef,undef,undef,undef,$$currlist{$uname}[$sec],time,undef,undef,undef,undef,'auto','',$cid,'',$context);
   # re-enroll as auto student
                       if ($drop_reply !~ /^ok/) {
                               $$logmsg .= &mt('An error occured during the attempt to convert [_1] from a manual type to an auto type student - [_2].',$uname,$drop_reply).$linefeed;
                       } else {
   # re-enroll as auto student
                           my ($auth,$authparam,$first,$middle,$last,$gene,$usec,$end,$start,$emailaddr,$pid,$emailenc);
                           &prepare_add($authtype,$autharg,$enddate,$startdate,\@stuinfo,\%place,\$dom,\$uname,\$auth,\$authparam,\$first,\$middle,\$last,\$gene,\$usec,\$end,\$start,\$emailaddr,\$pid,\$emailenc);
                           if ($$currlist{$uname}[$sec] ne $usec) {
                               my $showoldsec = $$currlist{$uname}[$sec];
                               if ($$currlist{$uname}[$sec] eq '') {
                                   $showoldsec = &mt('none');
                               }
                               my $showsec = $usec;
                               if ($usec eq '') {
                                   $showsec = &mt('none');
                               }
                               $switchresult .= &mt("Section for [_1] switched from '[_2]' to '[_3]'.",$uname,$showoldsec,$showsec).$linefeed;
                               if ($context eq 'automated') {
                                   $$logmsg .= &mt("Section switch for [_1] from '[_2]' to '[_3]'.",$uname,$showoldsec,$usec).$linefeed;
                               }
                               $switchcount ++;
                           }
                           &execute_add($context,'switchtype',$uname,$dom,$auth,$authparam,$first,$middle,$last,$gene,$pid,$usec,$end,$start,$emailenc,$cid,\$addresult,\$enrollcount,$linefeed,$logmsg);
                       }
                   } 
 # Check for section changes  # Check for section changes
                 unless ($$currlist{$uname}[$sec] eq $stuinfo[ $place{groupID} ]) {                  if ($$currlist{$uname}[$sec] eq $stuinfo[ $place{groupID} ]) {
   # Check for access date changes for students with access starting in the future.
                       if ( (grep/^$uname$/,@futurestudents) && ($$currlist{$uname}[$type] eq "auto") && ($adds == 1) ) {
                           my $datechange = &datechange_check($$currlist{$uname}[$cstart],$$currlist{$uname}[$cend],$startdate,$enddate);
                           if ($datechange) {
                               my $modify_access_result = &Apache::lonnet::modify_student_enrollment($dom,$uname,undef,undef,undef,undef,undef,$stuinfo[ $place{groupID} ],$enddate,$startdate,'auto','',$cid,'',$context);
                               $access = &showaccess($enddate,$startdate);
                               if ($modify_access_result =~ /^ok/) {
                                   $$logmsg .= &mt('Change in access dates for [_1].',$uname).$access.$linefeed;
                               } else {
                                   $$logmsg .= &mt('Error when attempting to change start and/or end access dates for [_1] in section: [_2] -error [_3].',$uname,$stuinfo[$place{groupID}],$modify_access_result).$linefeed;
                               }
                           }
                       }
                   } else {
                     if ( ($$currlist{$uname}[$type] eq "auto") && ($adds == 1) ) {                      if ( ($$currlist{$uname}[$type] eq "auto") && ($adds == 1) ) {
                         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);  # Delete from roles.db for current section
                         if ($modify_section_result =~ /^ok/) {                          my $expiretime = time;
                             $$logmsg .= "Section for $uname switched from old section: ".$$currlist{$uname}[$sec] ." to new section: ".$stuinfo[ $place{groupID} ].".".$linefeed;                          my $uurl='/'.$cid;
                           $uurl=~s/\_/\//g;
                           if ($$currlist{$uname}[$sec]) {
                               $uurl.='/'.$$currlist{$uname}[$sec];
                           }
                           my $expire_role_result = &Apache::lonnet::assignrole($dom,$uname,$uurl,'st',$expiretime,'','','',$context);
                           if ($expire_role_result eq 'ok') {
                               my $modify_section_result;
                               if (grep/^$uname$/,@activestudents) {
                                   $modify_section_result = &Apache::lonnet::modify_student_enrollment($dom,$uname,undef,undef,undef,undef,undef,$stuinfo[ $place{groupID} ],$$currlist{$uname}[$cend],$$currlist{$uname}[$cstart],'auto','',$cid,'',$context);
                               } else {
                                   $modify_section_result =  &Apache::lonnet::modify_student_enrollment($dom,$uname,undef,undef,undef,undef,undef,$stuinfo[ $place{groupID} ],$enddate,$startdate,'auto','',$cid,'',$context);
                                   $access =  &showaccess($enddate,$startdate);
                               }
                               if ($modify_section_result =~ /^ok/) {
                                   $switchresult .= &mt("Section for [_1] switched from old section: '[_2]' to new section: '[_3]'.",$uname,$$currlist{$uname}[$sec],$stuinfo[ $place{groupID} ]).$access.$linefeed;
                                   if ($context eq 'automated') {
                                       $$logmsg .= &mt('Section switch for [_1] from [_2] to [_3]',$uname,$$currlist{$uname}[$sec],$stuinfo[ $place{groupID} ]).$linefeed;
                                   }
                                   $switchcount ++;
                               } else {
                                   $$logmsg .= &mt("Error when attempting section change for [_1], from old section: '[_2]' to new section: '[_3]' -error: [_4]",$uname,$$currlist{$uname}[$sec],$stuinfo[ $place{groupID} ],$modify_section_result).$linefeed;
                               }
                         } else {                          } else {
                             $$logmsg .= "Error when attempting section change for $uname from old section ".$$currlist{$uname}[$sec]." to new section: ".$stuinfo[ $place{groupID} ]." -error: $modify_section_result".$linefeed;                              $$logmsg .= &mt("Error when attempting to expire role for [_1] in old section: '[_2]' -error: '[_3]'.",$uname,$$currlist{$uname}[$sec],$expire_role_result).$linefeed;
                         }                          }
                     }                      }
                 }                  }
             } else {              } else {
 # 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) {                      foreach my $match ( @{ $unameFromLCid{ $stuinfo[ $place{studentID} ] } }  ) {
                         foreach my $match ( @{ $unameFromLCid{ $stuinfo[ $place{studentID} ] } }  ) {                          $$logmsg .= &mt('A possible change in username has been detected for a student enrolled in this course.').' '.&mt('The existing LON-CAPA classlist contains user: [_1] and student/employee ID: [_2].',$match,$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 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;                              $$logmsg .= &mt('The username [_1] remains in the institutional classlist, but the same student/employee ID is used for new user: [_2] now found in the institutional classlist.',$match,$uname).' '.&mt('You may need to contact your Domain Coordinator to determine how to resolve this issue and whether to move student data files for user: [_1] to [_2].',$match,$uname).' ';
                           } else {
                               unless ($drops == 1) {
                                   $$logmsg .= &mt('This username - [_1] - has been dropped from the institutional classlist, but the student/employee ID of this user is also used by [_2] who now appears in the institutional classlist.',$match,$uname).' '.&mt('You may need to contact your Domain Coordinator to request a move of the student data files for user: [_1] to [_2].',$match,$uname).' ';
                             }                              }
                         }                          }
                           $$logmsg .= &mt('Because of this student/employee ID conflict, the new username - [_1] - has not been added to the LON-CAPA classlist',$uname).$linefeed;
                     }                      }
                 } elsif ($adds == 1) {                  } elsif ($adds == 1) {
 # Add student to LON-CAPA classlist                      my ($auth,$authparam,$first,$middle,$last,$gene,$usec,$end,$start,$emailaddr,$pid,$emailenc);
                     my $auth = $stuinfo[ $place{'authtype'} ];                      &prepare_add($authtype,$autharg,$enddate,$startdate,\@stuinfo,\%place,\$dom,\$uname,\$auth,\$authparam,\$first,\$middle,\$last,\$gene,\$usec,\$end,\$start,\$emailaddr,\$pid,\$emailenc);
                     my $authparam = $stuinfo[ $place{'autharg'} ];  
                     my $first = $stuinfo[ $place{'firstname'} ];  
                     my $middle = $stuinfo[ $place{'middlename'} ];  
                     my $last = $stuinfo[ $place{'lastname'} ];  
                     my $gene = $stuinfo[ $place{'generation'} ];  
                     my $usec = $stuinfo[ $place{'groupID'} ];  
                     my $end = $stuinfo[ $place{'enddate'} ];  
                     my $start = $stuinfo[ $place{'startdate'} ];  
                     my $emailaddr = $stuinfo[ $place{'email'} ];  
                     my $pid = $stuinfo[ $place{'studentID'} ];  
   
 # remove non alphanumeric values from section  
                     $usec =~ s/\W//g;  
   
                     unless ($emailaddr =~/^[^\@]+\@[^\@]+$/) { $emailaddr =''; }  
                     my $emailenc = &HTML::Entities::encode($emailaddr);   
   
 # Use course defaults where entry is absent  
                     if ( ($auth eq '') || (!defined($auth)) ) {  
                         $auth =  $authtype;  
                     }  
                     if ( ($authparam eq '')  || (!defined($authparam)) )  {  
                         $authparam = $autharg;  
                     }  
                     if ($auth =~ m/^krb/) {  
                         $auth .= ":".$authparam;  
                     }  
                     if ( ($end eq '') || (!defined($end)) )  {  
                          $end = $enddate;  
                     }  
                     if ( ($start eq '')  || (!defined($start)) )  {  
                          $start = $startdate;  
                     }  
 # Clean up whitespace  
                     foreach (\$dom,\$uname,\$pid,\$first,\$middle,\$last,\$gene,\$usec) {  
                          $$_ =~ s/(\s+$|^\s+)//g;  
                     }  
   
 # 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 $args = {'auth' => $auth,
                         my $authchk = '';                                      'authparam' => $authparam,
                         unless ($authparam eq '') { $authchk = 'ok'; };                                      'emailenc' => $emailenc,
 # If no account exists and passwords should be generated                                      'udom' => $dom,
                         if ($authtype eq "int") {                                      'uname' => $uname,
                             if ($authparam eq '') {                                      'pid' => $pid,
                                 ($authparam,$create_passwd,$authchk) = &create_password();                                      'first' => $first,
                             }                                      'middle' => $middle,
                         } elsif ($authtype eq "local") {                                      'last' => $last,
                             if ($authparam eq '') {                                      'gene' => $gene,
                                 ($authparam,$create_passwd,$authchk) = &create_password();                                      'usec' => $usec,
                             }                                      'end' => $end,
                         } elsif ($authtype =~ m/^krb/) {                                      'start' => $start,
                             if ($authparam eq '') {                                      'emailaddr' => $emailaddr,
                                 $$logmsg .= "No Kerberos domain was provided for the new user - $uname, so the new student was not enrolled in the course.".$linefeed;                                      'cid' => $cid,
                                 $authchk = 'invalid';                                      'crs' => $crs,
                             }                                      'cdom' => $dom,
                         } else {                                      'context' => $context,
                             $authchk = 'invalid';                                      'linefeed' => $linefeed,
                             $$logmsg .= "An invalid authentication type was provided for the new user - $uname, so the student was not enrolled in the course.".$linefeed;                                      'role' => 'st'
                         }                                     };
                         if ($authchk eq 'ok') {                           my $outcome = &create_newuser($args,$logmsg,$newusermsg,\$enrollcount,\$addresult,\%longroles,\%courseinfo,$context);
 # Now create user.  
                             my $reply=&Apache::lonnet::modifystudent($dom,$uname,$pid,$auth,$authparam,$first,$middle,$last,$gene,$usec,$end,$start,'',undef,$emailaddr,'auto',$cid);  
                             if ($reply eq 'ok') {  
                                 $enrollcount ++;  
                                 $addresult .= "$first $last ($pid) - $uname enrolled in section/group $usec.".$linefeed;  
                                 if ($context eq 'automated') {  
                                     $$logmsg .= "New $dom user $uname added successfully.".$linefeed;  
                                 }  
                                 unless ($emailenc eq '') {  
                                     my %emailHash;  
                                     $emailHash{'critnotification'}  = $emailenc;  
                                     $emailHash{'notification'} = $emailenc;  
                                     my $putresult = &Apache::lonnet::put('environment',\%emailHash,$dom,$uname);  
                                 }  
                                 if ($create_passwd) {  
 # Send e-mail with inital password to new user at $emailaddr  
                                     $$logmsg .= "Initial password -  - sent to ".$emailaddr.$linefeed;  
                                 } else {  
                                     $$logmsg .= $linefeed;  
                                 }  
                             } else {  
                                 $$logmsg .= "An error occurred adding new user $uname - ".$reply.$linefeed;  
                             }  
                         }  
                     } else {                      } else {
 # Get the user's information and authentication                          &execute_add($context,'newstudent',$uname,$dom,$auth,$authparam,$first,$middle,$last,$gene,$pid,$usec,$end,$start,$emailenc,$cid,\$addresult,\$enrollcount,$linefeed,$logmsg);
                         my %userenv = &Apache::lonnet::get('environment',['firstname','middlename','lastname','generation','id','critnotification','notification'],$dom,$uname);                      }
                         my ($tmp) = keys(%userenv);                      if ($courseinfo{'showphoto'}) {
                         if ($tmp =~ /^(con_lost|error)/i) {                          my ($result,$resulttype) = 
                             %userenv = ();                             &Apache::lonnet::auto_checkphotos($uname,$dom,$pid);
                         }                          if ($resulttype) {
 # Get the user's e-mail address                              push(@{$$phototypes{$resulttype}},$uname);
                         if ($userenv{critnotification} =~ m/%40/) {  
                             unless ($emailenc eq $userenv{critnotification}) {  
                                 $$logmsg .= "Current critical notification e-mail - ".$userenv{critnotification}." for $uname is different to e-mail address in Institutional classlist - ".$emailenc.$linefeed;  
                             }  
                         }  
                         if ($userenv{notification} =~ m/%40/) {  
                             unless ($emailenc eq $userenv{critnotification}) {  
                                 $$logmsg .= "Current standard notification e-mail - ".$userenv{notification}." for $uname is different to e-mail address in institutional classlist - ".$emailenc.$linefeed;  
                             }  
                         }                              
                         my $krbdefdom = '';  
                         my $currentauth=&Apache::lonnet::queryauthenticate($uname,$dom);  
                         if ($currentauth=~/^krb(4|5):/) {  
                             $currentauth=~/^krb(4|5):(.*)/;  
                             $krbdefdom=$1;  
                         }  
                         if ($currentauth=~/^krb(4|5):/ ||   
                             $currentauth=~/^unix:/ ||  
                             $currentauth=~/^internal:/ ||  
                             $currentauth=~/^localauth:/) {  
                                  
                         } else {  
                             $$logmsg .= "Invalid authentication method $currentauth for $uname.".$linefeed;    
                         }  
 # Report if authentication methods are different.  
                         if ($currentauth ne $auth ) {  
                             $$logmsg .= "Authentication mismatch for $uname - $currentauth in system, $auth based on information in classlist or default for this course.".$linefeed;  
                         }  
 # Check user data  
                         if ($first  ne $userenv{'firstname'}  ||  
                             $middle ne $userenv{'middlename'} ||  
                             $last   ne $userenv{'lastname'}   ||  
                             $gene   ne $userenv{'generation'} ||  
                             $pid    ne $userenv{'id'} ) {           
 # Make the change(s)  
                             my %changeHash;  
                             $changeHash{'firstname'}  = $first;  
                             $changeHash{'middlename'} = $middle;  
                             $changeHash{'lastname'}   = $last;  
                             $changeHash{'generation'} = $gene;  
                             $changeHash{'id'} = $pid;  
                             my $putresult = &Apache::lonnet::put('environment',\%changeHash,$dom,$uname);  
                             if ($putresult eq 'ok') {  
                                 $$logmsg .= "User information updated for user: $uname prior to enrollment.".$linefeed;  
                             } else {  
                                 $$logmsg .= "There was a problem modifying user data for existing user - $uname -error: $putresult, enrollment will still be attempted.".$linefeed;  
                             }  
                         }  
    
 # Assign the role of student in the course.  
                         my $classlist_reply = &Apache::lonnet::modify_student_enrollment($dom,$uname,$pid,$first,$middle,$last,$gene,$usec,$end,$start,'auto',$cid);  
                         if ($classlist_reply eq 'ok') {  
                             $enrollcount ++;  
                             $addresult .= "$first $last ($pid) - $uname enrolled in section/group $usec.".$linefeed;  
                             if ($context eq 'automated') {  
                                 $$logmsg .= "Existing $dom user $uname enrolled successfully.".$linefeed;  
                             }  
                         } else {  
                             $$logmsg .= "There was a problem updating the classlist db file for user $uname to show the new enrollment -error: $classlist_reply, so no enrollment occurred for this user.".$linefeed;  
                         }                          }
                     }                      }
                 }                  }
             }              }
         }          }
     }      }
       if ($courseinfo{'showphoto'}) {
           if (keys(%{$phototypes})>0) {
               my %lt = &photo_response_types();
               foreach my $type (sort(keys(%{$phototypes}))) {
                   my $numphoto = @{$$phototypes{$type}};
                   if ($numphoto > 0) {
                       if ($context eq 'updatenow') {
                           $photoresult .=  '<br /><b>'.
       &mt('For [_1] students, photos ',$numphoto).
       $lt{$type}.'</b><ul><li>';
                       } else {
                           $photoresult .=  "\n".&mt("For [quant,_1,student], photos ",$numphoto).
       $lt{$type}."\n";
                       }
                       foreach my $user (@{$$phototypes{$type}}) { 
                           $photoresult .= $user.$linefeed;
                       }
                       if ($context eq 'updatenow') {
                           $photoresult = substr($photoresult,0,
         rindex($photoresult,"<li>"));
                           $photoresult .= '</ul><br />';
                       } else {
                           $photoresult .= "\n";
                       }
                   }
               }
           }
       }
   
 # Do drops  # Do drops
     if ( ($drops == 1) && (@reg_students > 0) ) {      if ( ($drops == 1) && (@reg_students > 0) ) {
         foreach my $uname (@localstudents) {          foreach my $uname (@localstudents) {
Line 344  sub update_LC { Line 381  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 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;                              $$logmsg .= &mt('A possible change in username has been detected for a student enrolled in this course.').' '.&mt('The existing LON-CAPA classlist contains user: [_1] and student/employee ID: [_2].',$uname,$$currlist{$uname}[ $place{studentID} ]).' '.&mt('This username has been dropped from the institutional classlist, but the same student/employee ID is used for user: [_1] who still appears in the institutional classlist.',$match).' '.&mt('You may need to move the student data files for user: [_1] to [_2]',$uname,$match).' '.&mt('Because of this, user [_1] has not been dropped from the course.',$uname).$linefeed;
                             push @saved,$uname;                              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,'auto','',$cid,'',$context);
                         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.".$linefeed;                              $$logmsg .= &mt('An error occured during the attempt to expire the [_1] from the old section [_2] - [_3].',$uname,$$currlist{$uname}[$sec],$drop_reply).$linefeed;
                         } 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.' '.&mt("dropped from section: '[_1]'.",$$currlist{$uname}[$sec]).$linefeed; 
                               if ($context eq 'automated') {
                                   $$logmsg .= &mt('User [_1] student role expired from course.',$uname).$linefeed;
                               }
                         }                          }
                     }                      }
                 }                  }
Line 364  sub update_LC { Line 404  sub update_LC {
   
 # Terminated explictly allowed access to student creation/modification  # Terminated explictly allowed access to student creation/modification
     if ($context eq 'automated') {      if ($context eq 'automated') {
         delete($ENV{'allowed.cst'});          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 = 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 = &mt("The following [quant,_1,student was,students were] added to this LON-CAPA course:",$enrollcount).'<br/><ul><li>'.$addresult.'</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 = &mt("The following [quant,_1,student was,students were] added to this LON-CAPA course:",$enrollcount)."\n\n".$addresult."\n\n";
         }                }
     }      }
     if ($dropcount > 0) {      if ($dropcount > 0) {
         if ($context eq "updatenow") {          if ($context eq "updatenow") {
             $dropresult = substr($dropresult,0,rindex($dropresult,"<li>"));              $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 = &mt("The following [quant,_1,student was,students were] expired from this LON-CAPA course:",$dropcount).'<br/><ul><li>'.$dropresult.'</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 = &mt("The following [quant,_1,student was,students were] expired from this LON-CAPA course:",$dropcount)."\n\n".$dropresult."\n\n";
           }
       }
       if ($switchcount > 0) {
           if ($context eq "updatenow") {
               $switchresult = substr($switchresult,0,rindex($switchresult,"<li>"));
               $switchresult = &mt("The following [quant,_1,student] switched sections in this LON-CAPA course:",$switchcount).'<br/><ul><li>'.$switchresult.'</ul><br/><br/>';
           } else {
               $switchresult = &mt("The following [quant,_1,student] switched sections in this LON-CAPA course:",$switchcount)."\n\n".$switchresult."\n\n";
         }          }
     }      }
     if ( ($adds) && ($enrollcount == 0) ) {      if ( ($adds) && ($enrollcount == 0) ) {
         $addresult = "There were no new students to add to the course.";          $addresult = &mt('There were no new students to add to the course.');
         if ($context eq "updatenow") {          if ($context eq "updatenow") {
             $addresult .="<br/><br/>";              $addresult .="<br/><br/>";
         } else {          } else {
Line 391  sub update_LC { Line 439  sub update_LC {
         }          }
     }      }
     if ( ($drops) && ($dropcount == 0) ) {      if ( ($drops) && ($dropcount == 0) ) {
         $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.";          $dropresult = &mt('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.');
         if ($context eq "updatenow") {          if ($context eq "updatenow") {
             $dropresult .="<br/>";              $dropresult .="<br/>";
         } else {          } else {
             $dropresult .="\n";              $dropresult .="\n";
         }          }
     }      }
     my $changecount = $enrollcount + $dropcount;      my $changecount = $enrollcount + $dropcount + $switchcount;
     return ($changecount,$addresult.$dropresult);       return ($changecount,$addresult.$photoresult.$dropresult.$switchresult);
   }
   
   sub create_newuser {
       my ($args,$logmsg,$newusermsg,$enrollcount,$addresult,$longroles,
    $courseinfo,$called_context) = @_;
       my $auth = $args->{'auth'};
       my $authparam = $args->{'authparam'};
       my $emailenc = $args->{'emailenc'};
       my $udom = $args->{'udom'};
       my $uname = $args->{'uname'};
       my $pid = $args->{'pid'};
       my $first = $args->{'first'};
       my $middle = $args->{'middle'};
       my $last = $args->{'last'} ;
       my $gene = $args->{'gene'};
       my $usec = $args->{'usec'};
       my $end = $args->{'end'};
       my $start = $args->{'start'};
       my $emailaddr = $args->{'emailaddr'};
       my $cid = $args->{'cid'};
       my $crs = $args->{'crs'};
       my $cdom = $args->{'cdom'};
       my $context = $args->{'context'};
       my $linefeed = $args->{'linefeed'};
       my $role = $args->{'role'};
       my $create_passwd = 0;
       my $authchk = '';
       my $outcome;
       unless ($authparam eq '') { $authchk = 'ok'; };
   # If no account exists and passwords should be generated
       if ($auth eq "internal") {
           if ($authparam eq '') {
               $authparam = &create_password();
               if ($authparam eq '') {
                   $authchk = '';
               } else {
                   $create_passwd = 1;
                   $authchk = 'ok';
               }
           }
       } elsif ($auth eq "localauth") {
           ($authparam,$create_passwd,$authchk) = &Apache::lonnet::auto_create_password($crs,$cdom,$authparam,$udom);
       } elsif ($auth =~ m/^krb/) {
           if ($authparam eq '') {
               $$logmsg .= &mt('No Kerberos domain was provided for the new user - [_1], so the new user was not enrolled in the course',$uname).$linefeed;
               $authchk = 'invalid';
           }
       } else {
           $authchk = 'invalid';
           $$logmsg .= &mt('An invalid authentication type was provided for the new user - [_1], so the user was not enrolled in the course.',$uname).$linefeed;
       }
       if ($authchk eq 'ok') {
   # Now create user.
           my $type = 'auto';
           my $userurl = '/'.$cdom.'/'.$crs;
           if ($usec ne '') {
               $userurl .= '/'.$usec;
           }
           if ($context eq 'createowner' || $context eq 'createcourse') {
               my $result = &Apache::lonnet::modifyuser($udom,$uname,$pid,$auth,$authparam,$first,$middle,$last,$gene,'1',undef,$emailaddr);
               if ($result eq 'ok' && $context eq 'createcourse') {
                   $outcome = &Apache::loncommon::commit_standardrole($udom,$uname,$userurl,$role,$start,$end,$cdom,$crs,$usec,$called_context);
                   unless ($outcome =~ /^Error:/) {
                       $outcome = 'ok';
                   }
               } else {
                   $outcome = $result;
               }
           } else {
               $outcome=&Apache::lonnet::modifystudent($udom,$uname,$pid,$auth,$authparam,$first,$middle,$last,$gene,$usec,$end,$start,'',undef,$emailaddr,'auto','',$cid,'',$called_context);
           }
           if ($outcome eq 'ok') {
               my $access = &showaccess($end,$start);
               my $showsec = $usec;
               if ($usec eq '') {
                   $showsec = &mt('none');
               }
               $$addresult .= "$first $last ($pid) - $uname ".&mt("enrolled in section: '[_1]'.",$showsec).$access.$linefeed;
               unless ($context eq 'createowner' || $context eq 'createcourse') {
                   $$enrollcount ++;
               }
               if ($called_context eq 'automated') {
                   $$logmsg .= &mt('New [_1] user [_2] added successfully.',$udom,$uname);
               }
               unless ($emailenc eq '' || $context eq 'createowner' || $context eq 'createcourse') {
                   my %emailHash;
                   $emailHash{'critnotification'}  = $emailenc;
                   $emailHash{'notification'} = $emailenc;
                   $emailHash{'permanentemail'} = $emailenc;
                   my $putresult = &Apache::lonnet::put('environment',\%emailHash,$udom,$uname);
               }
               if ($create_passwd) {
   # Send e-mail with initial password to new user at $emailaddr.
   # If e-mail address is invalid, send password via message to courseowner i
   # (if automated call) or to user if roster update.
                   if ($emailaddr eq '') {
                       $$newusermsg .= &mt(' username: [_1], password: [_2]',$uname,$authparam).$linefeed."\n";
                   } else {
                       my $subject = &mt('New LON-CAPA account');
                       my $body;
                       my $portalurl = 'http://'.$ENV{'SERVER_NAME'};
                       my $protocol = 'http';
                       my $lonhost=&Apache::lonnet::domain($udom,'primary');
                       if ($lonhost ne '') {
                           my $ip = &Apache::lonnet::get_host_ip($lonhost);
                           if ($Apache::lonnet::protocol{$lonhost} eq 'https') {
                               $protocol = 'https';
                           }
                           if ($ip ne '') {
                               $portalurl = $protocol.'://'.$ip
                           }
                       }
                       if ($context eq 'createowner') {
                           $body = &mt('A user account has been created for you while creating your new course in the LON-CAPA course management and online homework system.')."\n\n".&mt('You should log-in to the system using the following credentials:')."\n".&mt('username: ').$uname."\n".&mt('password: ').$authparam."\n\n".&mt('The URL you should use to access the LON-CAPA system at your institution is: ').$portalurl."\n\n";
                       } elsif ($context eq 'createcourse') {
                           $body = &mt('You have been assigned the role of [_1] in a new course: [_2] - [_3] in the LON-CAPA course management and online homework system.',$$longroles{$role},$$courseinfo{'description'},$$courseinfo{'inst_code'}).' '.&mt('As you did not have an existing user account in the system, one has been created for you.')."\n\n".&mt("You should log-in to the system using the following credentials:\nusername: [_1]\npassword: [_2]",$uname,$authparam)."\n\n".&mt('The URL you should use to access the LON-CAPA system at your institution is: ').$portalurl."\n\n"; 
                       } else {
                           my $access_start = 'immediately';
                           if ($start > 0) {
                               $access_start = localtime($start)
                           }
                           $body = &mt('You have been enrolled in the LON-CAPA system at your institution, because you are a registered student in a class which is using the LON-CAPA couse management and online homework system.')."\n\n".&mt("You should log-in to the system using the following credentials:\nusername: [_1]\npassword: [_2]",$uname,$authparam)."\n\n".&mt('The URL you should use to access the LON-CAPA system at your institution is: ').$portalurl."\n\n".&mt('When you log-in you will be able to access the LON-CAPA course for [_1] - [_2] starting [_3].',$$courseinfo{'description'},$$courseinfo{'inst_code'},$access_start)."\n";
                       }
                       &Apache::lonmsg::sendemail($emailaddr,$subject,$body);
                   }
                   if ($called_context eq 'automated') {
                       $$logmsg .= &mt(' Initial password - sent to ').$emailaddr.$linefeed;
                   }
               } else {
                   if ($called_context eq 'automated') {
                       $$logmsg .= $linefeed;
                   }
               }
           } else {
               $$logmsg .= &mt('An error occurred adding new user [_1] - [_2].',$uname,$outcome).$linefeed;
           }
       } else {
           $$logmsg .= &mt('An error occurred adding the new user [_1] because the authcheck failed for authtype [_2] and parameter [_3].',$uname,$auth,$authparam).' '.&mt('The authcheck response was [_1].',$authchk).$linefeed;
       }
       return $outcome;
   }
   
   sub prepare_add {
       my ($authtype,$autharg,$enddate,$startdate,$stuinfo,$place,$dom,$uname,$auth,$authparam,$first,$middle,$last,$gene,$usec,$end,$start,$emailaddr,$pid,$emailenc) = @_;
       $$auth = $$stuinfo[ $$place{'authtype'} ];
       $$authparam = $$stuinfo[ $$place{'autharg'} ];
       $$first = $$stuinfo[ $$place{'firstname'} ];
       $$middle = $$stuinfo[ $$place{'middlename'} ];
       $$last = $$stuinfo[ $$place{'lastname'} ];
       $$gene = $$stuinfo[ $$place{'generation'} ];
       $$usec = $$stuinfo[ $$place{'groupID'} ];
       $$end = $$stuinfo[ $$place{'enddate'} ];
       $$start = $$stuinfo[ $$place{'startdate'} ];
       $$emailaddr = $$stuinfo[ $$place{'email'} ];
       $$pid = $$stuinfo[ $$place{'studentID'} ];
                                                                                     
   # remove non alphanumeric values from section
       $$usec =~ s/\W//g;
                                                                                     
       unless ($$emailaddr =~/^[^\@]+\@[^\@]+$/) { $$emailaddr =''; }
       $$emailenc = &HTML::Entities::encode($$emailaddr,'<>&"');
                                                                                     
   # Use course defaults where entry is absent
       if ( ($$auth eq '') || (!defined($$auth)) ) {
           $$auth =  $authtype;
       }
       if ( ($$authparam eq '')  || (!defined($$authparam)) )  {
           $$authparam = $autharg;
       }
       if ( ($$end eq '') || (!defined($$end)) )  {
           $$end = $enddate;
       }
       if ( ($$start eq '')  || (!defined($$start)) )  {
           $$start = $startdate;
       }
   # Clean up whitespace
       foreach ($dom,$uname,$pid,$first,$middle,$last,$gene,$usec) {
           $$_ =~ s/(\s+$|^\s+)//g;
       }
       return;
   }
   
   sub execute_add {
       my ($context,$caller,$uname,$dom,$auth,$authparam,$first,$middle,$last,$gene,$pid,$usec,$end,$start,$emailenc,$cid,$addresult,$enrollcount,$linefeed,$logmsg) = @_;
   # Get the user's information and authentication
       my %userenv = &Apache::lonnet::get('environment',['firstname','middlename','lastname','generation','id','critnotification','notification','permanentemail'],$dom,$uname);
       my ($tmp) = keys(%userenv);
       if ($tmp =~ /^(con_lost|error)/i) {
           %userenv = ();
       }
   # Get the user's e-mail address
       if ($userenv{critnotification} =~ m/%40/) {
           unless ($emailenc eq $userenv{critnotification}) {
               $$logmsg .= &mt('Current critical notification e-mail - [_1] for [_2] is different to e-mail address in institutional classlist - [_3].',
                              $userenv{critnotification},$uname,$emailenc).
                           $linefeed;
           }
       }
       if ($userenv{notification} =~ m/%40/) {
           unless ($emailenc eq $userenv{notification}) {
               $$logmsg .= &mt('Current standard notification e-mail - [_1] for [_2] is different to e-mail address in institutional classlist - [_3].',
                               $userenv{notification},$uname,$emailenc).
                           $linefeed;
           }
       }
       if ($userenv{permanentemail} =~ m/%40/) {
           unless ($emailenc eq $userenv{permanentemail}) {
               $$logmsg .= &mt('Current permanent e-mail
   - [_1] for [_2] is different to e-mail address in institutional classlist - [_3]',$userenv{permanentemail},$uname,$emailenc).$linefeed;
           }
       }
       my $krbdefdom = '';
       my $currentauth=&Apache::lonnet::queryauthenticate($uname,$dom);
       if ($currentauth=~/^(krb[45]):(.*)/) {
           $currentauth = $1;
           $krbdefdom = $2;
       } elsif ($currentauth=~ /^(unix|internal|localauth):/) {
           $currentauth = $1;
       } else {
           $$logmsg .= &mt('Invalid authentication method [_1] for [_2].',$currentauth,$uname).$linefeed;
       }
   # Report if authentication methods are different.
       if ($currentauth ne $auth) {
           $$logmsg .= &mt("Authentication type mismatch for [_1] - '[_2]' in system, '[_3]' based on information in classlist or default for this course.",$uname,$currentauth,$auth).$linefeed;
       } elsif ($auth =~ m/^krb/) {
           if ($krbdefdom ne $authparam) {
               $$logmsg .= &mt("Kerberos domain mismatch for [_1] - '[_2]' in system, '[_3]' based on information in classlist or default for this course.",$uname,$krbdefdom,$authparam).$linefeed;
           }
       }
                                                                                     
   # Check user data
       if ($first  ne $userenv{'firstname'}  ||
           $middle ne $userenv{'middlename'} ||
           $last   ne $userenv{'lastname'}   ||
           $gene   ne $userenv{'generation'} ||
           $pid    ne $userenv{'id'} ||
           $emailenc ne $userenv{'permanentemail'} ) {
   # Make the change(s)
           my %changeHash;
           $changeHash{'firstname'}  = $first;
           $changeHash{'middlename'} = $middle;
           $changeHash{'lastname'}   = $last;
           $changeHash{'generation'} = $gene;
           $changeHash{'id'} = $pid;
           $changeHash{'permanentemail'} = $emailenc;
           my $putresult = &Apache::lonnet::put('environment',\%changeHash,$dom,$uname);
           if ($putresult eq 'ok') {
               $$logmsg .= &mt('User information updated for user: [_1] prior to enrollment.',$uname).$linefeed;
           } else {
               $$logmsg .= &mt('There was a problem modifying user data for existing user - [_1] -error: [_2], enrollment will still be attempted.',$uname,$putresult).$linefeed;
           }
       }
                                                                                     
   # Assign the role of student in the course.
       my $classlist_reply = &Apache::lonnet::modify_student_enrollment($dom,$uname,$pid,$first,$middle,$last,$gene,$usec,$end,$start,'auto','',$cid,'',$context);
       if ($classlist_reply eq 'ok') {
           my $access = &showaccess($end,$start);
           my $showsec = $usec;
           if ($usec eq '') {
               $showsec = &mt('none');
           }
           if ($caller eq 'switchtype') {
               $$logmsg .= &mt("Existing user [_1] detected in institutional classlist - switched from 'manual' to 'auto' enrollment in section [_2].",$uname,$showsec).$access.$linefeed;
           } elsif ($caller eq 'newstudent') {
               $$enrollcount ++;
               $$addresult .= "$first $last ($pid) - $uname ".&mt("enrolled in section '[_1]'.",$showsec).$access.$linefeed;
           }
           if ($context eq 'automated') {
               $$logmsg .= &mt('Existing [_1] user [_2] enrolled successfully.',$dom,$uname).$linefeed;
           }
       } else {
              $$logmsg .= &mt('There was a problem updating the classlist db file for user [_1] to show the new enrollment -error: [_2], so no enrollment occurred for this user.',$uname,$classlist_reply).$linefeed;
       }
       return;
   }
   
   sub datechange_check {
       my ($oldstart,$oldend,$startdate,$enddate) = @_;
       my $datechange = 0;
       unless ($oldstart eq $startdate) {
           $datechange = 1;
       }
       if (!$datechange) {
           if (!$oldend) {
               if ($enddate) {
                   $datechange = 1;
               }
           } elsif ($oldend ne $enddate) {
               $datechange = 1;
           }
       }
       return $datechange;
   }
   
   sub showaccess {
       my ($end,$start) = @_;
       my $showstart;
       my $showend;
       if ( (!$start) || ($start <= time) ) {
           $showstart = 'immediately';
       } else {
           $showstart = &Apache::lonlocal::locallocaltime($start);
       }
       if (!$end) {
           $showend = 'no end date';
       } else {
           $showend = &Apache::lonlocal::locallocaltime($end);
       }
       my $access_msg = ' '.&mt('Access starts: [_1], ends: [_2].',$showstart,$showend);
       return $access_msg;
 }  }
   
 sub parse_classlist {  sub parse_classlist {
Line 407  sub parse_classlist { Line 765  sub parse_classlist {
     my $xmlfile = $tmpdir."/tmp/".$dom."_".$crs."_".$class."_classlist.xml";      my $xmlfile = $tmpdir."/tmp/".$dom."_".$crs."_".$class."_classlist.xml";
     my $uname = '';      my $uname = '';
     my @state;      my @state;
     my @items = ('autharg','authtype','email','enddate','firstname','generation','lastname','middlename','startdate','studentID');      my @items = ('autharg','authtype','email','firstname','generation','lastname','middlename','studentID');
     my $p = HTML::Parser->new      my $p = HTML::Parser->new
     (      (
         xml_mode => 1,          xml_mode => 1,
Line 417  sub parse_classlist { Line 775  sub parse_classlist {
                  push @state, $tagname;                   push @state, $tagname;
                  if ("@state" eq "students student") {                   if ("@state" eq "students student") {
                      $uname = $attr->{username};                       $uname = $attr->{username};
                        $$studentsref{$uname}[ $$placeref{'groupID'} ] = $groupID;
                  }                   }
             }, "tagname, attr"],              }, "tagname, attr"],
          text_h =>           text_h =>
              [sub {               [sub {
                  my ($text) = @_;                   my ($text) = @_;
                  if ("@state" eq "students student groupID") {                   if ("@state" eq "students student startdate") {
                      $$studentsref{$uname}[ $$placeref{'groupID'} ] = $groupID;                       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 {                   } else {
                      foreach my $item (@items) {                       foreach my $item (@items) {
                          if ("@state" eq "students student $item") {                           if ("@state" eq "students student $item") {
Line 441  sub parse_classlist { Line 810  sub parse_classlist {
                                                                                                                                                                                                                             
     $p->parse_file($xmlfile);      $p->parse_file($xmlfile);
     $p->eof;      $p->eof;
 #    if (-e "$xmlfile") {      if (-e "$xmlfile") {
 #        unlink $xmlfile;          unlink $xmlfile;
 #    }      }
     return;      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]);
       }
       return $timestamp;
   }
   
 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 get_courseinfo {
       my ($dom,$crs,$courseinfo) = @_;
       my $owner;
       if (defined($dom) && defined($crs)) {
           my %settings = &Apache::lonnet::get('environment',['internal.coursecode','internal.showphoto','description'],$dom,$crs);
           if ( defined($settings{'internal.coursecode'}) ) {
               $$courseinfo{'inst_code'} = $settings{'internal.coursecode'};
           }
           if ( defined($settings{'description'}) ) {
               $$courseinfo{'description'} = $settings{'description'};
           }
           if ( defined($settings{'internal.showphoto'}) ) {
               $$courseinfo{'showphoto'} = $settings{'internal.showphoto'};
           }
       }
       return;
   }
   
   sub place_hash {
       my %place = (
                     autharg   => 0,
                     authtype  => 1,
                     email     => 2,
                     enddate   => 3,
                     firstname => 4,
                     generation => 5,
                     groupID    => 6,
                     lastname   => 7,
                     middlename => 8,
                     startdate  => 9,
                     studentID  => 10,
                   );
       return %place;
   }
   
   sub photo_response_types {
       my %lt = &Apache::lonlocal::texthash(
                         'same' => 'remained unchanged',
                         'update' => 'were updated',
                         'new' => 'were added',
                         'missing' => 'were missing',
                         'error' => 'were not imported because an error occurred',
                         'nouser' => 'were for users without accounts',
                         'noid' => 'were for users without student/employee IDs',
    );
       return %lt;
 }  }
   
 sub CL_autharg { return 0; }  
 sub CL_authtype { return 1;}  
 sub CL_email { return 2;}  
 sub CL_enddate { return 3;}  
 sub CL_firstname { return 4;}  
 sub CL_generation { return 5;}  
 sub CL_groupID { return 6;}  
 sub CL_lastname { return 7;}  
 sub CL_middlename { return 8;}  
 sub CL_startdate { return 9; }  
 sub CL_studentID { return 10; }  
   
 1;  1;
Removed from v.1.6  
changed lines
  Added in v.1.43

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.