Diff for /loncom/enrollment/Enrollment.pm between versions 1.20 and 1.25

version 1.20, 2004/12/26 21:03:34 version 1.25, 2005/09/16 16:01:19
Line 74  sub update_LC { Line 74  sub update_LC {
     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 81  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  # Get role names
     my %longroles = ();      my %longroles = ();
Line 192  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 220  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 259  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 345  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 379  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 {  sub create_newuser {
Line 441  sub create_newuser { Line 459  sub create_newuser {
         if ($context eq 'createowner' || $context eq 'createcourse') {          if ($context eq 'createowner' || $context eq 'createcourse') {
             my $result = &Apache::lonnet::modifyuser($udom,$uname,$pid,$auth,$authparam,$first,$middle,$last,$gene,'1',undef,$emailaddr);              my $result = &Apache::lonnet::modifyuser($udom,$uname,$pid,$auth,$authparam,$first,$middle,$last,$gene,'1',undef,$emailaddr);
             if ($result eq 'ok' && $context eq 'createcourse') {              if ($result eq 'ok' && $context eq 'createcourse') {
                 $outcome = &Apache::loncreateuser::commit_standardrole($userurl,$role,$cdom,$crs,$start,$end);                  $outcome = &Apache::loncreateuser::commit_standardrole($udom,$uname,$userurl,$role,$start,$end,$cdom,$crs,$usec);
                 unless ($outcome =~ /^Error:/) {                  unless ($outcome =~ /^Error:/) {
                     $outcome = 'ok';                      $outcome = 'ok';
                 }                  }
Line 464  sub create_newuser { Line 482  sub create_newuser {
                 my %emailHash;                  my %emailHash;
                 $emailHash{'critnotification'}  = $emailenc;                  $emailHash{'critnotification'}  = $emailenc;
                 $emailHash{'notification'} = $emailenc;                  $emailHash{'notification'} = $emailenc;
                   $emailHash{'permanentemail'} = $emailenc;
                 my $putresult = &Apache::lonnet::put('environment',\%emailHash,$udom,$uname);                  my $putresult = &Apache::lonnet::put('environment',\%emailHash,$udom,$uname);
             }              }
             if ($create_passwd) {              if ($create_passwd) {
Line 546  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 559  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 588  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 596  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 752  sub create_password { Line 779  sub create_password {
     return ($passwd);      return ($passwd);
 }  }
   
 sub check_user_status {  
     my ($udom,$uname,$cdom,$crs,$role,$secgrp) = @_;  
     my %userinfo = &Apache::lonnet::dump('roles',$udom,$uname);  
     my @uroles = keys %userinfo;  
     my $srchstr;  
     my $active_chk = 'none';  
     if (@uroles > 0) {  
         if ( ($role eq 'cc') || ($secgrp eq '') || ( !defined($secgrp) ) ) {  
             $srchstr = '/'.$cdom.'/'.$crs.'_'.$role;  
         } else {  
             $srchstr = '/'.$cdom.'/'.$crs.'/'.$secgrp.'_'.$role;  
         }  
         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;  
 }  
   
 sub get_courseinfo {  sub get_courseinfo {
     my ($dom,$crs,$courseinfo) = @_;      my ($dom,$crs,$courseinfo) = @_;
     my $owner;      my $owner;

Removed from v.1.20  
changed lines
  Added in v.1.25


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