[LON-CAPA-cvs] cvs: loncom(version_1_0_2_scantron) /homework grades.pm
albertel
lon-capa-cvs@mail.lon-capa.org
Thu, 25 Sep 2003 02:46:19 -0000
albertel Wed Sep 24 22:46:19 2003 EDT
Modified files: (Branch: version_1_0_2_scantron)
/loncom/homework grades.pm
Log:
- saving my work
- validation pass started, checking IDS kinda there
- moving to storing scantron file in userfiles dir
Index: loncom/homework/grades.pm
diff -u loncom/homework/grades.pm:1.130.2.1.2.1 loncom/homework/grades.pm:1.130.2.1.2.2
--- loncom/homework/grades.pm:1.130.2.1.2.1 Wed Sep 24 19:51:14 2003
+++ loncom/homework/grades.pm Wed Sep 24 22:46:19 2003
@@ -1,7 +1,7 @@
# The LearningOnline Network with CAPA
# The LON-CAPA Grading handler
#
-# $Id: grades.pm,v 1.130.2.1.2.1 2003/09/24 23:51:14 albertel Exp $
+# $Id: grades.pm,v 1.130.2.1.2.2 2003/09/25 02:46:19 albertel Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -2800,7 +2800,7 @@
my ($request) = @_;
my $navmap = Apache::lonnavmaps::navmap-> new($ENV{'request.course.fn'}.'.db',
$ENV{'request.course.fn'}.'_parms.db');
- $navmap->init();
+# $navmap->init();
my %symbx = ();
my @titles = ();
@@ -3146,6 +3146,8 @@
}
sub scantron_uploads {
+ #FIXME need to support scantron files put in another location,
+ # maybe the course directory? a scantron dir in the course directory?
if (!-e $Apache::lonnet::perlvar{'lonScansDir'}) { return ''};
my $result= '<select name="scantron_selectfile">';
opendir(DIR,$Apache::lonnet::perlvar{'lonScansDir'});
@@ -3182,6 +3184,8 @@
my $file_selector=&scantron_uploads();
my $format_selector=&scantron_scantab();
my $result;
+ #FIXME allow instructor to be able to download the scantron file
+ # and to upload it,
$result.= <<SCANTRONFORM;
<form method="post" enctype="multipart/form-data" action="/adm/grades" name="scantro_process">
<input type="hidden" name="command" value="scantron_validate" />
@@ -3226,6 +3230,7 @@
my ($which) = @_;
my $fh=Apache::File->new($Apache::lonnet::perlvar{'lonTabDir'}.'/scantronformat.tab');
my %config;
+ #FIXME probably should move to XML it has already gotten a bit much now
foreach my $line (<$fh>) {
my ($name,$descrip)=split(/:/,$line);
if ($name ne $which ) { next; }
@@ -3242,6 +3247,12 @@
$config{'Qlength'}=$config[8];
$config{'Qoff'}=$config[9];
$config{'Qon'}=$config[10];
+ $config{'PaperID'}=$config[11];
+ $config{'PaperIDlength'}=$config[12];
+ $config{'FirstName'}=$config[13];
+ $config{'FirstNamelength'}=$config[14];
+ $config{'LastName'}=$config[15];
+ $config{'LastNamelength'}=$config[16];
last;
}
return %config;
@@ -3272,6 +3283,15 @@
}
$record{'scantron.ID'}=substr($data,$$scantron_config{'IDstart'}-1,
$$scantron_config{'IDlength'});
+ $record{'scantron.paperID'}=
+ substr($data,$$scantron_config{'PaperID'}-1,
+ $$scantron_config{'PaperIDlength'});
+ $record{'scantron.FirstName'}=
+ substr($data,$$scantron_config{'FirstName'}-1,
+ $$scantron_config{'FirstNamelength'});
+ $record{'scantron.LastName'}=
+ substr($data,$$scantron_config{'LastName'}-1,
+ $$scantron_config{'LastNamelength'});
my @alphabet=('A'..'Z');
my $questnum=0;
while ($questions) {
@@ -3282,6 +3302,7 @@
my (@array)=split(/$$scantron_config{'Qon'}/,$currentquest);
if (scalar(@array) gt 2) {
#FIXME do something intelligent with double bubbles
+ #actually not a concern right now, should be taking care of later
Apache->request->print("<br ><b>Wha!!!</b> <pre>".scalar(@array).
'-'.$currentquest.'-'.$questnum.'</pre><br />');
}
@@ -3335,6 +3356,125 @@
sub scantron_validate_file {
my ($r) = @_;
+ my ($symb,$url)=&get_symb_and_url($r);
+ if (!$symb) {return '';}
+ my $default_form_data=&defaultFormData($symb,$url);
+
+ if ($ENV{'form.scantron_corrections'}) {
+ &scantron_process_corrections($r);
+ }
+ #get the student pick code ready
+ $r->print(&Apache::loncommon::studentbrowser_javascript());
+ my $result= <<SCANTRONFORM;
+<form method="post" enctype="multipart/form-data" action="/adm/grades" name="scantronupload">
+ <input type="hidden" name="command" value="scantron_validate" />
+ <input type="hidden" name="selectpage" value="$ENV{'form.selectpage'}" />
+ <input type="hidden" name="scantron_format" value="$ENV{'form.scantron_format'}" />
+ <input type="hidden" name="scantron_selectfile" value="$ENV{'form.scantron_selectfile'}" />
+ $default_form_data
+SCANTRONFORM
+ $r->print($result);
+
+ my @validate_phases=( 'ID',
+ 'CODE',
+ 'doublebubble',
+ 'missingbubbles');
+ if (!$ENV{'form.validatepass'}) {
+ $ENV{'form.valiadatepass'} = 0;
+ }
+ my $currentphase=$ENV{'form.valiadatepass'};
+
+ if ($ENV{'form.scantron_selectfile'}=~m-^/-) {
+ #first pass copy file to classdir
+
+ }
+ my $stop=0;
+ while (!$stop && $currentphase < scalar(@validate_phases)) {
+ my $which="scantron_validate_".$validate_phases[$currentphase];
+ {
+ no strict 'refs';
+ ($stop,$currentphase)=&$which($r,$currentphase);
+ }
+ }
+ $r->print("<input type='hidden' name='validatepass' value='".$currentphase."' />");
+}
+
+sub scantron_validate_ID {
+ my ($r,$currentphase) = @_;
+
+ #get student info
+ my $classlist=&Apache::loncoursedata::get_classlist();
+ my %idmap=&username_to_idmap($classlist);
+
+ #get scantron line setup
+ my %scantron_config=&get_scantron_config($ENV{'form.scantron_format'});
+ #my $scanlines=Apache::File->new($Apache::lonnet::perlvar{'lonScansDir'}."/$ENV{'form.scantron_selectfile'}");
+ #FIXME really would prefer a scantron directory but tokenwrapper
+ # doesn't allow access to subdirs of userfiles
+ my $scanlines=&Apache::lonnet::getfile('/uploaded/'.
+ $ENV{'course.'.$ENV{'request.course.id'}.'.domain'}.'/'.
+ $ENV{'course.'.$ENV{'request.course.id'}.'.num'}.'/'.
+ 'scantron_'.$ENV{'form.scantron_selectfile'});
+
+ my @scanlines=split("\n",$scanlines);
+
+ my %found=('ids'=>{},'usernames'=>{});
+ foreach my $line (@scanlines) {
+ my $scan_record=&scantron_parse_scanline($line,\%scantron_config);
+ my $id=$$scan_record{'scantron.ID'};
+ $r->print("<p>Checking ID ".$$scan_record{'scantron.ID'}."</p>\n");
+ my $found;
+ foreach my $checkid (keys(%idmap)) {
+ if (lc($checkid) eq lc($id)) {
+ if ($checkid ne $id) {
+ $r->print("<p>Using $checkid for bubbled $id</p>\n");
+ }
+ $found=$checkid;last;
+ }
+ }
+ if ($found) {
+ if ($found{'ids'}{$found}) {
+ &scantron_get_ID_correction($r,$line,$scan_record,'duplicate',$found);
+ return(1);
+ } else {
+ $found{'ids'}{$found}++;
+ }
+ } else {
+ &scantron_get_ID_correction($r,$line,$scan_record,'incorrect');
+ return(1);
+ }
+ }
+
+ return (0,$currentphase+1);
+}
+
+sub scantron_get_ID_correction {
+ my ($r,$line,$scan_record,$error,$arg)=@_;
+ $r->print("<p>need to correct ID</p>\n");
+ $r->print('<input type="hidden" name="scantron_corrections" value="'.$error.'" />'."\n");
+ $r->print('<input type="hidden" name="scantron_line" value="'.&HTML::Entities::encode($line).'" />'."\n");
+ if ($error eq 'unknown') {
+ $r->print("<p> Unknown ID </p>\n");
+ } elsif ($error eq 'duplicate') {
+ $r->print("<p> Duplicated ID </p>\n");
+ }
+ $r->print("<p>Original ID is ".$$scan_record{'scantron.ID'}."</p>\n");
+ $r->print("<p>Name on paper is ".$$scan_record{'scantron.LastName'}.",".
+ $$scan_record{'scantron.FirstName'}."</p>");
+ $r->print("Corrected User -- ");
+ $r->print("\nusername:<input type='text' name='scantron_username' value='' />");
+ $r->print("\ndomain:".
+ &Apache::loncommon::select_dom_form(undef,'scantron_domain'));
+ #FIXME it would be nice if this sent back the user ID and
+ #could do partial userID matches
+ $r->print(&Apache::loncommon::selectstudent_link('scantronupload',
+ 'scantron_username','scantron_domain'));
+ &scantron_end_validate_form($r);
+}
+
+sub scantron_end_validate_form {
+ my ($r) = @_;
+ $r->print('<input type="submit" name="submit" /></form></body></html>');
}
sub scantron_process_students {