File:  [LON-CAPA] / loncom / enrollment / Enrollment.pm
Revision 1.51: download - view: text, annotated - select for diffs
Mon Sep 18 14:21:45 2017 UTC (6 years, 7 months ago) by raeburn
Branches: MAIN
CVS tags: version_2_11_2_msu, HEAD
- Bug 6863

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

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