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

Diff for /loncom/interface/Attic/lonchart.pm between versions 1.43 and 1.52

version 1.43, 2002/06/05 05:05:38 version 1.52, 2002/07/02 21:48:36
Line 46 Line 46
 #  #
 ###  ###
   
   =pod
   
   =cut
   
 package Apache::lonchart;  package Apache::lonchart;
   
 use strict;  use strict;
Line 55  use Apache::loncommon(); Line 59  use Apache::loncommon();
 use HTML::TokeParser;  use HTML::TokeParser;
 use GDBM_File;  use GDBM_File;
   
 # -------------------------------------------------------------- Module Globals  #my $jr; 
 my %hash;  # ----- FORMAT PRINT DATA ----------------------------------------------
 my %CachData;  
 my @cols;  
 my $r;  
 my $c;  
    
 # ------------------------------------------------------------- Find out status  
   
 sub ExtractStudentData {  sub FormatStudentInformation {
     my ($name,$coid)=@_;      my ($cache,$name,$studentInformation,$spacePadding)=@_;
       my $Str='';
   
       for(my $index=0; $index<(scalar @$studentInformation); $index++) {
           if(!&ShouldShowColumn($cache, 'heading'.$index)) {
               next;
           }
    my $data=$cache->{$name.':'.$studentInformation->[$index]};
    $Str .= $data;
   
    my @dataLength=split(//,$data);
    my $length=scalar @dataLength;
    $Str .= (' 'x($cache->{$studentInformation->[$index].'Length'}-
                         $length));
    $Str .= $spacePadding;
       }
   
       return $Str;
   }
   
   sub FormatStudentData {
       my ($name,$coid,$studentInformation,$spacePadding,$ChartDB)=@_;
     my ($sname,$sdom) = split(/\:/,$name);      my ($sname,$sdom) = split(/\:/,$name);
     my $ResId;  
     my $Code;  
     my $Tries;  
     my $Wrongs;  
     my %TempHash;  
     my $Version;  
     my $problemsCorrect;  
     my $problemsSolved;  
     my $totalProblems;  
     my $LatestVersion;  
     my $Str;      my $Str;
       my %CacheData;
   
       unless(tie(%CacheData,'GDBM_File',$ChartDB,&GDBM_READER,0640)) {
           return '';
       }
     # Handle Student information ------------------------------------------      # Handle Student information ------------------------------------------
       # Handle user data
       $Str=&FormatStudentInformation(\%CacheData, $name, $studentInformation, 
                                      $spacePadding);
   
     # Handle errors      # Handle errors
 #    if($CachData{$name.':error'} =~ /environment/) {      if($CacheData{$name.':error'} =~ /environment/) {
 # my $errorMessage = $CachData{$name.':error'};          $Str .= '<br>';
 # return '<td>'.$sname.'</td><td>'.$sdom.          untie(%CacheData);
 #    '</td><td><font color="#000088">'.$errorMessage.'</font></td>';          return $Str;
 #    }      }
   
     # Handle user data      if($CacheData{$name.':error'} =~ /course/) {
     $Str  = '<td><pre>'.$sname.'</pre></td><td><pre>'.$sdom;          $Str .= '<br>';
     $Str .= '</pre></td><td><pre>'.$CachData{$name.':section'};          untie(%CacheData);
     $Str .= '</pre></td><td><pre>'.$CachData{$name.':id'};          return $Str;
     $Str .= '</pre></td><td><pre>'.$CachData{$name.':fullname'};  
     $Str .= '</pre></td>';  
   
     if($CachData{$name.':error'} =~ /course/) {  
  return $Str;  
 # my $errorMessage = 'May have no course data or '.  
 #                   $CachData{$name.':error'};  
 # return '<td>'.$sname.'</td><td>'.$sdom.  
 #    '</td><td><font color="#000088">'.$errorMessage.'</font></td>';  
     }      }
   
     # Handle problem data ------------------------------------------------      # Handle problem data ------------------------------------------------
     $Str .= '<td><pre>';      my $Version;
     $problemsCorrect = 0;      my $problemsCorrect = 0;
     $totalProblems = 0;      my $totalProblems   = 0;
     $problemsSolved = 0;      my $problemsSolved  = 0;
     my $IterationNo = 0;      my $numberOfParts   = 0;
     foreach $ResId (@cols) {      foreach my $sequence (split(/\:/,$CacheData{'orderedSequences'})) {
  if ($IterationNo == 0) {          if(!&ShouldShowColumn(\%CacheData, 'sequence'.$sequence)) {
     # Looks to be skipping start resource              next;
     $IterationNo++;           }
     next;  
  }   my $characterCount=0;
    foreach my $problemID (split(/\:/,$CacheData{$sequence.':problems'})) {
  # ResId is 0 for sequences and pages,       my $problem = $CacheData{$problemID.':problem'};
  # please check tracetable for changes      my $LatestVersion = $CacheData{$name.":version:$problem"};
  if (!$ResId) {  
     my $outputProblemsCorrect = sprintf( "%3d", $problemsCorrect );              if(!$LatestVersion) {
     $Str .= '<font color="#007700">'.$outputProblemsCorrect.                  foreach my $part (split(/\:/,$CacheData{$sequence.':'.
     '</font></pre></td>';                                                          $problemID.
     $Str .= '<td><pre>';                                                          ':parts'})) {
     $problemsSolved += $problemsCorrect;                      $Str .= ' ';
     $problemsCorrect=0;                      $totalProblems++;
     next;                       $characterCount++;
  }                  }
                   next;
  # Set $1 and $2              }
  $ResId=~/(\d+)\.(\d+)/;  
  my $meta=$hash{'src_'.$ResId};              my %partData=undef;
  my $numberOfParts = 0;              #initialize data, displays skips correctly
  undef %TempHash;              foreach my $part (split(/\:/,$CacheData{$sequence.':'.
  foreach (split(/\,/,&Apache::lonnet::metadata($meta,'keys'))) {                                                      $problemID.
 #----------- Overwrite $1 in next statement ---------------------------------                                                      ':parts'})) {
     if ($_=~/^stores\_(\d+)\_tries$/) {                  $partData{$part.':tries'}=0;
  my $Part=&Apache::lonnet::metadata($meta,$_.'.part');                  $partData{$part.':code'}=' ';
  if ( $TempHash{"$Part"} eq '' ) {               }
     $TempHash{"$Part"} = $Part;      for(my $Version=1; $Version<=$LatestVersion; $Version++) {
     $TempHash{$numberOfParts}=$Part;                  foreach my $part (split(/\:/,$CacheData{$sequence.':'.
     $TempHash{"$Part.Code"} = ' ';                                                            $problemID.
     $numberOfParts++;                                                          ':parts'})) {
  }  
     }                      if(!defined($CacheData{$name.":$Version:$problem".
  }                                                 ":resource.$part.solved"})) {
                           next;
 #----------- Using $1 and $2 -----------------------------------------------                      }
  my $Prob = &Apache::lonnet::symbclean(  
        &Apache::lonnet::declutter($hash{'map_id_'.$1} ).                      my $tries=0;
                        '___'.$2.'___'.                      my $code=' ';
                        &Apache::lonnet::declutter( $hash{'src_'.$ResId} ));  
  $Code=' ';                      $tries = $CacheData{$name.":$Version:$problem".
  $Tries = 0;                                          ":resource.$part.tries"};
  $LatestVersion = $CachData{$name.":version:$Prob"};                      $partData{$part.':tries'}=($tries) ? $tries : 0;
   
  if ( $LatestVersion ) {                      my $val = $CacheData{$name.":$Version:$problem".
     for ( my $Version=1; $Version<=$LatestVersion; $Version++ ) {                                           ":resource.$part.solved"};
  my $vkeys = $CachData{$name.":$Version:keys:$Prob"};                      if    ($val eq 'correct_by_student')   {$code = '*';} 
  my @keys = split(/\:/,$vkeys);                        elsif ($val eq 'correct_by_override')  {$code = '+';}
                       elsif ($val eq 'incorrect_attempted')  {$code = '.';} 
  foreach my $Key (@keys) {                      elsif ($val eq 'incorrect_by_override'){$code = '-';}
 #---------------------- Changing $1 -------------------------------------------                      elsif ($val eq 'excused')              {$code = 'x';}
     if (($Key=~/\.(\w+)\.solved$/) && ($Key!~/^\d+\:/)) {                      elsif ($val eq 'ungraded_attempted')   {$code = '#';}
 #---------------------- Using $1 -----------------------------------------------                      else                                   {$code = ' ';}
  my $Part = $1;                      $partData{$part.':code'}=$code;
  $Tries = $CachData{$name.":$Version:$Prob".                  }
    ":resource.$Part.tries"};              }
  $TempHash{"$Part.Tries"}=($Tries) ? $Tries : 0;  
  my $Val = $CachData{$name.":$Version:$Prob".  
     ":resource.$Part.solved"};  
  if    ($Val eq 'correct_by_student')   {$Code = '*';}   
  elsif ($Val eq 'correct_by_override')  {$Code = '+';}  
  elsif ($Val eq 'incorrect_attempted')  {$Code = '.';}   
  elsif ($Val eq 'incorrect_by_override'){$Code = '-';}  
  elsif ($Val eq 'excused')              {$Code = 'x';}  
  elsif ($Val eq 'ungraded_attempted')   {$Code = '#';}  
  else                                   {$Code = ' ';}  
   
  $TempHash{"$Part.Code"} = $Code;              $Str.='<a href="/adm/grades?symb='.
     }                  &Apache::lonnet::escape($problem).
  }  
     }  
 # Actually append problem to output (all parts)  
     $Str.='<a href="/adm/grades?symb='.  
                 &Apache::lonnet::escape($Prob).  
                 '&student='.$sname.'&domain='.$sdom.'&command=submission">';                   '&student='.$sname.'&domain='.$sdom.'&command=submission">'; 
     for(my $n = 0; $n < $numberOfParts; $n++) {                foreach(split(/\:/,$CacheData{$sequence.':'.$problemID.
  my $part = $TempHash{$n};                                            ':parts'})) {
  my $code2 = $TempHash{"$part.Code"};                  if($partData{$_.':code'} eq '*') {
  if($code2 eq '*') {                      $problemsCorrect++;
     $problemsCorrect++;                      if (($partData{$_.':tries'}<10) &&
 # !!!!!!!!!!!------------------------- Should 10 not be maxtries? ------------                          ($partData{$_.':tries'} ne '')) {
     if (($TempHash{"$part.Tries"}<10) ||                          $partData{$_.':code'}=$partData{$_.':tries'};
  ($TempHash{"$part.Tries"} eq '')) {                      }
  $TempHash{"$part.Code"}=$TempHash{"$part.Tries"};                  } elsif($partData{$_.':code'} eq '+') {
     }                      $problemsCorrect++;
  } elsif($code2 eq '+') {                  }
     $problemsCorrect++;  
  }                  $Str .= $partData{$_.':code'};
                   $characterCount++;
   
                   if($partData{$_.':code'} ne 'x') {
                       $totalProblems++;
                   }
               }
               $Str.='</a>';
           }
   
           my $spacesNeeded=$CacheData{$sequence.':columnWidth'}-$characterCount;
           $spacesNeeded -= 3;
           $Str .= (' 'x$spacesNeeded);
   
    my $outputProblemsCorrect = sprintf( "%3d", $problemsCorrect );
    $Str .= '<font color="#007700">'.$outputProblemsCorrect.'</font>';
    $problemsSolved += $problemsCorrect;
    $problemsCorrect=0;
   
           $Str .= $spacePadding;
       }
   
       my $outputProblemsSolved = sprintf( "%4d", $problemsSolved );
       my $outputTotalProblems  = sprintf( "%4d", $totalProblems );
       $Str .= '<font color="#000088">'.$outputProblemsSolved.
       ' / '.$outputTotalProblems.'</font><br>';
   
  $Str .= $TempHash{"$part.Code"};      untie(%CacheData);
       return $Str;
   }
   
  if($code2 ne 'x') {  sub CreateTableHeadings {
     $totalProblems++;      my ($CacheData,$studentInformation,$headings,$spacePadding)=@_;
  }      my $Str='<pre>';
     }  
     $Str.='</a>';      for(my $index=0; $index<(scalar @$headings); $index++) {
  } else {          if(!&ShouldShowColumn($CacheData, 'heading'.$index)) {
     for(my $n=0; $n<$numberOfParts; $n++) {              next;
  $Str.=' ';          }
  $totalProblems++;  
     }   my $data=$$headings[$index];
  }   $Str .= $data;
   
    my @dataLength=split(//,$data);
    my $length=scalar @dataLength;
    $Str .= (' 'x($CacheData->{$$studentInformation[$index].'Length'}-
                         $length));
    $Str .= $spacePadding;
       }
   
       foreach my $sequence (split(/\:/,$CacheData->{'orderedSequences'})) {
           if(!&ShouldShowColumn($CacheData, 'sequence'.$sequence)) {
               next;
           }
   
           my $name = $CacheData->{$sequence.':title'};
    $Str .= $name;
    my @titleLength=split(//,$CacheData->{$sequence.':title'});
    my $leftover=$CacheData->{$sequence.':columnWidth'}-
                        (scalar @titleLength);
    $Str .= (' 'x$leftover);
    $Str .= $spacePadding;
     }      }
   
     $Str .= '<td><pre><font color="#000088">'.$problemsSolved.      $Str .= 'Total Solved/Total Problems';
     ' / '.$totalProblems.'</font></pre></td>';      $Str .= '</pre>';
   
     return $Str;      return $Str;
 }  }
   
   sub CreateColumnSelectionBox {
       my ($CacheData,$studentInformation,$headings,$spacePadding)=@_;
   
       my $missing=0;
       my $notThere='<tr><td align="right"><b>Select column to view:</b>';
       my $name;
       $notThere .= '<td align="left">';
       $notThere .= '<select name="reselect" size="4" multiple="true">'."\n";
   
       for(my $index=0; $index<(scalar @$headings); $index++) {
           if(&ShouldShowColumn($CacheData, 'heading'.$index)) {
               next;
           }
           $name = $headings->[$index];
           $notThere .= '<option value="heading'.$index.'">';
           $notThere .= $name.'</option>'."\n";
           $missing++;
       }
   
       foreach my $sequence (split(/\:/,$CacheData->{'orderedSequences'})) {
           if(&ShouldShowColumn($CacheData, 'sequence'.$sequence)) {
               next;
           }
           $name = $CacheData->{$sequence.':title'};
           $notThere .= '<option value="sequence'.$sequence.'">';
           $notThere .= $name.'</option>'."\n";
           $missing++;
       }
   
       if($missing) {
           $notThere .= '</select>';
       } else {
           $notThere='<tr><td>';
       }
   
       return $notThere.'</td></tr></tbody></table>';
   }
   
   sub CreateColumnSelectors {
       my ($CacheData,$studentInformation,$headings,$spacePadding)=@_;
   
       my $found=0;
       my ($name, $length, $position);
       my $present='<pre>';
       for(my $index=0; $index<(scalar @$headings); $index++) {
           if(!&ShouldShowColumn($CacheData, 'heading'.$index)) {
               next;
           }
           $name = $headings->[$index];
           $length=$CacheData->{$$studentInformation[$index].'Length'};
           $position=int($length/2);
    $present .= (' 'x($position));
           $present .= '<input type="checkbox" checked="on" ';
           $present .= 'name="heading'.$index.'">';
           $position+=2;
    $present .= (' 'x($length-$position));
    $present .= $spacePadding;
           $found++;
       }
   
       foreach my $sequence (split(/\:/,$CacheData->{'orderedSequences'})) {
           if(!&ShouldShowColumn($CacheData, 'sequence'.$sequence)) {
               next;
           }
           $name = $CacheData->{$sequence.':title'};
           $length=$CacheData->{$sequence.':columnWidth'};
           $position=int($length/2);
    $present .= (' 'x($position));
           $present .= '<input type="checkbox" checked="on" ';
           $present .= 'name="sequence'.$sequence.'">';
           $position+=2;
    $present .= (' 'x($length-$position));
    $present .= $spacePadding;
           $found++;
       }
   
       if($found) {
           $present .= '</pre>';
           $present  = $present;
       } else {
           $present = '';
       }
   
       return $present.'</form>'."\n";;
   }
   
 sub CreateForm {  sub CreateForm {
       my ($CacheData)=@_;
     my $OpSel1='';      my $OpSel1='';
     my $OpSel2='';      my $OpSel2='';
     my $OpSel3='';      my $OpSel3='';
     my $Status = $ENV{'form.status'};      my $Status = $CacheData->{'form.status'};
     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="stat" method="post" action="/adm/chart" >'."\n";
     $Ptr .= '<b> Sort by: &nbsp; </b>'."\n";      $Ptr .= '<table border="0"><tbody>';
       $Ptr .= '<tr><td align="right">';
       $Ptr .= '</td><td align="left">';
       $Ptr .= '<input type="submit" name="recalculate" ';
       $Ptr .= 'value="Recalculate Chart"/>'."\n";
     $Ptr .= '&nbsp;&nbsp;&nbsp;';      $Ptr .= '&nbsp;&nbsp;&nbsp;';
     $Ptr .= '<input type=submit name=sort value="User Name" />'."\n";      $Ptr .= '<input type="submit" name="refresh" ';
       $Ptr .= 'value="Refresh Chart"/>'."\n";
     $Ptr .= '&nbsp;&nbsp;&nbsp;';      $Ptr .= '&nbsp;&nbsp;&nbsp;';
     $Ptr .= '<input type=submit name=sort value="Last Name" />'."\n";      $Ptr .= '<input type="submit" name="reset" ';
       $Ptr .= 'value="Reset Selections"/></td>'."\n";
       $Ptr .= '</tr><tr><td align="right">';
       $Ptr .= '<b> Sort by: </b>'."\n";
       $Ptr .= '</td><td align="left">';
       $Ptr .= '<input type="submit" name="sort" value="User Name" />'."\n";
     $Ptr .= '&nbsp;&nbsp;&nbsp;';      $Ptr .= '&nbsp;&nbsp;&nbsp;';
     $Ptr .= '<input type=submit name=sort value="Section"/>'."\n";      $Ptr .= '<input type="submit" name="sort" value="Last Name" />'."\n";
     $Ptr .= '<br><br>';      $Ptr .= '&nbsp;&nbsp;&nbsp;';
       $Ptr .= '<input type="submit" name="sort" value="Section"/>'."\n";
       $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">'.
             '<select name="status">'.               '<select name="status">'. 
             '<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";
     $Ptr .= '&nbsp;&nbsp;&nbsp;';      $Ptr .= '</td></tr>';
     $Ptr .= '<input type=submit name=sort value="Recalculate Chart"/>'."\n";  
     $Ptr .= '</form>'."\n";      return $Ptr;
     $r->print( $Ptr );  
 }  }
   
 sub CreateTableHeadings {  sub CreateLegend {
     $r->print('<tr>');      my $Str = "<p><pre>".
     $r->print('<td>User Name</td>');                "1..9: correct by student in 1..9 tries\n".
     $r->print('<td>Domain</td>');                "   *: correct by student in more than 9 tries\n".
     $r->print('<td>Section</td>');        "   +: correct by override\n".
     $r->print('<td>PID</td>');                "   -: incorrect by override\n".
     $r->print('<td>Full Name</td>');        "   .: incorrect attempted\n".
         "   #: ungraded attempted\n".
     my $ResId;                "    : not attempted\n".
     my $IterationNo = 0;        "   x: excused".
     foreach $ResId (@cols) {                "</pre><p>"; 
  if ($IterationNo == 0) {$IterationNo++; next;}      return $Str;
  if (!$ResId) {   }
 #    my $PrNo = sprintf( "%3d", $ProbNo );  
 #    $Str .= '<td><font color="#007700">Chapter '.$PrNo.'</font></td>';  
     $r->print('<td><font color="#007700">Chapter '.'0'.'</font></td>');  
  }  
     }  
   
     $r->print('</tr>');  sub StartDocument {
     $r->rflush();      my $Str = '';
       $Str .= '<html>';
       $Str .= '<head><title>';
       $Str .= 'LON-CAPA Assessment Chart</title></head>';
       $Str .= '<body bgcolor="#FFFFFF">';
       $Str .= '<script>window.focus();</script>';
       $Str .= '<img align=right src=/adm/lonIcons/lonlogos.gif>';
       $Str .= '<h1>Assessment Chart</h1>';
       $Str .= '<h3>'.localtime().'</h3>';
       $Str .= '<h1>'.$ENV{'course.'.$ENV{'request.course.id'}.'.description'};
       $Str .= '</h1>';
   
     return;      return $Str;
 }  }
   
 # ------------------------------------------------------------ Build page table  # ----- END FORMAT PRINT DATA ------------------------------------------
   
   # ----- DOWNLOAD INFORMATION -------------------------------------------
   
   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;
       }
   
 sub tracetable {      foreach my $name (keys(%classlist)) {
     my ($rid,$beenhere)=@_;          if($c->aborted()) {
     unless ($beenhere=~/\&$rid\&/) {              $classlist{'error'}='aborted';
        $beenhere.=$rid.'&';                return \%classlist;
 # new ... updating the map according to sequence and page          }
        if (defined($hash{'is_map_'.$rid})) {  
    my $cmap=$hash{'map_type_'.$hash{'map_pc_'.$hash{'src_'.$rid}}};          my ($studentName,$studentDomain) = split(/\:/,$name);
            if ( $cmap eq 'sequence' || $cmap eq 'page' ) {           # Download student environment data, specifically the full name and id.
                $cols[$#cols+1]=0;           my %studentInformation=&Apache::lonnet::get('environment',
            }                                                      ['lastname','generation',
            if ((defined($hash{'map_start_'.$hash{'src_'.$rid}})) &&                                                       'firstname','middlename',
                (defined($hash{'map_finish_'.$hash{'src_'.$rid}}))) {                                                       'id'],
               my $frid=$hash{'map_finish_'.$hash{'src_'.$rid}};                                                      $studentDomain,
                                                       $studentName);
                 &tracetable($hash{'map_start_'.$hash{'src_'.$rid}},          $classlist{$name.':studentInformation'}=\%studentInformation;
                 '&'.$frid.'&');  
           if($c->aborted()) {
               if ($hash{'src_'.$frid}) {              $classlist{'error'}='aborted';
                  if ($hash{'src_'.$frid}=~              return \%classlist;
                                  /\.(problem|exam|quiz|assess|survey|form)$/) {          }
      $cols[$#cols+1]=$frid;  
                  }          #Section
       }          my %section=&Apache::lonnet::dump('roles',$studentDomain,$studentName);
           $classlist{$name.':section'}=\%section;
    }  
        } else {  
           if ($hash{'src_'.$rid}) {  
              if ($hash{'src_'.$rid}=~  
                                  /\.(problem|exam|quiz|assess|survey|form)$/) {  
          $cols[$#cols+1]=$rid;  
              }  
           }  
        }  
        if (defined($hash{'to_'.$rid})) {  
           foreach (split(/\,/,$hash{'to_'.$rid})){  
               &tracetable($hash{'goesto_'.$_},$beenhere);  
           }  
        }  
     }      }
   
       return \%classlist;
 }  }
   
 sub usection {  sub DownloadStudentCourseInformation {
     my ($udom,$unam,$courseid,$ActiveFlag)=@_;      my ($name,$courseID)=@_;
     $courseid=~s/\_/\//g;      my ($studentName,$studentDomain) = split(/\:/,$name);
     $courseid=~s/^(\w)/\/$1/;  
   
     my %result=&Apache::lonnet::dump('roles',$udom,$unam);      # Download student course data
       my %courseData=&Apache::lonnet::dump($courseID,$studentDomain,
    $studentName);
       return \%courseData;
   }
   
     my($checkForError)=keys (%result);  # ----- END DOWNLOAD INFORMATION ---------------------------------------
     if($checkForError =~ /^(con_lost|error|no_such_host)/i) {  
  return -1;  # ----- END PROCESSING FUNCTIONS ---------------------------------------
   
   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.';
       }
   
       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
    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 {
                   $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';
   }
   
   sub ProcessSection {
       my ($sectionData, $courseid,$ActiveFlag)=@_;
       $courseid=~s/\_/\//g;
       $courseid=~s/^(\w)/\/$1/;
   
     my $cursection='-1';      my $cursection='-1';
     my $oldsection='-1';      my $oldsection='-1';
     my $status='Expired';      my $status='Expired';
     foreach my $key (keys (%result)) {      my $section='';
  my $value = $result{$key};      foreach my $key (keys (%$sectionData)) {
    my $value = $sectionData->{$key};
         if ($key=~/^$courseid(?:\/)*(\w+)*\_st$/) {          if ($key=~/^$courseid(?:\/)*(\w+)*\_st$/) {
             my $section=$1;      $section=$1;
             if ($key eq $courseid.'_st') { $section=''; }      if($key eq $courseid.'_st') {
    $section='';
       }
     my ($dummy,$end,$start)=split(/\_/,$value);      my ($dummy,$end,$start)=split(/\_/,$value);
     my $now=time;      my $now=time;
     my $notactive=0;      my $notactive=0;
Line 353  sub usection { Line 694  sub usection {
     if($notactive == 0) {      if($notactive == 0) {
  $status='Active';   $status='Active';
  $cursection=$section;   $cursection=$section;
    last;
     }      }
     if($notactive == 1) {      if($notactive == 1) {
  $oldsection=$section;   $oldsection=$section;
Line 374  sub usection { Line 716  sub usection {
     return '-1';      return '-1';
 }  }
   
   sub ProcessStudentInformation {
       my ($CacheData,$studentInformation,$section,$date,$name,$courseID,$c)=@_;
       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 0;
   }
   
   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,$c);
           }
   
    untie(%CacheData);
       }
   
       return @names;
   }
   
   # ----- END PROCESSING FUNCTIONS ---------------------------------------
   
   # ----- HELPER FUNCTIONS -----------------------------------------------
   
   sub SpaceColumns {
       my ($students,$studentInformation,$headings,$ChartDB)=@_;
   
       my %CacheData;
       if(tie(%CacheData,'GDBM_File',$ChartDB,&GDBM_WRCREAT,0640)) {
           # Initialize Lengths
           for(my $index=0; $index<(scalar @$headings); $index++) {
       my @titleLength=split(//,$$headings[$index]);
       $CacheData{$$studentInformation[$index].'Length'}=
                   scalar @titleLength;
    }
   
           foreach my $name (@$students) {
               foreach (@$studentInformation) {
    my @dataLength=split(//,$CacheData{$name.':'.$_});
    my $length=scalar @dataLength;
    if($length > $CacheData{$_.'Length'}) {
       $CacheData{$_.'Length'}=$length;
    }
               }
           }
           untie(%CacheData);
       }
   
       return;
   }
   
 sub ProcessFullName {  sub ProcessFullName {
     my ($name)=@_;      my ($lastname, $generation, $firstname, $middlename)=@_;
     my $Str = '';      my $Str = '';
   
     if($CachData{$name.':lastname'} ne '') {      if($lastname ne '') {
  $Str .= $CachData{$name.':lastname'}.' ';   $Str .= $lastname.' ';
  if($CachData{$name.':generation'} ne '') {   if($generation ne '') {
     $Str .= $CachData{$name.':generation'};      $Str .= $generation;
  } else {   } else {
     chop($Str);      chop($Str);
  }   }
  $Str .= ', ';   $Str .= ', ';
  if($CachData{$name.':firstname'} ne '') {   if($firstname ne '') {
     $Str .= $CachData{$name.':firstname'}.' ';      $Str .= $firstname.' ';
  }   }
  if($CachData{$name.':middlename'} ne '') {   if($middlename ne '') {
     $Str .= $CachData{$name.':middlename'};      $Str .= $middlename;
  } else {   } else {
     chop($Str);      chop($Str);
     if($CachData{$name.'firstname'} eq '') {      if($firstname eq '') {
  chop($Str);   chop($Str);
     }      }
  }   }
     } else {      } else {
  if($CachData{$name.':firstname'} ne '') {   if($firstname ne '') {
     $Str .= $CachData{$name.':firstname'}.' ';      $Str .= $firstname.' ';
  }   }
  if($CachData{$name.':middlename'} ne '') {   if($middlename ne '') {
     $Str .= $CachData{$name.':middlename'}.' ';      $Str .= $middlename.' ';
  }   }
  if($CachData{$name.':generation'} ne '') {   if($generation ne '') {
     $Str .= $CachData{$name.':generation'};      $Str .= $generation;
  } else {   } else {
     chop($Str);      chop($Str);
  }   }
Line 414  sub ProcessFullName { Line 850  sub ProcessFullName {
     return $Str;      return $Str;
 }  }
   
 sub DownloadStudentInformation {  sub SortStudents {
     my ($name,$courseID)=@_;      my ($students,$CacheData)=@_;
     my ($studentName,$studentDomain) = split(/\:/,$name);  
     my $checkForError;  
     my $key;  
     my $Status=$CachData{$name.':Status'};  
   
 #-----------------------------------------------------------------  
     # Download student environment data, specifically the full name and id.  
     my %studentInformation=&Apache::lonnet::get('environment',  
  ['lastname','generation',  
  'firstname','middlename',  
  'id'],  
  $studentDomain,$studentName);  
     if($c->aborted()) {  
  return;  
     }  
     ($checkForError)=keys (%studentInformation);  
     if($checkForError =~ /^(con_lost|error|no_such_host)/i) {  
  $CachData{$name.':error'}=  
     'Could not download student environment data.';  
 # return;  
  $CachData{$name.':lastname'}='';  
  $CachData{$name.':generation'}='';  
  $CachData{$name.':firstname'}='';  
  $CachData{$name.':middlename'}='';  
  $CachData{$name.':fullname'}='';  
  $CachData{$name.':id'}='';  
     } else {  
  $CachData{$name.':lastname'}=$studentInformation{'lastname'};  
  $CachData{$name.':generation'}=$studentInformation{'generation'};  
  $CachData{$name.':firstname'}=$studentInformation{'firstname'};  
  $CachData{$name.':middlename'}=$studentInformation{'middlename'};  
  $CachData{$name.':fullname'}=&ProcessFullName($name);  
  $CachData{$name.':id'}=$studentInformation{'id'};  
     }  
   
     # Download student course data  
     my %courseData=&Apache::lonnet::dump($courseID,$studentDomain,  
  $studentName);  
     if($c->aborted()) {  
  return;  
     }  
     ($checkForError)=keys (%courseData);  
     if($checkForError =~ /^(con_lost|error|no_such_host)/i) {  
  $CachData{$name.':error'}='Could not download course data.';  
 # return;  
     } else {  
  foreach $key (keys (%courseData)) {  
     $CachData{$name.':'.$key}=$courseData{$key};  
  }  
     }  
   
     # Get student's section number      my @sorted1Students=();
     my $sec=&usection($studentDomain, $studentName, $courseID, $Status);      foreach (@$students) {
     if($sec != -1) {          my ($end,$start)=split(/\:/,$CacheData->{$_.':date'});
  $CachData{$name.':section'}=sprintf('%3s',$sec);          my $active=1;
     } else {          my $now=time;
  $CachData{$name.':section'}='';          my $Status=$CacheData->{'form.status'};
           $Status = ($Status) ? $Status : 'Active';
           if((($end) && $now > $end) && (($Status eq 'Active'))) { 
               $active=0; 
           }
           if(($Status eq 'Expired') && ($end == 0 || $now < $end)) {
               $active=0;
           }
           if($active) {
               push(@sorted1Students, $_);
           }
     }      }
   
     return;      my $Pos = $CacheData->{'form.sort'};
 }  
   
 sub SortStudents {  
 # --------------------------------------------------------------- Sort Students  
     my $Pos = $ENV{'form.sort'};  
     my @students = split(/:::/,$CachData{'NamesOfStudents'});  
     my %sortData;      my %sortData;
   
     if($Pos eq 'Last Name') {      if($Pos eq 'Last Name') {
  for(my $index=0; $index<$#students+1; $index++) {   for(my $index=0; $index<scalar @sorted1Students; $index++) {
     $sortData{$CachData{$students[$index].':fullname'}}=      $sortData{$CacheData->{$sorted1Students[$index].':fullname'}}=
  $students[$index];   $sorted1Students[$index];
  }   }
     } elsif($Pos eq 'Section') {      } elsif($Pos eq 'Section') {
  for(my $index=0; $index<$#students+1; $index++) {   for(my $index=0; $index<scalar @sorted1Students; $index++) {
     $sortData{$CachData{$students[$index].':section'}.      $sortData{$CacheData->{$sorted1Students[$index].':section'}.
       $students[$index]}=$students[$index];        $sorted1Students[$index]}=$sorted1Students[$index];
  }   }
     } else {      } else {
  # Sort by user name   # Sort by user name
  for(my $index=0; $index<$#students+1; $index++) {   for(my $index=0; $index<scalar @sorted1Students; $index++) {
     $sortData{$students[$index]}=$students[$index];      $sortData{$sorted1Students[$index]}=$sorted1Students[$index];
  }   }
     }      }
   
     my @order = ();      my @order = ();
     foreach my $key (sort keys(%sortData)) {      foreach my $key (sort(keys(%sortData))) {
  push (@order,$sortData{$key});   push (@order,$sortData{$key});
     }      }
   
     return @order;      return @order;
 }  }
   
 sub CollectClasslist {  sub TestCacheData {
 # -------------------------------------------------------------- Get class list      my ($ChartDB)=@_;
     my $cid=$ENV{'request.course.id'};      my $isCached=-1;
     my $chome=$ENV{'course.'.$cid.'.home'};      my %testData;
     my ($cdom,$cnum)=split(/\_/,$cid);      my $tieTries=0;
     my %classlist=&Apache::lonnet::dump('classlist',$cdom,$cnum);  
     my @names = ();  
   
     my($checkForError)=keys (%classlist);      if ((-e "$ChartDB") && (!defined($ENV{'form.recalculate'}))) {
     if($checkForError =~ /^(con_lost|error|no_such_host)/i) {   $isCached = 1;
  $r->print('<h1>Could not access course data</h1>');      } else {
  push (@names, 'error');   $isCached = 0;
  return @names;  
     }      }
   
 # ------------------------------------- Calculate Status and number of students      while($tieTries < 10) {
     my $now=time;          my $result=0;
     foreach my $name (sort(keys(%classlist))) {          if($isCached) {
  my $value=$classlist{$name};              $result=tie(%testData,'GDBM_File',$ChartDB,&GDBM_READER,0640);
  my ($end,$start)=split(/\:/,$value);          } else {
  my $active=1;              $result=tie(%testData,'GDBM_File',$ChartDB,&GDBM_NEWDB,0640);
  my $Status=$ENV{'form.status'};          }
  $Status = ($Status) ? $Status : 'Active';          if($result) {
  if((($end) && $now > $end) && (($Status eq 'Active'))) {               last;
     $active=0;           }
  }          $tieTries++;
  if(($Status eq 'Expired') && ($end == 0 || $now < $end)) {          sleep 1;
     $active=0;      }
  }      if($tieTries >= 10) {
  if($active) {          return -1;
     push(@names,$name);  
     $CachData{$name.':Status'}=$Status;  
  }  
     }      }
   
     $CachData{'NamesOfStudents'}=join(":::",@names);      untie(%testData);
   
     return @names;      return $isCached;
 }  }
   
 sub BuildChart {  sub ExtractStudentData {
 # ----------------------- Get first and last resource, see if there is anything      my ($courseData, $name, $ChartDB)=@_;
     my $firstres=$hash{'map_start_/res/'.$ENV{'request.course.uri'}};  
     my $lastres=$hash{'map_finish_/res/'.$ENV{'request.course.uri'}};      my %CacheData;
     if (!($firstres) || !($lastres)) {      if(tie(%CacheData,'GDBM_File',$ChartDB,&GDBM_WRCREAT,0640)) {
  $r->print('<h3>Undefined course sequence</h3>');          my ($checkForError) = keys(%$courseData);
  return;          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);
     }      }
   
 # --------------- Find all assessments and put them into some linear-like order      return;
     &tracetable($firstres,'&'.$lastres.'&');  }
   
 # ----------------------------------------------------------------- Render page  sub ShouldShowColumn {
     &CreateForm();      my ($cache,$test)=@_;
   
     my $cid=$ENV{'request.course.id'};      if($cache->{'form.reset'} eq 'true') {
     my $ChartDB = "/home/httpd/perl/tmp/$ENV{'user.name'}".          return 1;
                   "_$ENV{'user.domain'}_$cid\_chart.db";  
     my $isCached = 0;  
     my @students;  
     if ((-e "$ChartDB") && ($ENV{'form.sort'} ne 'Recalculate Chart')) {  
  if (tie(%CachData,'GDBM_File',"$ChartDB",&GDBM_READER,0640)) {  
     $isCached = 1;  
     @students=&SortStudents();  
  } else {  
     $r->print("Unable to tie hash to db file");  
     $r->rflush();  
     return;  
  }  
     } else {  
  if (tie(%CachData,'GDBM_File',$ChartDB,&GDBM_NEWDB,0640)) {  
     $isCached = 0;  
     @students=&CollectClasslist();  
     if($students[0] eq 'error') {  
  return;  
     }  
  } else {  
     $r->print("Unable to tie hash to db file");  
     return;  
  }  
     }      }
   
     $r->print('<h3>'.($#students+1).' students</h3>');      my $headings=$cache->{'form.headings'};
     $r->rflush();      my $sequences=$cache->{'form.sequences'};
       if($headings eq 'ALLHEADINGS' || $sequences eq 'ALLSEQUENCES' ||
 # ----------------------------------------------------------------- Start table         $headings=~/$test/ || $sequences=~/$test/) {
     $r->print('<table><tbody>');          return 1;
 #    &CreateTableHeadings();  
     my @updateStudentList = ();  
     foreach my $student (@students) {  
  if($c->aborted()) {  
     if($isCached == 0) {  
  $CachData{'NamesOfStudents'}=join(":::",@updateStudentList);  
     }  
     last;  
  }  
  if($isCached == 0) {  
     &DownloadStudentInformation($student,$cid);  
     push (@updateStudentList, $student);  
  }  
  my $Str=&ExtractStudentData($student,$cid);  
  $r->print('<tr>'.$Str.'</tr>');  
     }      }
     $r->print('</tbody></table>');  
   
     untie(%CachData);  #    my $reselected=$cache->{'form.reselect'};
   #    if($reselected=~/$test/) {
   #        return 1;
   #    }
   
       return 0;
   }
   
   sub ProcessFormData {
       my ($ChartDB)=@_;
       my %CacheData;
   
       if(tie(%CacheData,'GDBM_File',$ChartDB,&GDBM_WRCREAT,0640)) {
           if(defined($ENV{'form.sort'})) {
               $CacheData{'form.sort'}=$ENV{'form.sort'};
           } elsif(!defined($CacheData{'form.sort'})) {
               $CacheData{'form.sort'}='username';
           }
   
           # Ignore $ENV{'form.refresh'}
           # Ignore $ENV{'form.recalculate'}
   
           if(defined($ENV{'form.status'})) {
               $CacheData{'form.status'}=$ENV{'form.status'};
           } elsif(!defined($CacheData{'form.status'})) {
               $CacheData{'form.status'}='Active';
           }
   
           my @headings=();
           my @sequences=();
           my $found=0;
           foreach (keys(%ENV)) {
               if(/form\.heading/) {
                   $found++;
                   push(@headings, $_);
               } elsif(/form\.sequence/) {
                   $found++;
                   push(@sequences, $_);
               } elsif(/form\./) {
                   $found++;
               }
           }
   
           if($found) {
               $CacheData{'form.headings'}=join(":::",@headings);
               $CacheData{'form.sequences'}=join(":::",@sequences);
           }
   
           if(defined($ENV{'form.reselect'})) {
               my @reselected = (ref($ENV{'form.reselect'}) ? 
                                 @{$ENV{'form.reselect'}}
                                 : ($ENV{'form.reselect'}));
               foreach (@reselected) {
                   if(/heading/) {
                       $CacheData{'form.headings'}.=":::".$_;
                   } elsif(/sequence/) {
                       $CacheData{'form.sequences'}.=":::".$_;
                   }
               }
           }
   
           if(defined($ENV{'form.reset'})) {
               $CacheData{'form.reset'}='true';
               $CacheData{'form.status'}='Active';
               $CacheData{'form.sort'}='username';
               $CacheData{'form.headings'}='ALLHEADINGS';
               $CacheData{'form.sequences'}='ALLSEQUENCES';
           } else {
               $CacheData{'form.reset'}='false';
           }
   
           untie(%CacheData);
       }
   
     return;      return;
 }  }
   
 sub Start {  # ----- END HELPER FUNCTIONS --------------------------------------------
     $r->print('<head><title>'.  
               'LON-CAPA Assessment Chart</title></head>');  sub BuildChart {
     $r->print('<body bgcolor="#FFFFFF">'.      my ($r)=@_;
               '<script>window.focus();</script>'.      my $c = $r->connection;
               '<img align=right src=/adm/lonIcons/lonlogos.gif>'.  
               '<h1>Assessment Chart</h1>');      # Start the lonchart document
 # ---------------------------------------------------------------- Course title      $r->content_type('text/html');
     $r->print('<h1>'.$ENV{'course.'.$ENV{'request.course.id'}.      $r->send_http_header;
               '.description'}.'</h1><h3>'.localtime().      $r->print(&StartDocument());
               "</h3><p><pre>1..9: correct by student in 1..9 tries\n".  
               "   *: correct by student in more than 9 tries\n".  
       "   +: correct by override\n".  
               "   -: incorrect by override\n".  
       "   .: incorrect attempted\n".  
       "   #: ungraded attempted\n".  
               "    : not attempted\n".  
       "   x: excused</pre><p>");   
 # ------------------------------- This is going to take a while, produce output  
     $r->rflush();      $r->rflush();
   
     &BuildChart();      # Test for access to the CacheData
       my $isCached=0;
       my $cid=$ENV{'request.course.id'};
       my $ChartDB = "/home/httpd/perl/tmp/$ENV{'user.name'}".
                     "_$ENV{'user.domain'}_$cid\_chart.db";
   
       $isCached=&TestCacheData($ChartDB);
       if($isCached < 0) {
           $r->print("Unable to tie hash to db file");
           $r->rflush();
           return;
       }
       &ProcessFormData($ChartDB);
   
       # Download class list information if not using cached data
       my %CacheData;
       my @students=();
       my @studentInformation=('username','domain','section','id','fullname');
       my @headings=('User Name','Domain','Section','PID','Full Name');
       my $spacePadding='   ';
       if(!$isCached) {
           my $processTopResourceMapReturn=&ProcessTopResourceMap($ChartDB,$c);
           if($processTopResourceMapReturn ne 'OK') {
               $r->print($processTopResourceMapReturn);
               return;
           }
           if($c->aborted()) { return; }
           my $classlist=&DownloadPrerequisiteData($cid, $c);
           my ($checkForError)=keys(%$classlist);
           if($checkForError =~ /^(con_lost|error|no_such_host)/i ||
              defined($classlist->{'error'})) {
               return;
           }
           if($c->aborted()) { return; }
           @students=&ProcessClassList($classlist,$cid,$ChartDB,$c);
           if($c->aborted()) { return; }
           &SpaceColumns(\@students,\@studentInformation,\@headings,
                         $ChartDB);
           if($c->aborted()) { return; }
       } else {
           if(!$c->aborted() && tie(%CacheData,'GDBM_File',$ChartDB,
                                    &GDBM_READER,0640)) {
               @students=split(/:::/,$CacheData{'NamesOfStudents'});
           }
       }
   
       # Sort students and print out table desciptive data
       if(tie(%CacheData,'GDBM_File',$ChartDB,&GDBM_READER,0640)) {
           if(!$c->aborted()) { @students=&SortStudents(\@students,\%CacheData); }
           if(!$c->aborted()) { $r->print('<h1>'.(scalar @students).
                                          ' students</h1>'); }
    if(!$c->aborted()) { $r->rflush(); }
    if(!$c->aborted()) { $r->print(&CreateLegend()); }
    if(!$c->aborted()) { $r->print(&CreateForm(\%CacheData)); }
    if(!$c->aborted()) { $r->print(&CreateColumnSelectionBox(
                                                          \%CacheData,
                                                          \@studentInformation, 
          \@headings, 
                                                          $spacePadding)); }
    if(!$c->aborted()) { $r->print(&CreateColumnSelectors(
                                                          \%CacheData,
                                                          \@studentInformation, 
          \@headings, 
                                                          $spacePadding)); }
    if(!$c->aborted()) { $r->print(&CreateTableHeadings(
                                                            \%CacheData,
                                                            \@studentInformation, 
    \@headings, 
    $spacePadding)); }
    if(!$c->aborted()) { $r->rflush(); }
    untie(%CacheData);
       } else {
    $r->print("Init2: Unable to tie hash to db file");
    return;
       }
   
       my @updateStudentList = ();
       my $courseData;
       $r->print('<pre>');
       foreach (@students) {
           if($c->aborted()) {
               last;
           }
   
           if(!$isCached) {
               $courseData=&DownloadStudentCourseInformation($_, $cid);
               if($c->aborted()) { last; }
               push(@updateStudentList, $_);
               &ExtractStudentData($courseData, $_, $ChartDB);
           }
           $r->print(&FormatStudentData($_, $cid, \@studentInformation,
                                        $spacePadding, $ChartDB));
           $r->rflush();
       }
   
       if(!$isCached && tie(%CacheData,'GDBM_File',$ChartDB,&GDBM_WRCREAT,0640)) {
           $CacheData{'NamesOfStudents'}=join(":::", @updateStudentList);
   #    $CacheData{'NamesOfStudents'}=
   #            &Apache::lonnet::arrayref2str(\@updateStudentList);
           untie(%CacheData);
       }
   
     $r->print('</body>');      $r->print('</pre></body></html>');
       $r->rflush();
   
     return;      return;
 }  }
Line 650  sub Start { Line 1170  sub Start {
 # ================================================================ Main Handler  # ================================================================ Main Handler
   
 sub handler {  sub handler {
     undef %hash;      my $r=shift;
     undef %CachData;  #    $jr=$r;
     undef @cols;      unless(&Apache::lonnet::allowed('vgr',$ENV{'request.course.id'})) {
   
     $r=shift;  
     $c = $r->connection;  
     if (&Apache::lonnet::allowed('vgr',$ENV{'request.course.id'})) {  
 # ------------------------------------------- Set document type for header only  
  if ($r->header_only) {  
     if ($ENV{'browser.mathml'}) {  
  $r->content_type('text/xml');  
     } else {  
  $r->content_type('text/html');  
     }  
     &Apache::loncommon::no_cache($r);  
     $r->send_http_header;  
     return OK;  
  }  
   
  my $requrl=$r->uri;  
 # ----------------------------------------------------------------- Tie db file  
  if ($ENV{'request.course.fn'}) {  
     my $fn=$ENV{'request.course.fn'};  
     if (-e "$fn.db") {  
  if (tie(%hash,'GDBM_File',"$fn.db",&GDBM_READER,0640)) {  
 # ------------------------------------------------------------------- Hash tied  
 # ---------------------------------------------------------------- Send headers  
     $r->content_type('text/html');  
     $r->send_http_header;  
     $r->print('<html>');  
     &Start();  
     $r->print('</html>');  
     $r->rflush();  
 # ------------------------------------------------------------- End render page  
  } else {  
     $r->content_type('text/html');  
     $r->send_http_header;  
     $r->print('<html><body>Coursemap undefined.</body></html>');  
  }  
 # ------------------------------------------------------------------ Untie hash  
  unless (untie(%hash)) {  
     &Apache::lonnet::logthis("<font color=blue>WARNING: ".  
      "Could not untie coursemap $fn (browse).</font>");   
  }  
   
 # -------------------------------------------------------------------- All done  
  return OK;  
 # ----------------------------------------------- Errors, hash could no be tied  
     }  
  } else {  
     $ENV{'user.error.msg'}="$requrl:bre:0:0:Course not initialized";  
     return HTTP_NOT_ACCEPTABLE;   
  }  
     } else {  
  $ENV{'user.error.msg'}=   $ENV{'user.error.msg'}=
         $r->uri.":vgr:0:0:Cannot view grades for complete course";          $r->uri.":vgr:0:0:Cannot view grades for complete course";
  return HTTP_NOT_ACCEPTABLE;    return HTTP_NOT_ACCEPTABLE; 
     }      }
   
       # Set document type for header only
       if ($r->header_only) {
           if($ENV{'browser.mathml'}) {
               $r->content_type('text/xml');
           } else {
               $r->content_type('text/html');
           }
           &Apache::loncommon::no_cache($r);
           $r->send_http_header;
           return OK;
       }
       
       unless($ENV{'request.course.fn'}) {
           my $requrl=$r->uri;
           $ENV{'user.error.msg'}="$requrl:bre:0:0:Course not initialized";
           return HTTP_NOT_ACCEPTABLE; 
       }
   
       &BuildChart($r);
   
       return OK;
 }  }
 1;  1;
 __END__  __END__
Removed from v.1.43  
changed lines
  Added in v.1.52

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