File:
[LON-CAPA] /
loncom /
interface /
Attic /
lonchart.pm
Revision
1.43:
download - view:
text,
annotated -
select for diffs
Wed Jun 5 05:05:38 2002 UTC (22 years, 2 months ago) by
stredwic
Branches:
MAIN
CVS tags:
HEAD
See bugs 484,218 (see below)
This submission is in preparation to handle bug 218. It incorporates Guy's changes from version 1.41-1.42.
First change- I moved code and redefined functions. I changed caching from storing pure html to storing the downloaded data. This appears to have slowed the loading the html of cached data. The goal was achieved, which was to produce the same output and format of the data. The only difference is, now it outputs html using a table for the data instead of trying to format long strings of html.
Second change- I have incorporated the use of the stop button on the browser. This is part of bug 484. Now data will be cached up to the press of the stop button. Any sorting of the data will only work with the downloaded data. Hitting the recalculate button will cause it to attempt a full download again.
# The LearningOnline Network with CAPA
# (Publication Handler
#
# $Id: lonchart.pm,v 1.43 2002/06/05 05:05:38 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;
# -------------------------------------------------------------- Module Globals
my %hash;
my %CachData;
my @cols;
my $r;
my $c;
# ------------------------------------------------------------- Find out status
sub ExtractStudentData {
my ($name,$coid)=@_;
my ($sname,$sdom) = split(/\:/,$name);
my $ResId;
my $Code;
my $Tries;
my $Wrongs;
my %TempHash;
my $Version;
my $problemsCorrect;
my $problemsSolved;
my $totalProblems;
my $LatestVersion;
my $Str;
# Handle Student information ------------------------------------------
# Handle errors
# if($CachData{$name.':error'} =~ /environment/) {
# my $errorMessage = $CachData{$name.':error'};
# return '<td>'.$sname.'</td><td>'.$sdom.
# '</td><td><font color="#000088">'.$errorMessage.'</font></td>';
# }
# Handle user data
$Str = '<td><pre>'.$sname.'</pre></td><td><pre>'.$sdom;
$Str .= '</pre></td><td><pre>'.$CachData{$name.':section'};
$Str .= '</pre></td><td><pre>'.$CachData{$name.':id'};
$Str .= '</pre></td><td><pre>'.$CachData{$name.':fullname'};
$Str .= '</pre></td>';
if($CachData{$name.':error'} =~ /course/) {
return $Str;
# my $errorMessage = 'May have no course data or '.
# $CachData{$name.':error'};
# return '<td>'.$sname.'</td><td>'.$sdom.
# '</td><td><font color="#000088">'.$errorMessage.'</font></td>';
}
# Handle problem data ------------------------------------------------
$Str .= '<td><pre>';
$problemsCorrect = 0;
$totalProblems = 0;
$problemsSolved = 0;
my $IterationNo = 0;
foreach $ResId (@cols) {
if ($IterationNo == 0) {
# 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++;
}
}
}
#----------- Using $1 and $2 -----------------------------------------------
my $Prob = &Apache::lonnet::symbclean(
&Apache::lonnet::declutter($hash{'map_id_'.$1} ).
'___'.$2.'___'.
&Apache::lonnet::declutter( $hash{'src_'.$ResId} ));
$Code=' ';
$Tries = 0;
$LatestVersion = $CachData{$name.":version:$Prob"};
if ( $LatestVersion ) {
for ( my $Version=1; $Version<=$LatestVersion; $Version++ ) {
my $vkeys = $CachData{$name.":$Version:keys:$Prob"};
my @keys = split(/\:/,$vkeys);
foreach my $Key (@keys) {
#---------------------- Changing $1 -------------------------------------------
if (($Key=~/\.(\w+)\.solved$/) && ($Key!~/^\d+\:/)) {
#---------------------- Using $1 -----------------------------------------------
my $Part = $1;
$Tries = $CachData{$name.":$Version:$Prob".
":resource.$Part.tries"};
$TempHash{"$Part.Tries"}=($Tries) ? $Tries : 0;
my $Val = $CachData{$name.":$Version:$Prob".
":resource.$Part.solved"};
if ($Val eq 'correct_by_student') {$Code = '*';}
elsif ($Val eq 'correct_by_override') {$Code = '+';}
elsif ($Val eq 'incorrect_attempted') {$Code = '.';}
elsif ($Val eq 'incorrect_by_override'){$Code = '-';}
elsif ($Val eq 'excused') {$Code = 'x';}
elsif ($Val eq 'ungraded_attempted') {$Code = '#';}
else {$Code = ' ';}
$TempHash{"$Part.Code"} = $Code;
}
}
}
# Actually append problem to output (all parts)
$Str.='<a href="/adm/grades?symb='.
&Apache::lonnet::escape($Prob).
'&student='.$sname.'&domain='.$sdom.'&command=submission">';
for(my $n = 0; $n < $numberOfParts; $n++) {
my $part = $TempHash{$n};
my $code2 = $TempHash{"$part.Code"};
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++;
}
$Str .= $TempHash{"$part.Code"};
if($code2 ne 'x') {
$totalProblems++;
}
}
$Str.='</a>';
} else {
for(my $n=0; $n<$numberOfParts; $n++) {
$Str.=' ';
$totalProblems++;
}
}
}
$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: </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 .= ' ';
$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
sub tracetable {
my ($rid,$beenhere)=@_;
unless ($beenhere=~/\&$rid\&/) {
$beenhere.=$rid.'&';
# 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})) {
foreach (split(/\,/,$hash{'to_'.$rid})){
&tracetable($hash{'goesto_'.$_},$beenhere);
}
}
}
}
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;
}
my $cursection='-1';
my $oldsection='-1';
my $status='Expired';
foreach my $key (keys (%result)) {
my $value = $result{$key};
if ($key=~/^$courseid(?:\/)*(\w+)*\_st$/) {
my $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;
}
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 {
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);
}
}
return $Str;
}
sub DownloadStudentInformation {
my ($name,$courseID)=@_;
my ($studentName,$studentDomain) = split(/\:/,$name);
my $checkForError;
my $key;
my $Status=$CachData{$name.':Status'};
#-----------------------------------------------------------------
# Download student environment data, specifically the full name and id.
my %studentInformation=&Apache::lonnet::get('environment',
['lastname','generation',
'firstname','middlename',
'id'],
$studentDomain,$studentName);
if($c->aborted()) {
return;
}
($checkForError)=keys (%studentInformation);
if($checkForError =~ /^(con_lost|error|no_such_host)/i) {
$CachData{$name.':error'}=
'Could not download student environment data.';
# return;
$CachData{$name.':lastname'}='';
$CachData{$name.':generation'}='';
$CachData{$name.':firstname'}='';
$CachData{$name.':middlename'}='';
$CachData{$name.':fullname'}='';
$CachData{$name.':id'}='';
} else {
$CachData{$name.':lastname'}=$studentInformation{'lastname'};
$CachData{$name.':generation'}=$studentInformation{'generation'};
$CachData{$name.':firstname'}=$studentInformation{'firstname'};
$CachData{$name.':middlename'}=$studentInformation{'middlename'};
$CachData{$name.':fullname'}=&ProcessFullName($name);
$CachData{$name.':id'}=$studentInformation{'id'};
}
# Download student course data
my %courseData=&Apache::lonnet::dump($courseID,$studentDomain,
$studentName);
if($c->aborted()) {
return;
}
($checkForError)=keys (%courseData);
if($checkForError =~ /^(con_lost|error|no_such_host)/i) {
$CachData{$name.':error'}='Could not download course data.';
# return;
} else {
foreach $key (keys (%courseData)) {
$CachData{$name.':'.$key}=$courseData{$key};
}
}
# Get student's section number
my $sec=&usection($studentDomain, $studentName, $courseID, $Status);
if($sec != -1) {
$CachData{$name.':section'}=sprintf('%3s',$sec);
} else {
$CachData{$name.':section'}='';
}
return;
}
sub SortStudents {
# --------------------------------------------------------------- Sort Students
my $Pos = $ENV{'form.sort'};
my @students = split(/:::/,$CachData{'NamesOfStudents'});
my %sortData;
if($Pos eq 'Last Name') {
for(my $index=0; $index<$#students+1; $index++) {
$sortData{$CachData{$students[$index].':fullname'}}=
$students[$index];
}
} elsif($Pos eq 'Section') {
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 CollectClasslist {
# -------------------------------------------------------------- Get class list
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;
}
# ------------------------------------- Calculate Status and number of students
my $now=time;
foreach my $name (sort(keys(%classlist))) {
my $value=$classlist{$name};
my ($end,$start)=split(/\:/,$value);
my $active=1;
my $Status=$ENV{'form.status'};
$Status = ($Status) ? $Status : 'Active';
if((($end) && $now > $end) && (($Status eq 'Active'))) {
$active=0;
}
if(($Status eq 'Expired') && ($end == 0 || $now < $end)) {
$active=0;
}
if($active) {
push(@names,$name);
$CachData{$name.':Status'}=$Status;
}
}
$CachData{'NamesOfStudents'}=join(":::",@names);
return @names;
}
sub BuildChart {
# ----------------------- 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)) {
$r->print('<h3>Undefined course sequence</h3>');
return;
}
# --------------- Find all assessments and put them into some linear-like order
&tracetable($firstres,'&'.$lastres.'&');
# ----------------------------------------------------------------- Render page
&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();
# ----------------------------------------------------------------- Start table
$r->print('<table><tbody>');
# &CreateTableHeadings();
my @updateStudentList = ();
foreach my $student (@students) {
if($c->aborted()) {
if($isCached == 0) {
$CachData{'NamesOfStudents'}=join(":::",@updateStudentList);
}
last;
}
if($isCached == 0) {
&DownloadStudentInformation($student,$cid);
push (@updateStudentList, $student);
}
my $Str=&ExtractStudentData($student,$cid);
$r->print('<tr>'.$Str.'</tr>');
}
$r->print('</tbody></table>');
untie(%CachData);
return;
}
sub Start {
$r->print('<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();
&BuildChart();
$r->print('</body>');
return;
}
# ================================================================ Main Handler
sub handler {
undef %hash;
undef %CachData;
undef @cols;
$r=shift;
$c = $r->connection;
if (&Apache::lonnet::allowed('vgr',$ENV{'request.course.id'})) {
# ------------------------------------------- Set document type for header only
if ($r->header_only) {
if ($ENV{'browser.mathml'}) {
$r->content_type('text/xml');
} else {
$r->content_type('text/html');
}
&Apache::loncommon::no_cache($r);
$r->send_http_header;
return OK;
}
my $requrl=$r->uri;
# ----------------------------------------------------------------- Tie db file
if ($ENV{'request.course.fn'}) {
my $fn=$ENV{'request.course.fn'};
if (-e "$fn.db") {
if (tie(%hash,'GDBM_File',"$fn.db",&GDBM_READER,0640)) {
# ------------------------------------------------------------------- Hash tied
# ---------------------------------------------------------------- Send headers
$r->content_type('text/html');
$r->send_http_header;
$r->print('<html>');
&Start();
$r->print('</html>');
$r->rflush();
# ------------------------------------------------------------- End render page
} else {
$r->content_type('text/html');
$r->send_http_header;
$r->print('<html><body>Coursemap undefined.</body></html>');
}
# ------------------------------------------------------------------ Untie hash
unless (untie(%hash)) {
&Apache::lonnet::logthis("<font color=blue>WARNING: ".
"Could not untie coursemap $fn (browse).</font>");
}
# -------------------------------------------------------------------- All done
return OK;
# ----------------------------------------------- Errors, hash could no be tied
}
} else {
$ENV{'user.error.msg'}="$requrl:bre:0:0:Course not initialized";
return HTTP_NOT_ACCEPTABLE;
}
} else {
$ENV{'user.error.msg'}=
$r->uri.":vgr:0:0:Cannot view grades for complete course";
return HTTP_NOT_ACCEPTABLE;
}
}
1;
__END__
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>