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

Diff for /loncom/enrollment/Enrollment.pm between versions 1.1 and 1.55

version 1.1, 2003/12/05 17:04:37 version 1.55, 2021/09/08 12:13:13
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 XML::Simple;  use HTML::Parser;
 use LONCAPA::Configuration;  use LONCAPA::Configuration;
   use Math::Random;
   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,
           $showcredits,$defaultcredits,$autofailsafe,$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 $credidx=&Apache::loncoursedata::CL_CREDITS;
       my $instidx = &Apache::loncoursedata::CL_INSTSEC;
     my @localstudents = ();      my @localstudents = ();
       my @futurestudents = ();
       my @activestudents = ();
       my @excludedstudents = ();
     my $currlist;      my $currlist;
       my $now = time;
     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 40  sub update_LC { Line 92  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 56  sub update_LC { Line 130  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 = ();
       my %classcount;
     foreach my $class (@{$classesref}) {      foreach my $class (@{$classesref}) {
         my %enrolled = ();          my %enrolled = ();
         &parse_classlist($$configvars{'lonDaemons'},$dom,$crs,$class,\%place,$$groupref{$class},\%enrolled);          &parse_classlist($$configvars{'lonDaemons'},$dom,$crs,$class,\%place,$$groupref{$class},\%enrolled);
           $classcount{$class} = scalar(keys(%enrolled));
         foreach my $uname (sort keys %enrolled ) {          foreach my $uname (sort keys %enrolled ) {
             if (!grep/^$uname$/,@reg_students) {              if (!grep/^$uname$/,@reg_students) {
                 push @reg_students,$uname;                  push @reg_students,$uname;
Line 87  sub update_LC { Line 152  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 109  sub update_LC { Line 176  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 .=  &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 .= " No automated enrollment action taken for this student.\n";                  $$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 = ();
     foreach my $uname (@okusers) {      foreach my $uname (@okusers) {
         $enrollinfo{$uname}[ $place{'studentID'} ] =~ tr/A-Z/a-z/;          $enrollinfo{$uname}[ $place{'studentID'} ] =~ tr/A-Z/a-z/;
         my $stuID = $enrollinfo{$uname}[ $place{'studentID'} ];          my $stuID = $enrollinfo{$uname}[ $place{'studentID'} ];
Line 133  sub update_LC { Line 201  sub update_LC {
             @{$unameFromINid{$stuID}} = $uname;               @{$unameFromINid{$stuID}} = $uname; 
         }          }
     }      }
   
   # Explicitly allow access to creation/modification of students and group membership changes 
   # when called as an automated process.
       if ($context eq 'automated') {
           $env{'allowed.cst'}='F';
           $env{'allowed.mdg'}='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}};
 # Check for studentID changes              my ($access,$added,$inststatus,$instsec);
             if ( ($uidhash{$uname}) && ($uidhash{$uname} !~ /error\:/) )  {              my $credits;
                 unless ( ($uidhash{$uname}) eq ($stuinfo[ $place{studentID} ]) ) {              if ($showcredits) {
                     $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";                   $credits = $stuinfo[$place{'credits'}];
                   $credits =~ s/[^\d\.]//g;
                   if ($credits eq $defaultcredits) {
                       undef($credits);
                 }                  }
             }              }
               $inststatus = $stuinfo[$place{inststatus}];
               $instsec = $stuinfo[$place{instsec}];
               if (grep/^$uname$/,@localstudents) {
   # Check for studentID changes
                   if ( ($uidhash{$uname}) && ($uidhash{$uname} !~ /error\:/) )  {
                       unless ( ($uidhash{$uname}) eq ($stuinfo[ $place{studentID} ]) ) {
                           $$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 occurred 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,
                                        $credits,$instsec,$cid,\$addresult,\$enrollcount,
                                        $linefeed,$logmsg);
                           $added = 1;
                       }
                   }
 # Check for section changes  # Check for section changes
             unless ($$currlist{$uname}[$sec] eq $stuinfo[ $place{groupID} ]) {                  if ($$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";  # Check for access date changes for students with access starting in the future.
                 if ($$currlist{$uname}[$type] eq "auto") {                      if ( (grep/^$uname$/,@futurestudents) && ($$currlist{$uname}[$type] eq "auto") && ($adds == 1) ) {
                     my $modify_section_result = &Apache::lonnet::modifystudent($dom,$uname,'','','',undef,undef,undef,undef,$$currlist{$uname}[$sec],$nowtime,undef,undef,undef,undef,'auto',$cid);                          my $datechange = &datechange_check($$currlist{$uname}[$cstart],$$currlist{$uname}[$cend],$startdate,$enddate);
                     if ($modify_section_result !~ /^ok/) {                          if ($datechange) {
                         $logmsg .= "An error occured during the attempt to expire the $uname from the old section $$currlist{$uname}[$sec] - $modify_section_result\n";                              my $modify_access_result = &Apache::lonnet::modify_student_enrollment($dom,$uname,undef,undef,undef,undef,undef,$stuinfo[ $place{groupID} ],$enddate,$startdate,'auto','',$cid,'',$context,$credits,$instsec);
                               $access = &showaccess($enddate,$startdate);
                               if ($modify_access_result =~ /^ok/) {
                                   $$logmsg .= &mt('Change in access dates for [_1].',$uname).$access.$linefeed;
                                   $added = 1;
                               } 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 {
 # Assign the role of student in the new section                      if ( ($$currlist{$uname}[$type] eq "auto") && ($adds == 1) ) {
                     my $uurl='/'.$cid;  # Delete from roles.db for current section
                     $uurl=~s/\_/\//g;                          my $expiretime = time;
                     if ($stuinfo[ $place{groupID} ]) {                          my $uurl='/'.$cid;
                         $uurl.='/'.$stuinfo[ $place{groupID} ];                          $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,$credits,$instsec);
                               } else {
                                   $modify_section_result =  &Apache::lonnet::modify_student_enrollment($dom,$uname,undef,undef,undef,undef,undef,$stuinfo[ $place{groupID} ],$enddate,$startdate,'auto','',$cid,'',$context,$credits,$instsec);
                                   $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;
                                   $added = 1;
                                   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 {
                               $$logmsg .= &mt("Error when attempting to expire role for [_1] in old section: '[_2]' -error: '[_3]'.",$uname,$$currlist{$uname}[$sec],$expire_role_result).$linefeed;
                           }
                     }                      }
                     my $newend = $stuinfo[ $place{enddate} ];                  }
                     my $newstart = $stuinfo[ $place{startdate} ]);  # Check for credits changes
                     if ($newend eq '') {                  if (($showcredits) && 
                         $end = $enddate;                      ($$currlist{$uname}[$credidx] ne $credits) && (!$added)) {
                       my $modify_credits_result =
                           &Apache::lonnet::modify_student_enrollment($dom,$uname,undef,undef,undef,undef,undef,$stuinfo[ $place{groupID} ],$enddate,$startdate,'auto','',$cid,'',$context,$credits,$instsec);
                       if ($modify_credits_result =~ /^ok/) {
                           if ($credits ne '') {
                               $$logmsg .= &mt('Credits change for [_1] from [_2] to [_3].',$uname,$$currlist{$uname}[$credidx],$credits).$linefeed;
                           } else {
                               $$logmsg .= &mt('Credits change for [_1] from [_2] to course default [_3].',$uname,$$currlist{$uname}[$credidx],$defaultcredits).$linefeed;
                           }
                       } else {
                           $$logmsg .= &mt('Error when attempting to change credits for [_1] in section: [_2] -error [_3].',$uname,$stuinfo[$place{groupID}],$modify_credits_result).$linefeed;
                     }                      }
                     if ($newstart eq '') {                  }
                         $start = $startdate;  # Check for institutional section change
                   if (($$currlist{$uname}[$instidx] ne $instsec) && (!$added) && ($$currlist{$uname}[$type] eq "auto")) {
                       my $modify_instsec_result =
                           &Apache::lonnet::modify_student_enrollment($dom,$uname,undef,undef,undef,undef,undef,$stuinfo[ $place{groupID} ],$enddate,$startdate,'auto','',$cid,'',$context,$credits,$instsec);
                       if ($modify_instsec_result =~ /^ok/) {
                           $$logmsg .= &mt('Institutional section change for [_1] from [_2] to [_3].',$uname,$$currlist{$uname}[$instidx],$instsec).$linefeed;
                       } else {
                           $$logmsg .= &mt('Error when attempting to change institutional section for [_1] in section: [_2] -error [_3].',$uname,$stuinfo[$place{groupID}],$modify_instsec_result).$linefeed;
                     }                      }
                     &Apache::lonnet::assignrole($dom,$uname,$uurl,"st",$newend,$newstart);   
                 }                  }
             }              } 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) {  
                     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 $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 .= &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) {                      my ($auth,$authparam,$first,$middle,$last,$gene,$usec,$end,$start,$emailaddr,$pid,$emailenc,$credithours);
 # Add student to LON-CAPA classlist                      &prepare_add($authtype,$autharg,$enddate,$startdate,\@stuinfo,\%place,\$dom,\$uname,\$auth,\$authparam,\$first,\$middle,\$last,\$gene,\$usec,\$end,\$start,\$emailaddr,\$pid,\$emailenc);
                 my $auth = $stuinfo[ $place{'authtype'} ];  
                 my $authparam = $stuinfo[ $place{'autharg'} ];  
                 my $first = $stuinfo[ $place{'firstname'} ];  
                 my $middle = $stuinfo[ $place{'middlename'} ];  
                 my $last = $stuinfo[ $place{'lastname'} ];  
                 my $gene = $stuinfo[ $place{'generation'} ];  
                 my $usec = $stuinfo[ $place{'groupID'} ];  
                 my $end = $stuinfo[ $place{'enddate'} ];  
                 my $start = $stuinfo[ $place{'startdate'} ];  
                 my $emailaddr = $stuinfo[ $place{'email'} ];  
                 my $pid = $stuinfo[ $place{'studentID'} ];  
   
 # remove non alphanumeric values from section  
                 $usec =~ s/\W//g;  
   
                 unless ($emailaddr =~/^[^\@]+\@[^\@]+$/) { $emailaddr =''; }  
                 my $emailenc = &HTML::Entities::encode($emailaddr);   
   
 # Use course defaults where entry is absent  
                 if ($auth eq '') {  
                     $auth =  $authtype;  
                 }  
                 if ($authparam eq '') {  
                     $authparam = $autharg;  
                 }  
                 if ($end eq '') {  
                     $end = $enddate;  
                 }  
                 if ($start eq '') {  
                     $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);                      next if (($end) && ($end < $now));
                 if ($uhome eq 'no_host') { # User does not exist                      my $uhome=&Apache::lonnet::homeserver($uname,$dom);
                     $create_passwd = 0;                      if ($uhome eq 'no_host') { # User does not exist
                     if ($passwd eq '') {                          my $args = {'auth' => $auth,
 # If no account exists and passwords should be generated                                      'authparam' => $authparam,
                         if (($authtype eq "int") || ($authtype eq "loc")) {                                      'emailenc' => $emailenc,
                             ($passwd,$create_passwd) = &create_password($authtype); }                                      'udom' => $dom,
                         } elsif ($authtype =~ m/^krb/) {                                      'uname' => $uname,
                             $passwd = $autharg;                                      'pid' => $pid,
                         } else {                                      'first' => $first,
                             $logmsg .= "Invalid authentication type for $uname in $crs\n";                                      'middle' => $middle,
                         }                                        'last' => $last,
                     }                                      'gene' => $gene,
 # Now create user.                                      'usec' => $usec,
                     my $reply=&Apache::lonnet::modifystudent($dom,$uname,$pid,$auth,$authparam,$first,$middle,$last,$gene,$usec,$end,$start,'',undef,$emailaddr,'auto',$cid);                                      'end' => $end,
                     if ($reply eq 'ok') {                                      'start' => $start,
                         $enrollcount ++;                                      'emailaddr' => $emailaddr,
                         $addresult .= "$first $last ($pid) - $uname enrolled in section/group $usec.".$linefeed;                                      'cid' => $cid,
                         $logmsg .= "New user $uname added successfully. ";                                      'crs' => $crs,
                         unless ($emailenc eq '') {                                      'cdom' => $dom,
                             my %emailHash;                                      'context' => $context,
                             $emailHash{'critnotification'}  = $emailenc;                                      'linefeed' => $linefeed,
                             $emailHash{'notification'} = $emailenc;                                      'inststatus' => $inststatus,
                             my $putresult = &Apache::lonnet::put('environment',\%emailHash,$dom,$uname);                                      'instsec'  => $instsec,
                         }                                      'role' => 'st',
                         if ($create_passwd) {                                     };
 # Send e-mail with inital password to new user at $emailaddr                          if ($credits) {
                             $logmsg .= "Initial password -  - sent to $emailaddr\n";                              $args->{'credits'} = $credits;
                         } else {  
                             $logmsg .= "\n";  
                         }                          }
                           my $outcome = &create_newuser($args,$logmsg,$newusermsg,\$enrollcount,\$addresult,\%longroles,\%courseinfo,$context);
                     } else {                      } else {
                        $logmsg .= "An error occurred adding new user $uname - $reply\n";                          &execute_add($context,'newstudent',$uname,$dom,$auth,
                                        $authparam,$first,$middle,$last,$gene,$pid,
                                        $usec,$end,$start,$emailenc,$credits,$instsec,
                                        $cid,\$addresult,\$enrollcount,$linefeed,
                                        $logmsg);
                     }                      }
                 } else {                      if ($courseinfo{'showphoto'}) {
 # Get the user's information and authentication                          my ($result,$resulttype) = 
                     my %userenv = &Apache::lonnet::get('environment',['firstname','middlename','lastname','generation','id','critnotification','notification'],$dom,$uname);                             &Apache::lonnet::auto_checkphotos($uname,$dom,$pid);
                     my ($tmp) = keys(%userenv);                          if ($resulttype) {
                     if ($tmp =~ /^(con_lost|error)/i) {                              push(@{$$phototypes{$resulttype}},$uname);
                         %userenv = ();                          }
                     }                      }
 # Get the user's e-mail address                  }
                     if ($userenv{critnotification} =~ m/%40/) {              }
                         unless ($emailenc eq $userenv{critnotification}) {          }
                         $logmsg .= "Current critical notification e-mail - ".$userenv{critnotification}." for $uname is different to e-mail address in Institutional classlist - $emailenc\n";      }
                     }      if ($courseinfo{'showphoto'}) {
                     if ($userenv{notification} =~ m/%40/) {          if (keys(%{$phototypes})>0) {
                         unless ($emailenc eq $userenv{critnotification}) {              my %lt = &photo_response_types();
                             $logmsg .= "Current standard notification e-mail - ".$userenv{notification}." for $uname is different to e-mail address in Institutional classlist - $emailenc\n";              foreach my $type (sort(keys(%{$phototypes}))) {
                         }                  my $numphoto = @{$$phototypes{$type}};
                     }                                              if ($numphoto > 0) {
                     my $krbdefdom = '';                      if ($context eq 'updatenow') {
                     my $currentauth=&Apache::lonnet::queryauthenticate($uname,$dom);                          $photoresult .=  '<br /><b>'.
                     if ($currentauth=~/^krb(4|5):/) {      &mt('For [_1] students, photos ',$numphoto).
                         $currentauth=~/^krb(4|5):(.*)/;      $lt{$type}.'</b><ul><li>';
                         $krbdefdom=$1;  
                     }  
                     if ($currentauth=~/^krb(4|5):/ ||   
                         $currentauth=~/^unix:/ ||  
                         $currentauth=~/^internal:/ ||  
                         $currentauth=~/^localauth:/) {  
                                  
                     } else {                      } else {
                         $logmsg .= "Invalid authentication method $currentauth for $uname.\n";                            $photoresult .=  "\n".&mt("For [quant,_1,student], photos ",$numphoto).
       $lt{$type}."\n";
                     }                      }
 # Report if authentication methods are different.                      foreach my $user (@{$$phototypes{$type}}) { 
                     if ($currentauth ne $auth ) {                          $photoresult .= $user.$linefeed;
                          $logmsg .= "Authentication mismatch for $uname - $currentauth in system, $auth for class $crs\n";  
                     }                      }
 # Check user data                      if ($context eq 'updatenow') {
                     if ($first  ne $userenv{'firstname'}  ||                          $photoresult = substr($photoresult,0,
                         $middle ne $userenv{'middlename'} ||        rindex($photoresult,"<li>"));
                         $last   ne $userenv{'lastname'}   ||                          $photoresult .= '</ul><br />';
                         $gene   ne $userenv{'generation'} ||                      } else {
                         $pid    ne $userenv{'id'} ) {                                   $photoresult .= "\n";
 # 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: $uname enrolled in $crs\n";   
 # Assign the role of student  
                             $classlist_reply = &modify_student_enrollment($$configvars{'lonHostID'},$dom,$cid,$crs,$uname,$pid,$first,$middle,$last,$gene,$usec,$end,$start,'auto');  
                             if ($classlist_reply eq 'ok') {  
                                 my $uurl='/'.$cid;  
                                 $uurl=~s/\_/\//g;  
                                 if ($usec) {  
                                     $uurl.='/'.$usec;  
                                 }  
                                 &Apache::lonnet::assignrole($dom,$uname,$uurl,"st",$enddate,$startdate);  
                                 $addresult .=  "$first $last ($pid) - $uname enrolled in section/group $usec.".$linefeed;  
                                 $enrollcount ++;  
                                 $addresult .= "$first $last ($pid) - $uname enrolled in section/group $usec.".$linefeed;  
                                 $logmsg .= "Existing user $uname enrolled successfully in $crs\n";  
   
                             } else {  
                                 $logmsg .= "There was a problem updating the classlist db file for user $uname to show the new enrollment, so no enrollment occurred in $crs\n";  
                             }  
                         } else {  
                             $logmsg .= "There was a problem modifying user data for existing user - $uname, so no enrollment occurred in $crs.\n";  
                         }  
                     }                      }
                 }                  }
             }              }
         }          }
     }      }
   
 # Do drops  # Do drops
     if ( ($drops == 1) && (@reg_students > 0) ) {      if ( ($drops == 1) && (@reg_students > 0) ) {
           my %delaydrops;
         foreach my $uname (@localstudents) {          foreach my $uname (@localstudents) {
             if ($$currlist{$uname}[$type] eq "auto") {              if ($$currlist{$uname}[$type] eq "auto") {
                 my @saved = ();                  my @saved = ();
Line 340  sub update_LC { Line 445  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 .= &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}[ $stuid ]).' '.&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);  # Check enrollment count for institutional section of student to be dropped 
                           if ($$currlist{$uname}[$instidx]) {
                               if (exists($classcount{$$currlist{$uname}[$instidx]})) {
                                   if ($classcount{$$currlist{$uname}[$instidx]} == 0) {
                                       if ($autofailsafe) {
                                           push(@{$delaydrops{$$currlist{$uname}[$instidx]}},$uname);    
                                           next;
                                       }
                                   }
                               }
                           }
                           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\n";                              $$logmsg .= &mt('An error occurred 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;
                               }
                           }
                       }
                   }
               }
           }
           if (scalar(keys(%delaydrops)) > 0) {
               foreach my $class (keys(%delaydrops)) {
                   if (ref($delaydrops{$class}) eq 'ARRAY') {
                       if ($autofailsafe < scalar(@{$delaydrops{$class}})) {
                           $$logmsg .= &mt('The following students were not expired from the old section [_1] because the enrollment count retrieved for that institutional section was zero, and the number of students with roles to expire exceeded the failsafe threshold of [_2]:',$class,$autofailsafe);
                           if ($context eq "updatenow") {
                               $$logmsg .= '<br />'.join('<br />',@{$delaydrops{$class}}).$linefeed; 
                           } elsif ($context eq "automated") {
                               $$logmsg .= $linefeed.join($linefeed,@{$delaydrops{$class}}).$linefeed;
                           }
                       } else {
                           foreach my $uname (@{$delaydrops{$class}}) {
                               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/) {
                                   $$logmsg .= &mt('An error occurred during the attempt to expire the [_1] from the old section [_2] - [_3].',$uname,$$currlist{$uname}[$sec],$drop_reply).$linefeed;
                               } else {
                                   $dropcount ++;
                                   my %userenv = &Apache::lonnet::get('environment',['firstname','lastname','id'],$dom,$uname);
                                   $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;
                                   }
                               }
                         }                          }
                     }                      }
                 }                  }
             }              }
         }          }
     }      }
   
   # Terminated explictly allowed access to student creation/modification 
   # and group membership changes
       if ($context eq 'automated') {
           delete($env{'allowed.cst'});
           delete($env{'allowed.mdg'});
       }
     if ($enrollcount > 0) {      if ($enrollcount > 0) {
         if ($context eq "updatenow") {          if ($context eq "updatenow") {
             $addresult = "The following $enrollcount student(s) was/were added to this LON-CAPA course:<br/><ul><li>".$addresult."</li></ul><br/><br/>";              $addresult = substr($addresult,0,rindex($addresult,"<li>"));
               $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 = "The following $dropcount student(s) was/were expired from this LON-CAPA course:<br/><ul><li>".$dropresult."</li></ul><br/><br/>";              $dropresult = substr($dropresult,0,rindex($dropresult,"<li>"));
               $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 380  sub update_LC { Line 544  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";
         }          }
     }      }
     print STDERR $logmsg;      my $changecount = $enrollcount + $dropcount + $switchcount;
     return $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 $inststatus = $args->{'inststatus'};
       my $credits = $args->{'credits'};
       my $instsec = $args->{'instsec'};
       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($udom);
               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,$inststatus,$credits,$instsec);
           }
           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 course 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,$credits,$instsec,$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','inststatus'],$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,
                                                      $credits,$instsec);
       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 {
   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','credits','inststatus');
       @{ $$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;                       $$studentsref{$uname}[ $$placeref{'groupID'} ] = $groupID;
               }                       $$studentsref{$uname}[ $$placeref{'instsec'} ] = $class;
           }                   }
       }              }, "tagname, attr"],
   }           text_h =>
 #  if (-e "$xmlfile") {               [sub {
 #      unlink $xmlfile;                   my ($text) = @_;
 #  }                   if ("@state" eq "students student startdate") {
   return;                       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]);
       }
       return $timestamp;
 }  }
   
 sub create_password {  sub create_password {
       my ($udom) = @_;
       my %passwdconf = &Apache::lonnet::get_passwdconf($udom);
       my ($min,$max,@chars);
       $min = $Apache::lonnet::passwdmin;
       if (ref($passwdconf{'chars'}) eq 'ARRAY') {
           if ($passwdconf{'min'} =~ /^\d+$/) {
               if ($passwdconf{'min'} > $min) {
                   $min = $passwdconf{'min'};
               }
           }
           if ($passwdconf{'max'} =~ /^\d+$/) {
               $max = $passwdconf{'max'};
           }
           @chars = @{$passwdconf{'chars'}};
       }
       my @letts = qw(b c d f g h j k l m n p q r s t v w x y z);
       my (@included,%reqd);
       if (@chars) {
           map { $reqd{$_} = 1; } @chars;
       }
       if ($reqd{'uc'}) {
           my $letter = $letts[int( rand(21) )];   
           $letter =~ tr/a-z/A-Z/;
           if ($letter ne '') {
               push(@included,$letter); 
           }
       }
       if ($reqd{'lc'}) {
           my $letter = $letts[int( rand(21) )];
           if ($letter ne '') {
               push(@included,$letter);
           } 
       }
       if ($reqd{'num'}) {
           my $number = int( rand(10) );
           if ($number ne '') {
               push(@included,$number);
           }
       }
       if ($reqd{'spec'}) {
           my @specs = qw(! # * & _ - + $);
           my $special = $specs[int( rand(8) )];
           if ($special ne '') {
               push(@included,$special);
           }
       }
       my $start = 0;
       if (scalar(@included) > 0) {
           $start = scalar(@included);
       }
       my $end = 8;
       if ($min =~ /^\d+$/) {
           if ($min > $end) {
               $end = $min;
           } 
       }
       for (my $i=$start; $i<$end; $i++) {
           my $lettnum = int (rand 2);
           my $item = '';
           if ($lettnum) {
               $item = $letts[int( rand(21) )];
               my $uppercase = int(rand 2);
               if ($uppercase) {
                   $item =~ tr/a-z/A-Z/;
               }
           } else {
               $item = int( rand(10) );
           }
           if ($item ne '') {
               push(@included,$item);
           }
       }
       my $passwd = join('',&Math::Random::random_permutation(@included));
       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','internal.defaultcredits'],$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'};
           }
           if ( defined($settings{'internal.credithours'}) ) {
               $$courseinfo{'defaultcredits'} = $settings{'internal.defaultcredits'};
           }
       }
       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,
                     credits    => 11,
                     inststatus => 12,
                     instsec    => 13,
                   );
       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.1  
changed lines
  Added in v.1.55

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>