File:
[LON-CAPA] /
loncom /
interface /
Attic /
lonchart.pm
Revision
1.47:
download - view:
text,
annotated -
select for diffs
Mon Jul 1 13:59:13 2002 UTC (21 years, 10 months ago) by
stredwic
Branches:
MAIN
CVS tags:
HEAD
Fixed the problem where the columns didn't line up for sometimes if they
were longer than the headings. This problem occurred because I forgot
to split on the parts of a problem therefore the calculation for column
width was not including multiple parts.
# The LearningOnline Network with CAPA
# (Publication Handler
#
# $Id: lonchart.pm,v 1.47 2002/07/01 13:59:13 stredwic Exp $
#
# Copyright Michigan State University Board of Trustees
#
# This file is part of the LearningOnline Network with CAPA (LON-CAPA).
#
# LON-CAPA is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# LON-CAPA is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with LON-CAPA; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
#
# /home/httpd/html/adm/gpl.txt
#
# http://www.lon-capa.org/
#
# Homework Performance Chart
#
# (Navigate Maps Handler
#
# (Page Handler
#
# (TeX Content Handler
# YEAR=2000
# 05/29/00,05/30 Gerd Kortemeyer)
# 08/30,08/31,09/06,09/14,09/15,09/16,09/19,09/20,09/21,09/23,
# 10/02,10/10,10/14,10/16,10/18,10/19,10/31,11/6,11/14,11/16 Gerd Kortemeyer)
# YEAR=2001
# 3/1/1,6/1,17/1,29/1,30/1,31/1 Gerd Kortemeyer)
# 7/10/01 Behrouz Minaei
# 9/8 Gerd Kortemeyer
# 10/1, 10/19, 11/17, 11/22, 11/24, 11/28 12/18 Behrouz Minaei
# YEAR=2002
# 2/1, 2/6, 2/19, 2/28 Behrouz Minaei
#
###
package Apache::lonchart;
use strict;
use Apache::Constants qw(:common :http);
use Apache::lonnet();
use Apache::loncommon();
use HTML::TokeParser;
use GDBM_File;
my $jr;
# ----- FORMAT PRINT DATA ----------------------------------------------
sub FormatStudentInformation {
my ($cache,$name,$studentInformation,$spacePadding)=@_;
my $Str='<pre>';
foreach (@$studentInformation) {
my $data=$cache->{$name.':'.$_};
$Str .= $data;
my @dataLength=split(//,$data);
my $length=scalar @dataLength;
$Str .= (' 'x($cache->{$_.'Length'}-$length));
$Str .= $spacePadding;
}
return $Str;
}
sub FormatStudentData {
my ($name,$coid,$studentInformation,$spacePadding,$ChartDB)=@_;
my ($sname,$sdom) = split(/\:/,$name);
my $Str;
my %CacheData;
unless(tie(%CacheData,'GDBM_File',$ChartDB,&GDBM_READER,0640)) {
return '';
}
# Handle Student information ------------------------------------------
# Handle user data
$Str=&FormatStudentInformation(\%CacheData, $name, $studentInformation,
$spacePadding);
# Handle errors
if($CacheData{$name.':error'} =~ /environment/) {
untie(%CacheData);
$Str .= '</pre>';
return $Str;
# my $errorMessage = $CacheData{$name.':error'};
# return '<td>'.$sname.'</td><td>'.$sdom.
# '</td><td><font color="#000088">'.$errorMessage.'</font></td>';
}
if($CacheData{$name.':error'} =~ /course/) {
untie(%CacheData);
$Str .= '</pre>';
return $Str;
# my $errorMessage = 'May have no course data or '.
# $CacheData{$name.':error'};
# return '<td>'.$sname.'</td><td>'.$sdom.
# '</td><td><font color="#000088">'.$errorMessage.'</font></td>';
}
# Handle problem data ------------------------------------------------
my $Version;
my $problemsCorrect = 0;
my $totalProblems = 0;
my $problemsSolved = 0;
my $numberOfParts = 0;
foreach my $sequence (split(/\:/,$CacheData{'orderedSequences'})) {
my $characterCount=0;
foreach my $problemID (split(/\:/,$CacheData{$sequence.':problems'})) {
my $problem = $CacheData{$problemID.':problem'};
my $LatestVersion = $CacheData{$name.":version:$problem"};
if(!$LatestVersion) {
foreach my $part (split(/\:/,$CacheData{$sequence.':'.
$problemID.
':parts'})) {
$Str .= ' ';
$totalProblems++;
$characterCount++;
}
next;
}
my %partData=undef;
#initialize data, displays skips correctly
foreach my $part (split(/\:/,$CacheData{$sequence.':'.
$problemID.
':parts'})) {
$partData{$part.':tries'}=0;
$partData{$part.':code'}=' ';
}
for(my $Version=1; $Version<=$LatestVersion; $Version++) {
foreach my $part (split(/\:/,$CacheData{$sequence.':'.
$problemID.
':parts'})) {
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;
}
$Str .= '<font color="#000088">'.$problemsSolved.
' / '.$totalProblems.'</font></pre>';
untie(%CacheData);
return $Str;
}
sub CreateTableHeadings {
my ($CacheData,$studentInformation,$headings,$spacePadding)=@_;
my $Str='<pre>';
for(my $index=0; $index<(scalar @$headings); $index++) {
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'})) {
$Str .= $CacheData->{$sequence.':title'};
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 CreateColumnSelectors {
my ($CacheData,$studentInformation,$headings,$spacePadding)=@_;
my $Str='';
$Str .= '<form name="stat" method="post" action="/adm/chart" >'."\n";
$Str .= '<input type="submit" name="sort" value="Refresh Chart"/>';
$Str .= '</form>'."\n";
return $Str;
for(my $index=0; $index<(scalar @$headings); $index++) {
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'})) {
$Str .= $CacheData->{$sequence.':title'};
my @titleLength=split(//,$CacheData->{$sequence.':title'});
my $leftover=$CacheData->{$sequence.':columnWidth'}-
(scalar @titleLength);
$Str .= (' 'x$leftover);
$Str .= $spacePadding;
}
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: </b>'."\n";
$Ptr .= ' ';
$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 .= '<br><br>';
$Ptr .= '<b> Student Status: </b>'."\n".
'<select name="status">'.
'<option '.$OpSel1.' >Active</option>'."\n".
'<option '.$OpSel2.' >Expired</option>'."\n".
'<option '.$OpSel3.' >Any</option> </select> '."\n";
$Ptr .= '<br><br>';
$Ptr .= '<input type="submit" name="sort" value="Recalculate Chart"/>';
$Ptr .= "\n";
$Ptr .= ' ';
$Ptr .= '<input type="submit" name="sort" value="Refresh Chart"/>';
$Ptr .= "\n";
$Ptr .= '</form>'."\n";
return $Ptr;
}
sub CreateLegend {
my $Str = '<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>";
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>';
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}};
$lastResourceID=$hash{'map_finish_'.
$hash{'src_'.$currentResourceID}};
$currentResourceID=$hash{'map_start_'.
$hash{'src_'.$currentResourceID}};
if(!($currentResourceID) || !($lastResourceID)) {
$currentSequence=pop(@sequences);
$currentResourceID=pop(@currentResource);
$lastResourceID=pop(@finishResource);
if($currentSequence eq $topLevelSequenceNumber) {
last;
}
}
}
# Handle gradable resources: exams, problems, etc
$currentResourceID=~/(\d+)\.(\d+)/;
my $partA=$1;
my $partB=$2;
if($hash{'src_'.$currentResourceID}=~
/\.(problem|exam|quiz|assess|survey|form)$/ &&
$partA eq $currentSequence) {
my $Problem = &Apache::lonnet::symbclean(
&Apache::lonnet::declutter($hash{'map_id_'.$partA}).
'___'.$partB.'___'.
&Apache::lonnet::declutter($hash{'src_'.
$currentResourceID}));
$CacheData{$currentResourceID.':problem'}=$Problem;
if(!defined($CacheData{$currentSequence.':problems'})) {
$CacheData{$currentSequence.':problems'}=$currentResourceID;
} else {
$CacheData{$currentSequence.':problems'}.=
':'.$currentResourceID;
}
#Get Parts for problem
my $meta=$hash{'src_'.$currentResourceID};
foreach (split(/\,/,&Apache::lonnet::metadata($meta,'keys'))) {
if($_=~/^stores\_(\d+)\_tries$/) {
my $Part=&Apache::lonnet::metadata($meta,$_.'.part');
if(!defined($CacheData{$currentSequence.':'.
$currentResourceID.':parts'})) {
$CacheData{$currentSequence.':'.$currentResourceID.
':parts'}=$Part;
} else {
$CacheData{$currentSequence.':'.$currentResourceID.
':parts'}.=':'.$Part;
}
}
}
}
#if resource == finish resource
if($currentResourceID eq $lastResourceID) {
#pop off last resource of sequence
$currentResourceID=pop(@currentResource);
$lastResourceID=pop(@finishResource);
if(defined($CacheData{$currentSequence.':problems'})) {
# Capture sequence information here
if(!defined($CacheData{'orderedSequences'})) {
$CacheData{'orderedSequences'}=$currentSequence;
} else {
$CacheData{'orderedSequences'}.=':'.$currentSequence;
}
$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);
}
}
$currentSequence=pop(@sequences);
if($currentSequence eq $topLevelSequenceNumber) {
last;
}
#else
}
# MOVE!!!
#move to next resource
unless(defined($hash{'to_'.$currentResourceID})) {
# big problem, need to handle. Next is probably wrong
last;
}
my @nextResources=();
foreach (split(/\,/,$hash{'to_'.$currentResourceID})) {
push(@nextResources, $hash{'goesto_'.$_});
}
push(@currentResource, @nextResources);
# Set the next resource to be processed
$currentResourceID=pop(@currentResource);
}
unless (untie(%hash)) {
&Apache::lonnet::logthis("<font color=blue>WARNING: ".
"Could not untie coursemap $fn (browse)".
".</font>");
}
unless (untie(%CacheData)) {
&Apache::lonnet::logthis("<font color=blue>WARNING: ".
"Could not untie Cache Hash (browse)".
".</font>");
}
return 'OK';
}
sub ProcessSection {
my ($sectionData, $courseid,$ActiveFlag)=@_;
$courseid=~s/\_/\//g;
$courseid=~s/^(\w)/\/$1/;
my $cursection='-1';
my $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'};
}
# Get student's section number
my $sec=&ProcessSection($section, $courseID, $ENV{'form.status'});
if($sec != -1) {
$CacheData->{$name.':section'}=$sec;
} else {
$CacheData->{$name.':section'}='';
}
return 0;
}
sub ProcessClassList {
my ($classlist,$courseID,$ChartDB,$c)=@_;
my @names=();
my %CacheData;
if(tie(%CacheData,'GDBM_File',$ChartDB,&GDBM_WRCREAT,0640)) {
foreach my $name (keys(%$classlist)) {
if($name =~ /\:section/ || $name =~ /\:studentInformation/) {
next;
}
if($c->aborted()) {
last;
}
push(@names,$name);
&ProcessStudentInformation(
\%CacheData,
$classlist->{$name.':studentInformation'},
$classlist->{$name.':section'},
$classlist->{$name},
$name,$courseID,$c);
}
$CacheData{'NamesOfStudents'}=join(":::",@names);
# $CacheData{'NamesOfStudents'}=&Apache::lonnet::arrayref2str(\@names);
untie(%CacheData);
}
return @names;
}
# ----- END PROCESSING FUNCTIONS ---------------------------------------
# ----- HELPER FUNCTIONS -----------------------------------------------
sub SpaceColumns {
my ($students,$studentInformation,$headings,$ChartDB)=@_;
my %CacheData;
if(tie(%CacheData,'GDBM_File',$ChartDB,&GDBM_WRCREAT,0640)) {
# Initialize Lengths
for(my $index=0; $index<(scalar @$headings); $index++) {
my @titleLength=split(//,$$headings[$index]);
$CacheData{$$studentInformation[$index].'Length'}=
scalar @titleLength;
}
foreach my $name (@$students) {
foreach (@$studentInformation) {
my @dataLength=split(//,$CacheData{$name.':'.$_});
my $length=scalar @dataLength;
if($length > $CacheData{$_.'Length'}) {
$CacheData{$_.'Length'}=$length;
}
}
}
untie(%CacheData);
}
return;
}
sub ProcessFullName {
my ($lastname, $generation, $firstname, $middlename)=@_;
my $Str = '';
if($lastname ne '') {
$Str .= $lastname.' ';
if($generation ne '') {
$Str .= $generation;
} else {
chop($Str);
}
$Str .= ', ';
if($firstname ne '') {
$Str .= $firstname.' ';
}
if($middlename ne '') {
$Str .= $middlename;
} else {
chop($Str);
if($firstname eq '') {
chop($Str);
}
}
} else {
if($firstname ne '') {
$Str .= $firstname.' ';
}
if($middlename ne '') {
$Str .= $middlename.' ';
}
if($generation ne '') {
$Str .= $generation;
} else {
chop($Str);
}
}
return $Str;
}
sub SortStudents {
my ($CacheData)=@_;
my @students = split(/:::/,$CacheData->{'NamesOfStudents'});
# my @students=&Apache::lonnet::str2array($CacheData->{'NamesOfStudents'});
my @sorted1Students=();
foreach (@students) {
my ($end,$start)=split(/\:/,$CacheData->{$_.':date'});
my $active=1;
my $now=time;
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(@sorted1Students, $_);
}
}
my $Pos = $ENV{'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];
}
}
my @order = ();
foreach my $key (sort keys(%sortData)) {
push (@order,$sortData{$key});
}
return @order;
}
sub TestCacheData {
my ($ChartDB)=@_;
my $isCached=-1;
my %testData;
my $tieTries=0;
if ((-e "$ChartDB") && ($ENV{'form.sort'} ne 'Recalculate Chart')) {
$isCached = 1;
} else {
$isCached = 0;
}
while($tieTries < 3) {
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 >= 3) {
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};
}
}
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;
}
# Download class list information if not using cached data
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; }
}
# Sort students and print out table desciptive data
my %CacheData;
if(tie(%CacheData,'GDBM_File',$ChartDB,&GDBM_READER,0640)) {
if(!$c->aborted()) { @students=&SortStudents(\%CacheData); }
if(!$c->aborted()) { $r->print(&CreateLegend()); }
if(!$c->aborted()) { $r->print(&CreateForm()); }
if(!$c->aborted()) { $r->print('<h3>'.(scalar @students).
' students</h3>'); }
if(!$c->aborted()) { $r->rflush(); }
# if(!$c->aborted()) { $r->print(&CreateColumnSelectors(
# \%CacheData,
# \@studentInformation,
# \@headings,
# $spacePadding)); }
if(!$c->aborted()) { $r->print(&CreateTableHeadings(
\%CacheData,
\@studentInformation,
\@headings,
$spacePadding)); }
untie(%CacheData);
} else {
$r->print("Init2: Unable to tie hash to db file");
return;
}
my @updateStudentList = ();
my $courseData;
foreach (@students) {
if($c->aborted()) {
if(!$isCached &&
tie(%CacheData,'GDBM_File',$ChartDB,&GDBM_WRCREAT,0640)) {
$CacheData{'NamesOfStudents'}=join(":::", @updateStudentList);
# $CacheData{'NamesOfStudents'}=
# &Apache::lonnet::arrayref2str(\@updateStudentList);
untie(%CacheData);
}
last;
}
if(!$isCached) {
$courseData=&DownloadStudentCourseInformation($_, $cid);
if($c->aborted()) { next; }
push(@updateStudentList, $_);
&ExtractStudentData($courseData, $_, $ChartDB);
}
$r->print(&FormatStudentData($_, $cid, \@studentInformation,
$spacePadding, $ChartDB));
$r->rflush();
}
$r->print('</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__
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/back.gif){kind=icon}
Return to lonchart.pm CVS log ![[TXT]](/icons/text.gif){kind=icon}
![[DIR]](/icons/dir.gif){kind=icon}
Up to [LON-CAPA] / loncom / interface