version 1.28, 2002/02/04 13:52:09
|
version 1.52, 2002/07/02 21:48:36
|
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 Behrouz Minaei |
# 2/1, 2/6, 2/19, 2/28 Behrouz Minaei |
# |
# |
### |
### |
|
|
|
=pod |
|
|
|
=cut |
|
|
package Apache::lonchart; |
package Apache::lonchart; |
|
|
use strict; |
use strict; |
Line 56 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 @cols; |
|
my @rowlabels; |
|
my @students; |
|
|
|
# ------------------------------------------------------------- Find out status |
sub FormatStudentInformation { |
|
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; |
|
} |
|
|
sub ExtractStudentData { |
return $Str; |
my ($index,$coid)=@_; |
} |
my ($sname,$sdom) = split( /\:/, $students[$index] ); |
|
my $shome=&Apache::lonnet::homeserver( $sname,$sdom ); |
sub FormatStudentData { |
my $reply=&Apache::lonnet::reply('dump:'.$sdom.':'.$sname.':'.$coid,$shome ); |
my ($name,$coid,$studentInformation,$spacePadding,$ChartDB)=@_; |
my %result=(); |
my ($sname,$sdom) = split(/\:/,$name); |
my $ResId; |
my $Str; |
my $Code; |
my %CacheData; |
my $Tries; |
|
my $Wrongs; |
unless(tie(%CacheData,'GDBM_File',$ChartDB,&GDBM_READER,0640)) { |
my %TempHash; |
return ''; |
|
} |
|
# Handle Student information ------------------------------------------ |
|
# Handle user data |
|
$Str=&FormatStudentInformation(\%CacheData, $name, $studentInformation, |
|
$spacePadding); |
|
|
|
# Handle errors |
|
if($CacheData{$name.':error'} =~ /environment/) { |
|
$Str .= '<br>'; |
|
untie(%CacheData); |
|
return $Str; |
|
} |
|
|
|
if($CacheData{$name.':error'} =~ /course/) { |
|
$Str .= '<br>'; |
|
untie(%CacheData); |
|
return $Str; |
|
} |
|
|
|
# Handle problem data ------------------------------------------------ |
my $Version; |
my $Version; |
my $ProbNo; |
my $problemsCorrect = 0; |
my $ProbSolved; |
my $totalProblems = 0; |
my $ProbTotal; |
my $problemsSolved = 0; |
my $LatestVersion; |
my $numberOfParts = 0; |
my $Str=substr($students[$index]. |
foreach my $sequence (split(/\:/,$CacheData{'orderedSequences'})) { |
' ',0,14).' ! '. |
if(!&ShouldShowColumn(\%CacheData, 'sequence'.$sequence)) { |
substr($rowlabels[$index]. |
next; |
' ',0,45).' ! '; |
} |
unless ($reply=~/^error\:/) { |
|
map { |
my $characterCount=0; |
my ($name,$value)=split(/\=/,&Apache::lonnet::unescape($_)); |
foreach my $problemID (split(/\:/,$CacheData{$sequence.':problems'})) { |
$result{$name}=$value; |
my $problem = $CacheData{$problemID.':problem'}; |
} split(/\&/,$reply); |
my $LatestVersion = $CacheData{$name.":version:$problem"}; |
$ProbNo = 0; |
|
$ProbTotal = 0; |
if(!$LatestVersion) { |
$ProbSolved = 0; |
foreach my $part (split(/\:/,$CacheData{$sequence.':'. |
my $IterationNo = 0; |
$problemID. |
foreach $ResId (@cols) { |
':parts'})) { |
if ($IterationNo == 0) {$IterationNo++; next;} |
$Str .= ' '; |
if (!$ResId) { |
$totalProblems++; |
my $PrNo = sprintf( "%3d", $ProbNo ); |
$characterCount++; |
$Str .= ' '.'<font color="#007700">'.$PrNo.'</font> '; |
} |
$ProbSolved += $ProbNo; |
next; |
$ProbNo=0; |
} |
next; |
|
} |
my %partData=undef; |
$ResId=~/(\d+)\.(\d+)/; |
#initialize data, displays skips correctly |
my $meta=$hash{'src_'.$ResId}; |
foreach my $part (split(/\:/,$CacheData{$sequence.':'. |
my $PartNo = 0; |
$problemID. |
undef %TempHash; |
':parts'})) { |
map { |
$partData{$part.':tries'}=0; |
if ($_=~/^stores\_(\d+)\_tries$/) { |
$partData{$part.':code'}=' '; |
my $Part=&Apache::lonnet::metadata($meta,$_.'.part'); |
} |
if ( $TempHash{"$Part"} eq '' ) { |
for(my $Version=1; $Version<=$LatestVersion; $Version++) { |
$TempHash{"$Part"} = $Part; |
foreach my $part (split(/\:/,$CacheData{$sequence.':'. |
$TempHash{$PartNo}=$Part; |
$problemID. |
$TempHash{"$Part.Code"} = ' '; |
':parts'})) { |
$PartNo++; |
|
} |
if(!defined($CacheData{$name.":$Version:$problem". |
|
":resource.$part.solved"})) { |
|
next; |
|
} |
|
|
|
my $tries=0; |
|
my $code=' '; |
|
|
|
$tries = $CacheData{$name.":$Version:$problem". |
|
":resource.$part.tries"}; |
|
$partData{$part.':tries'}=($tries) ? $tries : 0; |
|
|
|
my $val = $CacheData{$name.":$Version:$problem". |
|
":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 = ' ';} |
|
$partData{$part.':code'}=$code; |
|
} |
|
} |
|
|
|
$Str.='<a href="/adm/grades?symb='. |
|
&Apache::lonnet::escape($problem). |
|
'&student='.$sname.'&domain='.$sdom.'&command=submission">'; |
|
foreach(split(/\:/,$CacheData{$sequence.':'.$problemID. |
|
':parts'})) { |
|
if($partData{$_.':code'} eq '*') { |
|
$problemsCorrect++; |
|
if (($partData{$_.':tries'}<10) && |
|
($partData{$_.':tries'} ne '')) { |
|
$partData{$_.':code'}=$partData{$_.':tries'}; |
|
} |
|
} elsif($partData{$_.':code'} 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>'; |
|
|
|
untie(%CacheData); |
|
return $Str; |
|
} |
|
|
|
sub CreateTableHeadings { |
|
my ($CacheData,$studentInformation,$headings,$spacePadding)=@_; |
|
my $Str='<pre>'; |
|
|
|
for(my $index=0; $index<(scalar @$headings); $index++) { |
|
if(!&ShouldShowColumn($CacheData, 'heading'.$index)) { |
|
next; |
|
} |
|
|
|
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 .= 'Total Solved/Total Problems'; |
|
$Str .= '</pre>'; |
|
|
|
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 { |
|
my ($CacheData)=@_; |
|
my $OpSel1=''; |
|
my $OpSel2=''; |
|
my $OpSel3=''; |
|
my $Status = $CacheData->{'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 .= '<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 .= ' '; |
|
$Ptr .= '<input type="submit" name="refresh" '; |
|
$Ptr .= 'value="Refresh Chart"/>'."\n"; |
|
$Ptr .= ' '; |
|
$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 .= ' '; |
|
$Ptr .= '<input type="submit" name="sort" value="Last Name" />'."\n"; |
|
$Ptr .= ' '; |
|
$Ptr .= '<input type="submit" name="sort" value="Section"/>'."\n"; |
|
$Ptr .= '</td></tr><tr><td align="right">'; |
|
$Ptr .= '<b> Student Status: </b>'."\n". |
|
'</td><td align="left">'. |
|
'<select name="status">'. |
|
'<option '.$OpSel1.' >Active</option>'."\n". |
|
'<option '.$OpSel2.' >Expired</option>'."\n". |
|
'<option '.$OpSel3.' >Any</option> </select> '."\n"; |
|
$Ptr .= '</td></tr>'; |
|
|
|
return $Ptr; |
|
} |
|
|
|
sub CreateLegend { |
|
my $Str = "<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>"; |
|
return $Str; |
|
} |
|
|
|
sub StartDocument { |
|
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 $Str; |
|
} |
|
|
|
# ----- 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; |
|
} |
|
|
|
foreach my $name (keys(%classlist)) { |
|
if($c->aborted()) { |
|
$classlist{'error'}='aborted'; |
|
return \%classlist; |
|
} |
|
|
|
my ($studentName,$studentDomain) = split(/\:/,$name); |
|
# Download student environment data, specifically the full name and id. |
|
my %studentInformation=&Apache::lonnet::get('environment', |
|
['lastname','generation', |
|
'firstname','middlename', |
|
'id'], |
|
$studentDomain, |
|
$studentName); |
|
$classlist{$name.':studentInformation'}=\%studentInformation; |
|
|
|
if($c->aborted()) { |
|
$classlist{'error'}='aborted'; |
|
return \%classlist; |
|
} |
|
|
|
#Section |
|
my %section=&Apache::lonnet::dump('roles',$studentDomain,$studentName); |
|
$classlist{$name.':section'}=\%section; |
|
} |
|
|
|
return \%classlist; |
|
} |
|
|
|
sub DownloadStudentCourseInformation { |
|
my ($name,$courseID)=@_; |
|
my ($studentName,$studentDomain) = split(/\:/,$name); |
|
|
|
# Download student course data |
|
my %courseData=&Apache::lonnet::dump($courseID,$studentDomain, |
|
$studentName); |
|
return \%courseData; |
|
} |
|
|
|
# ----- END DOWNLOAD INFORMATION --------------------------------------- |
|
|
|
# ----- 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; |
} |
} |
} split(/\,/,&Apache::lonnet::metadata($meta,'keys')); |
} |
|
} |
|
|
|
# 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; |
|
} |
|
|
my $Prob = &Apache::lonnet::declutter( $hash{'map_id_'.$1} ). |
#Get Parts for problem |
'___'.$2.'___'. |
my $meta=$hash{'src_'.$currentResourceID}; |
&Apache::lonnet::declutter( $hash{'src_'.$ResId} ); |
foreach (split(/\,/,&Apache::lonnet::metadata($meta,'keys'))) { |
$Code=' '; |
if($_=~/^stores\_(\d+)\_tries$/) { |
$Tries = 0; |
my $Part=&Apache::lonnet::metadata($meta,$_.'.part'); |
$LatestVersion = $result{"version:$Prob"}; |
if(!defined($CacheData{$currentSequence.':'. |
|
$currentResourceID.':parts'})) { |
if ( $LatestVersion ) { |
$CacheData{$currentSequence.':'.$currentResourceID. |
for ( my $Version=1; $Version<=$LatestVersion; $Version++ ) { |
':parts'}=$Part; |
my $vkeys = $result{"$Version:keys:$Prob"}; |
} else { |
my @keys = split(/\:/,$vkeys); |
$CacheData{$currentSequence.':'.$currentResourceID. |
|
':parts'}.=':'.$Part; |
foreach my $Key (@keys) { |
|
if (($Key=~/\.(\w+)\.solved$/) && ($Key!~/^\d+\:/)) { |
|
my $Part = $1; |
|
$Tries = $result{"$Version:$Prob:resource.$Part.tries"}; |
|
$TempHash{"$Part.Tries"}=($Tries) ? $Tries : 0; |
|
my $Val = $result{"$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; |
|
} |
|
} |
|
} |
|
for ( my $n = 0; $n < $PartNo; $n++ ) { |
|
my $part = $TempHash{$n}; |
|
my $Code = $TempHash{"$part.Code"}; |
|
if ( $Code eq '*') { |
|
$ProbNo++; |
|
if (($TempHash{"$part.Tries"}<10) || |
|
($TempHash{"$part.Tries"} eq '')) { |
|
$TempHash{"$part.Code"}=$TempHash{"$part.Tries"}; |
|
} |
|
} |
} |
elsif ( $Code eq '+' ) {$ProbNo++;} |
|
$Str .= $TempHash{"$part.Code"}; |
|
if ( $Code ne 'x' ) {$ProbTotal++;} |
|
} |
} |
} |
} |
else { |
} |
for(my $n=0; $n<$PartNo; $n++) { |
|
$Str.=' '; |
#if resource == finish resource |
$ProbTotal++; |
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>"); |
} |
} |
my $PrTot = sprintf( "%5d", $ProbTotal ); |
|
my $PrSvd = sprintf( "%5d", $ProbSolved ); |
unless (untie(%CacheData)) { |
$Str .= ' '.'<font color="#000088">'.$PrSvd.' /'.$PrTot.'</font> '; |
&Apache::lonnet::logthis("<font color=blue>WARNING: ". |
|
"Could not untie Cache Hash (browse)". |
return $Str ; |
".</font>"); |
|
} |
|
|
|
return 'OK'; |
|
} |
|
|
|
sub ProcessSection { |
|
my ($sectionData, $courseid,$ActiveFlag)=@_; |
|
$courseid=~s/\_/\//g; |
|
$courseid=~s/^(\w)/\/$1/; |
|
|
|
my $cursection='-1'; |
|
my $oldsection='-1'; |
|
my $status='Expired'; |
|
my $section=''; |
|
foreach my $key (keys (%$sectionData)) { |
|
my $value = $sectionData->{$key}; |
|
if ($key=~/^$courseid(?:\/)*(\w+)*\_st$/) { |
|
$section=$1; |
|
if($key eq $courseid.'_st') { |
|
$section=''; |
|
} |
|
my ($dummy,$end,$start)=split(/\_/,$value); |
|
my $now=time; |
|
my $notactive=0; |
|
if ($start) { |
|
if($now<$start) { |
|
$notactive=1; |
|
} |
|
} |
|
if($end) { |
|
if ($now>$end) { |
|
$notactive=1; |
|
} |
|
} |
|
if($notactive == 0) { |
|
$status='Active'; |
|
$cursection=$section; |
|
last; |
|
} |
|
if($notactive == 1) { |
|
$oldsection=$section; |
|
} |
|
} |
|
} |
|
if($status eq $ActiveFlag) { |
|
if($cursection eq '-1') { |
|
return $oldsection; |
|
} |
|
return $cursection; |
|
} |
|
if($ActiveFlag eq 'Any') { |
|
if($cursection eq '-1') { |
|
return $oldsection; |
|
} |
|
return $cursection; |
|
} |
|
return '-1'; |
} |
} |
|
|
|
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'}; |
|
} |
|
|
# ------------------------------------------------------------ Build page table |
# Get student's section number |
|
my $sec=&ProcessSection($section, $courseID, $CacheData->{'form.status'}); |
sub tracetable { |
if($sec != -1) { |
my ($rid,$beenhere)=@_; |
$CacheData->{$name.':section'}=$sec; |
unless ($beenhere=~/\&$rid\&/) { |
} else { |
$beenhere.=$rid.'&'; |
$CacheData->{$name.':section'}=''; |
# 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}}}; |
|
if ( $cmap eq 'sequence' || $cmap eq 'page' ) { |
|
$cols[$#cols+1]=0; |
|
} |
|
if ((defined($hash{'map_start_'.$hash{'src_'.$rid}})) && |
|
(defined($hash{'map_finish_'.$hash{'src_'.$rid}}))) { |
|
my $frid=$hash{'map_finish_'.$hash{'src_'.$rid}}; |
|
|
|
&tracetable($hash{'map_start_'.$hash{'src_'.$rid}}, |
|
'&'.$frid.'&'); |
|
|
|
if ($hash{'src_'.$frid}) { |
|
if ($hash{'src_'.$frid}=~ |
|
/\.(problem|exam|quiz|assess|survey|form)$/) { |
|
$cols[$#cols+1]=$frid; |
|
} |
|
} |
|
|
|
} |
|
} else { |
|
if ($hash{'src_'.$rid}) { |
|
if ($hash{'src_'.$rid}=~ |
|
/\.(problem|exam|quiz|assess|survey|form)$/) { |
|
$cols[$#cols+1]=$rid; |
|
} |
|
} |
|
} |
|
if (defined($hash{'to_'.$rid})) { |
|
map { |
|
&tracetable($hash{'goesto_'.$_},$beenhere); |
|
} split(/\,/,$hash{'to_'.$rid}); |
|
} |
|
} |
} |
|
|
|
return 0; |
} |
} |
|
|
# ================================================================ Main Handler |
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); |
|
} |
|
|
sub handler { |
untie(%CacheData); |
|
} |
|
|
undef %hash; |
return @names; |
undef @students; |
} |
undef @cols; |
|
undef @rowlabels; |
|
|
|
my $r=shift; |
|
|
|
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 |
|
|
|
|
|
# ------------------------------------------------------------------ Build page |
|
|
|
# ---------------------------------------------------------------- Send headers |
|
|
|
$r->content_type('text/html'); |
|
$r->send_http_header; |
|
$r->print( |
|
'<html><head><title>LON-CAPA Assessment Chart</title></head>'); |
|
|
|
$r->print('<body bgcolor="#FFFFFF">'. |
|
'<script>window.focus();</script>'. |
|
'<img align=right src=/adm/lonIcons/lonlogos.gif>'. |
|
'<h1>Assessment Chart</h1>'); |
|
|
|
# ---------------------------------------------------------------- Course title |
|
|
|
$r->print('<h1>'. |
|
$ENV{'course.'.$ENV{'request.course.id'}.'.description'}.'</h1><h3>'. |
|
localtime()."</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(); |
|
|
|
# ----------------------- Get first and last resource, see if there is anything |
|
|
|
|
|
my $firstres=$hash{'map_start_/res/'.$ENV{'request.course.uri'}}; |
|
my $lastres=$hash{'map_finish_/res/'.$ENV{'request.course.uri'}}; |
|
if (($firstres) && ($lastres)) { |
|
# ----------------------------------------------------------------- Render page |
|
|
|
my $cid=$ENV{'request.course.id'}; |
|
my $chome=$ENV{'course.'.$cid.'.home'}; |
|
my ($cdom,$cnum)=split(/\_/,$cid); |
|
|
|
# ---------------------------------------------- Read class list and row labels |
|
|
|
my $classlst=&Apache::lonnet::reply |
|
('dump:'.$cdom.':'.$cnum.':classlist',$chome); |
|
my $now=time; |
|
unless ($classlst=~/^error\:/) { |
|
map { |
|
my ($name,$value)=split(/\=/,$_); |
|
my ($end,$start)=split(/\:/,&Apache::lonnet::unescape($value)); |
|
my $active=1; |
|
if (($end) && ($now>$end)) { $active=0; } |
|
if ($active) { |
|
my $thisindex=$#students+1; |
|
$name=&Apache::lonnet::unescape($name); |
|
$students[$thisindex]=$name; |
|
my ($sname,$sdom)=split(/\:/,$name); |
|
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; |
|
|
|
$rowlabels[$thisindex]= |
|
sprintf('%3s ',$ssec).' '.$reply{$sname}.' '; |
|
my $i=0; |
|
map { |
|
$i++; |
|
if ( $_ ne '') { |
|
$rowlabels[$thisindex].=&Apache::lonnet::unescape($_).' '; |
|
} |
|
if ($i == 2) { |
|
chop($rowlabels[$thisindex]); |
|
$rowlabels[$thisindex].=', '; |
|
} |
|
} split(/\&/,$reply); |
|
|
|
} |
# ----- 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; |
|
} |
} |
} |
} sort split(/\&/,$classlst); |
} |
|
untie(%CacheData); |
|
} |
|
|
|
return; |
|
} |
|
|
|
sub ProcessFullName { |
|
my ($lastname, $generation, $firstname, $middlename)=@_; |
|
my $Str = ''; |
|
|
|
if($lastname ne '') { |
|
$Str .= $lastname.' '; |
|
if($generation ne '') { |
|
$Str .= $generation; |
|
} else { |
|
chop($Str); |
|
} |
|
$Str .= ', '; |
|
if($firstname ne '') { |
|
$Str .= $firstname.' '; |
|
} |
|
if($middlename ne '') { |
|
$Str .= $middlename; |
|
} else { |
|
chop($Str); |
|
if($firstname eq '') { |
|
chop($Str); |
|
} |
|
} |
} else { |
} else { |
$r->print('<h1>Could not access course data</h1>'); |
if($firstname ne '') { |
|
$Str .= $firstname.' '; |
|
} |
|
if($middlename ne '') { |
|
$Str .= $middlename.' '; |
|
} |
|
if($generation ne '') { |
|
$Str .= $generation; |
|
} else { |
|
chop($Str); |
|
} |
} |
} |
|
|
my $allstudents=$#students+1; |
return $Str; |
$r->print('<h3>'.$allstudents.' students</h3>'); |
} |
$r->rflush(); |
|
|
|
# --------------- Find all assessments and put them into some linear-like order |
sub SortStudents { |
|
my ($students,$CacheData)=@_; |
|
|
&tracetable($firstres,'&'.$lastres.'&'); |
my @sorted1Students=(); |
|
foreach (@$students) { |
|
my ($end,$start)=split(/\:/,$CacheData->{$_.':date'}); |
|
my $active=1; |
|
my $now=time; |
|
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, $_); |
|
} |
|
} |
|
|
|
my $Pos = $CacheData->{'form.sort'}; |
|
my %sortData; |
|
if($Pos eq 'Last Name') { |
|
for(my $index=0; $index<scalar @sorted1Students; $index++) { |
|
$sortData{$CacheData->{$sorted1Students[$index].':fullname'}}= |
|
$sorted1Students[$index]; |
|
} |
|
} elsif($Pos eq 'Section') { |
|
for(my $index=0; $index<scalar @sorted1Students; $index++) { |
|
$sortData{$CacheData->{$sorted1Students[$index].':section'}. |
|
$sorted1Students[$index]}=$sorted1Students[$index]; |
|
} |
|
} else { |
|
# Sort by user name |
|
for(my $index=0; $index<scalar @sorted1Students; $index++) { |
|
$sortData{$sorted1Students[$index]}=$sorted1Students[$index]; |
|
} |
|
} |
|
|
# ----------------------------------------------------------------- Start table |
my @order = (); |
|
foreach my $key (sort(keys(%sortData))) { |
|
push (@order,$sortData{$key}); |
|
} |
|
|
$r->print('<p><pre>'); |
return @order; |
my $index; |
|
for ($index=0;$index<=$#students;$index++) { |
|
$r->print(&ExtractStudentData($index,$cid).'<br>'); |
|
$r->rflush(); |
|
} |
|
$r->print('</pre>'); |
|
|
|
} else { |
|
$r->print('<h3>Undefined course sequence</h3>'); |
|
} |
|
|
|
$r->print('</body></html>'); |
|
|
|
# ------------------------------------------------------------- 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'}= |
|
$r->uri.":vgr:0:0:Cannot view grades for complete course"; |
|
return HTTP_NOT_ACCEPTABLE; |
|
|
|
|
sub TestCacheData { |
|
my ($ChartDB)=@_; |
|
my $isCached=-1; |
|
my %testData; |
|
my $tieTries=0; |
|
|
|
if ((-e "$ChartDB") && (!defined($ENV{'form.recalculate'}))) { |
|
$isCached = 1; |
|
} else { |
|
$isCached = 0; |
|
} |
|
|
|
while($tieTries < 10) { |
|
my $result=0; |
|
if($isCached) { |
|
$result=tie(%testData,'GDBM_File',$ChartDB,&GDBM_READER,0640); |
|
} else { |
|
$result=tie(%testData,'GDBM_File',$ChartDB,&GDBM_NEWDB,0640); |
|
} |
|
if($result) { |
|
last; |
|
} |
|
$tieTries++; |
|
sleep 1; |
|
} |
|
if($tieTries >= 10) { |
|
return -1; |
|
} |
|
|
|
untie(%testData); |
|
|
|
return $isCached; |
} |
} |
|
|
|
sub ExtractStudentData { |
|
my ($courseData, $name, $ChartDB)=@_; |
|
|
|
my %CacheData; |
|
if(tie(%CacheData,'GDBM_File',$ChartDB,&GDBM_WRCREAT,0640)) { |
|
my ($checkForError) = keys(%$courseData); |
|
if($checkForError =~ /^(con_lost|error|no_such_host)/i) { |
|
$CacheData{$name.':error'}='Could not download course data.'; |
|
} else { |
|
foreach my $key (keys (%$courseData)) { |
|
$CacheData{$name.':'.$key}=$courseData->{$key}; |
|
} |
|
if(defined($CacheData{'NamesOfStudents'})) { |
|
$CacheData{'NamesOfStudents'}.=':::'.$name; |
|
} else { |
|
$CacheData{'NamesOfStudents'}=$name; |
|
} |
|
} |
|
untie(%CacheData); |
|
} |
|
|
|
return; |
} |
} |
1; |
|
__END__ |
|
|
|
|
sub ShouldShowColumn { |
|
my ($cache,$test)=@_; |
|
|
|
if($cache->{'form.reset'} eq 'true') { |
|
return 1; |
|
} |
|
|
|
my $headings=$cache->{'form.headings'}; |
|
my $sequences=$cache->{'form.sequences'}; |
|
if($headings eq 'ALLHEADINGS' || $sequences eq 'ALLSEQUENCES' || |
|
$headings=~/$test/ || $sequences=~/$test/) { |
|
return 1; |
|
} |
|
|
|
# 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; |
|
} |
|
|
|
# ----- END HELPER FUNCTIONS -------------------------------------------- |
|
|
|
sub BuildChart { |
|
my ($r)=@_; |
|
my $c = $r->connection; |
|
|
|
# Start the lonchart document |
|
$r->content_type('text/html'); |
|
$r->send_http_header; |
|
$r->print(&StartDocument()); |
|
$r->rflush(); |
|
|
|
# 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('</pre></body></html>'); |
|
$r->rflush(); |
|
|
|
return; |
|
} |
|
|
|
# ================================================================ Main Handler |
|
|
|
sub handler { |
|
my $r=shift; |
|
# $jr=$r; |
|
unless(&Apache::lonnet::allowed('vgr',$ENV{'request.course.id'})) { |
|
$ENV{'user.error.msg'}= |
|
$r->uri.":vgr:0:0:Cannot view grades for complete course"; |
|
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; |
|
__END__ |