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

Diff for /loncom/interface/Attic/londropadd.pm between versions 1.55 and 1.56

version 1.55, 2002/09/26 14:04:34 version 1.56, 2002/10/15 14:41:31
Line 734  END Line 734  END
     return;      return;
 }  }
   
 # =================================================== get the current classlist  
 sub get_current_classlist {  
     my $r = shift;  
     # Call DownloadClasslist  
     my $cid = $ENV{'request.course.id'};  
     my $c = $r->connection;  
     my $classlisthash = &Apache::loncoursedata::DownloadClasslist  
         ($cid,'Not downloaded',$c);  
     # Call ProcessClasslist  
     my %cache;  
     my @students = &Apache::loncoursedata::ProcessClasslist(\%cache,  
                                                             $classlisthash,  
                                                             $cid,$c);  
     return (\@students,\%cache);  
 }  
   
 # ========================================================= Menu Phase Two Drop  # ========================================================= Menu Phase Two Drop
 sub print_drop_menu {  sub print_drop_menu {
     my $r=shift;      my $r=shift;
     $r->print("<h3>Drop Students</h3>");      $r->print("<h3>Drop Students</h3>");
     my $cid=$ENV{'request.course.id'};      my $cid=$ENV{'request.course.id'};
     my ($student_array,$student_data)=&get_current_classlist($r);      my ($classlist,$keylist) = &Apache::loncoursedata::get_classlist();
     if (! scalar(@$student_array)) {      if (! defined($classlist)) {
         $r->print("There are no students currently enrolled.\n");          $r->print("There are no students currently enrolled.\n");
         return;          return;
     }      }
     # Print out the available choices      # Print out the available choices
     &show_drop_list($student_array,$student_data,$r);      &show_drop_list($r,$classlist,$keylist);
     return;      return;
 }  }
   
Line 775  sub print_html_classlist { Line 759  sub print_html_classlist {
 </p>  </p>
 END  END
     my $cid=$ENV{'request.course.id'};      my $cid=$ENV{'request.course.id'};
     my ($student_array,$student_data)=&get_current_classlist($r);      my ($classlist,$keylist)=&Apache::loncoursedata::get_classlist();
     if (! scalar(@$student_array)) {      if (! defined($classlist)) {
         $r->print("There are no students currently enrolled.\n");          $r->print("There are no students currently enrolled.\n");
     } else {      } else {
         # Print out the available choices          # Print out the available choices
         if ($ENV{'form.action'} eq 'modifystudent') {          if ($ENV{'form.action'} eq 'modifystudent') {
             &show_class_list($r,'view','modify','modifystudent',              &show_class_list($r,'view','modify','modifystudent',
                              'any',$student_array,$student_data);                               'Active',$classlist,$keylist);
         } else {          } else {
             &show_class_list($r,'view','aboutme','classlist',              &show_class_list($r,'view','aboutme','classlist',
                              'any',$student_array,$student_data);                               'Active',$classlist,$keylist);
         }          }
     }      }
 }  }
Line 794  END Line 778  END
 sub print_csv_classlist {  sub print_csv_classlist {
     my $r=shift;      my $r=shift;
     my $cid=$ENV{'request.course.id'};      my $cid=$ENV{'request.course.id'};
     my ($student_array,$student_data)=&get_current_classlist($r);      my ($classlist,$keylist)=&Apache::loncoursedata::get_classlist();
     if (! scalar(@$student_array)) {      if (! defined($classlist)) {
         $r->print("There are no students currently enrolled.\n");          $r->print("There are no students currently enrolled.\n");
     } else {      } else {
         &show_class_list($r,'csv','nolink','csv',          &show_class_list($r,'csv','nolink','csv',
                          'any',$student_array,$student_data);                           'Active',$classlist,$keylist);
     }      }
 }  }
   
 # =================================================== Show student list to drop  # =================================================== Show student list to drop
 sub show_class_list {  sub show_class_list {
     my ($r,$mode,$linkto,$action,$statusmode,$students,$s_data)=@_;      my ($r,$mode,$linkto,$action,$statusmode,$classlist,$keylist)=@_;
     my $cid=$ENV{'request.course.id'};      my $cid=$ENV{'request.course.id'};
     &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},      &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},
                                             ['sortby']);                                              ['sortby']);
Line 816  sub show_class_list { Line 800  sub show_class_list {
     # Print out header       # Print out header 
     if ($mode eq 'view') {      if ($mode eq 'view') {
         if ($linkto eq 'aboutme') {          if ($linkto eq 'aboutme') {
             $r->print('Select a user name to view the users page.');              $r->print('Select a user name to view the users personal page.');
         } elsif ($linkto eq 'modify') {          } elsif ($linkto eq 'modify') {
             $r->print('Select a user name to modify the students information');              $r->print('Select a user name to modify the students information');
         }          }
Line 841  END Line 825  END
         $r->print('"'.join('","',("username","domain","ID","student name",          $r->print('"'.join('","',("username","domain","ID","student name",
                                   "section")).'"'."\n");                                    "section")).'"'."\n");
     }      }
       #
       # Sort the students
       my %index;
       my $i;
       foreach (@$keylist) {
           $index{$_} = $i++;
       }
       my $index  = $index{$sortby};
       my $second = $index{'username'};
       my $third  = $index{'domain'};
     my @Sorted_Students = sort {      my @Sorted_Students = sort {
             lc($s_data->{$a.':'.$sortby})  cmp lc($s_data->{$b.':'.$sortby})          lc($classlist->{$a}->[$index])  cmp lc($classlist->{$b}->[$index])
                 ||              ||
             lc($s_data->{$a.':username'}) cmp lc($s_data->{$b.':username'})          lc($classlist->{$a}->[$second]) cmp lc($classlist->{$b}->[$second])
                 ||              ||
             lc($s_data->{$a.':domain'})   cmp lc($s_data->{$b.':domain'})          lc($classlist->{$a}->[$third]) cmp lc($classlist->{$b}->[$third])
         } @$students;          } (keys(%$classlist));
     foreach my $student (@Sorted_Students) {      foreach my $student (@Sorted_Students) {
         my $error;          my $username = $classlist->{$student}->[$index{'username'}];
         if (exists($s_data->{$student.':error'})) {          my $domain   = $classlist->{$student}->[$index{'domain'}];
             $error = $s_data->{$student.':error'};          my $section  = $classlist->{$student}->[$index{'section'}];
         }          my $name     = $classlist->{$student}->[$index{'fullname'}];
         if ($error) {          my $id       = $classlist->{$student}->[$index{'id'}];
             $r->print('<tr><td colspan="6">'.          my $status   = $classlist->{$student}->[$index{'status'}];
                       '<font color="#FF8888">Error</font>'.  
                       'Error retrieving data for '.  
                       join('@',split(/:/,$student)).  
                       ', '.$error.'</td></tr>'."\n");  
             next;  
         }  
         my $username = $s_data->{$student.':username'};  
         my $domain   = $s_data->{$student.':domain'};  
         my $section  = $s_data->{$student.':section'};  
         my $name     = $s_data->{$student.':fullname'};  
         my $status   = $s_data->{$student.':Status'};  
         my $id       = $s_data->{$student.':id'};  
         next if (($statusmode ne 'any') && ($status ne $statusmode));          next if (($statusmode ne 'any') && ($status ne $statusmode));
         if ($mode eq 'view') {          if ($mode eq 'view') {
             $r->print("<tr>\n    <td>\n        ");              $r->print("<tr>\n    <td>\n        ");
Line 1136  sub get_enrollment_data { Line 1118  sub get_enrollment_data {
     return ($start,$end,$section);      return ($start,$end,$section);
 }  }
   
 # =================================================== Show student list to drop  #################################################
   #################################################
   
   =pod
   
   =item show_drop_list
   
   Display a list of students to drop
   Inputs: 
   
   =over 4
   
   =item $r, Apache request
   
   =item $classlist, hash pointer returned from loncoursedata::get_classlist();
   
   =item $keylist, array pointer returned from loncoursedata::get_classlist() 
   which describes the order elements are stored in the %$classlist values.
   
   =item $nosort, if true, sorting links are omitted.
   
   =back
   
   =cut
   
   #################################################
   #################################################
 sub show_drop_list {  sub show_drop_list {
     my ($students,$s_data,$r)=@_;      my ($r,$classlist,$keylist,$nosort)=@_;
     my $cid=$ENV{'request.course.id'};      my $cid=$ENV{'request.course.id'};
     &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},      &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},
                                             ['sortby']);                                              ['sortby']);
Line 1146  sub show_drop_list { Line 1154  sub show_drop_list {
     if ($sortby !~ /^(username|domain|section|fullname|id)$/) {      if ($sortby !~ /^(username|domain|section|fullname|id)$/) {
         $sortby = 'username';          $sortby = 'username';
     }      }
       #
     my $action = "drop";      my $action = "drop";
     $r->print(<<END);      $r->print(<<END);
 <input type="hidden" name="sortby" value="$sortby" />  <input type="hidden" name="sortby" value="$sortby" />
Line 1164  function uncheckAll(field) { Line 1173  function uncheckAll(field) {
 </script>  </script>
 <p>  <p>
 <input type="hidden" name="phase" value="four">  <input type="hidden" name="phase" value="four">
   END
   
       if ($nosort) {
           $r->print(<<END);
   <table border=2>
   <tr>
       <th>&nbsp;</th>
       <th>username</th>
       <th>domain</th>
       <th>ID</th>
       <th>student name</th>
       <th>section</th>
   </tr>
   END
   
       } else  {
           $r->print(<<END);
 <table border=2>  <table border=2>
 <tr><th>&nbsp;</th>  <tr><th>&nbsp;</th>
     <th>      <th>
Line 1179  function uncheckAll(field) { Line 1205  function uncheckAll(field) {
     </th>      </th>
 </tr>  </tr>
 END  END
       }
       #
       # Sort the students
       my %index;
       my $i;
       foreach (@$keylist) {
           $index{$_} = $i++;
       }
       my $index  = $index{$sortby};
       my $second = $index{'username'};
       my $third  = $index{'domain'};
     my @Sorted_Students = sort {      my @Sorted_Students = sort {
             lc($s_data->{$a.':'.$sortby})  cmp lc($s_data->{$b.':'.$sortby})          lc($classlist->{$a}->[$index])  cmp lc($classlist->{$b}->[$index])
                 ||              ||
             lc($s_data->{$a.':username'}) cmp lc($s_data->{$b.':username'})          lc($classlist->{$a}->[$second]) cmp lc($classlist->{$b}->[$second])
                 ||              ||
             lc($s_data->{$a.':domain'})   cmp lc($s_data->{$b.':domain'})          lc($classlist->{$a}->[$third]) cmp lc($classlist->{$b}->[$third])
         } @$students;          } (keys(%$classlist));
     foreach my $student (@Sorted_Students) {      foreach my $student (@Sorted_Students) {
         my $error;          my $error;
         if (exists($s_data->{$student.':error'})) {          my $username = $classlist->{$student}->[$index{'username'}];
             $error = $s_data->{$student.':error'};          my $domain   = $classlist->{$student}->[$index{'domain'}];
         }          my $section  = $classlist->{$student}->[$index{'section'}];
         if ($error) {          my $name     = $classlist->{$student}->[$index{'fullname'}];
             $r->print('<tr><td colspan="6">'.          my $id       = $classlist->{$student}->[$index{'id'}];
                       '<font color="#FF8888">Error</font>'.          my $status   = $classlist->{$student}->[$index{'status'}];
                       'Error retrieving data for '.  
                       join('@',split(/:/,$student)).  
                       ', '.$error.'</td></tr>'."\n");  
             next;  
         }  
         my $username = $s_data->{$student.':username'};  
         my $domain   = $s_data->{$student.':domain'};  
         my $section  = $s_data->{$student.':section'};  
         my $name     = $s_data->{$student.':fullname'};  
         my $status   = $s_data->{$student.':Status'};  
         my $id       = $s_data->{$student.':id'};  
         next if ($status ne 'Active');          next if ($status ne 'Active');
         #          #
         $r->print(<<"END");          $r->print(<<"END");
Line 1373  sub upfile_drop_add { Line 1399  sub upfile_drop_add {
                             }                              }
                         }                          }
                     }                      }
                       # Clean up whitespace
                       foreach (\$domain,\$username,\$id,\$fname,\$mname,
                                \$lname,\$gen,\$sec) {
                           $$_ =~ s/(\s+$|^\s+)//g;
                       }
                     if ($password) {                      if ($password) {
                         &modifystudent($domain,$username,$cid,$sec,                          &modifystudent($domain,$username,$cid,$sec,
                                        $desiredhost);                                         $desiredhost);
Line 1408  sub upfile_drop_add { Line 1439  sub upfile_drop_add {
         if ($ENV{'form.fullup'} eq 'yes') {          if ($ENV{'form.fullup'} eq 'yes') {
             $r->print('<h3>Dropping Students</h3>');              $r->print('<h3>Dropping Students</h3>');
             #  Get current classlist              #  Get current classlist
             my ($error,%currentlist)=&get_current_classlist($r);              my ($classlist,$keylist)=&Apache::loncoursedata::get_classlist();
             if (defined($error)) {              if (! defined($classlist)) {
                 $r->print('<pre>ERROR:$error</pre>');                  $r->print("There are no students currently enrolled.\n");
             }              } else {
             if (defined(%currentlist)) {                  # Remove the students we just added from the list of students.
                 # Drop the students  
                 foreach (@studentdata) {                  foreach (@studentdata) {
                     my %entries=&Apache::loncommon::record_sep($_);                      my %entries=&Apache::loncommon::record_sep($_);
                     unless (($entries{$fields{'username'}} eq '') ||                      unless (($entries{$fields{'username'}} eq '') ||
                             (!defined($entries{$fields{'username'}}))) {                              (!defined($entries{$fields{'username'}}))) {
                         delete($currentlist{$entries{$fields{'username'}}.                          delete($classlist->{$entries{$fields{'username'}}.
                                                 ':'.$domain});                                                  ':'.$domain});
                     }                      }
                 }                  }
                 # Print out list of dropped students                  # Print out list of dropped students.
                 &show_drop_list($r,%currentlist);                  &show_drop_list($r,$classlist,$keylist,'nosort');
             } else {  
                 $r->print("There are no students currently enrolled.\n");  
             }              }
         }          }
     } # end of unless      } # end of unless
 }  }
   
 ###################################################################  
 ###################################################################  
   
 =pod  
   
 =item &drop_students  
   
 Inputs: \@droplist, a pointer to an array of students to drop.  
 Students should be in format of studentname:studentdomain  
   
 Returns: $errors, a string describing any errors encountered.  
 $successes, a string describing the successful dropping of students.  
   
 =cut  
   
 ###################################################################  
 ###################################################################  
 sub drop_students {  
     my @droplist = @{shift()};  
     my $courseid = $ENV{'request.course.id'};  
     my $successes = '';  
     my $errors = '';  
     foreach (@droplist) {  
         my ($sname,$sdom)=split(/:/,$_);  
         my $result = &drop_student($sname,$sdom,$courseid);  
         if ($result !~ /ok/) {  
             $errors .= "Error dropping $sname\@$sdom: $result\n";  
         } else {  
             $successes .= "Dropped $sname\@$sdom\n";  
         }  
     }  
     return ($errors,$successes);  
 }  
 ###################################################################  
 ###################################################################  
   
   
 # ================================================================== Phase four  # ================================================================== Phase four
 sub drop_student_list {  sub drop_student_list {
     my $r=shift;      my $r=shift;
Line 1480  sub drop_student_list { Line 1471  sub drop_student_list {
     }      }
     foreach (@droplist) {      foreach (@droplist) {
         my ($uname,$udom)=split(/\:/,$_);          my ($uname,$udom)=split(/\:/,$_);
           # drop student
         my $result = &modifystudent($udom,$uname,$ENV{'request.course.id'});          my $result = &modifystudent($udom,$uname,$ENV{'request.course.id'});
         if ($result eq 'ok' || $result eq 'ok:') {          if ($result eq 'ok' || $result eq 'ok:') {
             $r->print('Dropped '.$uname.' @ '.$udom.'<br>');              $r->print('Dropped '.$uname.' @ '.$udom.'<br>');
Removed from v.1.55  
changed lines
  Added in v.1.56

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