Annotation of loncom/enrollment/Enrollment.pm, revision 1.31

1.7       albertel    1: # Automated Enrollment manager
1.31    ! raeburn     2: # $Id: Enrollment.pm,v 1.30 2006/02/07 17:56:41 raeburn Exp $
1.7       albertel    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: #
1.1       raeburn    26: package LONCAPA::Enrollment;
                     27: 
                     28: use Apache::loncoursedata;
                     29: use Apache::lonnet;
1.8       raeburn    30: use Apache::lonmsg;
1.28      raeburn    31: use Apache::lonlocal;
1.1       raeburn    32: use HTML::Entities;
                     33: use LONCAPA::Configuration;
1.8       raeburn    34: use Time::Local;
                     35: use lib '/home/httpd/lib/perl';
1.1       raeburn    36: 
                     37: use strict;
                     38: 
                     39: sub update_LC {
1.28      raeburn    40:     my ($dom,$crs,$adds,$drops,$startdate,$enddate,$authtype,$autharg,$classesref,$groupref,$logmsg,$newusermsg,$context,$phototypes) = @_; 
1.19      raeburn    41: # Get institutional code and title of this class
                     42:     my %courseinfo = ();
                     43:     &get_courseinfo($dom,$crs,\%courseinfo);
1.1       raeburn    44: # Get current LON-CAPA student enrollment for this class
                     45:     my $configvars = &LONCAPA::Configuration::read_conf('loncapa.conf');
                     46:     my $cid = $dom."_".$crs;
1.26      raeburn    47:     my $roster = &Apache::loncoursedata::get_classlist($dom,$crs);
1.1       raeburn    48:     my $cend = &Apache::loncoursedata::CL_END;
                     49:     my $cstart = &Apache::loncoursedata::CL_START; 
                     50:     my $stuid=&Apache::loncoursedata::CL_ID;
                     51:     my $sec=&Apache::loncoursedata::CL_SECTION;
                     52:     my $status=&Apache::loncoursedata::CL_STATUS;
                     53:     my $type=&Apache::loncoursedata::CL_TYPE;
1.16      raeburn    54:     my $lockedtype=&Apache::loncoursedata::CL_LOCKEDTYPE;
1.1       raeburn    55:     my @localstudents = ();
1.15      raeburn    56:     my @futurestudents = ();
                     57:     my @activestudents = ();
1.18      raeburn    58:     my @excludedstudents = ();
1.1       raeburn    59:     my $currlist;
                     60:     foreach my $uname (keys %{$roster} ) {
                     61:         if ($uname =~ m/^(.+):$dom$/) {
                     62:             if ($$roster{$uname}[$status] eq "Active") {
1.15      raeburn    63:                 push @activestudents, $1;
                     64:                 @{$$currlist{$1}} = @{$$roster{$uname}};
1.1       raeburn    65:                 push @localstudents, $1;
1.15      raeburn    66:             } elsif ( ($$roster{$uname}[$cstart] > time)  && ($$roster{$uname}[$cend] > time || $$roster{$uname}[$cend] == 0 || $$roster{$uname}[$cend] eq '') ) {
                     67:                 push @futurestudents, $1;
1.1       raeburn    68:                 @{$$currlist{$1}} = @{$$roster{$uname}};
1.15      raeburn    69:                 push @localstudents, $1;
1.18      raeburn    70:             } elsif ($$roster{$uname}[$lockedtype] == 1) {
                     71:                 push @excludedstudents, $1;
1.1       raeburn    72:             }
                     73:         }
                     74:     }
                     75:     my $linefeed = '';
                     76:     my $addresult = '';
                     77:     my $dropresult = '';
1.21      raeburn    78:     my $switchresult = '';
1.28      raeburn    79:     my $photoresult = '';
1.1       raeburn    80:     if ($context eq "updatenow") {
                     81:         $linefeed = "</li>\n<li>"; 
                     82:     } elsif ($context eq "automated") {
                     83:         $linefeed = "\n";
                     84:     }
                     85:     my $enrollcount = 0;
                     86:     my $dropcount = 0;
1.21      raeburn    87:     my $switchcount = 0;
1.1       raeburn    88: 
1.19      raeburn    89: # Get role names
                     90:     my %longroles = ();
                     91:     open(FILE,"<$$configvars{'lonTabDir'}.'/rolesplain.tab");
                     92:     my @rolesplain = <FILE>;
                     93:     close(FILE);
                     94:     foreach (@rolesplain) {
                     95:         if ($_ =~ /^(st|ta|ex|ad|in|cc):([\w\s]+)$/) {
                     96:             $longroles{$1} = $2;
                     97:         }
                     98:     }
                     99: 
1.8       raeburn   100:     srand( time() ^ ($$ + ($$ << 15))  ); # Seed rand in case initial passwords have to be generated for new users.
                    101: 
1.1       raeburn   102: # Get mapping of IDs to usernames for current LON-CAPA student enrollment for this class 
                    103:     my @LCids = ();
                    104:     my %unameFromLCid = ();
                    105:     foreach my $uname (sort keys %{$currlist}) {
                    106:         my $stuID = $$currlist{$uname}[$stuid];
                    107:         if (!grep/^$stuID$/,@LCids) {
                    108:             push @LCids, $stuID;
                    109:             @{$unameFromLCid{$stuID}} = ();
                    110:         }
                    111:         push @{$unameFromLCid{$stuID}},$uname;
                    112:     }
                    113:  
                    114: # Get latest institutional enrollment for this class.
                    115:     my %allenrolled = ();
                    116:     my @reg_students = ();
                    117:     my %place = ();
                    118:     $place{'autharg'} = &CL_autharg();
                    119:     $place{'authtype'} = &CL_authtype();
                    120:     $place{'email'} = &CL_email();
                    121:     $place{'enddate'} = &CL_enddate();
                    122:     $place{'firstname'} = &CL_firstname();
                    123:     $place{'generation'} = &CL_generation();
                    124:     $place{'groupID'} = &CL_groupID();
                    125:     $place{'lastname'} = &CL_lastname();
                    126:     $place{'middlename'} = &CL_middlename();
                    127:     $place{'startdate'} = &CL_startdate();
                    128:     $place{'studentID'} = &CL_studentID();
                    129:     my %ucount = ();
                    130:     my %enrollinfo = ();
                    131:     foreach my $class (@{$classesref}) {
                    132:         my %enrolled = ();
                    133:         &parse_classlist($$configvars{'lonDaemons'},$dom,$crs,$class,\%place,$$groupref{$class},\%enrolled);
                    134:         foreach my $uname (sort keys %enrolled ) {
                    135:             if (!grep/^$uname$/,@reg_students) {
                    136:                 push @reg_students,$uname;
                    137:                 $ucount{$uname} = 0;
                    138:                 @{$allenrolled{$uname}} = ();
                    139:             }
                    140:             @{$allenrolled{$uname}[$ucount{$uname}]} = @{$enrolled{$uname}};
                    141:             $ucount{$uname} ++;
                    142:         }
                    143:     }
                    144: 
                    145: # Check for multiple sections for a single student 
                    146:     my @okusers = ();
                    147:     foreach my $uname (@reg_students)  {
1.18      raeburn   148:         if (grep/^$uname$/,@excludedstudents) {
                    149:             $$logmsg .= "No re-enrollment for $uname - user was previously manually unenrolled and locked.".$linefeed;
                    150:         } elsif (@{$allenrolled{$uname}} > 1) {
1.1       raeburn   151:             my @sections = ();
                    152:             my $saved;
                    153:             for (my $i=0; $i<@{$allenrolled{$uname}}; $i++) {
                    154:                 my @stuinfo = @{$allenrolled{$uname}[$i]};
                    155:                 my $secnum = $stuinfo[ $place{'groupID'} ];
                    156:                 unless ($secnum eq '') {
                    157:                     unless (grep/^$secnum$/,@sections) {
                    158:                         $saved = $i; 
                    159:                         push @sections,$secnum;
                    160:                     }
                    161:                 }
                    162:             }
                    163:             if (@sections == 0) {
                    164:                 @{$enrollinfo{$uname}} = @{$allenrolled{$uname}[0]};
                    165:                 push @okusers, $uname;
                    166:             }
                    167:             elsif (@sections == 1) {
                    168:                 @{$enrollinfo{$uname}} = @{$allenrolled{$uname}[$saved]};
                    169:                 push @okusers, $uname;
                    170:             }
                    171:             elsif (@sections > 1) {
1.27      raeburn   172:                 $$logmsg .=  "$uname appears in classlists for more than one section of this course, i.e. in sections: ";
1.1       raeburn   173:                 foreach (@sections) {
1.5       raeburn   174:                     $$logmsg .= " $_,";
1.1       raeburn   175:                 }
1.5       raeburn   176:                 chop($$logmsg);
1.6       raeburn   177:                 $$logmsg .= ". Because of this ambiguity, no enrollment action was taken for this student.".$linefeed;
1.1       raeburn   178:             }
                    179:         } else {
                    180:             @{$enrollinfo{$uname}} = @{$allenrolled{$uname}[0]};
                    181:             push @okusers, $uname;
                    182:         }
                    183:     }
                    184: # Get mapping of student IDs to usernames for users in institutional data for this class  
                    185:     my @allINids = ();
1.3       raeburn   186:     my %unameFromINid = ();
1.1       raeburn   187:     foreach my $uname (@okusers) {
                    188:         $enrollinfo{$uname}[ $place{'studentID'} ] =~ tr/A-Z/a-z/;
                    189:         my $stuID = $enrollinfo{$uname}[ $place{'studentID'} ];
                    190:         if (grep/^$stuID$/,@allINids)  {
                    191:             push @{$unameFromINid{$stuID}},$uname;
                    192:         } else {
                    193:             push @allINids, $stuID;
                    194:             @{$unameFromINid{$stuID}} = $uname; 
                    195:         }
                    196:     }
1.28      raeburn   197: 
1.5       raeburn   198: # Explicitly allow access to creation/modification of students if called as an automated process.
                    199:     if ($context eq 'automated') {
1.22      albertel  200:         $env{'allowed.cst'}='F';
1.5       raeburn   201:     }
                    202: 
1.1       raeburn   203: # Compare IDs with existing LON-CAPA enrollment for this class
                    204:     foreach my $uname (@okusers) {
1.5       raeburn   205:         unless ($uname eq '') {
                    206:             my %uidhash=&Apache::lonnet::idrget($dom,$uname);
                    207:             my @stuinfo = @{$enrollinfo{$uname}};
1.15      raeburn   208:             my $access = '';
1.5       raeburn   209:             if (grep/^$uname$/,@localstudents) {
1.1       raeburn   210: # Check for studentID changes
1.5       raeburn   211:                 if ( ($uidhash{$uname}) && ($uidhash{$uname} !~ /error\:/) )  {
                    212:                     unless ( ($uidhash{$uname}) eq ($stuinfo[ $place{studentID} ]) ) {
1.6       raeburn   213:                         $$logmsg .= "Change in ID for $uname. StudentID in LON-CAPA system is $uidhash{$uname}; StudentID in institutional data is $stuinfo[ $place{studentID} ]".$linefeed; 
1.5       raeburn   214:                     }
1.1       raeburn   215:                 }
1.16      raeburn   216: # Check for switch from manual to auto
                    217:                 unless (($$currlist{$uname}[$type] eq "auto") || ($$currlist{$uname}[$lockedtype] eq "1") || (!$adds) ) {
                    218: # drop manually added student
                    219:                     my $drop_reply = &Apache::lonnet::modifystudent($dom,$uname,'','','',undef,undef,undef,undef,$$currlist{$uname}[$sec],time,undef,undef,undef,undef,'auto','',$cid);
                    220: # re-enroll as auto student
                    221:                     if ($drop_reply !~ /^ok/) {
                    222:                             $$logmsg .= "An error occured during the attempt to convert $uname from a manual type to an auto type student - $drop_reply.".$linefeed;
                    223:                     } else {
                    224: # re-enroll as auto student
                    225:                         my ($auth,$authparam,$first,$middle,$last,$gene,$usec,$end,$start,$emailaddr,$pid,$emailenc);
                    226:                         &prepare_add($authtype,$autharg,$enddate,$startdate,\@stuinfo,\%place,\$dom,\$uname,\$auth,\$authparam,\$first,\$middle,\$last,\$gene,\$usec,\$end,\$start,\$emailaddr,\$pid,\$emailenc);
                    227:                         if ($$currlist{$uname}[$sec] ne $usec) {
1.21      raeburn   228:                             $switchresult .= "Section for $uname switched from $$currlist{$uname}[$sec] to ".$usec.$linefeed;
                    229:                             if ($context eq 'automated') {
                    230:                                 $$logmsg .= "Section switch for $uname from $$currlist{$uname}[$sec] to ".$usec.$linefeed; ;
                    231:                             }
                    232:                             $switchcount ++;
1.16      raeburn   233:                         }
                    234:                         &execute_add($context,'switchtype',$uname,$dom,$auth,$authparam,$first,$middle,$last,$gene,$pid,$usec,$end,$start,$emailenc,$cid,\$addresult,\$enrollcount,$linefeed,$logmsg);
                    235:                     }
                    236:                 } 
1.1       raeburn   237: # Check for section changes
1.15      raeburn   238:                 if ($$currlist{$uname}[$sec] eq $stuinfo[ $place{groupID} ]) {
                    239: # Check for access date changes for students with access starting in the future.
                    240:                     if ( (grep/^$uname$/,@futurestudents) && ($$currlist{$uname}[$type] eq "auto") && ($adds == 1) ) {
1.16      raeburn   241:                         my $datechange = &datechange_check($$currlist{$uname}[$cstart],$$currlist{$uname}[$cend],$startdate,$enddate);
1.15      raeburn   242:                         if ($datechange) {
1.16      raeburn   243:                             my $modify_access_result = &Apache::lonnet::modify_student_enrollment($dom,$uname,undef,undef,undef,undef,undef,$stuinfo[ $place{groupID} ],$enddate,$startdate,'auto','',$cid);
1.15      raeburn   244:                             $access = &showaccess($enddate,$startdate);
                    245:                             if ($modify_access_result =~ /^ok/) {
                    246:                                 $$logmsg .= "Change in access dates for $uname.".$access.$linefeed;
                    247:                             } else {
                    248:                                 $$logmsg .= "Error when attempting to change start and/or end access dates for $uname in section: ".$stuinfo[ $place{groupID} ]." -error $modify_access_result".$linefeed;
                    249:                             }
                    250:                         }
                    251:                     }
                    252:                 } else {
1.5       raeburn   253:                     if ( ($$currlist{$uname}[$type] eq "auto") && ($adds == 1) ) {
1.10      raeburn   254: # Delete from roles.db for current section
                    255:                         my $expiretime = time;
                    256:                         my $uurl='/'.$cid;
                    257:                         $uurl=~s/\_/\//g;
                    258:                         if ($$currlist{$uname}[$sec]) {
                    259:                             $uurl.='/'.$$currlist{$uname}[$sec];
                    260:                         }
                    261:                         my $expire_role_result = &Apache::lonnet::assignrole($dom,$uname,$uurl,'st',$expiretime);
                    262:                         if ($expire_role_result eq 'ok') {
1.15      raeburn   263:                             my $modify_section_result;
                    264:                             if (grep/^$uname$/,@activestudents) {
1.16      raeburn   265:                                 $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);
1.15      raeburn   266:                             } else {
1.16      raeburn   267:                                 $modify_section_result =  &Apache::lonnet::modify_student_enrollment($dom,$uname,undef,undef,undef,undef,undef,$stuinfo[ $place{groupID} ],$enddate,$startdate,'auto','',$cid);
1.15      raeburn   268:                                 $access =  &showaccess($enddate,$startdate);
                    269:                             }
1.10      raeburn   270:                             if ($modify_section_result =~ /^ok/) {
1.21      raeburn   271:                                 $switchresult .= "Section for $uname switched from old section: ".$$currlist{$uname}[$sec] ." to new section: ".$stuinfo[ $place{groupID} ].".".$access.$linefeed;
                    272:                                 if ($context eq 'automated') {
                    273:                                     $$logmsg .= "Section switch for $uname from $$currlist{$uname}[$sec] to $stuinfo[ $place{groupID} ]".$linefeed;
                    274:                                 }
                    275:                                 $switchcount ++;
1.10      raeburn   276:                             } else {
                    277:                                 $$logmsg .= "Error when attempting section change for $uname from old section ".$$currlist{$uname}[$sec]." to new section: ".$stuinfo[ $place{groupID} ]." -error: $modify_section_result".$linefeed;
                    278:                             }
1.5       raeburn   279:                         } else {
1.10      raeburn   280:                             $$logmsg .= "Error when attempting to expire role for $uname in old section" .$$currlist{$uname}[$sec]." -error: $expire_role_result".$linefeed;
1.5       raeburn   281:                         }
1.1       raeburn   282:                     }
                    283:                 }
1.5       raeburn   284:             } else {
1.1       raeburn   285: # Check for changed usernames by checking studentIDs
1.5       raeburn   286:                 if ( ($stuinfo[ $place{studentID} ] ne '') && (grep/^$stuinfo[ $place{studentID} ]$/,@LCids) ) {
1.27      raeburn   287:                     foreach my $match ( @{ $unameFromLCid{ $stuinfo[ $place{studentID} ] } }  ) {
                    288:                         $$logmsg .= "A possible change in username has been detected for a student enrolled in this course. The existing LON-CAPA classlist contains user: $match and student ID: ".$stuinfo[ $place{studentID} ].". ";
                    289:                         if (grep/^$match$/,@okusers) {
                    290:                             $$logmsg .= "The username $match remains in the institutional classlist, but the same student ID is used for new user: $uname now found in the institutional classlist. You may need to contact your Domain Coordinator to determine how to reolve this issue and whether to move student data files for user: $match to $uname. ";
                    291:                         } else {
                    292:                             unless ($drops == 1) {
                    293:                                 $$logmsg .= "This username - $match - has been dropped from the institutional classlist, but the student ID of this user is also used by $uname who now appears in the institutional classlist. You may need to contact your Domain Coordinator to request a move of the student data files for user: $match to $uname. ";
1.5       raeburn   294:                             }
1.1       raeburn   295:                         }
1.27      raeburn   296:                         $$logmsg .= "Because of this student ID conflict, the new username - $uname - has not been added to the LON-CAPA classlist.".$linefeed;      
1.1       raeburn   297:                     }
1.5       raeburn   298:                 } elsif ($adds == 1) {
1.16      raeburn   299:                     my ($auth,$authparam,$first,$middle,$last,$gene,$usec,$end,$start,$emailaddr,$pid,$emailenc);
                    300:                     &prepare_add($authtype,$autharg,$enddate,$startdate,\@stuinfo,\%place,\$dom,\$uname,\$auth,\$authparam,\$first,\$middle,\$last,\$gene,\$usec,\$end,\$start,\$emailaddr,\$pid,\$emailenc);
1.1       raeburn   301: # Check for existing account in this LON-CAPA domain for this username
1.5       raeburn   302:                     my $uhome=&Apache::lonnet::homeserver($uname,$dom);
                    303:                     if ($uhome eq 'no_host') { # User does not exist
1.19      raeburn   304:                         my $args = {'auth' => $auth,
                    305:                                     'authparam' => $authparam,
                    306:                                     'emailenc' => $emailenc,
                    307:                                     'udom' => $dom,
                    308:                                     'uname' => $uname,
                    309:                                     'pid' => $pid,
                    310:                                     'first' => $first,
                    311:                                     'middle' => $middle,
                    312:                                     'last' => $last,
                    313:                                     'gene' => $gene,
                    314:                                     'usec' => $usec,
                    315:                                     'end' => $end,
                    316:                                     'start' => $start,
                    317:                                     'emailaddr' => $emailaddr,
                    318:                                     'cid' => $cid,
                    319:                                     'crs' => $crs,
                    320:                                     'cdom' => $dom,
                    321:                                     'context' => $context,
                    322:                                     'linefeed' => $linefeed,
                    323:                                     'role' => 'st'
                    324:                                    };
1.20      raeburn   325:                         my $outcome = &create_newuser($args,$logmsg,$newusermsg,\$enrollcount,\$addresult,\%longroles,\%courseinfo);
1.5       raeburn   326:                     } else {
1.16      raeburn   327:                         &execute_add($context,'newstudent',$uname,$dom,$auth,$authparam,$first,$middle,$last,$gene,$pid,$usec,$end,$start,$emailenc,$cid,\$addresult,\$enrollcount,$linefeed,$logmsg);
1.3       raeburn   328:                     }
1.31    ! raeburn   329:                     if ($courseinfo{'showphoto'}) {
1.28      raeburn   330:                         my ($result,$resulttype) = 
                    331:                            &Apache::lonnet::auto_checkphotos($uname,$dom,$pid);
                    332:                         if ($resulttype) {
                    333:                             push(@{$$phototypes{$resulttype}},$uname);
                    334:                         }
                    335:                     }
1.1       raeburn   336:                 }
                    337:             }
                    338:         }
                    339:     }
1.31    ! raeburn   340:     if ($courseinfo{'showphoto'}) {
1.28      raeburn   341:         if (keys(%{$phototypes})>0) {
                    342:             my %lt = &photo_response_types();
                    343:             foreach my $type (sort(keys(%{$phototypes}))) {
                    344:                 my $numphoto = @{$$phototypes{$type}};
                    345:                 if ($numphoto > 0) {
                    346:                     if ($context eq 'updatenow') {
                    347:                         $photoresult .=  '<br /><b>'.
1.29      albertel  348: 			    &mt('For [_1] students, photos ',$numphoto).
                    349: 			    $lt{$type}.'</b><ul><li>';
1.28      raeburn   350:                     } else {
                    351:                         $photoresult .=  "\nFor $numphoto students, photos ".
1.29      albertel  352: 			    $lt{$type}."\n";
1.28      raeburn   353:                     }
                    354:                     foreach my $user (@{$$phototypes{$type}}) { 
                    355:                         $photoresult .= $user.$linefeed;
                    356:                     }
                    357:                     if ($context eq 'updatenow') {
                    358:                         $photoresult = substr($photoresult,0,
1.29      albertel  359: 					      rindex($photoresult,"<li>"));
1.28      raeburn   360:                         $photoresult .= '</ul><br />';
                    361:                     } else {
                    362:                         $photoresult .= "\n";
                    363:                     }
                    364:                 }
                    365:             }
                    366:         }
                    367:     }
                    368: 
1.1       raeburn   369: # Do drops
                    370:     if ( ($drops == 1) && (@reg_students > 0) ) {
                    371:         foreach my $uname (@localstudents) {
                    372:             if ($$currlist{$uname}[$type] eq "auto") {
                    373:                 my @saved = ();
                    374:                 if (!grep/^$uname$/,@reg_students) {
                    375: # Check for changed usernames by checking studentIDs
                    376:                     if (grep/^$$currlist{$uname}[ $stuid ]$/,@allINids) {
                    377:                         foreach my $match (@{$unameFromINid{$$currlist{$uname}[ $stuid ]}} ) {
1.27      raeburn   378:                             $$logmsg .= "A possible change in username has been detected for a student enrolled in this course. The existing LON-CAPA classlist contains user: $uname and student ID: $$currlist{$uname}[ $place{studentID} ].  This username has been dropped from the institutional classlist, but the same student ID is used for user: $match who still appears in the institutional classlist. You may need to move the student data files for user: $uname to $match. Because of this, user $uname has not been dropped from the course.".$linefeed;
1.1       raeburn   379:                             push @saved,$uname;
                    380:                         }
                    381:                     } elsif (@saved == 0) {
1.16      raeburn   382:                         my $drop_reply = &Apache::lonnet::modifystudent($dom,$uname,'','','',undef,undef,undef,undef,$$currlist{$uname}[$sec],time,undef,undef,undef,undef,'auto','',$cid);
1.1       raeburn   383:                         if ($drop_reply !~ /^ok/) {
1.5       raeburn   384:                             $$logmsg .= "An error occured during the attempt to expire the $uname from the old section $$currlist{$uname}[$sec] - $drop_reply.".$linefeed;
1.1       raeburn   385:                         } else {
                    386:                             $dropcount ++;
                    387:                             my %userenv = &Apache::lonnet::get('environment',['firstname','lastname','id'],$dom,$uname);
                    388:                             $dropresult .= $userenv{'firstname'}." ".$userenv{'lastname'}." (".$userenv{'id'}.") - ".$uname." dropped from section/group ".$$currlist{$uname}[$sec].$linefeed; 
1.8       raeburn   389:                             if ($context eq 'automated') {
                    390:                                 $$logmsg .= "User $uname student role expired from course.".$linefeed;
                    391:                             }
1.1       raeburn   392:                         }
                    393:                     }
                    394:                 }
                    395:             }
                    396:         }
                    397:     }
1.5       raeburn   398: 
                    399: # Terminated explictly allowed access to student creation/modification
                    400:     if ($context eq 'automated') {
1.22      albertel  401:         delete($env{'allowed.cst'});
1.5       raeburn   402:     }
1.1       raeburn   403:     if ($enrollcount > 0) {
                    404:         if ($context eq "updatenow") {
1.6       raeburn   405:             $addresult = substr($addresult,0,rindex($addresult,"<li>"));
1.21      raeburn   406:             $addresult = "The following $enrollcount student(s) was/were added to this LON-CAPA course:<br/><ul><li>".$addresult."</ul><br/><br/>";
1.1       raeburn   407:         } else {
1.21      raeburn   408:             $addresult = "The following $enrollcount student(s) was/were added to this LON-CAPA course:\n\n".$addresult."\n\n";
                    409:         }
1.1       raeburn   410:     }
                    411:     if ($dropcount > 0) {
                    412:         if ($context eq "updatenow") {
1.6       raeburn   413:             $dropresult = substr($dropresult,0,rindex($dropresult,"<li>"));
1.21      raeburn   414:             $dropresult = "The following $dropcount student(s) was/were expired from this LON-CAPA course:<br/><ul><li>".$dropresult."</ul><br/><br/>";
1.1       raeburn   415:         } else {
                    416:             $dropresult = "The following $dropcount student(s) was/were expired from this LON-CAPA course:\n\n".$dropresult."\n\n";
                    417:         }
                    418:     }
1.21      raeburn   419:     if ($switchcount > 0) {
                    420:         if ($context eq "updatenow") {
                    421:             $switchresult = substr($switchresult,0,rindex($switchresult,"<li>"));
                    422:             $switchresult = "The following $switchcount student(s) switched sections in this LON-CAPA course:<br/><ul><li>".$switchresult."</ul><br/><br/>";
                    423:         } else {
                    424:             $switchresult = "The following $switchcount student(s) switched sections in this LON-CAPA course:\n\n".$switchresult."\n\n";
                    425:         }
                    426:     }
1.1       raeburn   427:     if ( ($adds) && ($enrollcount == 0) ) {
                    428:         $addresult = "There were no new students to add to the course.";
                    429:         if ($context eq "updatenow") {
                    430:             $addresult .="<br/><br/>";
                    431:         } else {
                    432:             $addresult .="\n";
                    433:         }
                    434:     }
                    435:     if ( ($drops) && ($dropcount == 0) ) {
                    436:         $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.";
                    437:         if ($context eq "updatenow") {
                    438:             $dropresult .="<br/>";
                    439:         } else {
                    440:             $dropresult .="\n";
                    441:         }
                    442:     }
1.21      raeburn   443:     my $changecount = $enrollcount + $dropcount + $switchcount;
1.28      raeburn   444:     return ($changecount,$addresult.$photoresult.$dropresult.$switchresult);
1.6       raeburn   445: }
1.1       raeburn   446: 
1.19      raeburn   447: sub create_newuser {
                    448:     my ($args,$logmsg,$newusermsg,$enrollcount,$addresult,$longroles,$courseinfo) = @_;
                    449:     my $auth = $args->{'auth'};
                    450:     my $authparam = $args->{'authparam'};
                    451:     my $emailenc = $args->{'emailenc'};
                    452:     my $udom = $args->{'udom'};
                    453:     my $uname = $args->{'uname'};
                    454:     my $pid = $args->{'pid'};
                    455:     my $first = $args->{'first'};
                    456:     my $middle = $args->{'middle'};
                    457:     my $last = $args->{'last'} ;
                    458:     my $gene = $args->{'gene'};
                    459:     my $usec = $args->{'usec'};
                    460:     my $end = $args->{'end'};
                    461:     my $start = $args->{'start'};
                    462:     my $emailaddr = $args->{'emailaddr'};
                    463:     my $cid = $args->{'cid'};
                    464:     my $crs = $args->{'crs'};
                    465:     my $cdom = $args->{'cdom'};
                    466:     my $context = $args->{'context'};
                    467:     my $linefeed = $args->{'linefeed'};
                    468:     my $role = $args->{'role'};
                    469:     my $create_passwd = 0;
                    470:     my $authchk = '';
                    471:     my $outcome;
                    472:     unless ($authparam eq '') { $authchk = 'ok'; };
                    473: # If no account exists and passwords should be generated
                    474:     if ($auth eq "internal") {
                    475:         if ($authparam eq '') {
                    476:             $authparam = &create_password();
                    477:             if ($authparam eq '') {
                    478:                 $authchk = '';
                    479:             } else {
                    480:                 $create_passwd = 1;
                    481:                 $authchk = 'ok';
                    482:             }
                    483:         }
                    484:     } elsif ($auth eq "localauth") {
                    485:         ($authparam,$create_passwd,$authchk) = &Apache::lonnet::auto_create_password($crs,$cdom,$authparam);
                    486:     } elsif ($auth =~ m/^krb/) {
                    487:         if ($authparam eq '') {
                    488:             $$logmsg .= "No Kerberos domain was provided for the new user - $uname, so the new user was not enrolled in the course.".$linefeed;
                    489:             $authchk = 'invalid';
                    490:         }
                    491:     } else {
                    492:         $authchk = 'invalid';
                    493:         $$logmsg .= "An invalid authentication type was provided for the new user - $uname, so the user was not enrolled in the course.".$linefeed;
                    494:     }   
                    495:     if ($authchk eq 'ok') {
                    496: # Now create user.
                    497:         my $type = 'auto';
                    498:         my $userurl = '/'.$cdom.'/'.$crs;
                    499:         if ($usec ne '') {
                    500:             $userurl .= '/'.$usec;
                    501:         }
                    502:         if ($context eq 'createowner' || $context eq 'createcourse') {
                    503:             my $result = &Apache::lonnet::modifyuser($udom,$uname,$pid,$auth,$authparam,$first,$middle,$last,$gene,'1',undef,$emailaddr);
                    504:             if ($result eq 'ok' && $context eq 'createcourse') {
1.24      raeburn   505:                 $outcome = &Apache::loncreateuser::commit_standardrole($udom,$uname,$userurl,$role,$start,$end,$cdom,$crs,$usec);
1.19      raeburn   506:                 unless ($outcome =~ /^Error:/) {
                    507:                     $outcome = 'ok';
                    508:                 }
                    509:             } else {
                    510:                 $outcome = $result;
                    511:             }
                    512:         } else {
                    513:             $outcome=&Apache::lonnet::modifystudent($udom,$uname,$pid,$auth,$authparam,$first,$middle,$last,$gene,$usec,$end,$start,'',undef,$emailaddr,'auto','',$cid);
                    514:         }
                    515:         if ($outcome eq 'ok') {
                    516:             my $access = &showaccess($end,$start);
                    517:             $$addresult .= "$first $last ($pid) - $uname enrolled in section/group $usec.".$access.$linefeed;
                    518:             unless ($context eq 'createowner' || $context eq 'createcourse') {
                    519:                 $$enrollcount ++;
                    520:             }
                    521:             if ($context eq 'automated') {
                    522:                 $$logmsg .= "New $udom user $uname added successfully.";
                    523:             }
                    524:             unless ($emailenc eq '' || $context eq 'createowner' || $context eq 'createcourse') {
                    525:                 my %emailHash;
                    526:                 $emailHash{'critnotification'}  = $emailenc;
                    527:                 $emailHash{'notification'} = $emailenc;
1.23      raeburn   528:                 $emailHash{'permanentemail'} = $emailenc;
1.19      raeburn   529:                 my $putresult = &Apache::lonnet::put('environment',\%emailHash,$udom,$uname);
                    530:             }
                    531:             if ($create_passwd) {
                    532: # Send e-mail with initial password to new user at $emailaddr.
                    533: # If e-mail address is invalid, send password via message to courseowner i
                    534: # (if automated call) or to user if roster update.
                    535:                 if ($emailaddr eq '') {
                    536:                     $$newusermsg .= " username: $uname, password: ".$authparam.$linefeed."\n";
                    537:                 } else {
                    538:                     my $subject = "New LON-CAPA account";
                    539:                     my $body;
                    540:                     if ($context eq 'createowner') {
                    541:                         $body = "A user account has been created for you while creating your new course in the LON-CAPA course management and online homework system.\n\nYou should log-in to the system using the following credentials:\nusername: $uname\npassword: $authparam\n\nThe URL you should use to access the LON-CAPA system at your school is: http://".$ENV{'SERVER_NAME'}."\n\n";
                    542:                     } elsif ($context eq 'createcourse') {
                    543:                         $body = "You have been assigned the role of $$longroles{$role} in a new course: $$courseinfo{'description'} - $$courseinfo{'inst_code'} in the LON-CAPA course management and online homework system.  As you did not have an existing user account in the system, one has been created for you.\n\nYou should log-in to the system using the following credentials:\nusername: $uname\npassword: $authparam\n\nThe URL you should use to access the LON-CAPA system at your school is: http://".$ENV{'SERVER_NAME'}."\n\n"; 
                    544:                     } else {
                    545:                         my $access_start = 'immediately';
                    546:                         if ($start > 0) {
                    547:                             $access_start = localtime($start)
                    548:                         }
                    549:                         $body = "You have been enrolled in the LON-CAPA system at your school, because you are a registered student in a class that is using the LON-CAPA couse management and online homework system.\n\nYou should log-in to the system using the following credentials:\nusername: $uname\npassword: $authparam\n\nThe URL you should use to access the LON-CAPA system at your school is: http://".$ENV{'SERVER_NAME'}."\n\n.When you log-in you will be able to access the LON-CAPA course for $$courseinfo{'description'} - $$courseinfo{'inst_code'} starting $access_start.\n";
                    550:                     }
                    551:                     &Apache::lonmsg::sendemail($emailaddr,$subject,$body);
                    552:                 }
                    553:                 if ($context eq 'automated') {
                    554:                     $$logmsg .= " Initial password -  - sent to ".$emailaddr.$linefeed;
                    555:                 }
                    556:             } else {
                    557:                 if ($context eq 'automated') {
                    558:                     $$logmsg .= $linefeed;
                    559:                 }
                    560:             }
                    561:         } else {
                    562:             $$logmsg .= "An error occurred adding new user $uname - ".$outcome.$linefeed;
                    563:         }
                    564:     }
                    565:     return $outcome;
                    566: }
                    567: 
1.16      raeburn   568: sub prepare_add {
                    569:     my ($authtype,$autharg,$enddate,$startdate,$stuinfo,$place,$dom,$uname,$auth,$authparam,$first,$middle,$last,$gene,$usec,$end,$start,$emailaddr,$pid,$emailenc) = @_;
                    570:     $$auth = $$stuinfo[ $$place{'authtype'} ];
                    571:     $$authparam = $$stuinfo[ $$place{'autharg'} ];
                    572:     $$first = $$stuinfo[ $$place{'firstname'} ];
                    573:     $$middle = $$stuinfo[ $$place{'middlename'} ];
                    574:     $$last = $$stuinfo[ $$place{'lastname'} ];
                    575:     $$gene = $$stuinfo[ $$place{'generation'} ];
                    576:     $$usec = $$stuinfo[ $$place{'groupID'} ];
                    577:     $$end = $$stuinfo[ $$place{'enddate'} ];
                    578:     $$start = $$stuinfo[ $$place{'startdate'} ];
                    579:     $$emailaddr = $$stuinfo[ $$place{'email'} ];
                    580:     $$pid = $$stuinfo[ $$place{'studentID'} ];
                    581:                                                                                   
                    582: # remove non alphanumeric values from section
                    583:     $$usec =~ s/\W//g;
                    584:                                                                                   
                    585:     unless ($$emailaddr =~/^[^\@]+\@[^\@]+$/) { $$emailaddr =''; }
                    586:     $$emailenc = &HTML::Entities::encode($$emailaddr,'<>&"');
                    587:                                                                                   
                    588: # Use course defaults where entry is absent
                    589:     if ( ($$auth eq '') || (!defined($$auth)) ) {
                    590:         $$auth =  $authtype;
                    591:     }
                    592:     if ( ($$authparam eq '')  || (!defined($$authparam)) )  {
                    593:         $$authparam = $autharg;
                    594:     }
                    595:     if ( ($$end eq '') || (!defined($$end)) )  {
                    596:         $$end = $enddate;
                    597:     }
                    598:     if ( ($$start eq '')  || (!defined($$start)) )  {
                    599:         $$start = $startdate;
                    600:     }
                    601: # Clean up whitespace
                    602:     foreach ($dom,$uname,$pid,$first,$middle,$last,$gene,$usec) {
                    603:         $$_ =~ s/(\s+$|^\s+)//g;
                    604:     }
                    605:     return;
                    606: }
                    607: 
                    608: sub execute_add {
                    609:     my ($context,$caller,$uname,$dom,$auth,$authparam,$first,$middle,$last,$gene,$pid,$usec,$end,$start,$emailenc,$cid,$addresult,$enrollcount,$linefeed,$logmsg) = @_;
                    610: # Get the user's information and authentication
1.23      raeburn   611:     my %userenv = &Apache::lonnet::get('environment',['firstname','middlename','lastname','generation','id','critnotification','notification','permanentemail'],$dom,$uname);
1.16      raeburn   612:     my ($tmp) = keys(%userenv);
                    613:     if ($tmp =~ /^(con_lost|error)/i) {
                    614:         %userenv = ();
                    615:     }
                    616: # Get the user's e-mail address
                    617:     if ($userenv{critnotification} =~ m/%40/) {
                    618:         unless ($emailenc eq $userenv{critnotification}) {
                    619:             $$logmsg .= "Current critical notification e-mail
                    620: - ".$userenv{critnotification}." for $uname is different to e-mail address in institutional classlist - ".$emailenc.$linefeed;
                    621:         }
                    622:     }
                    623:     if ($userenv{notification} =~ m/%40/) {
1.23      raeburn   624:         unless ($emailenc eq $userenv{notification}) {
1.16      raeburn   625:             $$logmsg .= "Current standard notification e-mail
                    626: - ".$userenv{notification}." for $uname is different to e-mail address in institutional classlist - ".$emailenc.$linefeed;
                    627:         }
                    628:     }
1.23      raeburn   629:     if ($userenv{permanentemail} =~ m/%40/) {
                    630:         unless ($emailenc eq $userenv{permanentemail}) {
                    631:             $$logmsg .= "Current permanent e-mail
                    632: - ".$userenv{permanentemail}." for $uname is different to e-mail address in institutional classlist - ".$emailenc.$linefeed;
                    633:         }
                    634:     }
1.16      raeburn   635:     my $krbdefdom = '';
                    636:     my $currentauth=&Apache::lonnet::queryauthenticate($uname,$dom);
                    637:     if ($currentauth=~/^(krb[45]):(.*)/) {
                    638:         $currentauth = $1;
                    639:         $krbdefdom = $2;
                    640:     } elsif ($currentauth=~ /^(unix|internal|localauth):/) {
                    641:         $currentauth = $1;
                    642:     } else {
                    643:         $$logmsg .= "Invalid authentication method $currentauth for $uname.".$linefeed;
                    644:     }
                    645: # Report if authentication methods are different.
                    646:     if ($currentauth ne $auth) {
                    647:         $$logmsg .= "Authentication type mismatch for $uname - '$currentauth' in system, '$auth' based on information in classlist or default for this course.".$linefeed;
                    648:     } elsif ($auth =~ m/^krb/) {
                    649:         if ($krbdefdom ne $authparam) {
                    650:             $$logmsg .= "Kerberos domain mismatch for $uname - '$krbdefdom' in system, '$authparam' based on information in classlist or default for this course.".$linefeed;
                    651:         }
                    652:     }
                    653:                                                                                   
                    654: # Check user data
                    655:     if ($first  ne $userenv{'firstname'}  ||
                    656:         $middle ne $userenv{'middlename'} ||
                    657:         $last   ne $userenv{'lastname'}   ||
                    658:         $gene   ne $userenv{'generation'} ||
1.23      raeburn   659:         $pid    ne $userenv{'id'} ||
                    660:         $emailenc ne $userenv{'permanentemail'} ) {
1.16      raeburn   661: # Make the change(s)
                    662:         my %changeHash;
                    663:         $changeHash{'firstname'}  = $first;
                    664:         $changeHash{'middlename'} = $middle;
                    665:         $changeHash{'lastname'}   = $last;
                    666:         $changeHash{'generation'} = $gene;
                    667:         $changeHash{'id'} = $pid;
1.23      raeburn   668:         $changeHash{'permanentemail'} = $emailenc;
1.16      raeburn   669:         my $putresult = &Apache::lonnet::put('environment',\%changeHash,$dom,$uname);
                    670:         if ($putresult eq 'ok') {
                    671:             $$logmsg .= "User information updated for user: $uname prior to enrollment.".$linefeed;
                    672:         } else {
                    673:             $$logmsg .= "There was a problem modifying user data for existing user - $uname -error: $putresult, enrollment will still be attempted.".$linefeed;
                    674:         }
                    675:     }
                    676:                                                                                   
                    677: # Assign the role of student in the course.
                    678:     my $classlist_reply = &Apache::lonnet::modify_student_enrollment($dom,$uname,$pid,$first,$middle,$last,$gene,$usec,$end,$start,'auto','',$cid);
                    679:     if ($classlist_reply eq 'ok') {
                    680:         my $access = &showaccess($end,$start);
                    681:         if ($caller eq 'switchtype') {
                    682:             $$logmsg .= "Existing user $uname detected in institutional classlist - switched from 'manual' to 'auto' enrollment in section/group $usec.".$access.$linefeed;
                    683:         } elsif ($caller eq 'newstudent') {
                    684:             $$enrollcount ++;
                    685:             $$addresult .= "$first $last ($pid) - $uname enrolled in section/group $usec.".$access.$linefeed;
                    686:         }
                    687:         if ($context eq 'automated') {
                    688:             $$logmsg .= "Existing $dom user $uname enrolled successfully.".$linefeed;
                    689:         }
                    690:     } else {
                    691:            $$logmsg .= "There was a problem updating the classlist db file for user $uname to show the new enrollment -error: $classlist_reply, so no enrollment occurred for this user.".$linefeed;
                    692:     }
                    693:     return;
                    694: }
                    695: 
                    696: sub datechange_check {
                    697:     my ($oldstart,$oldend,$startdate,$enddate) = @_;
                    698:     my $datechange = 0;
                    699:     unless ($oldstart eq $startdate) {
                    700:         $datechange = 1;
                    701:     }
                    702:     if (!$datechange) {
                    703:         if (!$oldend) {
                    704:             if ($enddate) {
                    705:                 $datechange = 1;
                    706:             }
                    707:         } elsif ($oldend ne $enddate) {
                    708:             $datechange = 1;
                    709:         }
                    710:     }
                    711:     return $datechange;
                    712: }
                    713: 
1.15      raeburn   714: sub showaccess {
                    715:     my ($end,$start) = @_;
                    716:     my $showstart;
                    717:     my $showend;
                    718:     if ( (!$start) || ($start <= time) ) {
                    719:         $showstart = 'immediately';
                    720:     } else {
                    721:         $showstart = &Apache::lonlocal::locallocaltime($start);
                    722:     }
                    723:     if (!$end) {
                    724:         $showend = 'no end date';
                    725:     } else {
                    726:         $showend = &Apache::lonlocal::locallocaltime($end);
                    727:     }
                    728:     my $access_msg = " Access starts: ".$showstart.", ends: ".$showend.".";
                    729:     return $access_msg;
                    730: }
                    731: 
1.1       raeburn   732: sub parse_classlist {
1.6       raeburn   733:     my ($tmpdir,$dom,$crs,$class,$placeref,$groupID,$studentsref) = @_;
1.5       raeburn   734:     my $xmlfile = $tmpdir."/tmp/".$dom."_".$crs."_".$class."_classlist.xml";
1.6       raeburn   735:     my $uname = '';
                    736:     my @state;
1.8       raeburn   737:     my @items = ('autharg','authtype','email','firstname','generation','lastname','middlename','studentID');
1.6       raeburn   738:     my $p = HTML::Parser->new
                    739:     (
                    740:         xml_mode => 1,
                    741:         start_h =>
                    742:             [sub {
                    743:                  my ($tagname, $attr) = @_;
                    744:                  push @state, $tagname;
                    745:                  if ("@state" eq "students student") {
                    746:                      $uname = $attr->{username};
                    747:                  }
                    748:             }, "tagname, attr"],
                    749:          text_h =>
                    750:              [sub {
                    751:                  my ($text) = @_;
                    752:                  if ("@state" eq "students student groupID") {
                    753:                      $$studentsref{$uname}[ $$placeref{'groupID'} ] = $groupID;
1.8       raeburn   754:                  } elsif ("@state" eq "students student startdate") {
                    755:                      my $start = $text;
                    756:                      unless ($text eq '') {
                    757:                          $start = &process_date($text);
                    758:                      }
                    759:                      $$studentsref{$uname}[ $$placeref{'startdate'} ] = $start; 
                    760:                  } elsif ("@state" eq "students student enddate") {
                    761:                      my $end = $text;
                    762:                      unless ($text eq '') {
                    763:                          $end = &process_date($text);
                    764:                      }
                    765:                      $$studentsref{$uname}[ $$placeref{'enddate'} ] = $end;
1.6       raeburn   766:                  } else {
                    767:                      foreach my $item (@items) {
                    768:                          if ("@state" eq "students student $item") {
                    769:                              $$studentsref{$uname}[ $$placeref{$item} ] = $text;
                    770:                          }
                    771:                      }
                    772:                  }
                    773:                }, "dtext"],
                    774:          end_h =>
                    775:                [sub {
                    776:                    my ($tagname) = @_;
                    777:                    pop @state;
                    778:                 }, "tagname"],
                    779:     );
                    780:                                                                                                              
                    781:     $p->parse_file($xmlfile);
                    782:     $p->eof;
1.8       raeburn   783:     if (-e "$xmlfile") {
                    784:         unlink $xmlfile;
                    785:     }
1.3       raeburn   786:     return;
1.1       raeburn   787: }
                    788: 
1.8       raeburn   789: sub process_date {
                    790:     my $timestr = shift;
                    791:     my $timestamp = '';
                    792:     if ($timestr =~ m/^\d{4}:\d{2}:\d{2}/) {
                    793:         my @entries = split/:/,$timestr;
                    794:         for (my $j=0; $j<@entries; $j++) {
                    795:             if ( length($entries[$j]) > 1 ) {
                    796:                 $entries[$j] =~ s/^0//;
                    797:             }
                    798:         }
                    799:         $entries[1] = $entries[1] - 1;
                    800:         $timestamp =  timelocal($entries[5],$entries[4],$entries[3],$entries[2],$entries[1],$entries[0]);
                    801:     }
                    802:     return $timestamp;
                    803: }
                    804: 
1.1       raeburn   805: sub create_password {
1.8       raeburn   806:     my $passwd = '';
1.11      raeburn   807:     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");
1.8       raeburn   808:     for (my $i=0; $i<8; $i++) {
                    809:         my $lettnum = int (rand 2);
                    810:         my $item = '';
                    811:         if ($lettnum) {
                    812:             $item = $letts[int( rand(26) )];
                    813:             my $uppercase = int(rand 2);
                    814:             if ($uppercase) {
                    815:                 $item =~ tr/a-z/A-Z/;
                    816:             }
                    817:         } else {
                    818:             $item = int( rand(10) );
                    819:         } 
                    820:         $passwd .= $item;
                    821:     }
                    822:     return ($passwd);
1.9       raeburn   823: }
                    824: 
1.19      raeburn   825: sub get_courseinfo {
                    826:     my ($dom,$crs,$courseinfo) = @_;
                    827:     my $owner;
                    828:     if (defined($dom) && defined($crs)) {
1.31    ! raeburn   829:         my %settings = &Apache::lonnet::get('environment',['internal.coursecode','internal.showphoto','description'],$dom,$crs);
1.19      raeburn   830:         if ( defined($settings{'internal.coursecode'}) ) {
                    831:             $$courseinfo{'inst_code'} = $settings{'internal.coursecode'};
                    832:         }
                    833:         if ( defined($settings{'description'}) ) {
                    834:             $$courseinfo{'description'} = $settings{'description'};
                    835:         }
1.31    ! raeburn   836:         if ( defined($settings{'internal.showphoto'}) ) {
        !           837:             $$courseinfo{'showphoto'} = $settings{'internal.showphoto'};
1.28      raeburn   838:         }
1.19      raeburn   839:     }
                    840:     return;
                    841: }
                    842: 
1.1       raeburn   843: sub CL_autharg { return 0; }
                    844: sub CL_authtype { return 1;}
                    845: sub CL_email { return 2;}
                    846: sub CL_enddate { return 3;}
                    847: sub CL_firstname { return 4;}
                    848: sub CL_generation { return 5;}
                    849: sub CL_groupID { return 6;}
                    850: sub CL_lastname { return 7;}
                    851: sub CL_middlename { return 8;}
                    852: sub CL_startdate { return 9; }
                    853: sub CL_studentID { return 10; }
                    854: 
1.28      raeburn   855: sub photo_response_types {
1.29      albertel  856:     my %lt = &Apache::lonlocal::texthash(
1.28      raeburn   857:                       'same' => 'remained unchanged',
                    858:                       'update' => 'were updated',
                    859:                       'new' => 'were added',
                    860:                       'missing' => 'were missing',
                    861:                       'error' => 'were not imported because an error occurred',
                    862:                       'nouser' => 'were for users without accounts',
                    863:                       'noid' => 'were for users without student IDs',
1.29      albertel  864: 					 );
1.28      raeburn   865:     return %lt;
                    866: }
                    867: 
                    868: 
1.1       raeburn   869: 1;

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