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

Diff for /loncom/enrollment/Enrollment.pm between versions 1.16 and 1.26

version 1.16, 2004/06/29 04:30:00 version 1.26, 2006/01/02 20:19:37
Line 32  use HTML::Entities; Line 32  use HTML::Entities;
 use LONCAPA::Configuration;  use LONCAPA::Configuration;
 use Time::Local;  use Time::Local;
 use lib '/home/httpd/lib/perl';  use lib '/home/httpd/lib/perl';
 use localenroll;  
   
 use strict;  use strict;
   
 sub update_LC {  sub update_LC {
     my ($dom,$crs,$adds,$drops,$startdate,$enddate,$authtype,$autharg,$classesref,$groupref,$logmsg,$newusermsg,$context) = @_;       my ($dom,$crs,$adds,$drops,$startdate,$enddate,$authtype,$autharg,$classesref,$groupref,$logmsg,$newusermsg,$context) = @_; 
   # Get institutional code and title of this class
       my %courseinfo = ();
       &get_courseinfo($dom,$crs,\%courseinfo);
 # Get current LON-CAPA student enrollment for this class  # Get current LON-CAPA student enrollment for this class
     my $configvars = &LONCAPA::Configuration::read_conf('loncapa.conf');      my $configvars = &LONCAPA::Configuration::read_conf('loncapa.conf');
     my $cid = $dom."_".$crs;      my $cid = $dom."_".$crs;
     my $roster = &Apache::loncoursedata::get_classlist($cid,$dom,$crs);      my $roster = &Apache::loncoursedata::get_classlist($dom,$crs);
     my $cend = &Apache::loncoursedata::CL_END;      my $cend = &Apache::loncoursedata::CL_END;
     my $cstart = &Apache::loncoursedata::CL_START;       my $cstart = &Apache::loncoursedata::CL_START; 
     my $stuid=&Apache::loncoursedata::CL_ID;      my $stuid=&Apache::loncoursedata::CL_ID;
Line 52  sub update_LC { Line 54  sub update_LC {
     my @localstudents = ();      my @localstudents = ();
     my @futurestudents = ();      my @futurestudents = ();
     my @activestudents = ();      my @activestudents = ();
       my @excludedstudents = ();
     my $currlist;      my $currlist;
     foreach my $uname (keys %{$roster} ) {      foreach my $uname (keys %{$roster} ) {
         if ($uname =~ m/^(.+):$dom$/) {          if ($uname =~ m/^(.+):$dom$/) {
Line 63  sub update_LC { Line 66  sub update_LC {
                 push @futurestudents, $1;                  push @futurestudents, $1;
                 @{$$currlist{$1}} = @{$$roster{$uname}};                  @{$$currlist{$1}} = @{$$roster{$uname}};
                 push @localstudents, $1;                  push @localstudents, $1;
               } elsif ($$roster{$uname}[$lockedtype] == 1) {
                   push @excludedstudents, $1;
             }              }
         }          }
     }      }
     my $linefeed = '';      my $linefeed = '';
     my $addresult = '';      my $addresult = '';
     my $dropresult = '';      my $dropresult = '';
       my $switchresult = '';
     if ($context eq "updatenow") {      if ($context eq "updatenow") {
         $linefeed = "</li>\n<li>";           $linefeed = "</li>\n<li>"; 
     } elsif ($context eq "automated") {      } elsif ($context eq "automated") {
Line 76  sub update_LC { Line 82  sub update_LC {
     }      }
     my $enrollcount = 0;      my $enrollcount = 0;
     my $dropcount = 0;      my $dropcount = 0;
       my $switchcount = 0;
   
   # Get role names
       my %longroles = ();
       open(FILE,"<$$configvars{'lonTabDir'}.'/rolesplain.tab");
       my @rolesplain = <FILE>;
       close(FILE);
       foreach (@rolesplain) {
           if ($_ =~ /^(st|ta|ex|ad|in|cc):([\w\s]+)$/) {
               $longroles{$1} = $2;
           }
       }
   
     srand( time() ^ ($$ + ($$ << 15))  ); # Seed rand in case initial passwords have to be generated for new users.      srand( time() ^ ($$ + ($$ << 15))  ); # Seed rand in case initial passwords have to be generated for new users.
   
Line 125  sub update_LC { Line 143  sub update_LC {
 # Check for multiple sections for a single student   # Check for multiple sections for a single student 
     my @okusers = ();      my @okusers = ();
     foreach my $uname (@reg_students)  {      foreach my $uname (@reg_students)  {
         if (@{$allenrolled{$uname}} > 1) {          if (grep/^$uname$/,@excludedstudents) {
               $$logmsg .= "No re-enrollment for $uname - user was previously manually unenrolled and locked.".$linefeed;
           } elsif (@{$allenrolled{$uname}} > 1) {
             my @sections = ();              my @sections = ();
             my $saved;              my $saved;
             for (my $i=0; $i<@{$allenrolled{$uname}}; $i++) {              for (my $i=0; $i<@{$allenrolled{$uname}}; $i++) {
Line 174  sub update_LC { Line 194  sub update_LC {
     }      }
 # Explicitly allow access to creation/modification of students if called as an automated process.  # Explicitly allow access to creation/modification of students if called as an automated process.
     if ($context eq 'automated') {      if ($context eq 'automated') {
         $ENV{'allowed.cst'}='F';          $env{'allowed.cst'}='F';
     }      }
   
 # Compare IDs with existing LON-CAPA enrollment for this class  # Compare IDs with existing LON-CAPA enrollment for this class
Line 202  sub update_LC { Line 222  sub update_LC {
                         my ($auth,$authparam,$first,$middle,$last,$gene,$usec,$end,$start,$emailaddr,$pid,$emailenc);                          my ($auth,$authparam,$first,$middle,$last,$gene,$usec,$end,$start,$emailaddr,$pid,$emailenc);
                         &prepare_add($authtype,$autharg,$enddate,$startdate,\@stuinfo,\%place,\$dom,\$uname,\$auth,\$authparam,\$first,\$middle,\$last,\$gene,\$usec,\$end,\$start,\$emailaddr,\$pid,\$emailenc);                          &prepare_add($authtype,$autharg,$enddate,$startdate,\@stuinfo,\%place,\$dom,\$uname,\$auth,\$authparam,\$first,\$middle,\$last,\$gene,\$usec,\$end,\$start,\$emailaddr,\$pid,\$emailenc);
                         if ($$currlist{$uname}[$sec] ne $usec) {                          if ($$currlist{$uname}[$sec] ne $usec) {
                             $$logmsg .= "Section for $uname switched from $$currlist{$uname}[$sec] to $usec".$linefeed;                              $switchresult .= "Section for $uname switched from $$currlist{$uname}[$sec] to ".$usec.$linefeed;
                               if ($context eq 'automated') {
                                   $$logmsg .= "Section switch for $uname from $$currlist{$uname}[$sec] to ".$usec.$linefeed; ;
                               }
                               $switchcount ++;
                         }                          }
                         &execute_add($context,'switchtype',$uname,$dom,$auth,$authparam,$first,$middle,$last,$gene,$pid,$usec,$end,$start,$emailenc,$cid,\$addresult,\$enrollcount,$linefeed,$logmsg);                          &execute_add($context,'switchtype',$uname,$dom,$auth,$authparam,$first,$middle,$last,$gene,$pid,$usec,$end,$start,$emailenc,$cid,\$addresult,\$enrollcount,$linefeed,$logmsg);
                     }                      }
Line 241  sub update_LC { Line 265  sub update_LC {
                                 $access =  &showaccess($enddate,$startdate);                                  $access =  &showaccess($enddate,$startdate);
                             }                              }
                             if ($modify_section_result =~ /^ok/) {                              if ($modify_section_result =~ /^ok/) {
                                 $$logmsg .= "Section for $uname switched from old section: ".$$currlist{$uname}[$sec] ." to new section: ".$stuinfo[ $place{groupID} ].".".$access.$linefeed;                                  $switchresult .= "Section for $uname switched from old section: ".$$currlist{$uname}[$sec] ." to new section: ".$stuinfo[ $place{groupID} ].".".$access.$linefeed;
                                   if ($context eq 'automated') {
                                       $$logmsg .= "Section switch for $uname from $$currlist{$uname}[$sec] to $stuinfo[ $place{groupID} ]".$linefeed;
                                   }
                                   $switchcount ++;
                             } else {                              } else {
                                 $$logmsg .= "Error when attempting section change for $uname from old section ".$$currlist{$uname}[$sec]." to new section: ".$stuinfo[ $place{groupID} ]." -error: $modify_section_result".$linefeed;                                  $$logmsg .= "Error when attempting section change for $uname from old section ".$$currlist{$uname}[$sec]." to new section: ".$stuinfo[ $place{groupID} ]." -error: $modify_section_result".$linefeed;
                             }                              }
Line 266  sub update_LC { Line 294  sub update_LC {
 # Check for existing account in this LON-CAPA domain for this username  # Check for existing account in this LON-CAPA domain for this username
                     my $uhome=&Apache::lonnet::homeserver($uname,$dom);                      my $uhome=&Apache::lonnet::homeserver($uname,$dom);
                     if ($uhome eq 'no_host') { # User does not exist                      if ($uhome eq 'no_host') { # User does not exist
                         my $create_passwd = 0;                          my $args = {'auth' => $auth,
                         my $authchk = '';                                      'authparam' => $authparam,
                         unless ($authparam eq '') { $authchk = 'ok'; };                                      'emailenc' => $emailenc,
 # If no account exists and passwords should be generated                                      'udom' => $dom,
                         if ($auth eq "internal") {                                      'uname' => $uname,
                             if ($authparam eq '') {                                      'pid' => $pid,
                                 ($authparam) = &create_password();                                      'first' => $first,
                                 if ($authparam eq '') {                                      'middle' => $middle,
                                     $authchk = '';                                      'last' => $last,
                                 } else {                                      'gene' => $gene,
                                     $create_passwd = 1;                                      'usec' => $usec,
                                     $authchk = 'ok';                                      'end' => $end,
                                 }                                              'start' => $start,
                             }                                      'emailaddr' => $emailaddr,
                         } elsif ($auth eq "localauth") {                                      'cid' => $cid,
                             ($authparam,$create_passwd,$authchk) = &localenroll::create_password($authparam);                                      'crs' => $crs,
                         } elsif ($auth =~ m/^krb/) {                                      'cdom' => $dom,
                             if ($authparam eq '') {                                      'context' => $context,
                                 $$logmsg .= "No Kerberos domain was provided for the new user - $uname, so the new student was not enrolled in the course.".$linefeed;                                      'linefeed' => $linefeed,
                                 $authchk = 'invalid';                                      'role' => 'st'
                             }                                     };
                         } else {                          my $outcome = &create_newuser($args,$logmsg,$newusermsg,\$enrollcount,\$addresult,\%longroles,\%courseinfo);
                             $authchk = 'invalid';  
                             $$logmsg .= "An invalid authentication type was provided for the new user - $uname, so the student was not enrolled in the course.".$linefeed;  
                         }  
                         if ($authchk eq 'ok') {   
 # Now create user.  
                             my $reply=&Apache::lonnet::modifystudent($dom,$uname,$pid,$auth,$authparam,$first,$middle,$last,$gene,$usec,$end,$start,'',undef,$emailaddr,'auto','',$cid);  
                             if ($reply eq 'ok') {  
                                 $access = &showaccess($end,$start);  
                                 $enrollcount ++;  
                                 $addresult .= "$first $last ($pid) - $uname enrolled in section/group $usec.".$access.$linefeed;  
                                 if ($context eq 'automated') {  
                                     $$logmsg .= "New $dom user $uname added successfully.";  
                                 }  
                                 unless ($emailenc eq '') {  
                                     my %emailHash;  
                                     $emailHash{'critnotification'}  = $emailenc;  
                                     $emailHash{'notification'} = $emailenc;  
                                     my $putresult = &Apache::lonnet::put('environment',\%emailHash,$dom,$uname);  
                                 }  
                                 if ($create_passwd) {  
 # Send e-mail with initial password to new user at $emailaddr.   
 # If e-mail address is invalid, send password via message to courseowner i  
 # (if automated call) or to user if roster update.   
                                     if ($emailaddr eq '') {  
                                         $$newusermsg .= " username: $uname, password: ".$authparam.$linefeed."\n";  
                                     } else {  
                                         my $subject = "New LON-CAPA account";  
                                         my $body = "You have been enrolled in the LON-CAPA system at your school, because you are a registered student in a class that is using the LON-CAPA course management and online homework system.\n\nYou should log-in to the system using the following credentials:\nusername: $uname\npassword: $authparam\n\nThe URL you should use to access the LON-CAPA system at your school is: http://".$ENV{'SERVER_NAME'};  
                                        &Apache::lonmsg::sendemail($emailaddr,$subject,$body);   
                                     }                                   
                                     if ($context eq 'automated') {  
                                         $$logmsg .= " Initial password -  - sent to ".$emailaddr.$linefeed;  
                                     }  
                                 } else {  
                                     if ($context eq 'automated') {  
                                         $$logmsg .= $linefeed;  
                                     }  
                                 }  
                             } else {  
                                 $$logmsg .= "An error occurred adding new user $uname - ".$reply.$linefeed;  
                             }  
                         }  
                     } else {                      } else {
                         &execute_add($context,'newstudent',$uname,$dom,$auth,$authparam,$first,$middle,$last,$gene,$pid,$usec,$end,$start,$emailenc,$cid,\$addresult,\$enrollcount,$linefeed,$logmsg);                          &execute_add($context,'newstudent',$uname,$dom,$auth,$authparam,$first,$middle,$last,$gene,$pid,$usec,$end,$start,$emailenc,$cid,\$addresult,\$enrollcount,$linefeed,$logmsg);
                     }                      }
Line 369  sub update_LC { Line 355  sub update_LC {
   
 # Terminated explictly allowed access to student creation/modification  # Terminated explictly allowed access to student creation/modification
     if ($context eq 'automated') {      if ($context eq 'automated') {
         delete($ENV{'allowed.cst'});          delete($env{'allowed.cst'});
     }      }
     if ($enrollcount > 0) {      if ($enrollcount > 0) {
         if ($context eq "updatenow") {          if ($context eq "updatenow") {
             $addresult = substr($addresult,0,rindex($addresult,"<li>"));              $addresult = substr($addresult,0,rindex($addresult,"<li>"));
             $addresult = "The following $enrollcount student(s) was/were added to this LON-CAPA course:<br/><ul><li>".$addresult."</li></ul><br/><br/>";              $addresult = "The following $enrollcount student(s) was/were added to this LON-CAPA course:<br/><ul><li>".$addresult."</ul><br/><br/>";
         } else {          } else {
             $addresult = "The following $enrollcount student(s) was/were added to this LON-CAPA course:\n\n".$addresult."\n\n";                  $addresult = "The following $enrollcount student(s) was/were added to this LON-CAPA course:\n\n".$addresult."\n\n";
         }                }
     }      }
     if ($dropcount > 0) {      if ($dropcount > 0) {
         if ($context eq "updatenow") {          if ($context eq "updatenow") {
             $dropresult = substr($dropresult,0,rindex($dropresult,"<li>"));              $dropresult = substr($dropresult,0,rindex($dropresult,"<li>"));
             $dropresult = "The following $dropcount student(s) was/were expired from this LON-CAPA course:<br/><ul><li>".$dropresult."</li></ul><br/><br/>";              $dropresult = "The following $dropcount student(s) was/were expired from this LON-CAPA course:<br/><ul><li>".$dropresult."</ul><br/><br/>";
         } else {          } else {
             $dropresult = "The following $dropcount student(s) was/were expired from this LON-CAPA course:\n\n".$dropresult."\n\n";              $dropresult = "The following $dropcount student(s) was/were expired from this LON-CAPA course:\n\n".$dropresult."\n\n";
         }          }
     }      }
       if ($switchcount > 0) {
           if ($context eq "updatenow") {
               $switchresult = substr($switchresult,0,rindex($switchresult,"<li>"));
               $switchresult = "The following $switchcount student(s) switched sections in this LON-CAPA course:<br/><ul><li>".$switchresult."</ul><br/><br/>";
           } else {
               $switchresult = "The following $switchcount student(s) switched sections in this LON-CAPA course:\n\n".$switchresult."\n\n";
           }
       }
     if ( ($adds) && ($enrollcount == 0) ) {      if ( ($adds) && ($enrollcount == 0) ) {
         $addresult = "There were no new students to add to the course.";          $addresult = "There were no new students to add to the course.";
         if ($context eq "updatenow") {          if ($context eq "updatenow") {
Line 403  sub update_LC { Line 397  sub update_LC {
             $dropresult .="\n";              $dropresult .="\n";
         }          }
     }      }
     my $changecount = $enrollcount + $dropcount;      my $changecount = $enrollcount + $dropcount + $switchcount;
     return ($changecount,$addresult.$dropresult);       return ($changecount,$addresult.$dropresult.$switchresult);
   }
   
   sub create_newuser {
       my ($args,$logmsg,$newusermsg,$enrollcount,$addresult,$longroles,$courseinfo) = @_;
       my $auth = $args->{'auth'};
       my $authparam = $args->{'authparam'};
       my $emailenc = $args->{'emailenc'};
       my $udom = $args->{'udom'};
       my $uname = $args->{'uname'};
       my $pid = $args->{'pid'};
       my $first = $args->{'first'};
       my $middle = $args->{'middle'};
       my $last = $args->{'last'} ;
       my $gene = $args->{'gene'};
       my $usec = $args->{'usec'};
       my $end = $args->{'end'};
       my $start = $args->{'start'};
       my $emailaddr = $args->{'emailaddr'};
       my $cid = $args->{'cid'};
       my $crs = $args->{'crs'};
       my $cdom = $args->{'cdom'};
       my $context = $args->{'context'};
       my $linefeed = $args->{'linefeed'};
       my $role = $args->{'role'};
       my $create_passwd = 0;
       my $authchk = '';
       my $outcome;
       unless ($authparam eq '') { $authchk = 'ok'; };
   # If no account exists and passwords should be generated
       if ($auth eq "internal") {
           if ($authparam eq '') {
               $authparam = &create_password();
               if ($authparam eq '') {
                   $authchk = '';
               } else {
                   $create_passwd = 1;
                   $authchk = 'ok';
               }
           }
       } elsif ($auth eq "localauth") {
           ($authparam,$create_passwd,$authchk) = &Apache::lonnet::auto_create_password($crs,$cdom,$authparam);
       } elsif ($auth =~ m/^krb/) {
           if ($authparam eq '') {
               $$logmsg .= "No Kerberos domain was provided for the new user - $uname, so the new user was not enrolled in the course.".$linefeed;
               $authchk = 'invalid';
           }
       } else {
           $authchk = 'invalid';
           $$logmsg .= "An invalid authentication type was provided for the new user - $uname, so the user was not enrolled in the course.".$linefeed;
       }   
       if ($authchk eq 'ok') {
   # Now create user.
           my $type = 'auto';
           my $userurl = '/'.$cdom.'/'.$crs;
           if ($usec ne '') {
               $userurl .= '/'.$usec;
           }
           if ($context eq 'createowner' || $context eq 'createcourse') {
               my $result = &Apache::lonnet::modifyuser($udom,$uname,$pid,$auth,$authparam,$first,$middle,$last,$gene,'1',undef,$emailaddr);
               if ($result eq 'ok' && $context eq 'createcourse') {
                   $outcome = &Apache::loncreateuser::commit_standardrole($udom,$uname,$userurl,$role,$start,$end,$cdom,$crs,$usec);
                   unless ($outcome =~ /^Error:/) {
                       $outcome = 'ok';
                   }
               } else {
                   $outcome = $result;
               }
           } else {
               $outcome=&Apache::lonnet::modifystudent($udom,$uname,$pid,$auth,$authparam,$first,$middle,$last,$gene,$usec,$end,$start,'',undef,$emailaddr,'auto','',$cid);
           }
           if ($outcome eq 'ok') {
               my $access = &showaccess($end,$start);
               $$addresult .= "$first $last ($pid) - $uname enrolled in section/group $usec.".$access.$linefeed;
               unless ($context eq 'createowner' || $context eq 'createcourse') {
                   $$enrollcount ++;
               }
               if ($context eq 'automated') {
                   $$logmsg .= "New $udom user $uname added successfully.";
               }
               unless ($emailenc eq '' || $context eq 'createowner' || $context eq 'createcourse') {
                   my %emailHash;
                   $emailHash{'critnotification'}  = $emailenc;
                   $emailHash{'notification'} = $emailenc;
                   $emailHash{'permanentemail'} = $emailenc;
                   my $putresult = &Apache::lonnet::put('environment',\%emailHash,$udom,$uname);
               }
               if ($create_passwd) {
   # Send e-mail with initial password to new user at $emailaddr.
   # If e-mail address is invalid, send password via message to courseowner i
   # (if automated call) or to user if roster update.
                   if ($emailaddr eq '') {
                       $$newusermsg .= " username: $uname, password: ".$authparam.$linefeed."\n";
                   } else {
                       my $subject = "New LON-CAPA account";
                       my $body;
                       if ($context eq 'createowner') {
                           $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";
                       } elsif ($context eq 'createcourse') {
                           $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"; 
                       } else {
                           my $access_start = 'immediately';
                           if ($start > 0) {
                               $access_start = localtime($start)
                           }
                           $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";
                       }
                       &Apache::lonmsg::sendemail($emailaddr,$subject,$body);
                   }
                   if ($context eq 'automated') {
                       $$logmsg .= " Initial password -  - sent to ".$emailaddr.$linefeed;
                   }
               } else {
                   if ($context eq 'automated') {
                       $$logmsg .= $linefeed;
                   }
               }
           } else {
               $$logmsg .= "An error occurred adding new user $uname - ".$outcome.$linefeed;
           }
       }
       return $outcome;
 }  }
   
 sub prepare_add {  sub prepare_add {
Line 450  sub prepare_add { Line 565  sub prepare_add {
 sub execute_add {  sub execute_add {
     my ($context,$caller,$uname,$dom,$auth,$authparam,$first,$middle,$last,$gene,$pid,$usec,$end,$start,$emailenc,$cid,$addresult,$enrollcount,$linefeed,$logmsg) = @_;      my ($context,$caller,$uname,$dom,$auth,$authparam,$first,$middle,$last,$gene,$pid,$usec,$end,$start,$emailenc,$cid,$addresult,$enrollcount,$linefeed,$logmsg) = @_;
 # Get the user's information and authentication  # Get the user's information and authentication
     my %userenv = &Apache::lonnet::get('environment',['firstname','middlename','lastname','generation','id','critnotification','notification'],$dom,$uname);      my %userenv = &Apache::lonnet::get('environment',['firstname','middlename','lastname','generation','id','critnotification','notification','permanentemail'],$dom,$uname);
     my ($tmp) = keys(%userenv);      my ($tmp) = keys(%userenv);
     if ($tmp =~ /^(con_lost|error)/i) {      if ($tmp =~ /^(con_lost|error)/i) {
         %userenv = ();          %userenv = ();
Line 463  sub execute_add { Line 578  sub execute_add {
         }          }
     }      }
     if ($userenv{notification} =~ m/%40/) {      if ($userenv{notification} =~ m/%40/) {
         unless ($emailenc eq $userenv{critnotification}) {          unless ($emailenc eq $userenv{notification}) {
             $$logmsg .= "Current standard notification e-mail              $$logmsg .= "Current standard notification e-mail
 - ".$userenv{notification}." for $uname is different to e-mail address in institutional classlist - ".$emailenc.$linefeed;  - ".$userenv{notification}." for $uname is different to e-mail address in institutional classlist - ".$emailenc.$linefeed;
         }          }
     }      }
       if ($userenv{permanentemail} =~ m/%40/) {
           unless ($emailenc eq $userenv{permanentemail}) {
               $$logmsg .= "Current permanent e-mail
   - ".$userenv{permanentemail}." for $uname is different to e-mail address in institutional classlist - ".$emailenc.$linefeed;
           }
       }
     my $krbdefdom = '';      my $krbdefdom = '';
     my $currentauth=&Apache::lonnet::queryauthenticate($uname,$dom);      my $currentauth=&Apache::lonnet::queryauthenticate($uname,$dom);
     if ($currentauth=~/^(krb[45]):(.*)/) {      if ($currentauth=~/^(krb[45]):(.*)/) {
Line 492  sub execute_add { Line 613  sub execute_add {
         $middle ne $userenv{'middlename'} ||          $middle ne $userenv{'middlename'} ||
         $last   ne $userenv{'lastname'}   ||          $last   ne $userenv{'lastname'}   ||
         $gene   ne $userenv{'generation'} ||          $gene   ne $userenv{'generation'} ||
         $pid    ne $userenv{'id'} ) {          $pid    ne $userenv{'id'} ||
           $emailenc ne $userenv{'permanentemail'} ) {
 # Make the change(s)  # Make the change(s)
         my %changeHash;          my %changeHash;
         $changeHash{'firstname'}  = $first;          $changeHash{'firstname'}  = $first;
Line 500  sub execute_add { Line 622  sub execute_add {
         $changeHash{'lastname'}   = $last;          $changeHash{'lastname'}   = $last;
         $changeHash{'generation'} = $gene;          $changeHash{'generation'} = $gene;
         $changeHash{'id'} = $pid;          $changeHash{'id'} = $pid;
           $changeHash{'permanentemail'} = $emailenc;
         my $putresult = &Apache::lonnet::put('environment',\%changeHash,$dom,$uname);          my $putresult = &Apache::lonnet::put('environment',\%changeHash,$dom,$uname);
         if ($putresult eq 'ok') {          if ($putresult eq 'ok') {
             $$logmsg .= "User information updated for user: $uname prior to enrollment.".$linefeed;              $$logmsg .= "User information updated for user: $uname prior to enrollment.".$linefeed;
Line 656  sub create_password { Line 779  sub create_password {
     return ($passwd);      return ($passwd);
 }  }
   
 sub check_user_status {  sub get_courseinfo {
     my ($udom,$uname,$cdom,$crs,$role,$secgrp) = @_;      my ($dom,$crs,$courseinfo) = @_;
     my %userinfo = &Apache::lonnet::dump('roles',$udom,$uname);      my $owner;
     my @uroles = keys %userinfo;      if (defined($dom) && defined($crs)) {
     my $srchstr;          my %settings = &Apache::lonnet::get('environment',['internal.coursecode','description'],$dom,$crs);
     my $active_chk = 'none';          if ( defined($settings{'internal.coursecode'}) ) {
     if (@uroles > 0) {              $$courseinfo{'inst_code'} = $settings{'internal.coursecode'};
         if ( ($role eq 'cc') || ($secgrp eq '') || ( !defined($secgrp) ) ) {  
             $srchstr = '/'.$cdom.'/'.$crs.'_'.$role;          }
         } else {          if ( defined($settings{'description'}) ) {
             $srchstr = '/'.$cdom.'/'.$crs.'/'.$secgrp.'_'.$role;              $$courseinfo{'description'} = $settings{'description'};
         }  
         if (grep/^$srchstr$/,@uroles) {  
             my $role_end = 0;  
             my $role_start = 0;  
             $active_chk = 'ok';  
             if ( $userinfo{$srchstr} =~ m/^($role)_(\d+)/ ) {  
                 $role_end = $2;  
                 if ( $userinfo{$srchstr} =~ m/^($role)_($role_end)_(\d+)$/ )  
                 {  
                     $role_start = $3;  
                 }  
             }     
             if ($role_start > 0) {  
                 if (time < $role_start) {  
                     $active_chk = 'expired';  
                 }  
             }  
             if ($role_end > 0) {  
                 if (time > $role_end) {  
                     $active_chk = 'expired';  
                 }  
             }  
         }          }
     }      }
     return $active_chk;      return;
 }  }
   
 sub CL_autharg { return 0; }  sub CL_autharg { return 0; }
Removed from v.1.16  
changed lines
  Added in v.1.26

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