[LON-CAPA-cvs] cvs: modules /raeburn checkscantron.pm
raeburn
lon-capa-cvs-allow@mail.lon-capa.org
Tue, 11 Mar 2008 00:25:14 -0000
This is a MIME encoded message
--raeburn1205195114
Content-Type: text/plain
raeburn Mon Mar 10 20:25:14 2008 EDT
Added files:
/modules/raeburn checkscantron.pm
Log:
Post-scantron grading verification.
- Compare last saved submission record for each student stored in LON-CAPA with record for student in scantron data file.
--raeburn1205195114
Content-Type: text/plain
Content-Disposition: attachment; filename="raeburn-20080310202514.txt"
Index: modules/raeburn/checkscantron.pm
+++ modules/raeburn/checkscantron.pm
# The LearningOnline Network with CAPA
# Checking scantron submission date
#
# $Id: checkscantron.pm,v 1.1 2008/03/11 00:25:12 raeburn 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/
#
#
###############################################################
###############################################################
package Apache::checkscantron;
use strict;
use lib qw(/home/httpd/lib/perl);
use Apache::Constants qw(:common);
use Apache::lonnet;
use Apache::loncommon();
use Apache::lonlocal;
use Apache::loncoursedata;
use Apache::grades;
use LONCAPA qw(:DEFAULT :match);
###############################################################
###############################################################
sub handler {
my $r = shift;
&Apache::loncommon::content_type($r,'text/html');
$r->send_http_header;
if ($r->header_only) {
return OK;
}
my $start_page = &Apache::loncommon::start_page('Scantron verification');
$r->print($start_page);
&Apache::lonhtmlcommon::clear_breadcrumbs();
&Apache::lonhtmlcommon::add_breadcrumb
({href=>"/adm/checkscantron",
text=>"Select sequence/scantron file"});
if ($env{'form.checksubmissions'}) {
&Apache::lonhtmlcommon::add_breadcrumb
({href=>"/adm/checkscantron",
text=>"Submission check result"});
$r->print(&Apache::lonhtmlcommon::breadcrumbs('Scantron verification'));
&print_result($r);
} else {
$r->print(&Apache::lonhtmlcommon::breadcrumbs('Scantron verification'));
$r->print('<br />');
&scantron_selectphase($r);
}
$r->print(&Apache::loncommon::end_page());
return OK;
}
sub scantron_selectphase {
my ($r) = @_;
my $sequence_selector=&Apache::grades::getSequenceDropDown();
my $file_selector=&Apache::grades::scantron_uploads();
my $format_selector=&Apache::grades::scantron_scantab();
my $result.= '
<form method="post" name="scantron_process">
'.&Apache::loncommon::start_data_table().'
'.&Apache::loncommon::start_data_table_header_row().'
<th colspan="2">
'.&mt('Specify file and which Folder/Sequence to grade').'
</th>
'.&Apache::loncommon::end_data_table_header_row().'
'.&Apache::loncommon::start_data_table_row().'
<td> '.&mt('Sequence to grade:').' </td><td> '.$sequence_selector.' </td>
'.&Apache::loncommon::end_data_table_row().'
'.&Apache::loncommon::start_data_table_row().'
<td> '.&mt('Filename of scoring office file:').' </td><td> '.$file_selector.' </td>
'.&Apache::loncommon::end_data_table_row().'
'.&Apache::loncommon::start_data_table_row().'
<td> '.&mt('Format of data file:').' </td><td> '.$format_selector.' </td>
'.&Apache::loncommon::end_data_table_row().'
'.&Apache::loncommon::start_data_table_row().'
<td colspan="2">
<input type="hidden" name="checksubmissions" value="1" />
<input type="submit" value="'.&mt('Compare Datafile with Records').'" />
</td>
'.&Apache::loncommon::end_data_table_row().'
'.&Apache::loncommon::end_data_table().'
</form>
';
$r->print($result);
}
sub print_result {
my ($r) = @_;
my $cid = $env{'request.course.id'};
my %lettdig = (
A => 1,
B => 2,
C => 3,
D => 4,
E => 5,
F => 6,
G => 7,
H => 8,
I => 9,
J => 0,
);
my $numletts = scalar(keys(%lettdig));
my $cnum = $env{'course.'.$cid.'.num'};
my $cdom = $env{'course.'.$cid.'.domain'};
my (undef, undef, $sequence) = &Apache::lonnet::decode_symb($env{'form.selectpage'});
my %record;
my %scantron_config =
&Apache::grades::get_scantron_config($env{'form.scantron_format'});
my ($scanlines,$scan_data)=&Apache::grades::scantron_getfile();
my $classlist=&Apache::loncoursedata::get_classlist();
my %idmap=&Apache::grades::username_to_idmap($classlist);
my $navmap=Apache::lonnavmaps::navmap->new();
my $map=$navmap->getResourceByUrl($sequence);
my @resources=$navmap->retrieveResources($map,undef,1,0);
my (%scandata,%lastname,%bylast);
my $result= <<SCANTRONFORM;
<form method="post" enctype="multipart/form-data" action="/adm/grades" name="scantronupload">
<input type="hidden" name="command" value="scantron_configphase" />
SCANTRONFORM
$r->print($result);
my @delayqueue;
my %completedstudents;
my $count=&Apache::grades::get_todo_count($scanlines,$scan_data);
my %prog_state=&Apache::lonhtmlcommon::Create_PrgWin($r,'Verification Status',
'Verification Progress',$count,
'inline',undef,'scantronupload');
my ($username,$domain,$uname,$started);
&Apache::grades::scantron_get_maxbubble(); # Need the bubble lines array to parse.
&Apache::lonhtmlcommon::Update_PrgWin($r,\%prog_state,
'Processing first student');
my $start=&Time::HiRes::time();
my $i=-1;
while ($i<$scanlines->{'count'}) {
($username,$domain,$uname)=('','','');
$i++;
my $line=&Apache::grades::scantron_get_line($scanlines,$scan_data,$i);
if ($line=~/^[\s\cz]*$/) { next; }
if ($started) {
&Apache::lonhtmlcommon::Increment_PrgWin($r,\%prog_state,
'last student');
}
$started=1;
my $scan_record=
&Apache::grades::scantron_parse_scanline($line,$i,\%scantron_config,
$scan_data);
unless ($uname=&Apache::grades::scantron_find_student($scan_record,$scan_data,
\%idmap,$i)) {
&Apache::grades::scantron_add_delay(\@delayqueue,$line,
'Unable to find a student that matches',1);
next;
}
if (exists $completedstudents{$uname}) {
&Apache::grades::scantron_add_delay(\@delayqueue,$line,
'Student '.$uname.' has multiple sheets',2); next;
}
my $pid = $scan_record->{'scantron.ID'};
$lastname{$pid} = $scan_record->{'scantron.LastName'};
push(@{$bylast{$lastname{$pid}}},$pid);
$scandata{$pid} = substr($line,$scantron_config{'Qstart'}-1,$env{'form.scantron_maxbubble'});
chomp($scandata{$pid});
$scandata{$pid} =~ s/\r$//;
($username,$domain)=split(/:/,$uname);
my $counter = -1;
my (%expected,%startpos);
foreach my $resource (@resources) {
next if (!$resource->is_problem());
my $symb = $resource->symb();
my $partsref = $resource->parts();
my @parts;
my @part_ids = ();
if (ref($partsref) eq 'ARRAY') {
@parts = @{$partsref};
foreach my $part (@parts) {
my @resp_ids = $resource->responseIds($part);
foreach my $resp (@resp_ids) {
$counter ++;
my $part_id = $part.'.'.$resp;
$expected{$part_id} = 0;
push(@part_ids,$part_id);
if ($env{"form.scantron.sub_bubblelines.$counter"}) {
my @sub_lines = split(/,/,$env{"form.scantron.sub_bubblelines.$counter"});
foreach my $item (@sub_lines) {
$expected{$part_id} += $item;
}
} else {
$expected{$part_id} = $env{"form.scantron.bubblelines.$counter"};
}
$startpos{$part_id} = $env{"form.scantron.first_bubble_line.$counter"};
}
}
}
if ($symb) {
my %recorded;
my (%returnhash) =
&Apache::lonnet::restore($symb,$cid,$domain,$username);
if ($returnhash{'version'}) {
my %lasthash=();
my $version;
for ($version=1;$version<=$returnhash{'version'};$version++) {
foreach my $key (sort(split(/\:/,$returnhash{$version.':keys'}))) {
$lasthash{$key}=$returnhash{$version.':'.$key};
}
}
foreach my $key (keys(%lasthash)) {
if ($key =~ /\.scantron$/) {
my $value = &unescape($lasthash{$key});
my ($part_id) = ($key =~ /^resource\.(.+)\.scantron$/);
if ($value eq '') {
for (my $i=0; $i<$expected{$part_id}; $i++) {
$recorded{$part_id} .= ' ';
}
} else {
my @tocheck;
my @items = split(//,$value);
if (($scantron_config{'Qon'} eq 'letter') ||
($scantron_config{'Qon'} eq 'number')) {
if (@items < $expected{$part_id}) {
my $fragment = substr($scandata{$pid},$startpos{$part_id},$expected{$part_id});
my @singles = split(//,$fragment);
foreach my $pos (@singles) {
if ($pos eq ' ') {
push(@tocheck,$pos);
} else {
my $next = shift(@items);
push(@tocheck,$next);
}
}
} else {
@tocheck = @items;
}
foreach my $letter (@tocheck) {
if ($scantron_config{'Qon'} eq 'letter') {
if ($letter !~ /^[A-J]$/) {
$letter = $scantron_config{'Qoff'};
}
$recorded{$part_id} .= $letter;
} elsif ($scantron_config{'Qon'} eq 'number') {
my $digit;
if ($letter !~ /^[A-J]$/) {
$digit = $scantron_config{'Qoff'};
} else {
$digit = $lettdig{$letter};
}
$recorded{$part_id} .= $digit;
}
}
} else {
for (my $i=0; $i<$expected{$part_id}; $i++) {
for (my $j=0; $j<$scantron_config{'Qlength'}; $j++) {
my $curr_sub = shift(@tocheck);
my $digit;
if ($curr_sub =~ /^[A-J]$/) {
$digit = $lettdig{$curr_sub}-1;
}
if ($curr_sub eq 'J') {
$digit += scalar($numletts);
}
if ($j == $digit) {
$recorded{$part_id} .= $scantron_config{'Qon'};
} else {
$recorded{$part_id} .= $scantron_config{'Qoff'};
}
}
}
}
}
}
}
}
foreach my $part_id (@part_ids) {
if ($recorded{$part_id} eq '') {
for (my $i=0; $i<$expected{$part_id}; $i++) {
for (my $j=0; $j<$scantron_config{'Qlength'}; $j++) {
$recorded{$part_id} .= $scantron_config{'Qoff'};
}
}
}
$record{$pid} .= $recorded{$part_id};
}
}
}
}
&Apache::lonhtmlcommon::Close_PrgWin($r,\%prog_state);
$r->print('<br />');
my ($okstudents,$badstudents,$passed,$failed);
$passed = 0;
$failed = 0;
foreach my $last (sort(keys(%bylast))) {
if (ref($bylast{$last}) eq 'ARRAY') {
foreach my $pid (sort(@{$bylast{$last}})) {
if ($scandata{$pid} eq $record{$pid}) {
my $css_class = ($passed % 2)?'LC_odd_row':'LC_even_row';
$okstudents .= &Apache::loncommon::start_data_table_row($css_class).
'<td>Scantron</td><td>'.$scandata{$pid}.'</td><td rowspan="2">'.$last.'</td><td rowspan="2">'.$pid.'</td>'."\n".
&Apache::loncommon::end_data_table_row()."\n".
&Apache::loncommon::start_data_table_row($css_class)."\n".
'<td>Submissions</td><td>'.$record{$pid}.'</td>'."\n".
&Apache::loncommon::end_data_table_row()."\n";
$passed ++;
} else {
my $css_class = ($failed % 2)?'LC_odd_row':'LC_even_row';
$badstudents .= &Apache::loncommon::start_data_table_row($css_class).
'<td>Scantron</td><td><span class="LC_nobreak">'.$scandata{$pid}.'</span></td><td rowspan="2">'.$last.'</td><td rowspan="2">'.$pid.'</td>'."\n".
&Apache::loncommon::end_data_table_row()."\n".
&Apache::loncommon::start_data_table_row($css_class)."\n".
'<td>Submissions</td><td><span class="LC_nobreak">'.$record{$pid}.'</span></td>'."\n".
&Apache::loncommon::end_data_table_row()."\n";
$failed ++;
}
}
}
}
$r->print('<p>Scantron data ('.$env{'form.scantron_maxbubble'}.' lines/student) and corresponding submission records match exactly for <b>'.$passed.'</b> student(s)</p>');
if ($passed) {
$r->print('Students with matches are as follows:<br /><br />');
$r->print(&Apache::loncommon::start_data_table()."\n".
&Apache::loncommon::start_data_table_header_row()."\n".
'<th>Source</th><th>Bubble records</th><th>Name</th><th>ID</th>'.
&Apache::loncommon::end_data_table_header_row()."\n".
$okstudents."\n".
&Apache::loncommon::end_data_table());
}
$r->print("<p>Discrepancies detected for <b>$failed</b> student(s)</p>");
if ($failed) {
$r->print("Students with mismatches are as follows:<br /><br />");
$r->print(&Apache::loncommon::start_data_table()."\n".
&Apache::loncommon::start_data_table_header_row()."\n".
'<th>Source</th><th>Bubble records</th><th>Name</th><th>ID</th>'.
&Apache::loncommon::end_data_table_header_row()."\n".
$badstudents."\n".
&Apache::loncommon::end_data_table());
}
$r->print(&Apache::loncommon::end_page());
return OK;
}
1;
--raeburn1205195114--