# The LearningOnline Network with CAPA
# Quick Student Grades Display
#
# $Id: lonquickgrades.pm,v 1.40 2006/03/15 22:11:04 albertel 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/
#
# Created Nov. 14, 2002 by Jeremy Bowers
package Apache::lonquickgrades;
use strict;
use Apache::Constants qw(:common :http);
use POSIX;
use Apache::loncommon;
use Apache::lonlocal;
use Apache::lonnet;
use Apache::grades;
sub handler {
my $r = shift;
return real_handler($r);
}
sub real_handler {
my $r = shift;
&Apache::loncommon::get_unprocessed_cgi($ENV{QUERY_STRING});
# Handle header-only request
if ($env{'browser.mathml'}) {
&Apache::loncommon::content_type($r,'text/xml');
} else {
&Apache::loncommon::content_type($r,'text/html');
}
if ($r->header_only) {
$r->send_http_header;
return OK;
}
# Send header, don't cache this page
&Apache::loncommon::no_cache($r);
$r->send_http_header;
my $showPoints =
$env{'course.'.$env{'request.course.id'}.'.grading'} eq 'standard';
my $notshowSPRSlink =
$env{'course.'.$env{'request.course.id'}.'.grading'} eq 'external';
# Create the nav map
my $navmap = Apache::lonnavmaps::navmap->new();
if (!defined($navmap)) {
my $requrl = $r->uri;
$env{'user.error.msg'} = "$requrl:bre:0:0:Navamp initialization failed.";
return HTTP_NOT_ACCEPTABLE;
}
# Keep this hash in sync with %statusIconMap in lonnavmaps; they
# should match color/icon
my $res = $navmap->firstResource(); # temp resource to access constants
# Header
my $title = $showPoints ? "Points Display" : "Completed Problems Display";
$r->print(&Apache::loncommon::start_page($title));
if (!$showPoints && !$notshowSPRSlink ) {
$r->print(<This screen shows how many problems (or problem parts) you have completed, and
how many you have not yet done. You can also look at a detailed
score sheet.
HEADER
}
$r->print("This may take a few moments to display.");
$r->rflush();
# End navmap using boilerplate
my $iterator = $navmap->getIterator(undef, undef, undef, 1);
my $depth = 1;
$iterator->next(); # ignore first BEGIN_MAP
my $curRes = $iterator->next();
# General overview of the following: Walk along the course resources.
# For every problem in the resource, tell its parent maps how many
# parts and how many parts correct it has. After that, each map will
# have a count of the total parts underneath it, correct and otherwise.
# After that, we will walk through the course again and read off
# maps in order, with their data.
# (If in the future people decide not to be cumulative, only add
# the counts to the parent map.)
# For convenience, "totalParts" is also "totalPoints" when we're looking
# at points; I can't come up with a variable name that makes sense
# equally for both cases.
my $totalParts = 0; my $totalPossible = 0; my $totalRight = 0;
my $totalAttempted = 0;
my $now = time();
my $topLevelParts = 0; my $topLevelRight = 0; my $topLevelAttempted = 0;
# Pre-run: Count parts correct
while ( $depth > 0 ) {
if ($curRes == $iterator->BEGIN_MAP()) {$depth++;}
if ($curRes == $iterator->END_MAP()) { $depth--; }
if (ref($curRes) && $curRes->is_problem() && !$curRes->randomout)
{
# Get number of correct, incorrect parts
my $parts = $curRes->parts();
my $partsRight = 0;
my $partsCount = 0;
my $partsAttempted = 0;
my $stack = $iterator->getStack();
for my $part (@{$parts}) {
my $completionStatus = $curRes->getCompletionStatus($part);
my $dateStatus = $curRes->getDateStatus($part);
if ($completionStatus == $curRes->EXCUSED()) {
next;
}
if ($showPoints) {
my $score = 0;
# If we're not telling status and the answer date isn't passed yet,
# it's an "attempted" point
if ($curRes->problemstatus($part) eq 'no' &&
($dateStatus != $curRes->ANSWER_OPEN)) {
my $status = $curRes->simpleStatus($part);
if ($status == $curRes->ATTEMPTED) {
$partsAttempted += $curRes->weight($part);
$totalAttempted += $partsAttempted;
}
} else {
$score = &Apache::grades::compute_points($curRes->weight($part), $curRes->awarded($part));
}
$partsRight += $score;
$totalRight += $score;
$partsCount += $curRes->weight($part);
if ($curRes->opendate($part) < $now) {
$totalPossible += $curRes->weight($part);
}
$totalParts += $curRes->weight($part);
} else {
my $status = $curRes->simpleStatus($part);
my $thisright = 0;
$partsCount++;
if ($status == $curRes->CORRECT ||
$status == $curRes->PARTIALLY_CORRECT ) {
$partsRight++;
$totalRight++;
$thisright = 1;
}
if ($status == $curRes->ATTEMPTED) {
$partsAttempted++;
$totalAttempted++;
}
my $dateStatus = $curRes->getDateStatus($part);
$totalParts++;
if ($curRes->opendate($part) < $now) {
$totalPossible++;
}
}
}
if ($depth == 1) { # in top-level only
$topLevelParts += $partsCount;
$topLevelRight += $partsRight;
$topLevelAttempted += $partsAttempted;
}
# Crawl down stack and record parts correct and total
for my $res (@{$stack}) {
if (ref($res) && $res->is_map()) {
if (!defined($res->{DATA}->{CHILD_PARTS})) {
$res->{DATA}->{CHILD_PARTS} = 0;
$res->{DATA}->{CHILD_CORRECT} = 0;
$res->{DATA}->{CHILD_ATTEMPTED} = 0;
}
$res->{DATA}->{CHILD_PARTS} += $partsCount;
$res->{DATA}->{CHILD_CORRECT} += $partsRight;
$res->{DATA}->{CHILD_ATTEMPTED} += $partsAttempted;
}
}
}
$curRes = $iterator->next();
}
$iterator = $navmap->getIterator(undef, undef, undef, 1);
$depth = 1;
$iterator->next(); # ignore first BEGIN_MAP
$curRes = $iterator->next();
my @start = (255, 255, 192);
my @end = (0, 192, 0);
my $indentString = ' ';
# Second pass: Print the maps.
$r->print('' .
&mt('Folder') . ' | ');
$title = &mt($showPoints ? "Points Scored" : "Done");
if ($totalAttempted) {
$title .= " / " . &mt("Attempted");
}
$r->print("$title / "
. &mt('Total') . " |
\n\n");
while ($depth > 0) {
if ($curRes == $iterator->BEGIN_MAP()) {$depth++;}
if ($curRes == $iterator->END_MAP()) { $depth--; }
if (ref($curRes) && $curRes->is_map()) {
my $title = $curRes->compTitle();
my $correct = $curRes->{DATA}->{CHILD_CORRECT};
my $total = $curRes->{DATA}->{CHILD_PARTS};
my $attempted = $curRes->{DATA}->{CHILD_ATTEMPTED};
if ($total > 0) {
my $ratio;
$ratio = $correct / $total;
my $color = mixColors(\@start, \@end, $ratio);
$r->print("
");
my $thisIndent = '';
for (my $i = 1; $i < $depth; $i++) { $thisIndent .= $indentString; }
$r->print("$thisIndent$title | ");
if ($totalAttempted) {
$r->print("$thisIndent$correct / $attempted / $total |
\n");
} else {
$r->print("$thisIndent$correct / $total | \n");
}
}
}
$curRes = $iterator->next();
}
# If there were any problems at the top level, print an extra "catchall"
if ($topLevelParts > 0) {
my $ratio = $topLevelRight / $topLevelParts;
my $color = mixColors(\@start, \@end, $ratio);
$r->print("");
$r->print(&mt("Problems Not Contained In A Folder")." | ");
$r->print("$topLevelRight / $topLevelParts |
");
}
if ($showPoints) {
my $maxHelpLink = Apache::loncommon::help_open_topic("Quick_Grades_Possibly_Correct");
$title = $showPoints ? "Points" : "Parts Done";
$r->print("Total $title: $totalRight ");
$r->print(&mt("Max Possible To Date")." $maxHelpLink: $totalPossible ");
$title = $showPoints ? "Points" : "Parts";
$r->print(&mt("Total $title In Course").": $totalParts |
\n\n");
}
$r->print("
".&Apache::loncommon::end_page());
return OK;
}
# Pass this two refs to arrays for the start and end color, and a number
# from 0 to 1 for how much of the latter you want to mix in. It will
# return a string ready to show ("#FFC309");
sub mixColors {
my $start = shift;
my $end = shift;
my $ratio = shift;
my ($a,$b);
my $final = "";
$a = $start->[0]; $b = $end->[0];
my $mix1 = POSIX::floor((1-$ratio)*$a + $ratio*$b);
$a = $start->[1]; $b = $end->[1];
my $mix2 = POSIX::floor((1-$ratio)*$a + $ratio*$b);
$a = $start->[2]; $b = $end->[2];
my $mix3 = POSIX::floor((1-$ratio)*$a + $ratio*$b);
$final = sprintf "%02x%02x%02x", $mix1, $mix2, $mix3;
return "#" . $final;
}
1;
500 Internal Server Error
Internal Server Error
The server encountered an internal error or
misconfiguration and was unable to complete
your request.
Please contact the server administrator at
root@localhost to inform them of the time this error occurred,
and the actions you performed just before this error.
More information about this error may be available
in the server error log.