Diff for /loncom/interface/Attic/lonchart.pm between versions 1.58 and 1.59

version 1.58, 2002/07/08 16:50:03 version 1.59, 2002/07/09 15:43:49
Line 84  display options back to default values. Line 84  display options back to default values.
   
 =head1 CODE LAYOUT DESCRIPTION  =head1 CODE LAYOUT DESCRIPTION
   
 The code is broken down into five components: formatting data for printing,  The code is broken down into three components: formatting data for printing,
 downloading data from servers, processing data, helper functions,  helper functions, and the central processing functions.  The module is broken 
 and the central processing functions.  The module is broken into chunks  into chunks for each component.
 for each component.  
   
 =head1 PACKAGES USED  =head1 PACKAGES USED
   
Line 105  use strict; Line 104  use strict;
 use Apache::Constants qw(:common :http);  use Apache::Constants qw(:common :http);
 use Apache::lonnet();  use Apache::lonnet();
 use Apache::loncommon();  use Apache::loncommon();
   use Apache::loncoursedata();
 use HTML::TokeParser;  use HTML::TokeParser;
 use GDBM_File;  use GDBM_File;
   
Line 152  sub FormatStudentInformation { Line 152  sub FormatStudentInformation {
     my $Str='';      my $Str='';
   
     for(my $index=0; $index<(scalar @$studentInformation); $index++) {      for(my $index=0; $index<(scalar @$studentInformation); $index++) {
         if(!&ShouldShowColumn($cache, 'heading'.$index)) {          if(!&ShouldShowColumn($cache, 'ChartHeading'.$index)) {
             next;              next;
         }          }
  my $data=$cache->{$name.':'.$studentInformation->[$index]};   my $data=$cache->{$name.':'.$studentInformation->[$index]};
Line 236  sub FormatStudentData { Line 236  sub FormatStudentData {
     my $problemsSolved  = 0;      my $problemsSolved  = 0;
     my $numberOfParts   = 0;      my $numberOfParts   = 0;
     foreach my $sequence (split(/\:/,$CacheData{'orderedSequences'})) {      foreach my $sequence (split(/\:/,$CacheData{'orderedSequences'})) {
         if(!&ShouldShowColumn(\%CacheData, 'sequence'.$sequence)) {          if(!&ShouldShowColumn(\%CacheData, 'ChartSequence'.$sequence)) {
             next;              next;
         }          }
   
Line 390  sub CreateTableHeadings { Line 390  sub CreateTableHeadings {
     my $Str='<tr>';      my $Str='<tr>';
   
     for(my $index=0; $index<(scalar @$headings); $index++) {      for(my $index=0; $index<(scalar @$headings); $index++) {
         if(!&ShouldShowColumn($CacheData, 'heading'.$index)) {          if(!&ShouldShowColumn($CacheData, 'ChartHeading'.$index)) {
             next;              next;
         }          }
   
Line 407  sub CreateTableHeadings { Line 407  sub CreateTableHeadings {
     }      }
   
     foreach my $sequence (split(/\:/,$CacheData->{'orderedSequences'})) {      foreach my $sequence (split(/\:/,$CacheData->{'orderedSequences'})) {
         if(!&ShouldShowColumn($CacheData, 'sequence'.$sequence)) {          if(!&ShouldShowColumn($CacheData, 'ChartSequence'.$sequence)) {
             next;              next;
         }          }
   
Line 464  sub CreateColumnSelectionBox { Line 464  sub CreateColumnSelectionBox {
     my $notThere='<tr><td align="right"><b>Select column to view:</b>';      my $notThere='<tr><td align="right"><b>Select column to view:</b>';
     my $name;      my $name;
     $notThere .= '<td align="left">';      $notThere .= '<td align="left">';
     $notThere .= '<select name="reselect" size="4" multiple="true">'."\n";      $notThere .= '<select name="ChartReselect" size="4" multiple="true">'."\n";
   
     for(my $index=0; $index<(scalar @$headings); $index++) {      for(my $index=0; $index<(scalar @$headings); $index++) {
         if(&ShouldShowColumn($CacheData, 'heading'.$index)) {          if(&ShouldShowColumn($CacheData, 'ChartHeading'.$index)) {
             next;              next;
         }          }
         $name = $headings->[$index];          $name = $headings->[$index];
         $notThere .= '<option value="heading'.$index.'">';          $notThere .= '<option value="ChartHeading'.$index.'">';
         $notThere .= $name.'</option>'."\n";          $notThere .= $name.'</option>'."\n";
         $missing++;          $missing++;
     }      }
   
     foreach my $sequence (split(/\:/,$CacheData->{'orderedSequences'})) {      foreach my $sequence (split(/\:/,$CacheData->{'orderedSequences'})) {
         if(&ShouldShowColumn($CacheData, 'sequence'.$sequence)) {          if(&ShouldShowColumn($CacheData, 'ChartSequence'.$sequence)) {
             next;              next;
         }          }
         $name = $CacheData->{$sequence.':title'};          $name = $CacheData->{$sequence.':title'};
         $notThere .= '<option value="sequence'.$sequence.'">';          $notThere .= '<option value="ChartSequence'.$sequence.'">';
         $notThere .= $name.'</option>'."\n";          $notThere .= $name.'</option>'."\n";
         $missing++;          $missing++;
     }      }
Line 529  sub CreateColumnSelectors { Line 529  sub CreateColumnSelectors {
   
     my $present = '<tr>';      my $present = '<tr>';
     for(my $index=0; $index<(scalar @$headings); $index++) {      for(my $index=0; $index<(scalar @$headings); $index++) {
         if(!&ShouldShowColumn($CacheData, 'heading'.$index)) {          if(!&ShouldShowColumn($CacheData, 'ChartHeading'.$index)) {
             next;              next;
         }          }
         $present .= '<td align="left">';          $present .= '<td align="left">';
         $present .= '<input type="checkbox" checked="on" ';          $present .= '<input type="checkbox" checked="on" ';
         $present .= 'name="heading'.$index.'" />';          $present .= 'name="ChartHeading'.$index.'" />';
         $present .= '</td>';          $present .= '</td>';
         $found++;          $found++;
     }      }
   
     foreach my $sequence (split(/\:/,$CacheData->{'orderedSequences'})) {      foreach my $sequence (split(/\:/,$CacheData->{'orderedSequences'})) {
         if(!&ShouldShowColumn($CacheData, 'sequence'.$sequence)) {          if(!&ShouldShowColumn($CacheData, 'ChartSequence'.$sequence)) {
             next;              next;
         }          }
         $present .= '<td align="left">';          $present .= '<td align="left">';
         $present .= '<input type="checkbox" checked="on" ';          $present .= '<input type="checkbox" checked="on" ';
         $present .= 'name="sequence'.$sequence.'" />';          $present .= 'name="ChartSequence'.$sequence.'" />';
         $present .= '</td>';          $present .= '</td>';
         $found++;          $found++;
     }      }
Line 586  sub CreateForm { Line 586  sub CreateForm {
     my $OpSel1='';      my $OpSel1='';
     my $OpSel2='';      my $OpSel2='';
     my $OpSel3='';      my $OpSel3='';
     my $Status = $CacheData->{'form.status'};      my $Status = $CacheData->{'form.ChartStatus'};
     if ( $Status eq 'Any' ) { $OpSel3='selected'; }      if ( $Status eq 'Any' ) { $OpSel3='selected'; }
     elsif ($Status eq 'Expired' ) { $OpSel2 = 'selected'; }      elsif ($Status eq 'Expired' ) { $OpSel2 = 'selected'; }
     else { $OpSel1 = 'selected'; }      else { $OpSel1 = 'selected'; }
   
     my $Ptr .= '<form name="stat" method="post" action="/adm/chart" >'."\n";      my $Ptr .= '<form name="ChartStat" method="post" action="/adm/chart" >';
       $Ptr .= "\n";
     $Ptr .= '<tr><td align="right">';      $Ptr .= '<tr><td align="right">';
     $Ptr .= '</td><td align="left">';      $Ptr .= '</td><td align="left">';
     $Ptr .= '<input type="submit" name="recalculate" ';      $Ptr .= '<input type="submit" name="ChartRecalculate" ';
     $Ptr .= 'value="Recalculate Chart"/>'."\n";      $Ptr .= 'value="Recalculate Chart"/>'."\n";
     $Ptr .= '&nbsp;&nbsp;&nbsp;';      $Ptr .= '&nbsp;&nbsp;&nbsp;';
     $Ptr .= '<input type="submit" name="refresh" ';      $Ptr .= '<input type="submit" name="ChartRefresh" ';
     $Ptr .= 'value="Refresh Chart"/>'."\n";      $Ptr .= 'value="Refresh Chart"/>'."\n";
     $Ptr .= '&nbsp;&nbsp;&nbsp;';      $Ptr .= '&nbsp;&nbsp;&nbsp;';
     $Ptr .= '<input type="submit" name="reset" ';      $Ptr .= '<input type="submit" name="ChartReset" ';
     $Ptr .= 'value="Reset Selections"/></td>'."\n";      $Ptr .= 'value="Reset Selections"/></td>'."\n";
     $Ptr .= '</tr><tr><td align="right">';      $Ptr .= '</tr><tr><td align="right">';
     $Ptr .= '<b> Sort by: </b>'."\n";      $Ptr .= '<b> Sort by: </b>'."\n";
     $Ptr .= '</td><td align="left">';      $Ptr .= '</td><td align="left">';
     $Ptr .= '<input type="submit" name="sort" value="User Name" />'."\n";      $Ptr .= '<input type="submit" name="ChartSort" value="User Name" />'."\n";
     $Ptr .= '&nbsp;&nbsp;&nbsp;';      $Ptr .= '&nbsp;&nbsp;&nbsp;';
     $Ptr .= '<input type="submit" name="sort" value="Last Name" />'."\n";      $Ptr .= '<input type="submit" name="ChartSort" value="Last Name" />'."\n";
     $Ptr .= '&nbsp;&nbsp;&nbsp;';      $Ptr .= '&nbsp;&nbsp;&nbsp;';
     $Ptr .= '<input type="submit" name="sort" value="Section"/>'."\n";      $Ptr .= '<input type="submit" name="ChartSort" value="Section"/>'."\n";
     $Ptr .= '</td></tr><tr><td align="right">';      $Ptr .= '</td></tr><tr><td align="right">';
     $Ptr .= '<b> Student Status: &nbsp; </b>'."\n".      $Ptr .= '<b> Student Status: &nbsp; </b>'."\n".
             '</td><td align="left">'.              '</td><td align="left">'.
             '<select name="status">'.               '<select name="ChartStatus">'. 
             '<option '.$OpSel1.' >Active</option>'."\n".              '<option '.$OpSel1.' >Active</option>'."\n".
             '<option '.$OpSel2.' >Expired</option>'."\n".              '<option '.$OpSel2.' >Expired</option>'."\n".
     '<option '.$OpSel3.' >Any</option> </select> '."\n";      '<option '.$OpSel3.' >Any</option> </select> '."\n";
Line 656  logo, and course title. Line 657  logo, and course title.
 =cut  =cut
   
 sub StartDocument {  sub StartDocument {
       my ($title, $header)=@_;
     my $Str = '';      my $Str = '';
     $Str .= '<html>';      $Str .= '<html>';
     $Str .= '<head><title>';      $Str .= '<head><title>';
     $Str .= 'LON-CAPA Assessment Chart</title></head>';      $Str .= $title.'</title></head>';
     $Str .= '<body bgcolor="#FFFFFF">';      $Str .= '<body bgcolor="#FFFFFF">';
     $Str .= '<script>window.focus();</script>';      $Str .= '<script>window.focus();</script>';
     $Str .= '<img align=right src=/adm/lonIcons/lonlogos.gif>';      $Str .= '<img align=right src=/adm/lonIcons/lonlogos.gif>';
     $Str .= '<h1>Assessment Chart</h1>';      $Str .= '<h1>'.$header.'</h1>';
     $Str .= '<h1>'.$ENV{'course.'.$ENV{'request.course.id'}.'.description'};      $Str .= '<h1>'.$ENV{'course.'.$ENV{'request.course.id'}.'.description'};
     $Str .= '</h1>';      $Str .= '</h1>';
   
Line 674  sub StartDocument { Line 676  sub StartDocument {
   
 =pod  =pod
   
 =head1 DOWNLOAD INFORMATION  =head1 HELPER FUNCTIONS
   
 This section contains all the files that get data from other servers   
 and/or itself.  There is one function that has a call to get remote  
 information but isn't included here which is ProcessTopLevelMap.  The  
 usage was small enough to be ignored, but that portion may be moved  
 here in the future.  
   
 =cut  
   
 # ----- DOWNLOAD INFORMATION -------------------------------------------  
   
 =pod  
   
 =item &DownloadPrerequisiteData()  
   
 Collects lastname, generation, middlename, firstname, PID, and section for each  
 student from their environment database.  The list of students is built from  
 collecting a classlist for the course that is to be displayed.  
   
 =over 4  
   
 Input: $courseID, $c  
   
 $courseID:  The id of the course  
   
 $c: The connection class that can determine if the browser has aborted.  It  
 is used to short circuit this function so that it doesn't continue to   
 get information when there is no need.  
   
 Output: \%classlist  
   
 \%classlist: A pointer to a hash containing the following data:  
   
 -A list of student name:domain (as keys) (known below as $name)  
   
 -A hash pointer for each student containing lastname, generation, firstname,  
 middlename, and PID : Key is $name.'studentInformation'  
   
 -A hash pointer to each students section data : Key is $name.section  
   
 =back  
   
 =cut  
   
 sub DownloadPrerequisiteData {  
     my ($courseID, $c)=@_;  
     my ($courseDomain,$courseNumber)=split(/\_/,$courseID);  
   
     my %classlist=&Apache::lonnet::dump('classlist',$courseDomain,  
                                         $courseNumber);  
     my ($checkForError)=keys (%classlist);  
     if($checkForError =~ /^(con_lost|error|no_such_host)/i) {  
         return \%classlist;  
     }  
   
     foreach my $name (keys(%classlist)) {  
         if($c->aborted()) {  
             $classlist{'error'}='aborted';  
             return \%classlist;  
         }  
   
         my ($studentName,$studentDomain) = split(/\:/,$name);  
         # Download student environment data, specifically the full name and id.  
         my %studentInformation=&Apache::lonnet::get('environment',  
                                                     ['lastname','generation',  
                                                      'firstname','middlename',  
                                                      'id'],  
                                                     $studentDomain,  
                                                     $studentName);  
         $classlist{$name.':studentInformation'}=\%studentInformation;  
   
         if($c->aborted()) {  
             $classlist{'error'}='aborted';  
             return \%classlist;  
         }  
   
         #Section  
         my %section=&Apache::lonnet::dump('roles',$studentDomain,$studentName);  
         $classlist{$name.':section'}=\%section;  
     }  
   
     return \%classlist;  
 }  
   
 =pod  
   
 =item &DownloadStudentCourseInformation()  
   
 Dump of all the course information for a single student.  There is no  
 pruning of data, it is all stored in a hash and returned.  
   
 =over 4  
   
 Input: $name, $courseID  
   
 $name: student name:domain  
   
 $courseID:  The id of the course  
   
 Output: \%courseData  
   
 \%courseData:  A hash pointer to the raw data from the student's course  
 database.  
   
 =back  
   
 =cut  
   
 sub DownloadStudentCourseInformation {  
     my ($name,$courseID)=@_;  
     my ($studentName,$studentDomain) = split(/\:/,$name);  
   
     # Download student course data  
     my %courseData=&Apache::lonnet::dump($courseID,$studentDomain,  
  $studentName);  
     return \%courseData;  
 }  
   
 # ----- END DOWNLOAD INFORMATION ---------------------------------------  
   
 =pod  
   
 =head1 PROCESSING FUNCTIONS  
   
 These functions process all the data for all the students.  Also, they  
 are the only functions that access the cache database for writing.  Thus  
 they are the only functions that cache data.  The downloading and caching  
 were separated to reduce problems with stopping downloading then can't  
 tie hash to database later.  
   
 =cut  
   
 # ----- PROCESSING FUNCTIONS ---------------------------------------  
   
 =pod  
   
 =item &ProcessTopResourceMap()  
   
 Trace through the "big hash" created in rat/lonuserstate.pm::loadmap.    
 Basically, this function organizes a subset of the data and stores it in  
 cached data.  The data stored is the problems, sequences, sequence titles,  
 parts of problems, and their ordering.  Column width information is also   
 partially handled here on a per sequence basis.  
   
 =over 4  
   
 Input: $ChartDB, $c  
   
 $ChartDB:  The name of the cache database file  
   
 $c:  The connection class used to determine if an abort has been sent to the   
 browser  
   
 Output: A string that contains an error message or "OK" if everything went   
 smoothly.  
   
 =back  
   
 =cut  
   
 sub ProcessTopResourceMap {  
     my ($ChartDB,$c)=@_;  
     my %hash;  
     my $fn=$ENV{'request.course.fn'};  
     if(-e "$fn.db") {  
  my $tieTries=0;  
  while($tieTries < 3) {  
     if(tie(%hash,'GDBM_File',"$fn.db",&GDBM_READER,0640)) {  
  last;  
     }  
     $tieTries++;  
     sleep 1;  
  }  
  if($tieTries >= 3) {  
             return 'Coursemap undefined.';  
         }  
     } else {  
         return 'Can not open Coursemap.';  
     }  
   
     my %CacheData;  
     unless(tie(%CacheData,'GDBM_File',$ChartDB,&GDBM_WRCREAT,0640)) {  
         untie(%hash);  
  return 'Could not tie cache hash.';  
     }  
   
     # Initialize state machine.  Set information pointing to top level map.  
     my (@sequences, @currentResource, @finishResource);  
     my ($currentSequence, $currentResourceID, $lastResourceID);  
   
     $currentResourceID=$hash{'ids_/res/'.$ENV{'request.course.uri'}};  
     push(@currentResource, $currentResourceID);  
     $lastResourceID=-1;  
     $currentSequence=-1;  
     my $topLevelSequenceNumber = $currentSequence;  
   
     while(1) {  
         if($c->aborted()) {  
             last;  
         }  
  # HANDLE NEW SEQUENCE!  
  #if page || sequence  
  if(defined($hash{'map_pc_'.$hash{'src_'.$currentResourceID}})) {  
     push(@sequences, $currentSequence);  
     push(@currentResource, $currentResourceID);  
     push(@finishResource, $lastResourceID);  
   
     $currentSequence=$hash{'map_pc_'.$hash{'src_'.$currentResourceID}};  
   
             # Mark sequence as containing problems.  If it doesn't, then  
             # it will be removed when processing for this sequence is  
             # complete.  This allows the problems in a sequence  
             # to be outputed before problems in the subsequences  
             if(!defined($CacheData{'orderedSequences'})) {  
                 $CacheData{'orderedSequences'}=$currentSequence;  
             } else {  
                 $CacheData{'orderedSequences'}.=':'.$currentSequence;  
             }  
   
     $lastResourceID=$hash{'map_finish_'.  
   $hash{'src_'.$currentResourceID}};  
     $currentResourceID=$hash{'map_start_'.  
      $hash{'src_'.$currentResourceID}};  
   
     if(!($currentResourceID) || !($lastResourceID)) {  
  $currentSequence=pop(@sequences);  
  $currentResourceID=pop(@currentResource);  
  $lastResourceID=pop(@finishResource);  
  if($currentSequence eq $topLevelSequenceNumber) {  
     last;  
  }  
     }  
  }  
   
  # Handle gradable resources: exams, problems, etc  
  $currentResourceID=~/(\d+)\.(\d+)/;  
         my $partA=$1;  
         my $partB=$2;  
  if($hash{'src_'.$currentResourceID}=~  
    /\.(problem|exam|quiz|assess|survey|form)$/ &&  
    $partA eq $currentSequence) {  
     my $Problem = &Apache::lonnet::symbclean(  
   &Apache::lonnet::declutter($hash{'map_id_'.$partA}).  
   '___'.$partB.'___'.  
   &Apache::lonnet::declutter($hash{'src_'.  
  $currentResourceID}));  
   
     $CacheData{$currentResourceID.':problem'}=$Problem;  
     if(!defined($CacheData{$currentSequence.':problems'})) {  
  $CacheData{$currentSequence.':problems'}=$currentResourceID;  
     } else {  
  $CacheData{$currentSequence.':problems'}.=  
     ':'.$currentResourceID;  
     }  
   
             # Get Parts for problem  
     my $meta=$hash{'src_'.$currentResourceID};  
     foreach (split(/\,/,&Apache::lonnet::metadata($meta,'keys'))) {  
  if($_=~/^stores\_(\d+)\_tries$/) {  
     my $Part=&Apache::lonnet::metadata($meta,$_.'.part');  
                     if(!defined($CacheData{$currentSequence.':'.  
                                           $currentResourceID.':parts'})) {  
                         $CacheData{$currentSequence.':'.$currentResourceID.  
                                    ':parts'}=$Part;  
                     } else {  
                         $CacheData{$currentSequence.':'.$currentResourceID.  
                                    ':parts'}.=':'.$Part;  
                     }  
  }  
     }  
  }  
   
  # if resource == finish resource, then it is the end of a sequence/page  
  if($currentResourceID eq $lastResourceID) {  
     # pop off last resource of sequence  
     $currentResourceID=pop(@currentResource);  
     $lastResourceID=pop(@finishResource);  
   
     if(defined($CacheData{$currentSequence.':problems'})) {  
  # Capture sequence information here  
  $CacheData{$currentSequence.':title'}=  
     $hash{'title_'.$currentResourceID};  
   
                 my $totalProblems=0;  
                 foreach my $currentProblem (split(/\:/,  
                                                $CacheData{$currentSequence.  
                                                ':problems'})) {  
                     foreach (split(/\:/,$CacheData{$currentSequence.':'.  
                                                    $currentProblem.  
                                                    ':parts'})) {  
                         $totalProblems++;  
                     }  
                 }  
  my @titleLength=split(//,$CacheData{$currentSequence.  
                                                     ':title'});  
                 # $extra is 3 for problems correct and 3 for space  
                 # between problems correct and problem output  
                 my $extra = 6;  
  if(($totalProblems + $extra) > (scalar @titleLength)) {  
     $CacheData{$currentSequence.':columnWidth'}=  
                         $totalProblems + $extra;  
  } else {  
     $CacheData{$currentSequence.':columnWidth'}=  
                         (scalar @titleLength);  
  }  
     } else {  
                 # Remove sequence from list, if it contains no problems to  
                 # display.  
                 $CacheData{'orderedSequences'}=~s/$currentSequence//;  
                 $CacheData{'orderedSequences'}=~s/::/:/g;  
                 $CacheData{'orderedSequences'}=~s/^:|:$//g;  
             }  
   
     $currentSequence=pop(@sequences);  
     if($currentSequence eq $topLevelSequenceNumber) {  
  last;  
     }  
  }  
   
  # MOVE!!!  
  # move to next resource  
  unless(defined($hash{'to_'.$currentResourceID})) {  
     # big problem, need to handle.  Next is probably wrong  
     last;  
  }  
  my @nextResources=();  
  foreach (split(/\,/,$hash{'to_'.$currentResourceID})) {  
     push(@nextResources, $hash{'goesto_'.$_});  
  }  
  push(@currentResource, @nextResources);  
  # Set the next resource to be processed  
  $currentResourceID=pop(@currentResource);  
     }  
   
     unless (untie(%hash)) {  
         &Apache::lonnet::logthis("<font color=blue>WARNING: ".  
                                  "Could not untie coursemap $fn (browse)".  
                                  ".</font>");   
     }  
   
     unless (untie(%CacheData)) {  
         &Apache::lonnet::logthis("<font color=blue>WARNING: ".  
                                  "Could not untie Cache Hash (browse)".  
                                  ".</font>");   
     }  
   
     return 'OK';  
 }  
   
 =pod  
   
 =item &ProcessSection()  
   
 Determine the section number for a student for the class.  A student can have   
 multiple sections for the same class.  The correct one is chosen.  
   
 =over 4  
   
 Input: $sectionData, $courseid, $ActiveFlag  
   
 $sectionData:  A pointer to a hash containing all section data for this   
 student for the class  
   
 $courseid:  The course ID.  
   
 $ActiveFlag:  The student's active status (Active/Expired)  
   
 Output: $oldsection, $cursection, or -1  
   
 $oldsection and $cursection and sections number that will be displayed in the   
 chart.  
   
 -1 is returned if an error occurs.  
   
 =back  
   
 =cut  
   
 sub ProcessSection {  
     my ($sectionData, $courseid,$ActiveFlag)=@_;  
     $courseid=~s/\_/\//g;  
     $courseid=~s/^(\w)/\/$1/;  
   
     my $cursection='-1';  
     my $oldsection='-1';  
     my $status='Expired';  
     my $section='';  
     foreach my $key (keys (%$sectionData)) {  
  my $value = $sectionData->{$key};  
         if ($key=~/^$courseid(?:\/)*(\w+)*\_st$/) {  
     $section=$1;  
     if($key eq $courseid.'_st') {  
  $section='';  
     }  
     my ($dummy,$end,$start)=split(/\_/,$value);  
     my $now=time;  
     my $notactive=0;  
     if ($start) {  
  if($now<$start) {  
     $notactive=1;  
  }  
     }  
     if($end) {  
  if ($now>$end) {  
     $notactive=1;  
  }  
     }  
     if($notactive == 0) {  
  $status='Active';  
  $cursection=$section;  
  last;  
     }  
     if($notactive == 1) {  
  $oldsection=$section;  
     }  
  }  
     }  
     if($status eq $ActiveFlag) {  
  if($cursection eq '-1') {  
     return $oldsection;  
  }  
  return $cursection;  
     }  
     if($ActiveFlag eq 'Any') {  
  if($cursection eq '-1') {  
     return $oldsection;  
  }  
  return $cursection;  
     }  
     return '-1';  
 }  
   
 =pod  
   
 =item &ProcessStudentInformation()  
   
 Takes data downloaded for a student and breaks it up into managable pieces and   
 stored in cache data.  The username, domain, class related date, PID,   
 full name, and section are all processed here.  
   
 =over 4  
   
 Input: $CacheData, $studentInformation, $section, $date, $name, $courseID  
   
 $CacheData:  A hash pointer to the cached data  
   
 $studentInformation:  Student information is what was requested in   
 &DownloadPrerequistedData().  See that function for what data is requested.  
   
 $section: A hash pointer to class section related information.  
   
 $date:  A composite of the start and end date for this class for this  
 student.  Format:  end:start  
   
 $name:  the username:domain information  
   
 $courseID: The course ID  
   
 Output: None  
   
 *NOTE:  There is no return value, but if an error occurs a key is added to   
 the cache data with the value being the error message.  The key is   
 username:domain:error.  It will only exist if an error occurs.  
   
 =back  
   
 =cut  
   
 sub ProcessStudentInformation {  
     my ($CacheData,$studentInformation,$section,$date,$name,$courseID)=@_;  
     my ($studentName,$studentDomain) = split(/\:/,$name);  
   
     $CacheData->{$name.':username'}=$studentName;  
     $CacheData->{$name.':domain'}=$studentDomain;  
     $CacheData->{$name.':date'}=$date;  
   
     my ($checkForError)=keys(%$studentInformation);  
     if($checkForError =~ /^(con_lost|error|no_such_host)/i) {  
  $CacheData->{$name.':error'}=  
     'Could not download student environment data.';  
  $CacheData->{$name.':fullname'}='';  
  $CacheData->{$name.':id'}='';  
     } else {  
  $CacheData->{$name.':fullname'}=&ProcessFullName(  
                                           $studentInformation->{'lastname'},  
           $studentInformation->{'generation'},  
           $studentInformation->{'firstname'},  
                                           $studentInformation->{'middlename'});  
  $CacheData->{$name.':id'}=$studentInformation->{'id'};  
     }  
   
     # Get student's section number  
     my $sec=&ProcessSection($section, $courseID, $CacheData->{'form.status'});  
     if($sec != -1) {  
  $CacheData->{$name.':section'}=$sec;  
     } else {  
  $CacheData->{$name.':section'}='';  
     }  
   
     return;  
 }  
   
 =pod  
   
 =item &ProcessClassList()  
   
 Taking the class list dumped from &DownloadPrerequisiteData(), all the   
 students and their non-class information is processed using the   
 &ProcessStudentInformation() function.  A date stamp is also recorded for  
 when the data was processed.  
   
 =over 4  
   
 Input: $classlist, $courseID, $ChartDB, $c  
   
 $classlist:  The hash of data collected about a student from   
 &DownloadPrerequisteData().  The hash contains a list of students, a pointer   
 to a hash of student information for each student, and each student's section   
 number.  
   
 $courseID:  The course ID  
   
 $ChartDB:  The name of the cache database file.  
   
 $c:  The connection class used to determine if an abort has been sent to the   
 browser  
   
 Output: @names  
   
 @names:  An array of students whose information has been processed, and are to   
 be considered in an arbitrary order.  
   
 =back  
   
 =cut  
   
 sub ProcessClassList {  
     my ($classlist,$courseID,$ChartDB,$c)=@_;  
     my @names=();  
   
     my %CacheData;  
     if(tie(%CacheData,'GDBM_File',$ChartDB,&GDBM_WRCREAT,0640)) {  
         foreach my $name (keys(%$classlist)) {  
             if($name =~ /\:section/ || $name =~ /\:studentInformation/ ||  
                $name eq '') {  
                 next;  
             }  
             if($c->aborted()) {  
                 last;  
             }  
             push(@names,$name);  
             &ProcessStudentInformation(  
                                     \%CacheData,  
                                     $classlist->{$name.':studentInformation'},  
                                     $classlist->{$name.':section'},  
                                     $classlist->{$name},  
                                     $name,$courseID);  
         }  
   
         # Time of download  
         $CacheData{'time'}=localtime();  
  untie(%CacheData);  
     }  
   
     return @names;  
 }  
   
 =pod  
   
 =item &ProcessStudentData()  
   
 Takes the course data downloaded for a student in   
 &DownloadStudentCourseInformation() and breaks it up into key value pairs  
 to be stored in the cached data.  The keys are comprised of the   
 $username:$domain:$keyFromCourseDatabase.  The student username:domain is  
 stored away signifying that the student's information has been downloaded and   
 can be reused from cached data.  
   
 =over 4  
   
 Input: $courseData, $name, $ChartDB  
   
 $courseData:  A hash pointer that points to the course data downloaded for a   
 student.  
   
 $name:  username:domain  
   
 $ChartDB:  The name of the cache database file which will allow the data to  
 be written to the cache.  
   
 Output: None  
   
 *NOTE:  There is no output, but an error message is stored away in the cache   
 data.  This is checked in &FormatStudentData().  The key username:domain:error   
 will only exist if an error occured.  The error is an error from   
 &DownloadStudentCourseInformation().  
   
 =back  These are just a couple of functions do various odd and end 
   jobs.
   
 =cut  =cut
   
 sub ProcessStudentData {  # ----- HELPER FUNCTIONS -----------------------------------------------
     my ($courseData, $name, $ChartDB)=@_;  
   
     my %CacheData;  
     if(tie(%CacheData,'GDBM_File',$ChartDB,&GDBM_WRCREAT,0640)) {  
         my ($checkForError) = keys(%$courseData);  
         if($checkForError =~ /^(con_lost|error|no_such_host)/i) {  
             $CacheData{$name.':error'}='Could not download course data.';  
         } else {  
             foreach my $key (keys (%$courseData)) {  
                 $CacheData{$name.':'.$key}=$courseData->{$key};  
             }  
             if(defined($CacheData{'NamesOfStudents'})) {  
                 $CacheData{'NamesOfStudents'}.=':::'.$name;  
             } else {  
                 $CacheData{'NamesOfStudents'}=$name;  
             }  
         }  
         untie(%CacheData);  
     }  
   
     return;  
 }  
   
 =pod  =pod
   
Line 1329  sub ProcessFormData { Line 714  sub ProcessFormData {
     my %CacheData;      my %CacheData;
   
     if(tie(%CacheData,'GDBM_File',$ChartDB,&GDBM_WRCREAT,0640)) {      if(tie(%CacheData,'GDBM_File',$ChartDB,&GDBM_WRCREAT,0640)) {
         # Ignore $ENV{'form.refresh'}          # Ignore $ENV{'form.ChartRefresh'}
         # Ignore $ENV{'form.recalculate'}          # Ignore $ENV{'form.ChartRecalculate'}
   
         if(defined($ENV{'form.sort'})) {          if(defined($ENV{'form.ChartSort'})) {
             $CacheData{'form.sort'}=$ENV{'form.sort'};              $CacheData{'form.ChartSort'}=$ENV{'form.ChartSort'};
         } elsif(!defined($CacheData{'form.sort'})) {          } elsif(!defined($CacheData{'form.ChartSort'})) {
             $CacheData{'form.sort'}='username';              $CacheData{'form.ChartSort'}='username';
         }          }
   
         if(defined($ENV{'form.status'})) {          if(defined($ENV{'form.ChartStatus'})) {
             $CacheData{'form.status'}=$ENV{'form.status'};              $CacheData{'form.ChartStatus'}=$ENV{'form.ChartStatus'};
         } elsif(!defined($CacheData{'form.status'})) {          } elsif(!defined($CacheData{'form.ChartStatus'})) {
             $CacheData{'form.status'}='Active';              $CacheData{'form.ChartStatus'}='Active';
         }          }
   
         # $found checks for any instances of form data in the ENV.  If it is          # $found checks for any instances of form data in the ENV.  If it is
Line 1350  sub ProcessFormData { Line 735  sub ProcessFormData {
         my @sequences=();          my @sequences=();
         my $found=0;          my $found=0;
         foreach (keys(%ENV)) {          foreach (keys(%ENV)) {
             if(/form\.heading/) {              if(/form\.ChartHeading/) {
                 $found++;                  $found++;
                 push(@headings, $_);                  push(@headings, $_);
             } elsif(/form\.sequence/) {              } elsif(/form\.ChartSequence/) {
                 $found++;                  $found++;
                 push(@sequences, $_);                  push(@sequences, $_);
             } elsif(/form\./) {              } elsif(/form\./) {
Line 1362  sub ProcessFormData { Line 747  sub ProcessFormData {
         }          }
   
         if($found) {          if($found) {
             $CacheData{'form.headings'}=join(":::",@headings);              $CacheData{'form.ChartHeadings'}=join(":::",@headings);
             $CacheData{'form.sequences'}=join(":::",@sequences);              $CacheData{'form.ChartSequences'}=join(":::",@sequences);
         }          }
   
         if(defined($ENV{'form.reselect'})) {          if(defined($ENV{'form.ChartReselect'})) {
             my @reselected = (ref($ENV{'form.reselect'}) ?               my @reselected = (ref($ENV{'form.ChartReselect'}) ? 
                               @{$ENV{'form.reselect'}}                                @{$ENV{'form.ChartReselect'}}
                               : ($ENV{'form.reselect'}));                                : ($ENV{'form.ChartReselect'}));
             foreach (@reselected) {              foreach (@reselected) {
                 if(/heading/) {                  if(/ChartHeading/) {
                     $CacheData{'form.headings'}.=":::".$_;                      $CacheData{'form.ChartHeadings'}.=":::".$_;
                 } elsif(/sequence/) {                  } elsif(/ChartSequence/) {
                     $CacheData{'form.sequences'}.=":::".$_;                      $CacheData{'form.ChartSequences'}.=":::".$_;
                 }                  }
             }              }
         }          }
   
         # !$found and !$isCached are how I determine if the chrt button          # !$found and !$isCached are how I determine if the chrt button
         # on the remote was pressed and needs to reset all the selections          # on the remote was pressed and needs to reset all the selections
         if(defined($ENV{'form.reset'}) || (!$found && !$isCached)) {          if(defined($ENV{'form.ChartReset'}) || (!$found && !$isCached)) {
             $CacheData{'form.reset'}='true';              $CacheData{'form.ChartReset'}='true';
             $CacheData{'form.status'}='Active';              $CacheData{'form.ChartStatus'}='Active';
             $CacheData{'form.sort'}='username';              $CacheData{'form.ChartSort'}='username';
             $CacheData{'form.headings'}='ALLHEADINGS';              $CacheData{'form.ChartHeadings'}='ALLHEADINGS';
             $CacheData{'form.sequences'}='ALLSEQUENCES';              $CacheData{'form.ChartSequences'}='ALLSEQUENCES';
         } else {          } else {
             $CacheData{'form.reset'}='false';              $CacheData{'form.ChartReset'}='false';
         }          }
   
         untie(%CacheData);          untie(%CacheData);
Line 1424  Output: None - All data stored in cache. Line 809  Output: None - All data stored in cache.
 =cut  =cut
   
 sub SpaceColumns {  sub SpaceColumns {
     my ($students,$studentInformation,$headings,$ChartDB)=@_;      my ($students,$studentInformation,$headings,$cache)=@_;
   
     my %CacheData;      # Initialize Lengths
     if(tie(%CacheData,'GDBM_File',$ChartDB,&GDBM_WRCREAT,0640)) {      for(my $index=0; $index<(scalar @$headings); $index++) {
         # Initialize Lengths          my @titleLength=split(//,$$headings[$index]);
         for(my $index=0; $index<(scalar @$headings); $index++) {          $cache->{$$studentInformation[$index].'Length'}=
     my @titleLength=split(//,$$headings[$index]);              scalar @titleLength;
     $CacheData{$$studentInformation[$index].'Length'}=      }
                 scalar @titleLength;  
  }  
   
         foreach my $name (@$students) {      foreach my $name (@$students) {
             foreach (@$studentInformation) {          foreach (@$studentInformation) {
  my @dataLength=split(//,$CacheData{$name.':'.$_});              my @dataLength=split(//,$cache->{$name.':'.$_});
  my $length=scalar @dataLength;              my $length=scalar @dataLength;
  if($length > $CacheData{$_.'Length'}) {              if($length > $cache->{$_.'Length'}) {
     $CacheData{$_.'Length'}=$length;                  $cache->{$_.'Length'}=$length;
  }  
             }              }
         }          }
         untie(%CacheData);  
     }      }
   
     return;      return;
 }  }
   
 # ----- END PROCESSING FUNCTIONS ---------------------------------------  
   
 =pod  
   
 =head1 HELPER FUNCTIONS  
   
 These are just a couple of functions do various odd and end   
 jobs.  
   
 =cut  
   
 # ----- HELPER FUNCTIONS -----------------------------------------------  
   
 =pod  
   
 =item &ProcessFullName()  
   
 Takes lastname, generation, firstname, and middlename (or some partial  
 set of this data) and returns the full name version as a string.  Format  
 is Lastname generation, firstname middlename or a subset of this.  
   
 =cut  
   
 sub ProcessFullName {  
     my ($lastname, $generation, $firstname, $middlename)=@_;  
     my $Str = '';  
   
     if($lastname ne '') {  
  $Str .= $lastname.' ';  
  if($generation ne '') {  
     $Str .= $generation;  
  } else {  
     chop($Str);  
  }  
  $Str .= ', ';  
  if($firstname ne '') {  
     $Str .= $firstname.' ';  
  }  
  if($middlename ne '') {  
     $Str .= $middlename;  
  } else {  
     chop($Str);  
     if($firstname eq '') {  
  chop($Str);  
     }  
  }  
     } else {  
  if($firstname ne '') {  
     $Str .= $firstname.' ';  
  }  
  if($middlename ne '') {  
     $Str .= $middlename.' ';  
  }  
  if($generation ne '') {  
     $Str .= $generation;  
  } else {  
     chop($Str);  
  }  
     }  
   
     return $Str;  
 }  
   
 =pod  =pod
   
 =item &SortStudents()  =item &SortStudents()
Line 1546  sub SortStudents { Line 864  sub SortStudents {
         my ($end,$start)=split(/\:/,$CacheData->{$_.':date'});          my ($end,$start)=split(/\:/,$CacheData->{$_.':date'});
         my $active=1;          my $active=1;
         my $now=time;          my $now=time;
         my $Status=$CacheData->{'form.status'};          my $Status=$CacheData->{'form.ChartStatus'};
         $Status = ($Status) ? $Status : 'Active';          $Status = ($Status) ? $Status : 'Active';
         if((($end) && $now > $end) && (($Status eq 'Active'))) {           if((($end) && $now > $end) && (($Status eq 'Active'))) { 
             $active=0;               $active=0; 
Line 1559  sub SortStudents { Line 877  sub SortStudents {
         }          }
     }      }
   
     my $Pos = $CacheData->{'form.sort'};      my $Pos = $CacheData->{'form.ChartSort'};
     my %sortData;      my %sortData;
     if($Pos eq 'Last Name') {      if($Pos eq 'Last Name') {
  for(my $index=0; $index<scalar @sorted1Students; $index++) {   for(my $index=0; $index<scalar @sorted1Students; $index++) {
Line 1588  sub SortStudents { Line 906  sub SortStudents {
   
 =pod  =pod
   
 =item &TestCacheData()  
   
 Determine if the cache database can be accessed with a tie.  It waits up to  
 ten seconds before returning failure.  This function exists to help with  
 the problems with stopping the data download.  When an abort occurs and the  
 user quickly presses a form button and httpd child is created.  This  
 child needs to wait for the other to finish (hopefully within ten seconds).  
   
 =over 4  
   
 Input: $ChartDB  
   
 $ChartDB: The name of the cache database to be opened  
   
 Output: -1, 0, 1  
   
 -1: Couldn't tie database  
  0: Use cached data  
  1: New cache database created, use that.  
   
 =back  
   
 =cut  
   
 sub TestCacheData {  
     my ($ChartDB)=@_;  
     my $isCached=-1;  
     my %testData;  
     my $tieTries=0;  
   
     if ((-e "$ChartDB") && (!defined($ENV{'form.recalculate'}))) {  
  $isCached = 1;  
     } else {  
  $isCached = 0;  
     }  
   
     while($tieTries < 10) {  
         my $result=0;  
         if($isCached) {  
             $result=tie(%testData,'GDBM_File',$ChartDB,&GDBM_READER,0640);  
         } else {  
             $result=tie(%testData,'GDBM_File',$ChartDB,&GDBM_NEWDB,0640);  
         }  
         if($result) {  
             last;  
         }  
         $tieTries++;  
         sleep 1;  
     }  
     if($tieTries >= 10) {  
         return -1;  
     }  
   
     untie(%testData);  
   
     return $isCached;  
 }  
   
 =pod  
   
 =item &ShouldShowColumn()  =item &ShouldShowColumn()
   
 Determine if a specified column should be shown on the chart.  Determine if a specified column should be shown on the chart.
Line 1670  Output: 0 (false), 1 (true) Line 928  Output: 0 (false), 1 (true)
 sub ShouldShowColumn {  sub ShouldShowColumn {
     my ($cache,$test)=@_;      my ($cache,$test)=@_;
   
     if($cache->{'form.reset'} eq 'true') {      if($cache->{'form.ChartReset'} eq 'true') {
         return 1;          return 1;
     }      }
   
     my $headings=$cache->{'form.headings'};      my $headings=$cache->{'form.ChartHeadings'};
     my $sequences=$cache->{'form.sequences'};      my $sequences=$cache->{'form.ChartSequences'};
     if($headings eq 'ALLHEADINGS' || $sequences eq 'ALLSEQUENCES' ||      if($headings eq 'ALLHEADINGS' || $sequences eq 'ALLSEQUENCES' ||
        $headings=~/$test/ || $sequences=~/$test/) {         $headings=~/$test/ || $sequences=~/$test/) {
         return 1;          return 1;
Line 1732  sub BuildChart { Line 990  sub BuildChart {
     # Start the lonchart document      # Start the lonchart document
     $r->content_type('text/html');      $r->content_type('text/html');
     $r->send_http_header;      $r->send_http_header;
     $r->print(&StartDocument());      $r->print(&StartDocument('LON-CAPA Assessment Chart', 'Assessment Chart'));
     $r->rflush();      $r->rflush();
   
     # Test for access to the CacheData      # Test for access to the CacheData
Line 1740  sub BuildChart { Line 998  sub BuildChart {
     my $cid=$ENV{'request.course.id'};      my $cid=$ENV{'request.course.id'};
     my $ChartDB = "/home/httpd/perl/tmp/$ENV{'user.name'}".      my $ChartDB = "/home/httpd/perl/tmp/$ENV{'user.name'}".
                   "_$ENV{'user.domain'}_$cid\_chart.db";                    "_$ENV{'user.domain'}_$cid\_chart.db";
       my $isRecalculate=0;
     $isCached=&TestCacheData($ChartDB);      if(defined($ENV{'form.ChartRecalculate'})) {
           $isRecalculate=1;
       }
       $isCached=&Apache::loncoursedata::TestCacheData($ChartDB, $isRecalculate);
     if($isCached < 0) {      if($isCached < 0) {
         $r->print("Unable to tie hash to db file");          $r->print("Unable to tie hash to db file</body></html>");
         $r->rflush();          $r->rflush();
         return;          return;
     }      }
Line 1756  sub BuildChart { Line 1017  sub BuildChart {
     my @headings=('User Name','Domain','Section','PID','Full Name');      my @headings=('User Name','Domain','Section','PID','Full Name');
     my $spacePadding='   ';      my $spacePadding='   ';
     if(!$isCached) {      if(!$isCached) {
         my $processTopResourceMapReturn=&ProcessTopResourceMap($ChartDB,$c);          unless(tie(%CacheData,'GDBM_File',$ChartDB,&GDBM_WRCREAT,0640)) {
               $r->print("Unable to tie hash to db file</body></html>");
               $r->rflush();
               return;
           }
   
           my $processTopResourceMapReturn=
               &Apache::loncoursedata::ProcessTopResourceMap(\%CacheData,$c);
         if($processTopResourceMapReturn ne 'OK') {          if($processTopResourceMapReturn ne 'OK') {
             $r->print($processTopResourceMapReturn);              $r->print($processTopResourceMapReturn.'</body></html>');
               untie(%CacheData);
             return;              return;
         }          }
         if($c->aborted()) { return; }  
         my $classlist=&DownloadPrerequisiteData($cid, $c);          if($c->aborted()) {
               untie(%CacheData);
               $r->print('</body></html>'); 
               return;
           }
   
           my $classlist=&Apache::loncoursedata::DownloadStudentNamePIDSection(
                                                                      $cid, $c);
         my ($checkForError)=keys(%$classlist);          my ($checkForError)=keys(%$classlist);
         if($checkForError =~ /^(con_lost|error|no_such_host)/i ||          if($checkForError =~ /^(con_lost|error|no_such_host)/i ||
            defined($classlist->{'error'})) {             defined($classlist->{'error'})) {
               $r->print("Error getting student data.</body></html>");
               $r->rflush();
               untie(%CacheData);
             return;              return;
         }          }
         if($c->aborted()) { return; }  
         @students=&ProcessClassList($classlist,$cid,$ChartDB,$c);          if($c->aborted()) {
         if($c->aborted()) { return; }              untie(%CacheData);
               $r->print('</body></html>'); 
               return;
           }
   
   
           @students=&Apache::loncoursedata::ProcessClassList(\%CacheData, 
                                                 $classlist, $cid, 
                                                 $CacheData{'form.ChartStatus'},
                                                 $c);
   
           if($c->aborted()) {
               untie(%CacheData);
               $r->print('</body></html>'); 
               return;
           }
   
         &SpaceColumns(\@students,\@studentInformation,\@headings,          &SpaceColumns(\@students,\@studentInformation,\@headings,
                       $ChartDB);                        \%CacheData);
         if($c->aborted()) { return; }  
           if($c->aborted()) {
               untie(%CacheData);
               $r->print('</body></html>'); 
               return;
           }
   
           untie(%CacheData);
     } else {      } else {
         if(!$c->aborted() && tie(%CacheData,'GDBM_File',$ChartDB,          if(!$c->aborted() && tie(%CacheData,'GDBM_File',$ChartDB,
                                  &GDBM_READER,0640)) {                                   &GDBM_READER,0640)) {
Line 1829  sub BuildChart { Line 1131  sub BuildChart {
         }          }
   
         if(!$isCached) {          if(!$isCached) {
             $courseData=&DownloadStudentCourseInformation($_, $cid);              $courseData=
                   &Apache::loncoursedata::DownloadStudentCourseInformation($_, 
                                                                            $cid);
             if($c->aborted()) { last; }              if($c->aborted()) { last; }
             push(@updateStudentList, $_);              if(tie(%CacheData,'GDBM_File',$ChartDB,&GDBM_WRCREAT,0640)) {
             &ProcessStudentData($courseData, $_, $ChartDB);                  &Apache::loncoursedata::ProcessStudentData(\%CacheData, 
                                                              $courseData, $_);
                   push(@updateStudentList, $_);
                   untie(%CacheData);
               } else {
                   next;
               }
         }          }
         $r->print(&FormatStudentData($_, \@studentInformation,          $r->print(&FormatStudentData($_, \@studentInformation,
                                      $spacePadding, $ChartDB));                                       $spacePadding, $ChartDB));

Removed from v.1.58  
changed lines
  Added in v.1.59


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