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

version 1.32, 2002/02/28 01:49:33 version 1.43, 2002/06/05 05:05:38
Line 25 Line 25
 #  #
 # http://www.lon-capa.org/  # http://www.lon-capa.org/
 #  #
 #  
 # Homework Performance Chart  # Homework Performance Chart
 #  #
 # (Navigate Maps Handler  # (Navigate Maps Handler
Line 43 Line 42
 # 9/8 Gerd Kortemeyer  # 9/8 Gerd Kortemeyer
 # 10/1, 10/19, 11/17, 11/22, 11/24, 11/28 12/18 Behrouz Minaei  # 10/1, 10/19, 11/17, 11/22, 11/24, 11/28 12/18 Behrouz Minaei
 # YEAR=2002  # YEAR=2002
 # 2/1, 2/6, 2/19 Behrouz Minaei  # 2/1, 2/6, 2/19, 2/28 Behrouz Minaei
 #  #
 ###  ###
   
Line 60  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 $shome=&Apache::lonnet::homeserver( $sname,$sdom );            
     my $reply=&Apache::lonnet::reply('dump:'.$sdom.':'.$sname.':'.$coid,$shome );  
     my %result=();  
     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
     unless ($reply=~/^error\:/) {  #    if($CachData{$name.':error'} =~ /environment/) {
         foreach (split(/\&/,$reply)) {  # my $errorMessage = $CachData{$name.':error'};
             my ($name,$value)=split(/\=/,&Apache::lonnet::unescape($_));  # return '<td>'.$sname.'</td><td>'.$sdom.
             $result{$name}=$value;  #    '</td><td><font color="#000088">'.$errorMessage.'</font></td>';
         }  #    }
  $ProbNo = 0;  
  $ProbTotal = 0;      # Handle user data
         $ProbSolved = 0;      $Str  = '<td><pre>'.$sname.'</pre></td><td><pre>'.$sdom;
  my $IterationNo = 0;      $Str .= '</pre></td><td><pre>'.$CachData{$name.':section'};
         foreach $ResId (@cols) {      $Str .= '</pre></td><td><pre>'.$CachData{$name.':id'};
     if ($IterationNo == 0) {$IterationNo++; next;}      $Str .= '</pre></td><td><pre>'.$CachData{$name.':fullname'};
     if (!$ResId) {       $Str .= '</pre></td>';
  my $PrNo = sprintf( "%3d", $ProbNo );  
  $Str .= ' '.'<font color="#007700">'.$PrNo.'</font> ';      if($CachData{$name.':error'} =~ /course/) {
  $ProbSolved += $ProbNo;   return $Str;
  $ProbNo=0;  # my $errorMessage = 'May have no course data or '.
  next;   #                   $CachData{$name.':error'};
     }  # return '<td>'.$sname.'</td><td>'.$sdom.
             $ResId=~/(\d+)\.(\d+)/;  #    '</td><td><font color="#000088">'.$errorMessage.'</font></td>';
     my $meta=$hash{'src_'.$ResId};      }
     my $PartNo = 0;  
     undef %TempHash;      # Handle problem data ------------------------------------------------
     foreach (split(/\,/,&Apache::lonnet::metadata($meta,'keys'))) {      $Str .= '<td><pre>';
  if ($_=~/^stores\_(\d+)\_tries$/) {      $problemsCorrect = 0;
                     my $Part=&Apache::lonnet::metadata($meta,$_.'.part');      $totalProblems = 0;
     if ( $TempHash{"$Part"} eq '' ) {       $problemsSolved = 0;
  $TempHash{"$Part"} = $Part;      my $IterationNo = 0;
  $TempHash{$PartNo}=$Part;      foreach $ResId (@cols) {
  $TempHash{"$Part.Code"} = ' ';     if ($IterationNo == 0) {
  $PartNo++;      # Looks to be skipping start resource
     }      $IterationNo++; 
       next;
    }
   
    # 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; 
    }
   
    # Set $1 and $2
    $ResId=~/(\d+)\.(\d+)/;
    my $meta=$hash{'src_'.$ResId};
    my $numberOfParts = 0;
    undef %TempHash;
    foreach (split(/\,/,&Apache::lonnet::metadata($meta,'keys'))) {
   #----------- Overwrite $1 in next statement ---------------------------------
       if ($_=~/^stores\_(\d+)\_tries$/) {
    my $Part=&Apache::lonnet::metadata($meta,$_.'.part');
    if ( $TempHash{"$Part"} eq '' ) { 
       $TempHash{"$Part"} = $Part;
       $TempHash{$numberOfParts}=$Part;
       $TempHash{"$Part.Code"} = ' ';  
       $numberOfParts++;
  }   }
             }      }
    }
   
             my $Prob = &Apache::lonnet::declutter( $hash{'map_id_'.$1} ).  #----------- Using $1 and $2 -----------------------------------------------
    my $Prob = &Apache::lonnet::symbclean(
          &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) {
  if (($Key=~/\.(\w+)\.solved$/) && ($Key!~/^\d+\:/)) {  #---------------------- Changing $1 -------------------------------------------
     my $Part = $1;      if (($Key=~/\.(\w+)\.solved$/) && ($Key!~/^\d+\:/)) {
     $Tries = $result{"$Version:$Prob:resource.$Part.tries"};  #---------------------- Using $1 -----------------------------------------------
     $TempHash{"$Part.Tries"}=($Tries) ? $Tries : 0;   my $Part = $1;
     my $Val = $result{"$Version:$Prob:resource.$Part.solved"};   $Tries = $CachData{$name.":$Version:$Prob".
     if ($Val eq 'correct_by_student'){$Code='*';}      ":resource.$Part.tries"};
     elsif ($Val eq 'correct_by_override'){$Code = '+';}                           $TempHash{"$Part.Tries"}=($Tries) ? $Tries : 0;
     elsif ($Val eq 'incorrect_attempted'){$Code = '.';}    my $Val = $CachData{$name.":$Version:$Prob".
     elsif ($Val eq 'incorrect_by_override'){$Code = '-';}      ":resource.$Part.solved"};
     elsif ($Val eq 'excused'){$Code = 'x';}   if    ($Val eq 'correct_by_student')   {$Code = '*';} 
     elsif ($Val eq 'ungraded_attempted'){$Code = '#';}   elsif ($Val eq 'correct_by_override')  {$Code = '+';}
     else {$Code = ' ';}   elsif ($Val eq 'incorrect_attempted')  {$Code = '.';} 
     $TempHash{"$Part.Code"} = $Code;   elsif ($Val eq 'incorrect_by_override'){$Code = '-';}
  }   elsif ($Val eq 'excused')              {$Code = 'x';}
          }   elsif ($Val eq 'ungraded_attempted')   {$Code = '#';}
                 }    else                                   {$Code = ' ';}
  for ( my $n = 0; $n < $PartNo; $n++ ) {    
     my $part = $TempHash{$n};   $TempHash{"$Part.Code"} = $Code;
     my $Code = $TempHash{"$part.Code"};      }
                     if ( $Code eq '*') {   }
  $ProbNo++;      }
                         if (($TempHash{"$part.Tries"}<10) ||  # Actually append problem to output (all parts)
                             ($TempHash{"$part.Tries"} eq '')) {      $Str.='<a href="/adm/grades?symb='.
     $TempHash{"$part.Code"}=$TempHash{"$part.Tries"};                  &Apache::lonnet::escape($Prob).
  }                  '&student='.$sname.'&domain='.$sdom.'&command=submission">'; 
                     }      for(my $n = 0; $n < $numberOfParts; $n++) {  
     elsif ( $Code eq '+' ) {$ProbNo++;}   my $part = $TempHash{$n};
     $Str .= $TempHash{"$part.Code"};   my $code2 = $TempHash{"$part.Code"};
     if ( $Code ne 'x' ) {$ProbTotal++;}   if($code2 eq '*') {
       $problemsCorrect++;
   # !!!!!!!!!!!------------------------- Should 10 not be maxtries? ------------
       if (($TempHash{"$part.Tries"}<10) ||
    ($TempHash{"$part.Tries"} eq '')) {
    $TempHash{"$part.Code"}=$TempHash{"$part.Tries"};
       }
    } elsif($code2 eq '+') {
       $problemsCorrect++;
  }   }
             }     
     else {   $Str .= $TempHash{"$part.Code"};
  for(my $n=0; $n<$PartNo; $n++) {  
     $Str.=' ';   if($code2 ne 'x') {
     $ProbTotal++;      $totalProblems++;
  }   }
     }      }
         }       $Str.='</a>';
    } else {
       for(my $n=0; $n<$numberOfParts; $n++) {
    $Str.=' ';
    $totalProblems++;
       }
    }
     }      }
     my $PrTot = sprintf( "%5d", $ProbTotal );  
     my $PrSvd = sprintf( "%5d", $ProbSolved );  
     $Str .= ' '.'<font color="#000088">'.$PrSvd.'  /'.$PrTot.'</font> ';  
   
     return $Str ;      $Str .= '<td><pre><font color="#000088">'.$problemsSolved.
       ' / '.$totalProblems.'</font></pre></td>';
   
       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 224  sub tracetable { Line 317  sub tracetable {
     }      }
 }  }
   
   sub usection {
       my ($udom,$unam,$courseid,$ActiveFlag)=@_;
       $courseid=~s/\_/\//g;
       $courseid=~s/^(\w)/\/$1/;
   
       my %result=&Apache::lonnet::dump('roles',$udom,$unam);
   
       my($checkForError)=keys (%result);
       if($checkForError =~ /^(con_lost|error|no_such_host)/i) {
    return -1;
       }
   
 sub BuildChart {      my $cursection='-1';
 # ----------------------- Get first and last resource, see if there is anything      my $oldsection='-1';
     my $firstres=$hash{'map_start_/res/'.$ENV{'request.course.uri'}};      my $status='Expired';
     my $lastres=$hash{'map_finish_/res/'.$ENV{'request.course.uri'}};      foreach my $key (keys (%result)) {
     if (($firstres) && ($lastres)) {   my $value = $result{$key};
 # ----------------------------------------------------------------- Render page          if ($key=~/^$courseid(?:\/)*(\w+)*\_st$/) {
  my $cid=$ENV{'request.course.id'};              my $section=$1;
         my $chome=$ENV{'course.'.$cid.'.home'};              if ($key eq $courseid.'_st') { $section=''; }
         my ($cdom,$cnum)=split(/\_/,$cid);      my ($dummy,$end,$start)=split(/\_/,$value);
 # ---------------------------------------------- Read class list and row labels      my $now=time;
  my $classlst=&Apache::lonnet::reply      my $notactive=0;
                             ('dump:'.$cdom.':'.$cnum.':classlist',$chome);      if ($start) {
  my $now=time;   if($now<$start) {
  unless ($classlst=~/^error\:/) {      $notactive=1;
     foreach my $KeyPoint(sort split(/\&/,$classlst)) {   }
  my ($name,$value)=split(/\=/,$KeyPoint);      }
  my ($end,$start)=split(/\:/,&Apache::lonnet::unescape($value));      if($end) {
  my $active=1;   if ($now>$end) {
  if (($end) && ($now>$end)) { $active=0; }      $notactive=1;
  if ($active) {  
     my $thisindex=$#students+1;  
     $name=&Apache::lonnet::unescape($name);  
     $students[$thisindex]=$name;  
     my ($sname,$sdom)=split(/\:/,$name);  
     $PreCol[$thisindex]=$sname.':';  
     my $ssec=&Apache::lonnet::usection($sdom,$sname,$cid);  
     if ($ssec==-1) {  
  $rowlabels[$thisindex]=  
     'Data not available: '.$name;  
     } else {  
  my %reply=&Apache::lonnet::idrget($sdom,$sname);  
  my $reply=&Apache::lonnet::reply('get:'.$sdom.':'.$sname.  
                                      ':environment:lastname&generation&firstname&middlename',  
                                                  &Apache::lonnet::homeserver($sname,$sdom));  
  #$ssec=(int($ssec)) ? int($ssec) : $ssec;  
  my $sec=sprintf('%3s',$ssec);  
  $rowlabels[$thisindex]=$sec.' '.$reply{$sname}.' ';  
  $PreCol[$thisindex] .= $reply.':'.$sec;  
  my $i=0;  
  foreach (split(/\&/,$reply)) {  
     $i++;  
     if ( $_ ne '') {  
  $rowlabels[$thisindex].=&Apache::lonnet::unescape($_).' ';  
     }  
     if ($i == 2) {  
  chop($rowlabels[$thisindex]);  
  $rowlabels[$thisindex].=', ';  
     }  
  }  
     }  
  }   }
     }      }
       if($notactive == 0) {
    $status='Active';
    $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';
   }
   
   sub ProcessFullName {
       my ($name)=@_;
       my $Str = '';
   
       if($CachData{$name.':lastname'} ne '') {
    $Str .= $CachData{$name.':lastname'}.' ';
    if($CachData{$name.':generation'} ne '') {
       $Str .= $CachData{$name.':generation'};
  } else {   } else {
     $r->print('<h1>Could not access course data</h1>');      chop($Str);
  }   }
    $Str .= ', ';
    if($CachData{$name.':firstname'} ne '') {
       $Str .= $CachData{$name.':firstname'}.' ';
    }
    if($CachData{$name.':middlename'} ne '') {
       $Str .= $CachData{$name.':middlename'};
    } else {
       chop($Str);
       if($CachData{$name.'firstname'} eq '') {
    chop($Str);
       }
    }
       } 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 $Ptr = '<form name=stat method=post action="/adm/chart" >'."\n";  # --------------------------------------------------------------- Sort Students
     $Ptr .= '<b> Sort by: &nbsp; </b>'."\n";      my $Pos = $ENV{'form.sort'};
     $Ptr .= '&nbsp;&nbsp;&nbsp;';      my @students = split(/:::/,$CachData{'NamesOfStudents'});
     $Ptr .= '<input type=submit name=sort value="Email Name" />'."\n";      my %sortData;
     $Ptr .= '&nbsp;&nbsp;&nbsp;';  
     $Ptr .= '<input type=submit name=sort value="Last Name" />'."\n";      if($Pos eq 'Last Name') {
     $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].':fullname'}}=
     $Ptr .= '<br>';   $students[$index];
     $Ptr .= '<input type=submit name=sort value="Recalculate Chart"/>'."\n";   }
     $Ptr .= '</form>'."\n";      } elsif($Pos eq 'Section') {
     $r->print( $Ptr );   for(my $index=0; $index<$#students+1; $index++) {
       $sortData{$CachData{$students[$index].':section'}.
         $students[$index]}=$students[$index];
    }
       } else {
    # Sort by user name
    for(my $index=0; $index<$#students+1; $index++) {
       $sortData{$students[$index]}=$students[$index];
    }
       }
   
       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($checkForError)=keys (%classlist);
       if($checkForError =~ /^(con_lost|error|no_such_host)/i) {
    $r->print('<h1>Could not access course data</h1>');
    push (@names, 'error');
    return @names;
       }
   
     my $Pos = $ENV{'form.sort'};  # ------------------------------------- Calculate Status and number of students
     if ( $Pos eq 'Last Name' ) {$Pos=1;}      my $now=time;
     elsif ( $Pos eq 'Section' ) {$Pos=2;}      foreach my $name (sort(keys(%classlist))) {
     else {$Pos=0;}   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 377  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 428  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');
Line 458  sub handler { Line 711  sub handler {
 }  }
 1;  1;
 __END__  __END__
   
   
   
   
   
   
   
Removed from v.1.32  
changed lines
  Added in v.1.43

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