--- loncom/homework/grades.pm 2003/07/29 20:54:39 1.128
+++ loncom/homework/grades.pm 2010/01/15 16:41:43 1.588
@@ -1,7 +1,7 @@
# The LearningOnline Network with CAPA
# The LON-CAPA Grading handler
#
-# $Id: grades.pm,v 1.128 2003/07/29 20:54:39 ng Exp $
+# $Id: grades.pm,v 1.588 2010/01/15 16:41:43 bisitz Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -25,16 +25,8 @@
#
# http://www.lon-capa.org/
#
-# 2/9,2/13 Guy Albertelli
-# 6/8 Gerd Kortemeyer
-# 7/26 H.K. Ng
-# 8/20 Gerd Kortemeyer
-# Year 2002
-# June-August H.K. Ng
-# Year 2003
-# February, March H.K. Ng
-# July, H. K. Ng
-#
+
+
package Apache::grades;
use strict;
@@ -45,135 +37,445 @@ use Apache::loncommon;
use Apache::lonhtmlcommon;
use Apache::lonnavmaps;
use Apache::lonhomework;
+use Apache::lonpickcode;
use Apache::loncoursedata;
-use Apache::lonmsg qw(:user_normal_msg);
+use Apache::lonmsg();
use Apache::Constants qw(:common);
+use Apache::lonlocal;
+use Apache::lonenc;
use String::Similarity;
+use LONCAPA;
+
+use POSIX qw(floor);
+
+
-my %oldessays=();
my %perm=();
-# ----- These first few routines are general use routines.----
+# These variables are used to recover from ssi errors
+
+my $ssi_retries = 5;
+my $ssi_error;
+my $ssi_error_resource;
+my $ssi_error_message;
+
+
+sub ssi_with_retries {
+ my ($resource, $retries, %form) = @_;
+ my ($content, $response) = &Apache::loncommon::ssi_with_retries($resource, $retries, %form);
+ if ($response->is_error) {
+ $ssi_error = 1;
+ $ssi_error_resource = $resource;
+ $ssi_error_message = $response->code . " " . $response->message;
+ }
+
+ return $content;
+
+}
#
-# --- Retrieve the parts that matches stores_\d+ from the metadata file.---
+# Prodcuces an ssi retry failure error message to the user:
+#
+
+sub ssi_print_error {
+ my ($r) = @_;
+ my $helpurl = &Apache::loncommon::top_nav_help('Helpdesk');
+ $r->print('
+
+
+'.&mt('Unable to retrieve a resource from a server:').'
+'.&mt('Resource:').' '.$ssi_error_resource.'
+'.&mt('Error:').' '.$ssi_error_message.'
+
'.
+&mt('It is recommended that you try again later, as this error may mean the server was just temporarily unavailable, or is down for maintenance.').'
'.
+&mt('If the error persists, please contact the [_1] for assistance.',$helpurl).
+'
Current Resource: '.$probTitle.' | '; + } + $result.=' | '.&mt('Problem Part').' | ' + .''.&mt('Res. ID').' | ' + .''.&mt('Type').' | ' + .&Apache::loncommon::end_data_table_header_row(); my %resptype = (); my $hdgrade='no'; - for (sort keys(%$handgrade)) { - my ($responsetype,$handgrade)=split(/:/,$$handgrade{$_}); - my $partID = (split(/_/))[0]; - $resptype{$partID} = $responsetype; - $hdgrade = $handgrade if ($handgrade eq 'yes'); - $result.='
---|---|---|
Part '.$partID.' | '. - 'Type: '.$responsetype.' | Handgrade: '.$handgrade.' | '; + my %partsseen; + foreach my $partID (sort(keys(%$responseType))) { + foreach my $resID (sort(keys(%{ $responseType->{$partID} }))) { + my $handgrade=$$handgrade{$partID.'_'.$resID}; + my $responsetype = $responseType->{$partID}->{$resID}; + $hdgrade = $handgrade if ($handgrade eq 'yes'); + $result.=&Apache::loncommon::start_data_table_row(); + if ($checkboxes) { + if (exists($partsseen{$partID})) { + $result.=""; + } else { + $result.=" | "; + } + $partsseen{$partID}=1; + } + my $display_part=&get_display_part($partID,$symb); + $result.=' | '.$display_part.' | ' + .''.''.$resID.' | ' + .''.&mt($responsetype).' | ' +# .''.&mt('Handgrade: [_1]',$handgrade).' | ' + .&Apache::loncommon::end_data_table_row(); + } + } + $result.=&Apache::loncommon::end_data_table(); + return $result,$responseType,$hdgrade,$partlist,$handgrade; +} + +sub reset_caches { + &reset_analyze_cache(); + &reset_perm(); +} + +{ + my %analyze_cache; + my %analyze_cache_formkeys; + + sub reset_analyze_cache { + undef(%analyze_cache); + undef(%analyze_cache_formkeys); + } + + sub get_analyze { + my ($symb,$uname,$udom,$no_increment,$add_to_hash)=@_; + my $key = "$symb\0$uname\0$udom"; + if (exists($analyze_cache{$key})) { + my $getupdate = 0; + if (ref($add_to_hash) eq 'HASH') { + foreach my $item (keys(%{$add_to_hash})) { + if (ref($analyze_cache_formkeys{$key}) eq 'HASH') { + if (!exists($analyze_cache_formkeys{$key}{$item})) { + $getupdate = 1; + last; + } + } else { + $getupdate = 1; + } + } + } + if (!$getupdate) { + return $analyze_cache{$key}; + } + } + + my (undef,undef,$url)=&Apache::lonnet::decode_symb($symb); + $url=&Apache::lonnet::clutter($url); + my %form = ('grade_target' => 'analyze', + 'grade_domain' => $udom, + 'grade_symb' => $symb, + 'grade_courseid' => $env{'request.course.id'}, + 'grade_username' => $uname, + 'grade_noincrement' => $no_increment); + if (ref($add_to_hash)) { + %form = (%form,%{$add_to_hash}); + } + my $subresult=&ssi_with_retries($url, $ssi_retries,%form); + (undef,$subresult)=split(/_HASH_REF__/,$subresult,2); + my %analyze=&Apache::lonnet::str2hash($subresult); + if (ref($add_to_hash) eq 'HASH') { + $analyze_cache_formkeys{$key} = $add_to_hash; + } else { + $analyze_cache_formkeys{$key} = {}; + } + return $analyze_cache{$key} = \%analyze; + } + + sub get_order { + my ($partid,$respid,$symb,$uname,$udom,$no_increment)=@_; + my $analyze = &get_analyze($symb,$uname,$udom,$no_increment); + return $analyze->{"$partid.$respid.shown"}; + } + + sub get_radiobutton_correct_foil { + my ($partid,$respid,$symb,$uname,$udom)=@_; + my $analyze = &get_analyze($symb,$uname,$udom); + my $foils = &get_order($partid,$respid,$symb,$uname,$udom); + if (ref($foils) eq 'ARRAY') { + foreach my $foil (@{$foils}) { + if ($analyze->{"$partid.$respid.foil.value.$foil"} eq 'true') { + return $foil; + } + } + } + } + + sub scantron_partids_tograde { + my ($resource,$cid,$uname,$udom,$check_for_randomlist) = @_; + my (%analysis,@parts); + if (ref($resource)) { + my $symb = $resource->symb(); + my $add_to_form; + if ($check_for_randomlist) { + $add_to_form = { 'check_parts_withrandomlist' => 1,}; + } + my $analyze = &get_analyze($symb,$uname,$udom,undef,$add_to_form); + if (ref($analyze) eq 'HASH') { + %analysis = %{$analyze}; + } + if (ref($analysis{'parts'}) eq 'ARRAY') { + foreach my $part (@{$analysis{'parts'}}) { + my ($id,$respid) = split(/\./,$part); + if (!&Apache::loncommon::check_if_partid_hidden($id,$symb,$udom,$uname)) { + push(@parts,$part); + } + } + } + } + return (\%analysis,\@parts); } - $result.='
'; - } - if ($response eq 'essay') { - if (! exists ($ENV{'form.'.$symb})) { + ''. - '
'. - ' Answer '. - (join ' ',@ans).' '. - ' '.$grayFont.'Option ID '.$grayFont. - (join ' '.$grayFont,@IDs).'
'; + } elsif ($response eq 'radiobutton') { + my %answer=&Apache::lonnet::str2hash($answer); + my ($toprow,$bottomrow); + my $correct = + &get_radiobutton_correct_foil($partid,$respid,$symb,$uname,$udom); + foreach my $foil (@$order) { + if (exists($answer{$foil})) { + if ($foil eq $correct) { + $toprow.=''. + '
'. + ' '.&mt('Answer').' '.$toprow.''. + ' '.$grayFont.&mt('Item ID').' '. + $middlerow.''.' '.$grayFont.&mt('Option ID').' '. + $bottomrow.'
'; + } elsif ($response eq 'essay') { + if (! exists ($env{'form.'.$symb})) { my (%keyhash) = &Apache::lonnet::dump('nohist_handgrade', - $ENV{'course.'.$ENV{'request.course.id'}.'.domain'}, - $ENV{'course.'.$ENV{'request.course.id'}.'.num'}); + $env{'course.'.$env{'request.course.id'}.'.domain'}, + $env{'course.'.$env{'request.course.id'}.'.num'}); - my $loginuser = $ENV{'user.name'}.':'.$ENV{'user.domain'}; - $ENV{'form.keywords'} = $keyhash{$symb.'_keywords'} ne '' ? $keyhash{$symb.'_keywords'} : ''; - $ENV{'form.kwclr'} = $keyhash{$loginuser.'_kwclr'} ne '' ? $keyhash{$loginuser.'_kwclr'} : 'red'; - $ENV{'form.kwsize'} = $keyhash{$loginuser.'_kwsize'} ne '' ? $keyhash{$loginuser.'_kwsize'} : '0'; - $ENV{'form.kwstyle'} = $keyhash{$loginuser.'_kwstyle'} ne '' ? $keyhash{$loginuser.'_kwstyle'} : ''; - $ENV{'form.'.$symb} = 1; # so that we don't have to read it from disk for multiple sub of the same prob. - } - return ''. + '
'. + ' '.&mt('Answer').' '.$toprow.''.' '.$grayFont.&mt('Option ID').' '. + $grayFont.$bottomrow.'
'.&keywords_highlight($answer).''; + my $loginuser = $env{'user.name'}.':'.$env{'user.domain'}; + $env{'form.keywords'} = $keyhash{$symb.'_keywords'} ne '' ? $keyhash{$symb.'_keywords'} : ''; + $env{'form.kwclr'} = $keyhash{$loginuser.'_kwclr'} ne '' ? $keyhash{$loginuser.'_kwclr'} : 'red'; + $env{'form.kwsize'} = $keyhash{$loginuser.'_kwsize'} ne '' ? $keyhash{$loginuser.'_kwsize'} : '0'; + $env{'form.kwstyle'} = $keyhash{$loginuser.'_kwstyle'} ne '' ? $keyhash{$loginuser.'_kwstyle'} : ''; + $env{'form.'.$symb} = 1; # so that we don't have to read it from disk for multiple sub of the same prob. + } + $answer =~ s-\n-
'.&keywords_highlight($answer).''; + } elsif ( $response eq 'organic') { + my $result='Smile representation: "'.$answer.'"'; + my $jme=$record->{$version."resource.$partid.$respid.molecule"}; + $result.=&Apache::chemresponse::jme_img($jme,$answer,400); + return $result; + } elsif ( $response eq 'Task') { + if ( $answer eq 'SUBMITTED') { + my $files = $record->{$version."resource.$respid.$partid.bridgetask.portfiles"}; + my $result = &Apache::bridgetask::file_list($files,$uname,$udom); + return $result; + } elsif ( grep(/^\Q$version\E.*?\.instance$/, keys(%{$record})) ) { + my @matches = grep(/^\Q$version\E.*?\.instance$/, + keys(%{$record})); + return join('
' + .&mt('Overall result: [_1]', + $record->{$version."resource.$respid.$partid.status"}) + .'
'; + + $result .= ''."\n";
- $result.='
'."\n"; - $result.=&show_grading_menu_form($symb,$url); + $result.=&show_grading_menu_form($symb); return $result; } sub csvuploadmap { my ($request)= @_; - my ($symb,$url)=&get_symb_and_url($request); + my ($symb)=&get_symb($request); if (!$symb) {return '';} my $datatoken; - if (!$ENV{'form.datatoken'}) { + if (!$env{'form.datatoken'}) { $datatoken=&Apache::loncommon::upfile_store($request); } else { - $datatoken=$ENV{'form.datatoken'}; + $datatoken=$env{'form.datatoken'}; &Apache::loncommon::load_tmp_file($request); } my @records=&Apache::loncommon::upfile_record_sep(); - &csvuploadmap_header($request,$symb,$url,$datatoken,$#records+1); + if ($env{'form.noFirstLine'}) { shift(@records); } + &csvuploadmap_header($request,$symb,$datatoken,$#records+1); my ($i,$keyfields); if (@records) { - my @fields=&csvupload_fields($url); - - if ($ENV{'form.upfile_associate'} eq 'reverse') { + my $fieldserror; + my @fields=&csvupload_fields($symb,\$fieldserror); + if ($fieldserror) { + $request->print(&navmap_errormsg()); + return; + } + if ($env{'form.upfile_associate'} eq 'reverse') { &Apache::loncommon::csv_print_samples($request,\@records); $i=&Apache::loncommon::csv_print_select_table($request,\@records, \@fields); @@ -2597,47 +4006,122 @@ sub csvuploadmap { unshift(@fields,['none','']); $i=&Apache::loncommon::csv_samples_select_table($request,\@records, \@fields); - my %sone=&Apache::loncommon::record_sep($records[0]); - $keyfields=join(',',sort(keys(%sone))); + foreach my $rec (@records) { + my %temp = &Apache::loncommon::record_sep($rec); + if (%temp) { + $keyfields=join(',',sort(keys(%temp))); + last; + } + } } } &csvuploadmap_footer($request,$i,$keyfields); - $request->print(&show_grading_menu_form($symb,$url)); + $request->print(&show_grading_menu_form($symb)); return ''; } -sub csvuploadassign { +sub csvuploadoptions { my ($request)= @_; - my ($symb,$url)=&get_symb_and_url($request); - if (!$symb) {return '';} - &Apache::loncommon::load_tmp_file($request); - my @gradedata = &Apache::loncommon::upfile_record_sep(); - my @keyfields = split(/\,/,$ENV{'form.keyfields'}); - my %fields=(); - for (my $i=0; $i<=$ENV{'form.nfields'}; $i++) { - if ($ENV{'form.upfile_associate'} eq 'reverse') { - if ($ENV{'form.f'.$i} ne 'none') { - $fields{$keyfields[$i]}=$ENV{'form.f'.$i}; + my ($symb)=&get_symb($request); + my $checked=(($env{'form.noFirstLine'})?'1':'0'); + my $ignore=&mt('Ignore First Line'); + $request->print(< Uploading Class Grade Options+ + ++ + +ENDPICK + my %fields=&get_fields(); + if (!defined($fields{'domain'})) { + my $domform = &Apache::loncommon::select_dom_form($env{'request.role.domain'},'default_domain'); + $request->print("\nUsers are in domain: ".$domform." \n"); + } + foreach my $key (sort(keys(%env))) { + if ($key !~ /^form\.(.*)$/) { next; } + my $cleankey=$1; + if ($cleankey eq 'command') { next; } + $request->print(''."\n"); + } + # FIXME do a check for any duplicated user ids... + # FIXME do a check for any invalid user ids?... + $request->print('+ '."\n"); + $request->print(&show_grading_menu_form($symb)); + return ''; +} + +sub get_fields { + my %fields; + my @keyfields = split(/\,/,$env{'form.keyfields'}); + for (my $i=0; $i<=$env{'form.nfields'}; $i++) { + if ($env{'form.upfile_associate'} eq 'reverse') { + if ($env{'form.f'.$i} ne 'none') { + $fields{$keyfields[$i]}=$env{'form.f'.$i}; } } else { - if ($ENV{'form.f'.$i} ne 'none') { - $fields{$ENV{'form.f'.$i}}=$keyfields[$i]; + if ($env{'form.f'.$i} ne 'none') { + $fields{$env{'form.f'.$i}}=$keyfields[$i]; } } } + return %fields; +} + +sub csvuploadassign { + my ($request)= @_; + my ($symb)=&get_symb($request); + if (!$symb) {return '';} + my $error_msg = ''; + &Apache::loncommon::load_tmp_file($request); + my @gradedata = &Apache::loncommon::upfile_record_sep(); + if ($env{'form.noFirstLine'}) { shift(@gradedata); } + my %fields=&get_fields(); $request->print(' Assigning Grades'); - my $courseid=$ENV{'request.course.id'}; + my $courseid=$env{'request.course.id'}; my ($classlist) = &getclasslist('all',0); my @notallowed; my @skipped; my $countdone=0; foreach my $grade (@gradedata) { my %entries=&Apache::loncommon::record_sep($grade); + my $domain; + if ($entries{$fields{'domain'}}) { + $domain=$entries{$fields{'domain'}}; + } else { + $domain=$env{'form.default_domain'}; + } + $domain=~s/\s//g; my $username=$entries{$fields{'username'}}; - my $domain=$entries{$fields{'domain'}}; + $username=~s/\s//g; + if (!$username) { + my $id=$entries{$fields{'ID'}}; + $id=~s/\s//g; + my %ids=&Apache::lonnet::idget($domain,$id); + $username=$ids{$id}; + } if (!exists($$classlist{"$username:$domain"})) { - push(@skipped,"$username:$domain"); + my $id=$entries{$fields{'ID'}}; + $id=~s/\s//g; + if ($id) { + push(@skipped,"$id:$domain"); + } else { + push(@skipped,"$username:$domain"); + } next; } my $usec=$classlist->{"$username:$domain"}[5]; @@ -2645,34 +4129,70 @@ sub csvuploadassign { push(@notallowed,"$username:$domain"); next; } + my %points; my %grades; foreach my $dest (keys(%fields)) { - if ($dest eq 'username' || $dest eq 'domain') { next; } - if ($entries{$fields{$dest}} eq '') { next; } - my $store_key=$dest; - $store_key=~s/^stores/resource/; - $store_key=~s/_/\./g; - $grades{$store_key}=$entries{$fields{$dest}}; - } - $grades{"resource.regrader"}="$ENV{'user.name'}:$ENV{'user.domain'}"; - &Apache::lonnet::cstore(\%grades,$symb,$ENV{'request.course.id'}, - $domain,$username); - $request->print('.'); - $request->rflush(); - $countdone++; + if ($dest eq 'ID' || $dest eq 'username' || + $dest eq 'domain') { next; } + if ($entries{$fields{$dest}} =~ /^\s*$/) { next; } + if ($dest=~/stores_(.*)_points/) { + my $part=$1; + my $wgt =&Apache::lonnet::EXT('resource.'.$part.'.weight', + $symb,$domain,$username); + if ($wgt) { + $entries{$fields{$dest}}=~s/\s//g; + my $pcr=$entries{$fields{$dest}} / $wgt; + my $award=($pcr == 0) ? 'incorrect_by_override' + : 'correct_by_override'; + $grades{"resource.$part.awarded"}=$pcr; + $grades{"resource.$part.solved"}=$award; + $points{$part}=1; + } else { + $error_msg = "" . + &mt("Some point values were assigned" + ." for problems with a weight " + ."of zero. These values were " + ."ignored."); + } + } else { + if ($dest=~/stores_(.*)_awarded/) { if ($points{$1}) {next;} } + if ($dest=~/stores_(.*)_solved/) { if ($points{$1}) {next;} } + my $store_key=$dest; + $store_key=~s/^stores/resource/; + $store_key=~s/_/\./g; + $grades{$store_key}=$entries{$fields{$dest}}; + } + } + if (! %grades) { + push(@skipped,&mt("[_1]: no data to save","$username:$domain")); + } else { + $grades{"resource.regrader"}="$env{'user.name'}:$env{'user.domain'}"; + my $result=&Apache::lonnet::cstore(\%grades,$symb, + $env{'request.course.id'}, + $domain,$username); + if ($result eq 'ok') { + $request->print('.'); + } else { + $request->print(" ". + &mt("Failed to save data for student [_1]. Message when trying to save was: [_2]", + "$username:$domain",$result)." "); + } + $request->rflush(); + $countdone++; + } } - $request->print("Stored $countdone students\n"); + $request->print(' '.&Apache::lonhtmlcommon::confirm_success(&mt("Saved scores for [quant,_1,student]",$countdone),$countdone==0)); if (@skipped) { - $request->print(' Skipped Students '); - foreach my $student (@skipped) { $request->print("$student\n"); } + $request->print(' '.&Apache::lonhtmlcommon::confirm_success(&mt('No scores stored for the following username(s):'),1).' '); + $request->print(join(', ',@skipped)); } if (@notallowed) { - $request->print(' Students Not Allowed to Modify '); - foreach my $student (@notallowed) { $request->print("$student\n"); } + $request->print(' '.&Apache::lonhtmlcommon::confirm_success(&mt('Modification of scores not allowed for the following username(s):'),1).' '); + $request->print(join(', ',@notallowed)); } $request->print(" \n"); - $request->print(&show_grading_menu_form($symb,$url)); - return ''; + $request->print(&show_grading_menu_form($symb)); + return $error_msg; } #------------- end of section for handling csv file upload --------- # @@ -2684,12 +4204,13 @@ sub csvuploadassign { sub pickStudentPage { my ($request) = shift; + my $alertmsg = &mt('Please select the student you wish to grade.'); $request->print(< '. - 'Manual Grading by Page or Sequence'; + my $result=''. + &mt('Manual Grading by Page or Sequence').''; $result.='\n"; + $ctr=0; foreach (@$titles) { my ($minder,$showtitle) = ($_ =~ /(\d+)\.(.*)/); @@ -2732,78 +4262,99 @@ LISTJAVASCRIPT $result.=''."\n". ''."\n"; - $result.=' View Problems Text: no '."\n". - ' yes '." \n"; - - $result.=' Submission Details: '. - ' none'."\n". - ' by dates and submissions'."\n". - ' all details'."\n"; - - $result.=''."\n". - ''."\n". + my $options = + ''."\n". + ''." \n"; + $result.=' '.&mt('View Problem Text').': '.$options; + + $options = + ''."\n". + ''."\n". + ''."\n"; + $result.=' '.&mt('Submissions').': '.$options; + + $result.=&build_section_inputs(); + my $stu_status = join(':',&Apache::loncommon::get_env_multiple('form.Status')); + $result.=''."\n". ''."\n". - ''."\n". - ''."\n". - ''." \n"; + ''."\n". + ''." \n"; + + $result.=' '.&mt('Use CODE').': '."\n"; $result.=' " /> '."\n"; + 'onClick="javascript:checkPickOne(this.form);" value="'.&mt('Next').' →" /> '."\n"; $request->print($result); - my $studentTable.=' Select a student you wish to grade and then click on the Next button. '. - '
| '. + &Apache::loncommon::end_data_table_row(); + } + $studentTable.=&Apache::loncommon::end_data_table()."\n"; $studentTable.='" />'."\n"; + 'onClick="javascript:checkPickOne(this.form);" value="'.&mt('Next').' →" />'."\n"; - $studentTable.=&show_grading_menu_form($symb,$url); + $studentTable.=&show_grading_menu_form($symb); $request->print($studentTable); return ''; } sub getSymbMap { - my ($request) = @_; - my $navmap = Apache::lonnavmaps::navmap-> new($ENV{'request.course.fn'}.'.db', - $ENV{'request.course.fn'}.'_parms.db'); - $navmap->init(); - + my ($map_error) = @_; + my $navmap = Apache::lonnavmaps::navmap->new(); + unless (ref($navmap)) { + if (ref($map_error)) { + $$map_error = 'navmap'; + } + return; + } my %symbx = (); my @titles = (); my $minder = 0; # Gather every sequence that has problems. - my @sequences = $navmap->retrieveResources(undef, sub { shift->is_map(); }, 1); + my @sequences = $navmap->retrieveResources(undef, sub { shift->is_map(); }, + 1,0,1); for my $sequence ($navmap->getById('0.0'), @sequences) { if ($navmap->hasResource($sequence, sub { shift->is_problem(); }, 0) ) { - my $title = $minder.'.'.$sequence->compTitle(); - push @titles, $title; # minder in case two titles are identical - $symbx{$title} = $sequence->symb(); + my $title = $minder.'.'. + &HTML::Entities::encode($sequence->compTitle(),'"\'&'); + push(@titles, $title); # minder in case two titles are identical + $symbx{$title} = &HTML::Entities::encode($sequence->symb(),'"\'&'); $minder++; } } - - $navmap->untieHashes(); return \@titles,\%symbx; } @@ -2812,56 +4363,81 @@ sub getSymbMap { sub displayPage { my ($request) = shift; - my ($symb,$url) = &get_symb_and_url($request); - my $cdom = $ENV{"course.$ENV{'request.course.id'}.domain"}; - my $cnum = $ENV{"course.$ENV{'request.course.id'}.num"}; - my $getsec = $ENV{'form.section'} eq '' ? 'all' : $ENV{'form.section'}; - my $pageTitle = $ENV{'form.page'}; + my ($symb) = &get_symb($request); + my $cdom = $env{"course.$env{'request.course.id'}.domain"}; + my $cnum = $env{"course.$env{'request.course.id'}.num"}; + my $getsec = $env{'form.section'} eq '' ? 'all' : $env{'form.section'}; + my $pageTitle = $env{'form.page'}; my ($classlist,undef,$fullname) = &getclasslist($getsec,'1'); - my ($uname,$udom) = split(/:/,$ENV{'form.student'}); - my $usec=$classlist->{$ENV{'form.student'}}[5]; + my ($uname,$udom) = split(/:/,$env{'form.student'}); + my $usec=$classlist->{$env{'form.student'}}[5]; + + #need to make sure we have the correct data for later EXT calls, + #thus invalidate the cache + &Apache::lonnet::devalidatecourseresdata( + $env{'course.'.$env{'request.course.id'}.'.num'}, + $env{'course.'.$env{'request.course.id'}.'.domain'}); + &Apache::lonnet::clear_EXT_cache_status(); + if (!&canview($usec)) { - $request->print('Unable to view requested student.('.$ENV{'form.student'}.')'); - $request->print(&show_grading_menu_form($symb,$url)); + $request->print(''.&mt('Unable to view requested student. ([_1])',$env{'form.student'}).''); + $request->print(&show_grading_menu_form($symb)); return; } - my $result=' | Prob. | '. + ''.($env{'form.vProb'} eq 'no' ? &mt('Title') : &mt('Problem Text')).'/'.&mt('Grade').' | '. + &Apache::loncommon::end_data_table_header_row(); - $studentTable.=' Note: Problems graded correct by the computer are marked with a '.$checkIcon. - ' symbol.'."\n". - '
---|
'.
- '
'.$ENV{'form.title'}.''; - $result.='Student: '.$ENV{'form.fullname'}. - ' ('.$uname.($udom eq $cdom ? '':':'.$udom).')'."\n"; + my $result=''.$env{'form.title'}.''; + $result.=''.&mt('Student: ').&nameUserString(undef,$env{'form.fullname'},$uname,$udom). + ''."\n"; $request->print($result); - my $navmap = Apache::lonnavmaps::navmap-> new($ENV{'request.course.fn'}.'.db', - $ENV{'request.course.fn'}.'_parms.db',1, 1); - my ($mapUrl, $id, $resUrl) = split(/___/, $ENV{'form.page'}); - my $map = $navmap->getResourceByUrl($resUrl); # add to navmaps + my $navmap = Apache::lonnavmaps::navmap->new(); + unless (ref($navmap)) { + $request->print(&navmap_errormsg()); + return; + } + my ($mapUrl, $id, $resUrl) = &Apache::lonnet::decode_symb( $env{'form.page'}); + my $map = $navmap->getResourceByUrl($resUrl); # add to navmaps + if (!$map) { + $request->print(''.&mt('Unable to grade requested sequence ([_1]).',$resUrl).''); + my ($symb)=&get_symb($request); + $request->print(&show_grading_menu_form($symb)); + return; + } my $iterator = $navmap->getIterator($map->map_start(), $map->map_finish()); - my $studentTable='
'.&navmap_errormsg().' '); + return; + } + my $default_form_data=&defaultFormData($symb); + my $grading_menu_button=&show_grading_menu_form($symb); + my $file_selector=&scantron_uploads($file2grade); my $format_selector=&scantron_scantab(); + my $CODE_selector=&scantron_CODElist(); + my $CODE_unique=&scantron_CODEunique(); my $result; - $result.= <
+ + |
+ '.&Apache::loncommon::end_data_table_row().'
+ '.&Apache::loncommon::end_data_table().'
+');
+ }
+
+ # Chunk of the form that prompts to view a scoring office file,
+ # corrected file, skipped records in a file.
+
+ $r->print('
+ + '.&mt('Download a scoring office file').' + | + '.&Apache::loncommon::end_data_table_header_row().' + '.&Apache::loncommon::start_data_table_row().' + '.&mt('Filename of scoring office file: [_1]',$file_selector).'
+ + + '.&Apache::loncommon::end_data_table_row().' + '.&Apache::loncommon::end_data_table().' + + +'); + + &Apache::lonpickcode::code_list($r,2); + + $r->print('
+ '.&mt('Review bubblesheet data and submissions for a previously graded folder/sequence')."\n".
+ ' | '."\n".
+ &Apache::loncommon::end_data_table_header_row()."\n".
+ &Apache::loncommon::start_data_table_row()."\n".
+ ' '.&mt('Graded folder/sequence:').' | '."\n".
+ ' '.$sequence_selector.' | '.
+ &Apache::loncommon::end_data_table_row()."\n".
+ &Apache::loncommon::start_data_table_row()."\n".
+ ' '.&mt('Filename of scoring office file:').' | '."\n".
+ ' '.$file_selector.' | '."\n".
+ &Apache::loncommon::end_data_table_row()."\n".
+ &Apache::loncommon::start_data_table_row()."\n".
+ ' '.&mt('Format of data file:').' | '."\n".
+ ' '.$format_selector.' | '."\n".
+ &Apache::loncommon::end_data_table_row()."\n".
+ &Apache::loncommon::start_data_table_row()."\n".
+ ' '.&mt('Options').' | '."\n".
+ ' | '.
+ &Apache::loncommon::end_data_table_row()."\n".
+ &Apache::loncommon::start_data_table_row()."\n".
+ ''."\n".
+ ''."\n".
+ ''."\n".
+ ' | '."\n".
+ &Apache::loncommon::end_data_table_row()."\n".
+ &Apache::loncommon::end_data_table()."\n".
+ ''); + $r->print($grading_menu_button); + return; } +=pod + +=item get_scantron_config + + Parse and return the scantron configuration line selected as a + hash of configuration file fields. + + Arguments: + which - the name of the configuration to parse from the file. + + + Returns: + If the named configuration is not in the file, an empty + hash is returned. + a hash with the fields + name - internal name for the this configuration setup + description - text to display to operator that describes this config + CODElocation - if 0 or the string 'none' + - no CODE exists for this config + if -1 || the string 'letter' + - a CODE exists for this config and is + a string of letters + Unsupported value (but planned for future support) + if a positive integer + - The CODE exists as the first n items from + the question section of the form + if the string 'number' + - The CODE exists for this config and is + a string of numbers + CODEstart - (only matter if a CODE exists) column in the line where + the CODE starts + CODElength - length of the CODE + IDstart - column where the student/employee ID starts + IDlength - length of the student/employee ID info + Qstart - column where the information from the bubbled + 'questions' start + Qlength - number of columns comprising a single bubble line from + the sheet. (usually either 1 or 10) + Qon - either a single character representing the character used + to signal a bubble was chosen in the positional setup, or + the string 'letter' if the letter of the chosen bubble is + in the final, or 'number' if a number representing the + chosen bubble is in the file (1->A 0->J) + Qoff - the character used to represent that a bubble was + left blank + PaperID - if the scanning process generates a unique number for each + sheet scanned the column that this ID number starts in + PaperIDlength - number of columns that comprise the unique ID number + for the sheet of paper + FirstName - column that the first name starts in + FirstNameLength - number of columns that the first name spans + + LastName - column that the last name starts in + LastNameLength - number of columns that the last name spans + +=cut + sub get_scantron_config { my ($which) = @_; - my $fh=Apache::File->new($Apache::lonnet::perlvar{'lonTabDir'}.'/scantronformat.tab'); + my @lines = &get_scantronformat_file(); my %config; - foreach my $line (<$fh>) { + #FIXME probably should move to XML it has already gotten a bit much now + foreach my $line (@lines) { my ($name,$descrip)=split(/:/,$line); if ($name ne $which ) { next; } chomp($line); @@ -3226,14 +5412,39 @@ sub get_scantron_config { $config{'IDstart'}=$config[5]; $config{'IDlength'}=$config[6]; $config{'Qstart'}=$config[7]; - $config{'Qlength'}=$config[8]; + $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; } +=pod + +=item username_to_idmap + + creates a hash keyed by student/employee ID with values of the corresponding + student username:domain. + + Arguments: + + $classlist - reference to the class list hash. This is a hash + keyed by student name:domain whose elements are references + to arrays containing various chunks of information + about the student. (See loncoursedata for more info). + + Returns + %idmap - the constructed hash + +=cut + sub username_to_idmap { my ($classlist)= @_; my %idmap; @@ -3244,81 +5455,2191 @@ sub username_to_idmap { return %idmap; } +=pod + +=item scantron_fixup_scanline + + Process a requested correction to a scanline. + + Arguments: + $scantron_config - hash from &get_scantron_config() + $scan_data - hash of correction information + (see &scantron_getfile()) + $line - existing scanline + $whichline - line number of the passed in scanline + $field - type of change to process + (either + 'ID' -> correct the student/employee ID + 'CODE' -> correct the CODE + 'answer' -> fixup the submitted answers) + + $args - hash of additional info, + - 'ID' + 'newid' -> studentID to use in replacement + of existing one + - 'CODE' + 'CODE_ignore_dup' - set to true if duplicates + should be ignored. + 'CODE' - is new code or 'use_unfound' + if the existing unfound code should + be used as is + - 'answer' + 'response' - new answer or 'none' if blank + 'question' - the bubble line to change + 'questionnum' - the question identifier, + may include subquestion. + + Returns: + $line - the modified scanline + + Side effects: + $scan_data - may be updated + +=cut + + +sub scantron_fixup_scanline { + my ($scantron_config,$scan_data,$line,$whichline,$field,$args)=@_; + if ($field eq 'ID') { + if (length($args->{'newid'}) > $$scantron_config{'IDlength'}) { + return ($line,1,'New value too large'); + } + if (length($args->{'newid'}) < $$scantron_config{'IDlength'}) { + $args->{'newid'}=sprintf('%-'.$$scantron_config{'IDlength'}.'s', + $args->{'newid'}); + } + substr($line,$$scantron_config{'IDstart'}-1, + $$scantron_config{'IDlength'})=$args->{'newid'}; + if ($args->{'newid'}=~/^\s*$/) { + &scan_data($scan_data,"$whichline.user", + $args->{'username'}.':'.$args->{'domain'}); + } + } elsif ($field eq 'CODE') { + if ($args->{'CODE_ignore_dup'}) { + &scan_data($scan_data,"$whichline.CODE_ignore_dup",'1'); + } + &scan_data($scan_data,"$whichline.useCODE",'1'); + if ($args->{'CODE'} ne 'use_unfound') { + if (length($args->{'CODE'}) > $$scantron_config{'CODElength'}) { + return ($line,1,'New CODE value too large'); + } + if (length($args->{'CODE'}) < $$scantron_config{'CODElength'}) { + $args->{'CODE'}=sprintf('%-'.$$scantron_config{'CODElength'}.'s',$args->{'CODE'}); + } + substr($line,$$scantron_config{'CODEstart'}-1, + $$scantron_config{'CODElength'})=$args->{'CODE'}; + } + } elsif ($field eq 'answer') { + my $length=$scantron_config->{'Qlength'}; + my $off=$scantron_config->{'Qoff'}; + my $on=$scantron_config->{'Qon'}; + my $answer=${off}x$length; + if ($args->{'response'} eq 'none') { + &scan_data($scan_data, + "$whichline.no_bubble.".$args->{'questionnum'},'1'); + } else { + if ($on eq 'letter') { + my @alphabet=('A'..'Z'); + $answer=$alphabet[$args->{'response'}]; + } elsif ($on eq 'number') { + $answer=$args->{'response'}+1; + if ($answer == 10) { $answer = '0'; } + } else { + substr($answer,$args->{'response'},1)=$on; + } + &scan_data($scan_data, + "$whichline.no_bubble.".$args->{'questionnum'},undef,'1'); + } + my $where=$length*($args->{'question'}-1)+$scantron_config->{'Qstart'}; + substr($line,$where-1,$length)=$answer; + } + return $line; +} + +=pod + +=item scan_data + + Edit or look up an item in the scan_data hash. + + Arguments: + $scan_data - The hash (see scantron_getfile) + $key - shorthand of the key to edit (actual key is + scantronfilename_key). + $data - New value of the hash entry. + $delete - If true, the entry is removed from the hash. + + Returns: + The new value of the hash table field (undefined if deleted). + +=cut + + +sub scan_data { + my ($scan_data,$key,$value,$delete)=@_; + my $filename=$env{'form.scantron_selectfile'}; + if (defined($value)) { + $scan_data->{$filename.'_'.$key} = $value; + } + if ($delete) { delete($scan_data->{$filename.'_'.$key}); } + return $scan_data->{$filename.'_'.$key}; +} + +# ----- These first few routines are general use routines.---- + +# Return the number of occurences of a pattern in a string. + +sub occurence_count { + my ($string, $pattern) = @_; + + my @matches = ($string =~ /$pattern/g); + + return scalar(@matches); +} + + +# Take a string known to have digits and convert all the +# digits into letters in the range J,A..I. + +sub digits_to_letters { + my ($input) = @_; + + my @alphabet = ('J', 'A'..'I'); + + my @input = split(//, $input); + my $output =''; + for (my $i = 0; $i < scalar(@input); $i++) { + if ($input[$i] =~ /\d/) { + $output .= $alphabet[$input[$i]]; + } else { + $output .= $input[$i]; + } + } + return $output; +} + +=pod + +=item scantron_parse_scanline + + Decodes a scanline from the selected scantron file + + Arguments: + line - The text of the scantron file line to process + whichline - Line number + scantron_config - Hash describing the format of the scantron lines. + scan_data - Hash of extra information about the scanline + (see scantron_getfile for more information) + just_header - True if should not process question answers but only + the stuff to the left of the answers. + Returns: + Hash containing the result of parsing the scanline + + Keys are all proceeded by the string 'scantron.' + + CODE - the CODE in use for this scanline + useCODE - 1 if the CODE is invalid but it usage has been forced + by the operator + CODE_ignore_dup - 1 if the CODE is a duplicated use when unique + CODEs were selected, but the usage has been + forced by the operator + ID - student/employee ID + PaperID - if used, the ID number printed on the sheet when the + paper was scanned + FirstName - first name from the sheet + LastName - last name from the sheet + + if just_header was not true these key may also exist + + missingerror - a list of bubble ranges that are considered to be answers + to a single question that don't have any bubbles filled in. + Of the form questionnumber:firstbubblenumber:count. + doubleerror - a list of bubble ranges that are considered to be answers + to a single question that have more than one bubble filled in. + Of the form questionnumber::firstbubblenumber:count + + In the above, count is the number of bubble responses in the + input line needed to represent the possible answers to the question. + e.g. a radioresponse with 15 choices in an answer sheet with 10 choices + per line would have count = 2. + + maxquest - the number of the last bubble line that was parsed + + ( Wha!!! ".scalar(@array). - '-'.$currentquest.'-'.$questnum.' '); - } - if (length($array[0]) eq $$scantron_config{'Qlength'}) { - $record{"scantron.$questnum.answer"}=''; - } else { - $record{"scantron.$questnum.answer"}=$alphabet[length($array[0])]; - } + my $ansnum =1; # Multiple 'answer lines'/question. + + chomp($questions); # Get rid of any trailing \n. + $questions =~ s/\r$//; # Get rid of trailing \r too (MAC or Win uploads). + while (length($questions)) { + my $answers_needed = $bubble_lines_per_response{$questnum}; + my $answer_length = ($$scantron_config{'Qlength'} * $answers_needed) + || 1; + $questnum++; + my $quest_id = $questnum; + my $currentquest = substr($questions,0,$answer_length); + $questions = substr($questions,$answer_length); + if (length($currentquest) < $answer_length) { next; } + + if ($subdivided_bubble_lines{$questnum-1} =~ /,/) { + my $subquestnum = 1; + my $subquestions = $currentquest; + my @subanswers_needed = + split(/,/,$subdivided_bubble_lines{$questnum-1}); + foreach my $subans (@subanswers_needed) { + my $subans_length = + ($$scantron_config{'Qlength'} * $subans) || 1; + my $currsubquest = substr($subquestions,0,$subans_length); + $subquestions = substr($subquestions,$subans_length); + $quest_id = "$questnum.$subquestnum"; + if (($$scantron_config{'Qon'} eq 'letter') || + ($$scantron_config{'Qon'} eq 'number')) { + $ansnum = &scantron_validator_lettnum($ansnum, + $questnum,$quest_id,$subans,$currsubquest,$whichline, + \@alphabet,\%record,$scantron_config,$scan_data); + } else { + $ansnum = &scantron_validator_positional($ansnum, + $questnum,$quest_id,$subans,$currsubquest,$whichline, \@alphabet,\%record,$scantron_config,$scan_data); + } + $subquestnum ++; + } + } else { + if (($$scantron_config{'Qon'} eq 'letter') || + ($$scantron_config{'Qon'} eq 'number')) { + $ansnum = &scantron_validator_lettnum($ansnum,$questnum, + $quest_id,$answers_needed,$currentquest,$whichline, + \@alphabet,\%record,$scantron_config,$scan_data); + } else { + $ansnum = &scantron_validator_positional($ansnum,$questnum, + $quest_id,$answers_needed,$currentquest,$whichline, + \@alphabet,\%record,$scantron_config,$scan_data); + } + } } $record{'scantron.maxquest'}=$questnum; return \%record; } +sub scantron_validator_lettnum { + my ($ansnum,$questnum,$quest_id,$answers_needed,$currquest,$whichline, + $alphabet,$record,$scantron_config,$scan_data) = @_; + + # Qon 'letter' implies for each slot in currquest we have: + # ? or * for doubles, a letter in A-Z for a bubble, and + # about anything else (esp. a value of Qoff) for missing + # bubbles. + # + # Qon 'number' implies each slot gives a digit that indexes the + # bubbles filled, or Qoff, or a non-number for unbubbled lines, + # and * or ? for double bubbles on a single line. + # + + my $matchon; + if ($$scantron_config{'Qon'} eq 'letter') { + $matchon = '[A-Z]'; + } elsif ($$scantron_config{'Qon'} eq 'number') { + $matchon = '\d'; + } + my $occurrences = 0; + if (($responsetype_per_response{$questnum-1} eq 'essayresponse') || + ($responsetype_per_response{$questnum-1} eq 'formularesponse') || + ($responsetype_per_response{$questnum-1} eq 'stringresponse') || + ($responsetype_per_response{$questnum-1} eq 'imageresponse') || + ($responsetype_per_response{$questnum-1} eq 'reactionresponse') || + ($responsetype_per_response{$questnum-1} eq 'organicresponse')) { + my @singlelines = split('',$currquest); + foreach my $entry (@singlelines) { + $occurrences = &occurence_count($entry,$matchon); + if ($occurrences > 1) { + last; + } + } + } else { + $occurrences = &occurence_count($currquest,$matchon); + } + if (($currquest =~ /\?/ || $currquest =~ /\*/) || ($occurrences > 1)) { + push(@{$record->{'scantron.doubleerror'}},$quest_id); + for (my $ans=0; $ans<$answers_needed; $ans++) { + my $bubble = substr($currquest,$ans,1); + if ($bubble =~ /$matchon/ ) { + if ($$scantron_config{'Qon'} eq 'number') { + if ($bubble == 0) { + $bubble = 10; + } + $record->{"scantron.$ansnum.answer"} = + $alphabet->[$bubble-1]; + } else { + $record->{"scantron.$ansnum.answer"} = $bubble; + } + } else { + $record->{"scantron.$ansnum.answer"}=''; + } + $ansnum++; + } + } elsif (!defined($currquest) + || (&occurence_count($currquest, $$scantron_config{'Qoff'}) == length($currquest)) + || (&occurence_count($currquest,$matchon) == 0)) { + for (my $ans=0; $ans<$answers_needed; $ans++ ) { + $record->{"scantron.$ansnum.answer"}=''; + $ansnum++; + } + if (!&scan_data($scan_data,"$whichline.no_bubble.$quest_id")) { + push(@{$record->{'scantron.missingerror'}},$quest_id); + } + } else { + if ($$scantron_config{'Qon'} eq 'number') { + $currquest = &digits_to_letters($currquest); + } + for (my $ans=0; $ans<$answers_needed; $ans++) { + my $bubble = substr($currquest,$ans,1); + $record->{"scantron.$ansnum.answer"} = $bubble; + $ansnum++; + } + } + return $ansnum; +} + +sub scantron_validator_positional { + my ($ansnum,$questnum,$quest_id,$answers_needed,$currquest, + $whichline,$alphabet,$record,$scantron_config,$scan_data) = @_; + + # Otherwise there's a positional notation; + # each bubble line requires Qlength items, and there are filled in + # bubbles for each case where there 'Qon' characters. + # + + my @array=split($$scantron_config{'Qon'},$currquest,-1); + + # If the split only gives us one element.. the full length of the + # answer string, no bubbles are filled in: + + if ($answers_needed eq '') { + return; + } + + if (length($array[0]) eq $$scantron_config{'Qlength'}*$answers_needed) { + for (my $ans=0; $ans<$answers_needed; $ans++ ) { + $record->{"scantron.$ansnum.answer"}=''; + $ansnum++; + } + if (!&scan_data($scan_data,"$whichline.no_bubble.$quest_id")) { + push(@{$record->{"scantron.missingerror"}},$quest_id); + } + } elsif (scalar(@array) == 2) { + my $location = length($array[0]); + my $line_num = int($location / $$scantron_config{'Qlength'}); + my $bubble = $alphabet->[$location % $$scantron_config{'Qlength'}]; + for (my $ans=0; $ans<$answers_needed; $ans++) { + if ($ans eq $line_num) { + $record->{"scantron.$ansnum.answer"} = $bubble; + } else { + $record->{"scantron.$ansnum.answer"} = ' '; + } + $ansnum++; + } + } else { + # If there's more than one instance of a bubble character + # That's a double bubble; with positional notation we can + # record all the bubbles filled in as well as the + # fact this response consists of multiple bubbles. + # + if (($responsetype_per_response{$questnum-1} eq 'essayresponse') || + ($responsetype_per_response{$questnum-1} eq 'formularesponse') || + ($responsetype_per_response{$questnum-1} eq 'stringresponse') || + ($responsetype_per_response{$questnum-1} eq 'imageresponse') || + ($responsetype_per_response{$questnum-1} eq 'reactionresponse') || + ($responsetype_per_response{$questnum-1} eq 'organicresponse')) { + my $doubleerror = 0; + while (($currquest >= $$scantron_config{'Qlength'}) && + (!$doubleerror)) { + my $currline = substr($currquest,0,$$scantron_config{'Qlength'}); + $currquest = substr($currquest,$$scantron_config{'Qlength'}); + my @currarray = split($$scantron_config{'Qon'},$currline,-1); + if (length(@currarray) > 2) { + $doubleerror = 1; + } + } + if ($doubleerror) { + push(@{$record->{'scantron.doubleerror'}},$quest_id); + } + } else { + push(@{$record->{'scantron.doubleerror'}},$quest_id); + } + my $item = $ansnum; + for (my $ans=0; $ans<$answers_needed; $ans++) { + $record->{"scantron.$item.answer"} = ''; + $item ++; + } + + my @ans=@array; + my $i=0; + my $increment = 0; + while ($#ans) { + $i+=length($ans[0]) + $increment; + my $line = int($i/$$scantron_config{'Qlength'} + $ansnum); + my $bubble = $i%$$scantron_config{'Qlength'}; + $record->{"scantron.$line.answer"}.=$alphabet->[$bubble]; + shift(@ans); + $increment = 1; + } + $ansnum += $answers_needed; + } + return $ansnum; +} + +=pod + +=item scantron_add_delay + + Adds an error message that occurred during the grading phase to a + queue of messages to be shown after grading pass is complete + + Arguments: + $delayqueue - arrary ref of hash ref of error messages + $scanline - the scanline that caused the error + $errormesage - the error message + $errorcode - a numeric code for the error + + Side Effects: + updates the $delayqueue to have a new hash ref of the error + +=cut + sub scantron_add_delay { + my ($delayqueue,$scanline,$errormessage,$errorcode)=@_; + push(@$delayqueue, + {'line' => $scanline, 'emsg' => $errormessage, + 'ecode' => $errorcode } + ); } +=pod + +=item scantron_find_student + + Finds the username for the current scanline + + Arguments: + $scantron_record - hash result from scantron_parse_scanline + $scan_data - hash of correction information + (see &scantron_getfile() form more information) + $idmap - hash from &username_to_idmap() + $line - number of current scanline + + Returns: + Either 'username:domain' or undef if unknown + +=cut + sub scantron_find_student { - my ($scantron_record,$idmap)=@_; + my ($scantron_record,$scan_data,$idmap,$line)=@_; my $scanID=$$scantron_record{'scantron.ID'}; + if ($scanID =~ /^\s*$/) { + return &scan_data($scan_data,"$line.user"); + } foreach my $id (keys(%$idmap)) { - Apache->request->print(' checking studnet -'.$id.'- againt -'.$scanID.'-'); - if (lc($id) eq lc($scanID)) { Apache->request->print('success');return $$idmap{$id}; } + if (lc($id) eq lc($scanID)) { + return $$idmap{$id}; + } } return undef; } +=pod + +=item scantron_filter + + Filter sub for lonnavmaps, filters out hidden resources if ignore + hidden resources was selected + +=cut + sub scantron_filter { my ($curres)=@_; - if (ref($curres) && $curres->is_problem() && !$curres->randomout) { + + if (ref($curres) && $curres->is_problem()) { + # if the user has asked to not have either hidden + # or 'randomout' controlled resources to be graded + # don't include them + if ($env{'form.scantron_options_hidden'} eq 'ignore_hidden' + && $curres->randomout) { + return 0; + } return 1; } return 0; } -sub scantron_process_students { +=pod + +=item scantron_process_corrections + + Gets correction information out of submitted form data and corrects + the scanline + +=cut + +sub scantron_process_corrections { + my ($r) = @_; + my %scantron_config=&get_scantron_config($env{'form.scantron_format'}); + my ($scanlines,$scan_data)=&scantron_getfile(); + my $classlist=&Apache::loncoursedata::get_classlist(); + my $which=$env{'form.scantron_line'}; + my $line=&scantron_get_line($scanlines,$scan_data,$which); + my ($skip,$err,$errmsg); + if ($env{'form.scantron_skip_record'}) { + $skip=1; + } elsif ($env{'form.scantron_corrections'} =~ /^(duplicate|incorrect)ID$/) { + my $newstudent=$env{'form.scantron_username'}.':'. + $env{'form.scantron_domain'}; + my $newid=$classlist->{$newstudent}->[&Apache::loncoursedata::CL_ID]; + ($line,$err,$errmsg)= + &scantron_fixup_scanline(\%scantron_config,$scan_data,$line,$which, + 'ID',{'newid'=>$newid, + 'username'=>$env{'form.scantron_username'}, + 'domain'=>$env{'form.scantron_domain'}}); + } elsif ($env{'form.scantron_corrections'} =~ /^(duplicate|incorrect)CODE$/) { + my $resolution=$env{'form.scantron_CODE_resolution'}; + my $newCODE; + my %args; + if ($resolution eq 'use_unfound') { + $newCODE='use_unfound'; + } elsif ($resolution eq 'use_found') { + $newCODE=$env{'form.scantron_CODE_selectedvalue'}; + } elsif ($resolution eq 'use_typed') { + $newCODE=$env{'form.scantron_CODE_newvalue'}; + } elsif ($resolution =~ /^use_closest_(\d+)/) { + $newCODE=$env{"form.scantron_CODE_closest_$1"}; + } + if ($env{'form.scantron_corrections'} eq 'duplicateCODE') { + $args{'CODE_ignore_dup'}=1; + } + $args{'CODE'}=$newCODE; + ($line,$err,$errmsg)= + &scantron_fixup_scanline(\%scantron_config,$scan_data,$line,$which, + 'CODE',\%args); + } elsif ($env{'form.scantron_corrections'} =~ /^(missing|double)bubble$/) { + foreach my $question (split(',',$env{'form.scantron_questions'})) { + ($line,$err,$errmsg)= + &scantron_fixup_scanline(\%scantron_config,$scan_data,$line, + $which,'answer', + { 'question'=>$question, + 'response'=>$env{"form.scantron_correct_Q_$question"}, + 'questionnum'=>$env{"form.scantron_questionnum_Q_$question"}}); + if ($err) { last; } + } + } + if ($err) { + $r->print("Unable to accept last correction, an error occurred :$errmsg:"); + } else { + &scantron_put_line($scanlines,$scan_data,$which,$line,$skip); + &scantron_putfile($scanlines,$scan_data); + } +} + +=pod + +=item reset_skipping_status + + Forgets the current set of remember skipped scanlines (and thus + reverts back to considering all lines in the + scantron_skipped_ '.&mt('List of CODES to validate against:').' | '.
+ $env{'form.scantron_CODElist'}.' | + +'.&mt('Please double check the information below before clicking on \'[_1]\'',&mt($button_text)).' + +
+ '.&mt('If this information is correct, please click on \'[_1]\'.',&mt($button_text)).' +'.&mt('If something is incorrect, please click the \'Grading Menu\' button to start over.').' + ++'); +} + +=pod + +=item scantron_do_warning + + Check if the operator has picked something for all required + fields. Error out if something is missing. + +=cut + +sub scantron_do_warning { + my ($r)=@_; + my ($symb)=&get_symb($r); + if (!$symb) {return '';} + my $default_form_data=&defaultFormData($symb); + $r->print(&scantron_form_start().$default_form_data); + if ( $env{'form.selectpage'} eq '' || + $env{'form.scantron_selectfile'} eq '' || + $env{'form.scantron_format'} eq '' ) { + $r->print(" ".&mt('You have forgetten to specify some information. Please go Back and try again.')." "); + if ( $env{'form.selectpage'} eq '') { + $r->print(''.&mt('You have not selected a Sequence to grade').' '); + } + if ( $env{'form.scantron_selectfile'} eq '') { + $r->print(''.&mt('You have not selected a file that contains the student\'s response data.').' '); + } + if ( $env{'form.scantron_format'} eq '') { + $r->print(''.&mt('You have not selected a the format of the student\'s response data.').' '); + } + } else { + my $warning=&scantron_warning_screen('Grading: Validate Records'); + $r->print(' +'.$warning.' + + +'); + } + $r->print("".&show_grading_menu_form($symb)); + return ''; +} + +=pod + +=item scantron_form_start + + html hidden input for remembering all selected grading options + +=cut + +sub scantron_form_start { + my ($max_bubble)=@_; + my $result= < '.&mt('Gathering necessary information.').' ');$r->rflush(); + #get the student pick code ready + $r->print(&Apache::loncommon::studentbrowser_javascript()); + my $nav_error; + my $max_bubble=&scantron_get_maxbubble(\$nav_error); + if ($nav_error) { + $r->print(&navmap_errormsg()); + return ''; + } + my $result=&scantron_form_start($max_bubble).$default_form_data; + $r->print($result); + + my @validate_phases=( 'sequence', + 'ID', + 'CODE', + 'doublebubble', + 'missingbubbles'); + if (!$env{'form.validatepass'}) { + $env{'form.validatepass'} = 0; + } + my $currentphase=$env{'form.validatepass'}; + + + my $stop=0; + while (!$stop && $currentphase < scalar(@validate_phases)) { + $r->print(&mt('Validating '.$validate_phases[$currentphase]).''); + $r->rflush(); + my $which="scantron_validate_".$validate_phases[$currentphase]; + { + no strict 'refs'; + ($stop,$currentphase)=&$which($r,$currentphase); + } + } + if (!$stop) { + my $warning=&scantron_warning_screen('Start Grading'); + $r->print(&mt('Validation process complete.').' '. + $warning. + &mt('Perform verification for each student after storage of submissions?'). + ' '. + (' 'x3).' '. + &mt('Grading will take longer if you use verification.').' '. + &mt("Alternatively, the 'Review bubblesheet data' utility (see grading menu) can be used for all students after grading is complete.").' '. + ''. + ''."\n"); + } else { + $r->print(''); + $r->print(""); + } + if ($stop) { + if ($validate_phases[$currentphase] eq 'sequence') { + $r->print(''); + $r->print(' '.&mt('this error').' '); + + $r->print(" ".&mt("Or click the 'Grading Menu' button to start over.")." "); + } else { + if ($validate_phases[$currentphase] eq 'doublebubble' || $validate_phases[$currentphase] eq 'missingbubbles') { + $r->print(''); + } else { + $r->print(''); + } + $r->print(' '.&mt('using corrected info').''); + $r->print(""); + $r->print(" ".&mt("this scanline saving it for later.")); + } + } + $r->print(" ".&show_grading_menu_form($symb)); + return ''; +} + + +=pod + +=item scantron_remove_file + + Removes the requested bubble sheet data file, makes sure that + scantron_original_ ".&mt('Some resources in the sequence currently are not set to exam mode. Grading these resources currently may not work correctly.')." "); + return (1,$currentphase); + } + } + + return (0,$currentphase+1); +} + + + +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,$scan_data)=&scantron_getfile(); + + my $nav_error; + &scantron_get_maxbubble(\$nav_error); # parse needs the bubble_lines.. array. + if ($nav_error) { + $r->print(&navmap_errormsg()); + return(1,$currentphase); + } + + my %found=('ids'=>{},'usernames'=>{}); + for (my $i=0;$i<=$scanlines->{'count'};$i++) { + my $line=&scantron_get_line($scanlines,$scan_data,$i); + if ($line=~/^[\s\cz]*$/) { next; } + my $scan_record=&scantron_parse_scanline($line,$i,\%scantron_config, + $scan_data); + my $id=$$scan_record{'scantron.ID'}; + my $found; + foreach my $checkid (keys(%idmap)) { + if (lc($checkid) eq lc($id)) { $found=$checkid;last; } + } + if ($found) { + my $username=$idmap{$found}; + if ($found{'ids'}{$found}) { + &scantron_get_correction($r,$i,$scan_record,\%scantron_config, + $line,'duplicateID',$found); + return(1,$currentphase); + } elsif ($found{'usernames'}{$username}) { + &scantron_get_correction($r,$i,$scan_record,\%scantron_config, + $line,'duplicateID',$username); + return(1,$currentphase); + } + #FIXME store away line we previously saw the ID on to use above + $found{'ids'}{$found}++; + $found{'usernames'}{$username}++; + } else { + if ($id =~ /^\s*$/) { + my $username=&scan_data($scan_data,"$i.user"); + if (defined($username) && $found{'usernames'}{$username}) { + &scantron_get_correction($r,$i,$scan_record, + \%scantron_config, + $line,'duplicateID',$username); + return(1,$currentphase); + } elsif (!defined($username)) { + &scantron_get_correction($r,$i,$scan_record, + \%scantron_config, + $line,'incorrectID'); + return(1,$currentphase); + } + $found{'usernames'}{$username}++; + } else { + &scantron_get_correction($r,$i,$scan_record,\%scantron_config, + $line,'incorrectID'); + return(1,$currentphase); + } + } + } + + return (0,$currentphase+1); +} + + +sub scantron_get_correction { + my ($r,$i,$scan_record,$scan_config,$line,$error,$arg)=@_; +#FIXME in the case of a duplicated ID the previous line, probably need +#to show both the current line and the previous one and allow skipping +#the previous one or the current one + + if ( $$scan_record{'scantron.PaperID'} =~ /\S/) { + $r->print("".&mt("An error was detected ($error)". + " for PaperID [_1]", + $$scan_record{'scantron.PaperID'})." \n"); + } else { + $r->print("".&mt("An error was detected ($error)". + " in scanline [_1] [_2]", + $i,$line)." \n"); + } + my $message=" ".&mt("The ID on the form is [_1] ".&mt("The encoded ID is not in the classlist"). + " \n"); + } elsif ($error eq 'duplicateID') { + $r->print("".&mt("The encoded ID has also been used by a previous paper [_1]",$arg)." \n"); + } + $r->print($message); + $r->print("".&mt("How should I handle this?")."
".&mt("The encoded CODE is not in the list of possible CODEs.")." \n"); + } elsif ($error eq 'duplicateCODE') { + $r->print("".&mt("The encoded CODE has also been used by a previous paper [_1], and CODEs are supposed to be unique.",join(', ',@{$arg}))." \n"); + } + $r->print("".&mt("The CODE on the form is '[_1]'",
+ $$scan_record{'scantron.CODE'})." ".&mt("How should I handle this?")." ".&mt("There have been multiple bubbles scanned for some question(s)")." ".&mt("Please indicate which bubble should be used for grading")." ".&mt("There have been no bubbles scanned for some question(s)")." ".&mt("Please indicate which bubble should be used for grading.")." ');
+ if ($scancode eq '') {
+ $r->print(&mt('Mismatch grading bubble sheet for user: [_1] with ID: [_2].',
+ $uname.':'.$udom,$scan_record->{'scantron.ID'}));
+ } else {
+ $r->print(&mt('Mismatch grading bubble sheet for user: [_1] with ID: [_2] and CODE: [_3].',
+ $uname.':'.$udom,$scan_record->{'scantron.ID'},$scancode));
+ }
+ $r->print(' '. + &mt('A second grading pass was needed for user: [_1] with ID: [_2], because a mismatch was seen on the first pass.',$uname.':'.$udom,$scan_record->{'scantron.ID'}).' '. + &mt("As a consequence, this user's submission history records two tries."). + ' '); + } + } + } + if (&Apache::loncommon::connection_aborted($r)) { last; } + } continue { + &Apache::lonxml::clear_problem_counter(); + &Apache::lonnet::delenv('scantron.'); + } + &Apache::lonhtmlcommon::Close_PrgWin($r,\%prog_state); + &Apache::lonnet::remove_lock($lock); +# my $lasttime = &Time::HiRes::time()-$start; +# $r->print(" took $lasttime "); + + $r->print(""); + $r->print(&show_grading_menu_form($symb)); + return ''; +} + +sub graders_resources_pass { + my ($resources,$grader_partids_by_symb,$grader_randomlists_by_symb) = @_; + if ((ref($resources) eq 'ARRAY') && (ref($grader_partids_by_symb)) && + (ref($grader_randomlists_by_symb) eq 'HASH')) { + foreach my $resource (@{$resources}) { + my $ressymb = $resource->symb(); + my ($analysis,$parts) = + &scantron_partids_tograde($resource,$env{'request.course.id'}, + $env{'user.name'},$env{'user.domain'},1); + $grader_partids_by_symb->{$ressymb} = $parts; + if (ref($analysis) eq 'HASH') { + if (ref($analysis->{'parts_withrandomlist'}) eq 'ARRAY') { + $grader_randomlists_by_symb->{$ressymb} = + $analysis->{'parts_withrandomlist'}; + } + } + } } - #FIXME - # if delay queue exists 2 submits one to process delayed students one - # to ignore delayed students, possibly saving the delay queue for later - - $navmap->untieHashes(); + return; +} + +sub grade_student_bubbles { + my ($r,$uname,$udom,$scan_record,$scancode,$resources,$parts) = @_; + if (ref($resources) eq 'ARRAY') { + my $count = 0; + foreach my $resource (@{$resources}) { + my $ressymb = $resource->symb(); + my %form = ('submitted' => 'scantron', + 'grade_target' => 'grade', + 'grade_username' => $uname, + 'grade_domain' => $udom, + 'grade_courseid' => $env{'request.course.id'}, + 'grade_symb' => $ressymb, + 'CODE' => $scancode + ); + if (ref($parts) eq 'HASH') { + if (ref($parts->{$ressymb}) eq 'ARRAY') { + foreach my $part (@{$parts->{$ressymb}}) { + $form{'scantron_questnum_start.'.$part} = + 1+$env{'form.scantron.first_bubble_line.'.$count}; + $count++; + } + } + } + my $result=&ssi_with_retries($resource->src(),$ssi_retries,%form); + return 'ssi_error' if ($ssi_error); + last if (&Apache::loncommon::connection_aborted($r)); + } + } + return; +} + +sub scantron_upload_scantron_data { + my ($r)=@_; + my $dom = $env{'request.role.domain'}; + my $domdesc = &Apache::lonnet::domain($dom,'description'); + $r->print(&Apache::loncommon::coursebrowser_javascript($dom)); + my $select_link=&Apache::loncommon::selectcourse_link('rules','courseid', + 'domainid', + 'coursename',$dom); + my $syllabuslink = ''.&mt('Syllabus').''. + (' 'x2).&mt('(shows course personnel)'); + my $default_form_data=&defaultFormData(&get_symb($r,1)); + my $nofile_alert = &mt('Please use the browse button to select a file from your local directory.'); + my $nocourseid_alert = &mt("Please use the 'Select Course' link to open a separate window where you can search for a course to which a file can be uploaded."); + $r->print(' + + +'.&mt('Send scanned bubblesheet data to a course').'+ ++ + + + "); + if ($symb) { + $r->print(&show_grading_menu_form($symb)); + } else { + $r->print($doanotherupload); + } + return ''; + } + my %coursedata=&Apache::lonnet::coursedescription($env{'form.domainid'}.'_'.$env{'form.courseid'}); + my $uploadedfile; + $r->print(' '.&mt("Uploading file to [_1]",$coursedata{'description'}).''); + if (length($env{'form.upfile'}) < 2) { + $r->print(&mt('[_1]Error:[_2] The file you attempted to upload, [_3] contained no information. Please check that you entered the correct filename.','','',''.&HTML::Entities::encode($env{'form.upfile.filename'},'<>&"').'')); + } else { + my $result = + &Apache::lonnet::userfileupload('upfile','','scantron','','','', + $env{'form.courseid'},$env{'form.domainid'}); + if ($result =~ m{^/uploaded/}) { + $r->print(&mt('[_1]Success:[_2] Successfully uploaded [_3] bytes of data into location: [_4]', + '','',(length($env{'form.upfile'})-1), + ''.$result.'')); + ($uploadedfile) = ($result =~ m{/([^/]+)$}); + $r->print(&validate_uploaded_scantron_file($env{'form.domainid'}, + $env{'form.courseid'},$uploadedfile)); + } else { + $r->print(&mt('[_1]Error:[_2] An error ([_3]) occurred when attempting to upload the file, [_4]', + '','',$result, + ''.&HTML::Entities::encode($env{'form.upfile.filename'},'<>&"').'')); + } + } + if ($symb) { + $r->print(&scantron_selectphase($r,$uploadedfile)); + } else { + $r->print($doanotherupload); + } + return ''; +} + +sub validate_uploaded_scantron_file { + my ($cdom,$cname,$fname) = @_; + my $scanlines=&Apache::lonnet::getfile('/uploaded/'.$cdom.'/'.$cname.'/'.$fname); + my @lines; + if ($scanlines ne '-1') { + @lines=split("\n",$scanlines,-1); + } + my $output; + if (@lines) { + my (%counts,$max_match_format); + my ($max_match_count,$max_match_pct) = (0,0); + my $classlist = &Apache::loncoursedata::get_classlist($cdom,$cname); + my %idmap = &username_to_idmap($classlist); + foreach my $key (keys(%idmap)) { + my $lckey = lc($key); + $idmap{$lckey} = $idmap{$key}; + } + my %unique_formats; + my @formatlines = &get_scantronformat_file(); + foreach my $line (@formatlines) { + chomp($line); + my @config = split(/:/,$line); + my $idstart = $config[5]; + my $idlength = $config[6]; + if (($idstart ne '') && ($idlength > 0)) { + if (ref($unique_formats{$idstart.':'.$idlength}) eq 'ARRAY') { + push(@{$unique_formats{$idstart.':'.$idlength}},$config[0].':'.$config[1]); + } else { + $unique_formats{$idstart.':'.$idlength} = [$config[0].':'.$config[1]]; + } + } + } + foreach my $key (keys(%unique_formats)) { + my ($idstart,$idlength) = split(':',$key); + %{$counts{$key}} = ( + 'found' => 0, + 'total' => 0, + ); + foreach my $line (@lines) { + next if ($line =~ /^#/); + next if ($line =~ /^[\s\cz]*$/); + my $id = substr($line,$idstart-1,$idlength); + $id = lc($id); + if (exists($idmap{$id})) { + $counts{$key}{'found'} ++; + } + $counts{$key}{'total'} ++; + } + if ($counts{$key}{'total'}) { + my $percent_match = (100*$counts{$key}{'found'})/($counts{$key}{'total'}); + if (($max_match_format eq '') || ($percent_match > $max_match_pct)) { + $max_match_pct = $percent_match; + $max_match_format = $key; + $max_match_count = $counts{$key}{'total'}; + } + } + } + if (ref($unique_formats{$max_match_format}) eq 'ARRAY') { + my $format_descs; + my $numwithformat = @{$unique_formats{$max_match_format}}; + for (my $i=0; $i<$numwithformat; $i++) { + my ($name,$desc) = split(':',$unique_formats{$max_match_format}[$i]); + if ($i<$numwithformat-2) { + $format_descs .= '"'.$desc.'", '; + } elsif ($i==$numwithformat-2) { + $format_descs .= '"'.$desc.'" '.&mt('and').' '; + } elsif ($i==$numwithformat-1) { + $format_descs .= '"'.$desc.'"'; + } + } + my $showpct = sprintf("%.0f",$max_match_pct).'%'; + $output .= ''.&mt('Comparison of student IDs in the uploaded file with the course roster found matches for [_1] of the [_2] entries in the file (for the format defined for [_3]).',''.$showpct.'',''.$max_match_count.'',$format_descs). + ' '.&mt('A low percentage of matches results from one of the following:').'
+ '.&mt('The requested file name was invalid.').' + +'); + $r->print(&show_grading_menu_form(&get_symb($r,1))); + return; + } + my $orig='/uploaded/'.$cdom.'/'.$cname.'/scantron_orig_'.$file; + my $corrected='/uploaded/'.$cdom.'/'.$cname.'/scantron_corrected_'.$file; + my $skipped='/uploaded/'.$cdom.'/'.$cname.'/scantron_skipped_'.$file; + &Apache::lonnet::allowuploaded('/adm/grades',$orig); + &Apache::lonnet::allowuploaded('/adm/grades',$corrected); + &Apache::lonnet::allowuploaded('/adm/grades',$skipped); + $r->print(' ++ '.&mt('[_1]Original[_2] file as uploaded by the scantron office.', + '','').' + ++ '.&mt('[_1]Corrections[_2], a file of corrected records that were used in grading.', + '','').' + ++ '.&mt('[_1]Skipped[_2], a file of records that were skipped.', + '','').' + +'); + $r->print(&show_grading_menu_form(&get_symb($r,1))); + return ''; +} + +sub checkscantron_results { + my ($r) = @_; + my ($symb)=&get_symb($r); + if (!$symb) {return '';} + my $grading_menu_button=&show_grading_menu_form($symb); + my $cid = $env{'request.course.id'}; + my %lettdig = &letter_to_digits(); + 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(); + unless (ref($navmap)) { + $r->print(&navmap_errormsg()); + return ''; + } + my $map=$navmap->getResourceByUrl($sequence); + my @resources=$navmap->retrieveResources($map,\&scantron_filter,1,0); + my (%grader_partids_by_symb,%grader_randomlists_by_symb); + &graders_resources_pass(\@resources,\%grader_partids_by_symb, \%grader_randomlists_by_symb); + + my ($uname,$udom); + my (%scandata,%lastname,%bylast); + $r->print(' +'); + my ($okstudents,$badstudents,$numstudents,$passed,$failed); + $passed = 0; + $failed = 0; + $numstudents = 0; + foreach my $last (sort(keys(%bylast))) { + if (ref($bylast{$last}) eq 'ARRAY') { + foreach my $pid (sort(@{$bylast{$last}})) { + my $showscandata = $scandata{$pid}; + my $showrecord = $record{$pid}; + $showscandata =~ s/\s/ /g; + $showrecord =~ s/\s/ /g; + if ($scandata{$pid} eq $record{$pid}) { + my $css_class = ($passed % 2)?'LC_odd_row':'LC_even_row'; + $okstudents .= ' '.&mt('Bubblesheet').' | '.$showscandata.' | '.$last.' | '.$pid.' | '."\n".
+'Submissions | '.$showrecord.' | '.&mt('Bubblesheet').' | '.$scandata{$pid}.' | '.$last.' | '.$pid.' | '."\n".
+'Submissions | '.$record{$pid}.' | '."\n".
+''.&mt('Comparison of bubblesheet data (including corrections) with corresponding submission records (most recent submission) for [quant,_1,student] ([_2] scantron lines/student).',$numstudents,$env{'form.scantron_maxbubble'}).' '); + $r->print(''.&mt('Exact matches for [quant,_1,student].',$passed).' '); + $r->print(&Apache::loncommon::start_data_table()."\n". + &Apache::loncommon::start_data_table_header_row()."\n". + ' '.&mt('Source').' | '.&mt('Bubble records').' | '.&mt('Name').' | '.&mt('ID').' | '.
+ &Apache::loncommon::end_data_table_header_row()."\n".
+ $okstudents."\n".
+ &Apache::loncommon::end_data_table().''); + } + if ($failed) { + $r->print(&mt('Students with differences between bubblesheet data and submissions are as follows:').' '); + $r->print(&Apache::loncommon::start_data_table()."\n". + &Apache::loncommon::start_data_table_header_row()."\n". + ' '.&mt('Source').' | '.&mt('Bubble records').' | '.&mt('Name').' | '.&mt('ID').' | '.
+ &Apache::loncommon::end_data_table_header_row()."\n".
+ $badstudents."\n".
+ &Apache::loncommon::end_data_table()).''. + &mt('Differences can occur if submissions were modified using manual grading after a bubblesheet grading pass.').' '.&mt('If unexpected discrepancies were detected, it is recommended that you inspect the original bubblesheets.'); + } + $r->print(' '.$grading_menu_button); + return; } + +sub verify_scantron_grading { + my ($resource,$domain,$username,$cid,$counter,$scandata,$partids, + $scantron_config,$lettdig,$numletts) = @_; + my ($record,%expected,%startpos); + return ($counter,$record) if (!ref($resource)); + return ($counter,$record) if (!$resource->is_problem()); + my $symb = $resource->symb(); + return ($counter,$record) if (ref($partids) ne 'ARRAY'); + foreach my $part_id (@{$partids}) { + $counter ++; + $expected{$part_id} = 0; + 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++) { + for (my $j=0; $j<$scantron_config->{'length'}; $j++) { + $recorded{$part_id} .= $scantron_config->{'Qoff'}; + } + } + } 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,$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 { + @tocheck = @items; + for (my $i=0; $i<$expected{$part_id}; $i++) { + 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); + } + for (my $j=0; $j<$scantron_config->{'Qlength'}; $j++) { + if ($j == $digit) { + $recorded{$part_id} .= $scantron_config->{'Qon'}; + } else { + $recorded{$part_id} .= $scantron_config->{'Qoff'}; + } + } + } + } + } + } + } + } + foreach my $part_id (@{$partids}) { + 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 .= $recorded{$part_id}; + } + } + return ($counter,$record); +} + +sub letter_to_digits { + my %lettdig = ( + A => 1, + B => 2, + C => 3, + D => 4, + E => 5, + F => 6, + G => 7, + H => 8, + I => 9, + J => 0, + ); + return %lettdig; +} + + #-------- end of section for handling grading scantron forms ------- # #------------------------------------------------------------------- - #-------------------------- Menu interface ------------------------- # #--- Show a Grading Menu button - Calls the next routine --- sub show_grading_menu_form { - my ($symb,$url)=@_; + my ($symb)=@_; my $result.=' '.&mt('Please select a grading task').''; + $Str .= ''. + &Apache::lonnet::recprefix($env{'request.course.id'}). + '-'; + + $Str .=" Manual Grading/View Submission'; - my ($table,undef,$hdgrade) = &showResourceInfo($url,$probTitle); - $result.=$table; + my ($table,undef,$hdgrade) = &showResourceInfo($symb,$probTitle); + my $result; my (undef,$sections) = &getclasslist('all','0'); my $savedState = &savedState(); my $saveCmd = ($$savedState{'saveCmd'} eq '' ? 'submission' : $$savedState{'saveCmd'}); @@ -3494,9 +8644,17 @@ GRADINGMENUJS my $saveSub = ($$savedState{'saveSub'} eq '' ? 'all' : $$savedState{'saveSub'}); my $saveStatus = ($$savedState{'saveStatus'} eq '' ? 'Active' : $$savedState{'saveStatus'}); + # Preselect sections + my $selsec=""; + if (ref($sections)) { + foreach my $section (sort(@$sections)) { + $selsec.=''."\n"; + } + } + $result.='
'."\n"; + $result.=&show_grading_menu_form($symb); return $result; } +sub process_clicker_file { + my ($r)=@_; + my ($symb)=&get_symb($r); + if (!$symb) {return '';} + + my %Saveable_Parameters=&clicker_grading_parameters(); + &Apache::loncommon::store_course_settings('grades_clicker', + \%Saveable_Parameters); + + my ($result) = &showResourceInfo($symb,$env{'form.probTitle'}); + if (($env{'form.gradingmechanism'} eq 'specific') && ($env{'form.specificid'}!~/\w/)) { + $result.=''.&mt('You need to specify a clicker ID for the correct answer').''; + return $result.&show_grading_menu_form($symb); + } + if (($env{'form.gradingmechanism'} eq 'given') && ($env{'form.givenanswer'}!~/\S/)) { + $result.=''.&mt('You need to specify the correct answer').''; + return $result.&show_grading_menu_form($symb); + } + my $foundgiven=0; + if ($env{'form.gradingmechanism'} eq 'given') { + $env{'form.givenanswer'}=~s/^\s*//gs; + $env{'form.givenanswer'}=~s/\s*$//gs; + $env{'form.givenanswer'}=~s/[^a-zA-Z0-9\.\*\-]+/\,/g; + $env{'form.givenanswer'}=uc($env{'form.givenanswer'}); + my @answers=split(/\,/,$env{'form.givenanswer'}); + $foundgiven=$#answers+1; + } + my %clicker_ids=&gather_clicker_ids(); + my %correct_ids; + if ($env{'form.gradingmechanism'} eq 'personnel') { + %correct_ids=&gather_adv_clicker_ids(); + } + if ($env{'form.gradingmechanism'} eq 'specific') { + foreach my $correct_id (split(/[\s\,]/,$env{'form.specificid'})) {; + $correct_id=~tr/a-z/A-Z/; + $correct_id=~s/\s//gs; + $correct_id=~s/^[\#0]+//; + $correct_id=~s/[\-\:]//g; + if ($correct_id) { + $correct_ids{$correct_id}='specified'; + } + } + } + if ($env{'form.gradingmechanism'} eq 'attendance') { + $result.=&mt('Score based on attendance only'); + } elsif ($env{'form.gradingmechanism'} eq 'given') { + $result.=&mt('Score based on [_1] ([_2] answers)',''.$env{'form.givenanswer'}.'',$foundgiven); + } else { + my $number=0; + $result.=' '.&mt('Correctness determined by the following IDs').'';
+ foreach my $id (sort(keys(%correct_ids))) {
+ $result.='
'."\n"; + return $result.&show_grading_menu_form($symb); +} + +sub iclicker_eval { + my ($questiontitles,$responses)=@_; + my $number=0; + my $errormsg=''; + foreach my $line (split(/[\n\r]/,$env{'form.upfile'})) { + my %components=&Apache::loncommon::record_sep($line); + my @entries=map {$components{$_}} (sort(keys(%components))); + if ($entries[0] eq 'Question') { + for (my $i=3;$i<$#entries;$i+=6) { + $$questiontitles[$number]=$entries[$i]; + $number++; + } + } + if ($entries[0]=~/^\#/) { + my $id=$entries[0]; + my @idresponses; + $id=~s/^[\#0]+//; + for (my $i=0;$i<$number;$i++) { + my $idx=3+$i*6; + push(@idresponses,$entries[$idx]); + } + $$responses{$id}=join(',',@idresponses); + } + } + return ($errormsg,$number); +} + +sub interwrite_eval { + my ($questiontitles,$responses)=@_; + my $number=0; + my $errormsg=''; + my $skipline=1; + my $questionnumber=0; + my %idresponses=(); + foreach my $line (split(/[\n\r]/,$env{'form.upfile'})) { + my %components=&Apache::loncommon::record_sep($line); + my @entries=map {$components{$_}} (sort(keys(%components))); + if ($entries[1] eq 'Time') { $skipline=0; next; } + if ($entries[1] eq 'Response') { $skipline=1; } + next if $skipline; + if ($entries[0]!=$questionnumber) { + $questionnumber=$entries[0]; + $$questiontitles[$number]=&mt('Question [_1]',$questionnumber); + $number++; + } + my $id=$entries[4]; + $id=~s/^[\#0]+//; + $id=~s/^v\d*\://i; + $id=~s/[\-\:]//g; + $idresponses{$id}[$number]=$entries[6]; + } + foreach my $id (keys(%idresponses)) { + $$responses{$id}=join(',',@{$idresponses{$id}}); + $$responses{$id}=~s/^\s*\,//; + } + return ($errormsg,$number); +} + +sub assign_clicker_grades { + my ($r)=@_; + my ($symb)=&get_symb($r); + if (!$symb) {return '';} +# See which part we are saving to + my $res_error; + my ($partlist,$handgrade,$responseType) = &response_type($symb,\$res_error); + if ($res_error) { + return &navmap_errormsg(); + } +# FIXME: This should probably look for the first handgradeable part + my $part=$$partlist[0]; +# Start screen output + my ($result) = &showResourceInfo($symb,$env{'form.probTitle'}); + + my $heading=&mt('Assigning grades based on clicker file'); + $result.=(<
'."\n"; + return $result.&show_grading_menu_form($symb); +} + +sub navmap_errormsg { + return ' '.
+ &mt('An error occurred retrieving information about resources in the course.').' ';
+}
+
sub handler {
my $request=$_[0];
-
- undef(%perm);
- if ($ENV{'browser.mathml'}) {
- $request->content_type('text/xml');
+ &reset_caches();
+ if ($env{'browser.mathml'}) {
+ &Apache::loncommon::content_type($request,'text/xml');
} else {
- $request->content_type('text/html');
+ &Apache::loncommon::content_type($request,'text/html');
}
$request->send_http_header;
return '' if $request->header_only;
&Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'});
- my $url=$ENV{'form.url'};
- my $symb=$ENV{'form.symb'};
- my $command=$ENV{'form.command'};
- if (!$url) {
- my ($temp1,$temp2);
- ($temp1,$temp2,$ENV{'form.url'})=split(/___/,$symb);
- $url = $ENV{'form.url'};
- }
- &send_header($request);
- if ($url eq '' && $symb eq '') {
- if ($ENV{'user.adv'}) {
- if (($ENV{'form.codeone'}) && ($ENV{'form.codetwo'}) &&
- ($ENV{'form.codethree'})) {
- my $token=$ENV{'form.codeone'}.'*'.$ENV{'form.codetwo'}.'*'.
- $ENV{'form.codethree'};
+ my $symb=&get_symb($request,1);
+ my @commands=&Apache::loncommon::get_env_multiple('form.command');
+ my $command=$commands[0];
+
+ if ($#commands > 0) {
+ &Apache::lonnet::logthis("grades got multiple commands ".join(':',@commands));
+ }
+
+ $ssi_error = 0;
+ my $brcrum = [{href=>"/adm/grades",text=>"Grading"}];
+ $request->print(&Apache::loncommon::start_page('Grading',undef,
+ {'bread_crumbs' => $brcrum}));
+ if ($symb eq '' && $command eq '') {
+ if ($env{'user.adv'}) {
+ if (($env{'form.codeone'}) && ($env{'form.codetwo'}) &&
+ ($env{'form.codethree'})) {
+ my $token=$env{'form.codeone'}.'*'.$env{'form.codetwo'}.'*'.
+ $env{'form.codethree'};
my ($tsymb,$tuname,$tudom,$tcrsid)=
&Apache::lonnet::checkin($token);
if ($tsymb) {
- my ($map,$id,$url)=split(/\_\_\_/,$tsymb);
+ my ($map,$id,$url)=&Apache::lonnet::decode_symb($tsymb);
if (&Apache::lonnet::allowed('mgr',$tcrsid)) {
- $request->print(&Apache::lonnet::ssi_body('/res/'.$url,
+ $request->print(&ssi_with_retries('/res/'.$url, $ssi_retries,
('grade_username' => $tuname,
'grade_domain' => $tudom,
'grade_courseid' => $tcrsid,
@@ -3622,23 +9349,9 @@ sub handler {
}
}
} else {
- if (!($perm{'vgr'}=&Apache::lonnet::allowed('vgr',$ENV{'request.course.id'}))) {
- if ($perm{'vgr'}=&Apache::lonnet::allowed('vgr',$ENV{'request.course.id'}.'/'.$ENV{'request.course.sec'})) {
- $perm{'vgr_section'}=$ENV{'request.course.sec'};
- } else {
- delete($perm{'vgr'});
- }
- }
- if (!($perm{'mgr'}=&Apache::lonnet::allowed('mgr',$ENV{'request.course.id'}))) {
- if ($perm{'mgr'}=&Apache::lonnet::allowed('mgr',$ENV{'request.course.id'}.'/'.$ENV{'request.course.sec'})) {
- $perm{'mgr_section'}=$ENV{'request.course.sec'};
- } else {
- delete($perm{'mgr'});
- }
- }
-
+ &init_perm();
if ($command eq 'submission' && $perm{'vgr'}) {
- ($ENV{'form.student'} eq '' ? &listStudents($request) : &submission($request,0,0));
+ ($env{'form.student'} eq '' ? &listStudents($request) : &submission($request,0,0));
} elsif ($command eq 'pickStudentPage' && $perm{'vgr'}) {
&pickStudentPage($request);
} elsif ($command eq 'displayPage' && $perm{'vgr'}) {
@@ -3648,7 +9361,9 @@ sub handler {
} elsif ($command eq 'processGroup' && $perm{'vgr'}) {
&processGroup($request);
} elsif ($command eq 'gradingmenu' && $perm{'vgr'}) {
- $request->print(&gradingmenu($request));
+ $request->print(&grading_menu($request));
+ } elsif ($command eq 'submit_options' && $perm{'vgr'}) {
+ $request->print(&submit_options($request));
} elsif ($command eq 'viewgrades' && $perm{'vgr'}) {
$request->print(&viewgrades($request));
} elsif ($command eq 'handgrade' && $perm{'mgr'}) {
@@ -3657,52 +9372,235 @@ sub handler {
$request->print(&editgrades($request));
} elsif ($command eq 'verify' && $perm{'vgr'}) {
$request->print(&verifyreceipt($request));
+ } elsif ($command eq 'processclicker' && $perm{'mgr'}) {
+ $request->print(&process_clicker($request));
+ } elsif ($command eq 'processclickerfile' && $perm{'mgr'}) {
+ $request->print(&process_clicker_file($request));
+ } elsif ($command eq 'assignclickergrades' && $perm{'mgr'}) {
+ $request->print(&assign_clicker_grades($request));
} elsif ($command eq 'csvform' && $perm{'mgr'}) {
$request->print(&upcsvScores_form($request));
} elsif ($command eq 'csvupload' && $perm{'mgr'}) {
$request->print(&csvupload($request));
} elsif ($command eq 'csvuploadmap' && $perm{'mgr'} ) {
$request->print(&csvuploadmap($request));
- } elsif ($command eq 'csvuploadassign' && $perm{'mgr'}) {
- if ($ENV{'form.associate'} ne 'Reverse Association') {
- $request->print(&csvuploadassign($request));
+ } elsif ($command eq 'csvuploadoptions' && $perm{'mgr'}) {
+ if ($env{'form.associate'} ne 'Reverse Association') {
+ $request->print(&csvuploadoptions($request));
} else {
- if ( $ENV{'form.upfile_associate'} ne 'reverse' ) {
- $ENV{'form.upfile_associate'} = 'reverse';
+ if ( $env{'form.upfile_associate'} ne 'reverse' ) {
+ $env{'form.upfile_associate'} = 'reverse';
} else {
- $ENV{'form.upfile_associate'} = 'forward';
+ $env{'form.upfile_associate'} = 'forward';
}
$request->print(&csvuploadmap($request));
}
+ } elsif ($command eq 'csvuploadassign' && $perm{'mgr'} ) {
+ $request->print(&csvuploadassign($request));
} elsif ($command eq 'scantron_selectphase' && $perm{'mgr'}) {
$request->print(&scantron_selectphase($request));
+ } elsif ($command eq 'scantron_warning' && $perm{'mgr'}) {
+ $request->print(&scantron_do_warning($request));
+ } elsif ($command eq 'scantron_validate' && $perm{'mgr'}) {
+ $request->print(&scantron_validate_file($request));
} elsif ($command eq 'scantron_process' && $perm{'mgr'}) {
$request->print(&scantron_process_students($request));
+ } elsif ($command eq 'scantronupload' &&
+ (&Apache::lonnet::allowed('usc',$env{'request.role.domain'})||
+ &Apache::lonnet::allowed('usc',$env{'request.course.id'}))) {
+ $request->print(&scantron_upload_scantron_data($request));
+ } elsif ($command eq 'scantronupload_save' &&
+ (&Apache::lonnet::allowed('usc',$env{'request.role.domain'})||
+ &Apache::lonnet::allowed('usc',$env{'request.course.id'}))) {
+ $request->print(&scantron_upload_scantron_data_save($request));
+ } elsif ($command eq 'scantron_download' &&
+ &Apache::lonnet::allowed('usc',$env{'request.course.id'})) {
+ $request->print(&scantron_download_scantron_data($request));
+ } elsif ($command eq 'checksubmissions' && $perm{'vgr'}) {
+ $request->print(&checkscantron_results($request));
} elsif ($command) {
- $request->print("Access Denied");
+ $request->print(''. + &mt('It is recommended that you [_1]re-initialize the course[_2] and then return to this grading page..','',''). + ' '.&mt('Access Denied ([_1])',$command).' '); } } - &send_footer($request); + if ($ssi_error) { + &ssi_print_error($request); + } + $request->print(&Apache::loncommon::end_page()); + &reset_caches(); return ''; } -sub send_header { - my ($request)= @_; - $request->print(&Apache::lontexconvert::header()); -# $request->print(" -#"); - $request->print(&Apache::loncommon::bodytag('Grading')); -} - -sub send_footer { - my ($request)= @_; - $request->print(''); - $request->print(&Apache::lontexconvert::footer()); -} - 1; __END__; + + +=head1 NAME + +Apache::grades + +=head1 SYNOPSIS + +Handles the viewing of grades. + +This is part of the LearningOnline Network with CAPA project +described at http://www.lon-capa.org. + +=head1 OVERVIEW + +Do an ssi with retries: +While I'd love to factor out this with the vesrion in lonprintout, +that would either require a data coupling between modules, which I refuse to perpetuate (there's quite enough of that already), or would require the invention of another infrastructure +I'm not quite ready to invent (e.g. an ssi_with_retry object). + +At least the logic that drives this has been pulled out into loncommon. + + + +ssi_with_retries - Does the server side include of a resource. + if the ssi call returns an error we'll retry it up to + the number of times requested by the caller. + If we still have a proble, no text is appended to the + output and we set some global variables. + to indicate to the caller an SSI error occurred. + All of this is supposed to deal with the issues described + in LonCAPA BZ 5631 see: + http://bugs.lon-capa.org/show_bug.cgi?id=5631 + by informing the user that this happened. + +Parameters: + resource - The resource to include. This is passed directly, without + interpretation to lonnet::ssi. + form - The form hash parameters that guide the interpretation of the resource + + retries - Number of retries allowed before giving up completely. +Returns: + On success, returns the rendered resource identified by the resource parameter. +Side Effects: + The following global variables can be set: + ssi_error - If an unrecoverable error occurred this becomes true. + It is up to the caller to initialize this to false + if desired. + ssi_error_resource - If an unrecoverable error occurred, this is the value + of the resource that could not be rendered by the ssi + call. + ssi_error_message - The error string fetched from the ssi response + in the event of an error. + + +=head1 HANDLER SUBROUTINE + +ssi_with_retries() + +=head1 SUBROUTINES + +=over + +=item scantron_get_correction() : + + Builds the interface screen to interact with the operator to fix a + specific error condition in a specific scanline + + Arguments: + $r - Apache request object + $i - number of the current scanline + $scan_record - hash ref as returned from &scantron_parse_scanline() + $scan_config - hash ref as returned from &get_scantron_config() + $line - full contents of the current scanline + $error - error condition, valid values are + 'incorrectCODE', 'duplicateCODE', + 'doublebubble', 'missingbubble', + 'duplicateID', 'incorrectID' + $arg - extra information needed + For errors: + - duplicateID - paper number that this studentID was seen before on + - duplicateCODE - array ref of the paper numbers this CODE was + seen on before + - incorrectCODE - current incorrect CODE + - doublebubble - array ref of the bubble lines that have double + bubble errors + - missingbubble - array ref of the bubble lines that have missing + bubble errors + +=item scantron_get_maxbubble() : + + Arguments: + $nav_error - Reference to scalar which is a flag to indicate a + failure to retrieve a navmap object. + if $nav_error is set to 1 by scantron_get_maxbubble(), the + calling routine should trap the error condition and display the warning + found in &navmap_errormsg(). + + Returns the maximum number of bubble lines that are expected to + occur. Does this by walking the selected sequence rendering the + resource and then checking &Apache::lonxml::get_problem_counter() + for what the current value of the problem counter is. + + Caches the results to $env{'form.scantron_maxbubble'}, + $env{'form.scantron.bubble_lines.n'}, + $env{'form.scantron.first_bubble_line.n'} and + $env{"form.scantron.sub_bubblelines.n"} + which are the total number of bubble, lines, the number of bubble + lines for response n and number of the first bubble line for response n, + and a comma separated list of numbers of bubble lines for sub-questions + (for optionresponse, matchresponse, and rankresponse items), for response n. + + +=item scantron_validate_missingbubbles() : + + Validates all scanlines in the selected file to not have any + answers that don't have bubbles that have not been verified + to be bubble free. + +=item scantron_process_students() : + + Routine that does the actual grading of the bubble sheet information. + + The parsed scanline hash is added to %env + + Then foreach unskipped scanline it does an &Apache::lonnet::ssi() + foreach resource , with the form data of + + 'submitted' =>'scantron' + 'grade_target' =>'grade', + 'grade_username'=> username of student + 'grade_domain' => domain of student + 'grade_courseid'=> of course + 'grade_symb' => symb of resource to grade + + This triggers a grading pass. The problem grading code takes care + of converting the bubbled letter information (now in %env) into a + valid submission. + +=item scantron_upload_scantron_data() : + + Creates the screen for adding a new bubble sheet data file to a course. + +=item scantron_upload_scantron_data_save() : + + Adds a provided bubble information data file to the course if user + has the correct privileges to do so. + +=item valid_file() : + + Validates that the requested bubble data file exists in the course. + +=item scantron_download_scantron_data() : + + Shows a list of the three internal files (original, corrected, + skipped) for a specific bubble sheet data file that exists in the + course. + +=item scantron_validate_ID() : + + Validates all scanlines in the selected file to not have any + invalid or underspecified student/employee IDs + +=item navmap_errormsg() : + + Returns HTML mark-up inside a with a link to re-initialize the course. + Should be called whenever the request to instantiate a navmap object fails. + +=back + +=cut |
---|