[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.42 and 1.43

version 1.42, 2002/06/04 19:59:34 version 1.43, 2002/06/05 05:05:38
Line 59  use GDBM_File; Line 59  use GDBM_File;
 my %hash;  my %hash;
 my %CachData;  my %CachData;
 my @cols;  my @cols;
 my @rowlabels;  
 my @students;  
 my @PreCol;  
 my $r;  my $r;
   my $c;
     
 # ------------------------------------------------------------- Find out status  # ------------------------------------------------------------- Find out status
   
 sub ExtractStudentData {  sub ExtractStudentData {
     my ($index,$coid)=@_;      my ($name,$coid)=@_;
     my ($sname,$sdom) = split( /\:/, $students[$index] );      my ($sname,$sdom) = split(/\:/,$name);
     my %result=&Apache::lonnet::dump($coid,$sdom,$sname);  
     my $ResId;      my $ResId;
     my $Code;      my $Code;
     my $Tries;      my $Tries;
     my $Wrongs;      my $Wrongs;
     my %TempHash;      my %TempHash;
     my $Version;      my $Version;
     my $ProbNo;      my $problemsCorrect;
     my $ProbSolved;      my $problemsSolved;
     my $ProbTotal;      my $totalProblems;
     my $LatestVersion;                           my $LatestVersion;
     my $Str=substr($students[$index].      my $Str;
             '                                                        ',0,14).' ! '.  
             substr($rowlabels[$index].      # Handle Student information ------------------------------------------
             '                                                        ',0,45).' ! ';      # Handle errors
   #    if($CachData{$name.':error'} =~ /environment/) {
   # my $errorMessage = $CachData{$name.':error'};
   # return '<td>'.$sname.'</td><td>'.$sdom.
   #    '</td><td><font color="#000088">'.$errorMessage.'</font></td>';
   #    }
   
       # Handle user data
       $Str  = '<td><pre>'.$sname.'</pre></td><td><pre>'.$sdom;
       $Str .= '</pre></td><td><pre>'.$CachData{$name.':section'};
       $Str .= '</pre></td><td><pre>'.$CachData{$name.':id'};
       $Str .= '</pre></td><td><pre>'.$CachData{$name.':fullname'};
       $Str .= '</pre></td>';
   
     my($checkForError)=keys (%result);      if($CachData{$name.':error'} =~ /course/) {
     if($checkForError =~ /^(con_lost|error|no_such_host)/i) {  
  my $PrTot = sprintf( "%5d", $ProbTotal );  
  my $PrSvd = sprintf( "%5d", $ProbSolved );  
  $Str .= ' '.'<font color="#000088">'.$PrSvd.'  /'.$PrTot.'</font> ';  
  return $Str;   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>';
     }      }
   
     $ProbNo = 0;      # Handle problem data ------------------------------------------------
     $ProbTotal = 0;      $Str .= '<td><pre>';
     $ProbSolved = 0;      $problemsCorrect = 0;
       $totalProblems = 0;
       $problemsSolved = 0;
     my $IterationNo = 0;      my $IterationNo = 0;
     foreach $ResId (@cols) {      foreach $ResId (@cols) {
  if ($IterationNo == 0) {$IterationNo++; next;}   if ($IterationNo == 0) {
  if (!$ResId) {       # Looks to be skipping start resource
     my $PrNo = sprintf( "%3d", $ProbNo );      $IterationNo++; 
     $Str .= ' '.'<font color="#007700">'.$PrNo.'</font> ';      next;
     $ProbSolved += $ProbNo;   }
     $ProbNo=0;  
    # ResId is 0 for sequences and pages, 
    # please check tracetable for changes
    if (!$ResId) {
       my $outputProblemsCorrect = sprintf( "%3d", $problemsCorrect );
       $Str .= '<font color="#007700">'.$outputProblemsCorrect.
       '</font></pre></td>';
       $Str .= '<td><pre>';
       $problemsSolved += $problemsCorrect;
       $problemsCorrect=0;
     next;       next; 
  }   }
   
    # Set $1 and $2
  $ResId=~/(\d+)\.(\d+)/;   $ResId=~/(\d+)\.(\d+)/;
  my $meta=$hash{'src_'.$ResId};   my $meta=$hash{'src_'.$ResId};
  my $PartNo = 0;   my $numberOfParts = 0;
  undef %TempHash;   undef %TempHash;
  foreach (split(/\,/,&Apache::lonnet::metadata($meta,'keys'))) {   foreach (split(/\,/,&Apache::lonnet::metadata($meta,'keys'))) {
   #----------- Overwrite $1 in next statement ---------------------------------
     if ($_=~/^stores\_(\d+)\_tries$/) {      if ($_=~/^stores\_(\d+)\_tries$/) {
  my $Part=&Apache::lonnet::metadata($meta,$_.'.part');   my $Part=&Apache::lonnet::metadata($meta,$_.'.part');
  if ( $TempHash{"$Part"} eq '' ) {    if ( $TempHash{"$Part"} eq '' ) { 
     $TempHash{"$Part"} = $Part;      $TempHash{"$Part"} = $Part;
     $TempHash{$PartNo}=$Part;      $TempHash{$numberOfParts}=$Part;
     $TempHash{"$Part.Code"} = ' ';        $TempHash{"$Part.Code"} = ' ';  
     $PartNo++;      $numberOfParts++;
  }   }
     }      }
  }   }
   
   #----------- Using $1 and $2 -----------------------------------------------
  my $Prob = &Apache::lonnet::symbclean(   my $Prob = &Apache::lonnet::symbclean(
        &Apache::lonnet::declutter($hash{'map_id_'.$1} ).         &Apache::lonnet::declutter($hash{'map_id_'.$1} ).
                        '___'.$2.'___'.                         '___'.$2.'___'.
                        &Apache::lonnet::declutter( $hash{'src_'.$ResId} ));                         &Apache::lonnet::declutter( $hash{'src_'.$ResId} ));
  $Code=' ';   $Code=' ';
  $Tries = 0;   $Tries = 0;
  $LatestVersion = $result{"version:$Prob"};   $LatestVersion = $CachData{$name.":version:$Prob"};
   
  if ( $LatestVersion ) {   if ( $LatestVersion ) {
     for ( my $Version=1; $Version<=$LatestVersion; $Version++ ) {      for ( my $Version=1; $Version<=$LatestVersion; $Version++ ) {
  my $vkeys = $result{"$Version:keys:$Prob"};   my $vkeys = $CachData{$name.":$Version:keys:$Prob"};
  my @keys = split(/\:/,$vkeys);     my @keys = split(/\:/,$vkeys);  
   
  foreach my $Key (@keys) {     foreach my $Key (@keys) {
   #---------------------- Changing $1 -------------------------------------------
     if (($Key=~/\.(\w+)\.solved$/) && ($Key!~/^\d+\:/)) {      if (($Key=~/\.(\w+)\.solved$/) && ($Key!~/^\d+\:/)) {
   #---------------------- Using $1 -----------------------------------------------
  my $Part = $1;   my $Part = $1;
  $Tries = $result{"$Version:$Prob:resource.$Part.tries"};   $Tries = $CachData{$name.":$Version:$Prob".
      ":resource.$Part.tries"};
  $TempHash{"$Part.Tries"}=($Tries) ? $Tries : 0;   $TempHash{"$Part.Tries"}=($Tries) ? $Tries : 0;
  my $Val = $result{"$Version:$Prob:resource.$Part.solved"};   my $Val = $CachData{$name.":$Version:$Prob".
  if ($Val eq 'correct_by_student'){$Code='*';}       ":resource.$Part.solved"};
  elsif ($Val eq 'correct_by_override'){$Code = '+';}   if    ($Val eq 'correct_by_student')   {$Code = '*';} 
  elsif ($Val eq 'incorrect_attempted'){$Code = '.';}    elsif ($Val eq 'correct_by_override')  {$Code = '+';}
    elsif ($Val eq 'incorrect_attempted')  {$Code = '.';} 
  elsif ($Val eq 'incorrect_by_override'){$Code = '-';}   elsif ($Val eq 'incorrect_by_override'){$Code = '-';}
  elsif ($Val eq 'excused'){$Code = 'x';}   elsif ($Val eq 'excused')              {$Code = 'x';}
  elsif ($Val eq 'ungraded_attempted'){$Code = '#';}   elsif ($Val eq 'ungraded_attempted')   {$Code = '#';}
  else {$Code = ' ';}   else                                   {$Code = ' ';}
   
  $TempHash{"$Part.Code"} = $Code;   $TempHash{"$Part.Code"} = $Code;
     }      }
Line 157  sub ExtractStudentData { Line 185  sub ExtractStudentData {
     $Str.='<a href="/adm/grades?symb='.      $Str.='<a href="/adm/grades?symb='.
                 &Apache::lonnet::escape($Prob).                  &Apache::lonnet::escape($Prob).
                 '&student='.$sname.'&domain='.$sdom.'&command=submission">';                   '&student='.$sname.'&domain='.$sdom.'&command=submission">'; 
     for ( my $n = 0; $n < $PartNo; $n++ ) {        for(my $n = 0; $n < $numberOfParts; $n++) {  
  my $part = $TempHash{$n};   my $part = $TempHash{$n};
  my $Code = $TempHash{"$part.Code"};   my $code2 = $TempHash{"$part.Code"};
  if ( $Code eq '*') {   if($code2 eq '*') {
     $ProbNo++;      $problemsCorrect++;
   # !!!!!!!!!!!------------------------- Should 10 not be maxtries? ------------
     if (($TempHash{"$part.Tries"}<10) ||      if (($TempHash{"$part.Tries"}<10) ||
  ($TempHash{"$part.Tries"} eq '')) {   ($TempHash{"$part.Tries"} eq '')) {
  $TempHash{"$part.Code"}=$TempHash{"$part.Tries"};   $TempHash{"$part.Code"}=$TempHash{"$part.Tries"};
     }      }
    } elsif($code2 eq '+') {
       $problemsCorrect++;
  }   }
  elsif ( $Code eq '+' ) {$ProbNo++;}  
  $Str .= $TempHash{"$part.Code"};   $Str .= $TempHash{"$part.Code"};
  if ( $Code ne 'x' ) {$ProbTotal++;}  
    if($code2 ne 'x') {
       $totalProblems++;
    }
     }      }
     $Str.='</a>';      $Str.='</a>';
  } else {   } else {
     for(my $n=0; $n<$PartNo; $n++) {      for(my $n=0; $n<$numberOfParts; $n++) {
  $Str.=' ';   $Str.=' ';
  $ProbTotal++;   $totalProblems++;
     }      }
  }   }
     }      }
   
     my $PrTot = sprintf( "%5d", $ProbTotal );      $Str .= '<td><pre><font color="#000088">'.$problemsSolved.
     my $PrSvd = sprintf( "%5d", $ProbSolved );      ' / '.$totalProblems.'</font></pre></td>';
     $Str .= ' '.'<font color="#000088">'.$PrSvd.'  /'.$PrTot.'</font> ';  
   
     return $Str ;      return $Str;
   }
   
   sub CreateForm {
       my $OpSel1='';
       my $OpSel2='';
       my $OpSel3='';
       my $Status = $ENV{'form.status'};
       if ( $Status eq 'Any' ) { $OpSel3='selected'; }
       elsif ($Status eq 'Expired' ) { $OpSel2 = 'selected'; }
       else { $OpSel1 = 'selected'; }
   
       my $Ptr = '<form name=stat method=post action="/adm/chart" >'."\n";
       $Ptr .= '<b> Sort by: &nbsp; </b>'."\n";
       $Ptr .= '&nbsp;&nbsp;&nbsp;';
       $Ptr .= '<input type=submit name=sort value="User Name" />'."\n";
       $Ptr .= '&nbsp;&nbsp;&nbsp;';
       $Ptr .= '<input type=submit name=sort value="Last Name" />'."\n";
       $Ptr .= '&nbsp;&nbsp;&nbsp;';
       $Ptr .= '<input type=submit name=sort value="Section"/>'."\n";
       $Ptr .= '<br><br>';
       $Ptr .= '<b> Student Status: &nbsp; </b>'."\n".
               '<select name="status">'. 
               '<option '.$OpSel1.' >Active</option>'."\n".
               '<option '.$OpSel2.' >Expired</option>'."\n".
       '<option '.$OpSel3.' >Any</option> </select> '."\n";
       $Ptr .= '&nbsp;&nbsp;&nbsp;';
       $Ptr .= '<input type=submit name=sort value="Recalculate Chart"/>'."\n";
       $Ptr .= '</form>'."\n";
       $r->print( $Ptr );
 }  }
   
   sub CreateTableHeadings {
       $r->print('<tr>');
       $r->print('<td>User Name</td>');
       $r->print('<td>Domain</td>');
       $r->print('<td>Section</td>');
       $r->print('<td>PID</td>');
       $r->print('<td>Full Name</td>');
   
       my $ResId;
       my $IterationNo = 0;
       foreach $ResId (@cols) {
    if ($IterationNo == 0) {$IterationNo++; next;}
    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>');
       $r->rflush();
   
       return;
   }
   
 # ------------------------------------------------------------ Build page table  # ------------------------------------------------------------ Build page table
   
Line 242  sub usection { Line 328  sub usection {
     if($checkForError =~ /^(con_lost|error|no_such_host)/i) {      if($checkForError =~ /^(con_lost|error|no_such_host)/i) {
  return -1;   return -1;
     }      }
   
     my $cursection='-1';      my $cursection='-1';
     my $oldsection='-1';      my $oldsection='-1';
     my $status='Expired';      my $status='Expired';
Line 253  sub usection { Line 340  sub usection {
     my ($dummy,$end,$start)=split(/\_/,$value);      my ($dummy,$end,$start)=split(/\_/,$value);
     my $now=time;      my $now=time;
     my $notactive=0;      my $notactive=0;
     if ($start) { if ($now<$start) { $notactive=1; } }      if ($start) {
     if ($end) { if ($now>$end) { $notactive=1; } }   if($now<$start) {
     if ($notactive == 0) { $status='Active';$cursection=$section;}      $notactive=1;
     if ($notactive == 1) { $oldsection=$section;}   }
         }      }
     }      if($end) {
     if ($status eq $ActiveFlag) {   if ($now>$end) {
       if ($cursection eq '-1') { return $oldsection; }      $notactive=1;
       return $cursection;   }
     }      }
     if ($ActiveFlag eq 'Any') {       if($notactive == 0) {
       if ($cursection eq '-1') { return $oldsection; }   $status='Active';
       return $cursection;   $cursection=$section;
       }
       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';      return '-1';
 }  }
   
 sub BuildChart {  sub ProcessFullName {
 # ----------------------- Get first and last resource, see if there is anything      my ($name)=@_;
     my $firstres=$hash{'map_start_/res/'.$ENV{'request.course.uri'}};      my $Str = '';
     my $lastres=$hash{'map_finish_/res/'.$ENV{'request.course.uri'}};  
     if (($firstres) && ($lastres)) {      if($CachData{$name.':lastname'} ne '') {
 # ----------------------------------------------------------------- Render page   $Str .= $CachData{$name.':lastname'}.' ';
  my $cid=$ENV{'request.course.id'};   if($CachData{$name.':generation'} ne '') {
         my $chome=$ENV{'course.'.$cid.'.home'};      $Str .= $CachData{$name.':generation'};
         my ($cdom,$cnum)=split(/\_/,$cid);  
 # ---------------------------------------------- Read class list and row labels  
  my %classlist=&Apache::lonnet::dump('classlist',$cdom,$cnum);  
   
  my($checkForError)=keys (%classlist);  
  if($checkForError =~ /^(con_lost|error|no_such_host)/i) {  
     $r->print('<h1>Could not access course data</h1>');  
  } else {   } else {
     my $now=time;      chop($Str);
     foreach my $name (sort(keys(%classlist))) {   }
  my $value=$classlist{$name};   $Str .= ', ';
  my ($end,$start)=split(/\:/,$value);   if($CachData{$name.':firstname'} ne '') {
  my $active=1;      $Str .= $CachData{$name.':firstname'}.' ';
  my $Status=$ENV{'form.status'};   }
  $Status = ($Status) ? $Status : 'Active';   if($CachData{$name.':middlename'} ne '') {
  if ( ( ($end) && $now > $end ) &&       $Str .= $CachData{$name.':middlename'};
      ( ($Status eq 'Active') ) ) { $active=0; }   } else {
  if ( ($Status eq 'Expired') &&       chop($Str);
      ($end == 0 || $now < $end) ) { $active=0; }      if($CachData{$name.'firstname'} eq '') {
  if ($active) {   chop($Str);
     my $thisindex=$#students+1;  
     $students[$thisindex]=$name;  
     my ($sname,$sdom)=split(/\:/,$name);  
     $PreCol[$thisindex]=$sname.':';  
     my $ssec=&usection($sdom,$sname,$cid,$Status);  
     if ($ssec==-1) {  
  $rowlabels[$thisindex]=  
     'Data not available: '.$name;  
     } else {  
  my %reply=&Apache::lonnet::idrget($sdom,$sname);  
  my %name=&Apache::lonnet::get('environment',  
        ['lastname','generation'  
        ,'firstname'  
        ,'middlename'],  
        $sdom,$sname);  
  my $name=$name{'lastname'};  
  if ($name{'generation'}) {$name.=" $name{generation}";}  
  $name.=',';  
  if ($name{'firstname'}) {$name.=" $name{firstname}";}  
  if ($name{'middlename'}) {$name.=" $name{middlename}";}  
  if ($name eq ',') {$name='';}  
  #$ssec=(int($ssec)) ? int($ssec) : $ssec;  
  my $sec=sprintf('%3s',$ssec);  
  $rowlabels[$thisindex]=$sec.' '.$reply{$sname}.' ';  
  $PreCol[$thisindex] .= $name.':'.$sec;  
  $rowlabels[$thisindex].=$name.' ';  
     }  
  }  
     }      }
  }   }
       } else {
    if($CachData{$name.':firstname'} ne '') {
       $Str .= $CachData{$name.':firstname'}.' ';
    }
    if($CachData{$name.':middlename'} ne '') {
       $Str .= $CachData{$name.':middlename'}.' ';
    }
    if($CachData{$name.':generation'} ne '') {
       $Str .= $CachData{$name.':generation'};
    } else {
       chop($Str);
    }
       }
   
  my $allstudents=$#students+1;      return $Str;
  $r->print('<h3>'.$allstudents.' students</h3>');  }
  &CreateForm();  
  $r->rflush();  
   
 # --------------- Find all assessments and put them into some linear-like order  sub DownloadStudentInformation {
  &tracetable($firstres,'&'.$lastres.'&');      my ($name,$courseID)=@_;
 # ----------------------------------------------------------------- Start table      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'};
       }
   
         $r->print('<p><pre>');      # Download student course data
   my $index;      my %courseData=&Apache::lonnet::dump($courseID,$studentDomain,
         for ($index=0;$index<=$#students;$index++) {   $studentName);
     my $Str=&ExtractStudentData($index,$cid);      if($c->aborted()) {
     $r->print($Str.'<br>');   return;
             $r->rflush();      }
     $CachData{$PreCol[$index]}=$Str;      ($checkForError)=keys (%courseData);
         }      if($checkForError =~ /^(con_lost|error|no_such_host)/i) {
         $r->print('</pre>');   $CachData{$name.':error'}='Could not download course data.';
   # return;
     } else {      } else {
  $r->print('<h3>Undefined course sequence</h3>');   foreach $key (keys (%courseData)) {
       $CachData{$name.':'.$key}=$courseData{$key};
    }
       }
   
       # Get student's section number
       my $sec=&usection($studentDomain, $studentName, $courseID, $Status);
       if($sec != -1) {
    $CachData{$name.':section'}=sprintf('%3s',$sec);
       } else {
    $CachData{$name.':section'}='';
     }      }
   
       return;
 }  }
   
 sub CreateForm {  sub SortStudents {
     my $OpSel1='';  # --------------------------------------------------------------- Sort Students
     my $OpSel2='';      my $Pos = $ENV{'form.sort'};
     my $OpSel3='';      my @students = split(/:::/,$CachData{'NamesOfStudents'});
     my $Status = $ENV{'form.status'};      my %sortData;
     if ( $Status eq 'Any' ) { $OpSel3='selected'; }  
     elsif ($Status eq 'Expired' ) { $OpSel2 = 'selected'; }  
     else { $OpSel1 = 'selected'; }  
   
     my $Ptr = '<form name=stat method=post action="/adm/chart" >'."\n";      if($Pos eq 'Last Name') {
     $Ptr .= '<b> Sort by: &nbsp; </b>'."\n";   for(my $index=0; $index<$#students+1; $index++) {
     $Ptr .= '&nbsp;&nbsp;&nbsp;';      $sortData{$CachData{$students[$index].':fullname'}}=
     $Ptr .= '<input type=submit name=sort value="User Name" />'."\n";   $students[$index];
     $Ptr .= '&nbsp;&nbsp;&nbsp;';   }
     $Ptr .= '<input type=submit name=sort value="Last Name" />'."\n";      } elsif($Pos eq 'Section') {
     $Ptr .= '&nbsp;&nbsp;&nbsp;';   for(my $index=0; $index<$#students+1; $index++) {
     $Ptr .= '<input type=submit name=sort value="Section"/>'."\n";      $sortData{$CachData{$students[$index].':section'}.
     $Ptr .= '<br><br>';        $students[$index]}=$students[$index];
     $Ptr .= '<b> Student Status: &nbsp; </b>'."\n".   }
             '<select name="status">'.       } else {
             '<option '.$OpSel1.' >Active</option>'."\n".   # Sort by user name
             '<option '.$OpSel2.' >Expired</option>'."\n".   for(my $index=0; $index<$#students+1; $index++) {
     '<option '.$OpSel3.' >Any</option> </select> '."\n";      $sortData{$students[$index]}=$students[$index];
     $Ptr .= '&nbsp;&nbsp;&nbsp;';   }
     $Ptr .= '<input type=submit name=sort value="Recalculate Chart"/>'."\n";      }
     $Ptr .= '</form>'."\n";  
     $r->print( $Ptr );      my @order = ();
       foreach my $key (sort keys(%sortData)) {
    push (@order,$sortData{$key});
       }
   
       return @order;
 }  }
   
 sub CacheChart {  sub CollectClasslist {
     my %list = ();  # -------------------------------------------------------------- Get class list
     my $count=0;      my $cid=$ENV{'request.course.id'};
       my $chome=$ENV{'course.'.$cid.'.home'};
       my ($cdom,$cnum)=split(/\_/,$cid);
       my %classlist=&Apache::lonnet::dump('classlist',$cdom,$cnum);
       my @names = ();
   
     my $Pos = $ENV{'form.sort'};      my($checkForError)=keys (%classlist);
     if ( $Pos eq 'Last Name' ) {$Pos=1;}      if($checkForError =~ /^(con_lost|error|no_such_host)/i) {
     elsif ( $Pos eq 'Section' ) {$Pos=2;}   $r->print('<h1>Could not access course data</h1>');
     else {$Pos=0;}   push (@names, 'error');
    return @names;
       }
   
   # ------------------------------------- Calculate Status and number of students
       my $now=time;
       foreach my $name (sort(keys(%classlist))) {
    my $value=$classlist{$name};
    my ($end,$start)=split(/\:/,$value);
    my $active=1;
    my $Status=$ENV{'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(@names,$name);
       $CachData{$name.':Status'}=$Status;
    }
       }
   
       $CachData{'NamesOfStudents'}=join(":::",@names);
   
       return @names;
   }
   
     foreach my $key( keys %CachData) {   sub BuildChart {
  my @Temp=split(/\:/,$key);  # ----------------------- Get first and last resource, see if there is anything
  my $Use = $Temp[$Pos];      my $firstres=$hash{'map_start_/res/'.$ENV{'request.course.uri'}};
  $list{$Use.$key}=$key;      my $lastres=$hash{'map_finish_/res/'.$ENV{'request.course.uri'}};
  $count++;      if (!($firstres) || !($lastres)) {
    $r->print('<h3>Undefined course sequence</h3>');
    return;
     }      }
   
     my @order = sort(keys(%list));  # --------------- Find all assessments and put them into some linear-like order
       &tracetable($firstres,'&'.$lastres.'&');
   
     $r->print('<h3>'.$count.' students</h3>');  # ----------------------------------------------------------------- Render page
     &CreateForm();      &CreateForm();
   
       my $cid=$ENV{'request.course.id'};
       my $ChartDB = "/home/httpd/perl/tmp/$ENV{'user.name'}".
                     "_$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>');
     $r->rflush();      $r->rflush();
       
     $r->print('<p><pre>');  # ----------------------------------------------------------------- Start table
     for ( my $n; $n < $count; $n++) {      $r->print('<table><tbody>');
  $r->print($CachData{$list{$order[$n]}}.'<br>');  #    &CreateTableHeadings();
     }      my @updateStudentList = ();
     $r->print('</pre>');      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);
   
       return;
 }  }
   
 sub Start {  sub Start {
     undef %hash;      $r->print('<head><title>'.
     undef %CachData;  
     undef @students;  
     undef @cols;  
     undef @rowlabels;  
     undef @PreCol;  
   
     $r->print('<html><head><title>'.  
               'LON-CAPA Assessment Chart</title></head>');                'LON-CAPA Assessment Chart</title></head>');
     $r->print('<body bgcolor="#FFFFFF">'.      $r->print('<body bgcolor="#FFFFFF">'.
               '<script>window.focus();</script>'.                '<script>window.focus();</script>'.
Line 438  sub Start { Line 640  sub Start {
 # ------------------------------- This is going to take a while, produce output  # ------------------------------- This is going to take a while, produce output
     $r->rflush();      $r->rflush();
   
     my $cid=$ENV{'request.course.id'};      &BuildChart();
     my $ChartDB = "/home/httpd/perl/tmp/$ENV{'user.name'}".  
                   "_$ENV{'user.domain'}_$cid\_chart.db";  
   
     if ((-e "$ChartDB") && ($ENV{'form.sort'} ne 'Recalculate Chart')) {      $r->print('</body>');
  if (tie(%CachData,'GDBM_File',"$ChartDB",&GDBM_READER,0640)) {  
     &CacheChart();      return;
  }  
  else {  
     $r->print("Unable to tie hash to db file");  
  }  
     }  
     else {  
  if (tie(%CachData,'GDBM_File',$ChartDB,&GDBM_WRCREAT,0640)) {  
     foreach (keys %CachData) {delete $CachData{$_};}  
     &BuildChart();  
  }  
  else {  
     $r->print("Unable to tie hash to db file");  
  }  
     }  
     untie(%CachData);  
 }  }
   
 # ================================================================ Main Handler  # ================================================================ Main Handler
   
 sub handler {  sub handler {
       undef %hash;
       undef %CachData;
       undef @cols;
   
     $r=shift;      $r=shift;
       $c = $r->connection;
     if (&Apache::lonnet::allowed('vgr',$ENV{'request.course.id'})) {      if (&Apache::lonnet::allowed('vgr',$ENV{'request.course.id'})) {
 # ------------------------------------------- Set document type for header only  # ------------------------------------------- Set document type for header only
  if ($r->header_only) {   if ($r->header_only) {
Line 489  sub handler { Line 679  sub handler {
 # ---------------------------------------------------------------- Send headers  # ---------------------------------------------------------------- Send headers
     $r->content_type('text/html');      $r->content_type('text/html');
     $r->send_http_header;      $r->send_http_header;
       $r->print('<html>');
     &Start();      &Start();
     $r->print('</body></html>');                       $r->print('</html>');
       $r->rflush();
 # ------------------------------------------------------------- End render page  # ------------------------------------------------------------- End render page
  } else {   } else {
     $r->content_type('text/html');      $r->content_type('text/html');
Removed from v.1.42  
changed lines
  Added in v.1.43

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