--- loncom/homework/grades.pm 2003/09/29 20:58:50 1.130.2.1.2.5
+++ loncom/homework/grades.pm 2012/08/09 23:25:48 1.596.2.13
@@ -1,7 +1,7 @@
# The LearningOnline Network with CAPA
# The LON-CAPA Grading handler
#
-# $Id: grades.pm,v 1.130.2.1.2.5 2003/09/29 20:58:50 albertel Exp $
+# $Id: grades.pm,v 1.596.2.13 2012/08/09 23:25:48 raeburn 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,55 +37,104 @@ 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::Constants qw(:common);
+use Apache::lonmsg();
+use Apache::Constants qw(:common :http);
+use Apache::lonlocal;
+use Apache::lonenc;
+use Apache::bridgetask();
use String::Similarity;
+use LONCAPA;
+
+use POSIX qw(floor);
+
+
-my %oldessays=();
my %perm=();
+my %old_essays=();
-# ----- 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(); + &reset_old_essays(); +} + +{ + 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,$type,$trial,$rndseed)=@_; + my $key = "$symb\0$uname\0$udom"; + if ($type eq 'randomizetry') { + if ($trial ne '') { + $key .= "\0".$trial; + } + } + 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 ($type eq 'randomizetry') { + $form{'grade_questiontype'} = $type; + if ($rndseed ne '') { + $form{'grade_rndseed'} = $rndseed; + } + } + 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,$type,$trial,$rndseed)=@_; + my $analyze = &get_analyze($symb,$uname,$udom,$no_increment,undef,$type,$trial,$rndseed); + return $analyze->{"$partid.$respid.shown"}; + } + + sub get_radiobutton_correct_foil { + my ($partid,$respid,$symb,$uname,$udom,$type,$trial,$rndseed)=@_; + my $analyze = &get_analyze($symb,$uname,$udom,undef,undef,$type,$trial,$rndseed); + my $foils = &get_order($partid,$respid,$symb,$uname,$udom,undef,$type,$trial,$rndseed); + 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,$type,$trial,$rndseed); + 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').' '. + $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); @@ -2611,47 +4147,123 @@ 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 @warnings; 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]; @@ -2659,34 +4271,82 @@ 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'; + if ($pcr>1) { + push(@warnings,&mt("[_1]: point value larger than weight","$username:$domain")); + } + $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('.'); +# Remove from grading queue + &Apache::bridgetask::remove_from_queue('gradingqueue',$symb, + $env{'course.'.$env{'request.course.id'}.'.domain'}, + $env{'course.'.$env{'request.course.id'}.'.num'}, + $domain,$username); + } 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(''.&Apache::lonhtmlcommon::confirm_success(&mt("Saved scores for [quant,_1,student]",$countdone),$countdone==0)); + if (@warnings) { + $request->print(' '.&Apache::lonhtmlcommon::confirm_success(&mt('Warnings generated for the following saved scores:'),1).' '); + $request->print(join(', ',@warnings)); } - $request->print(" Stored $countdone students\n"); 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 --------- # @@ -2698,12 +4358,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+)\.(.*)/); @@ -2746,78 +4416,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; } @@ -2826,55 +4517,83 @@ 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=' |
'.
- '
'.$ENV{'form.title'}.''; - $result.=' Student: '.&nameUserString(undef,$ENV{'form.fullname'},$uname,$udom).
+ my $result=' |
'.
- '
|
-
|
-
'.$line.''); + my $where=$length*($args->{'question'}-1)+$scantron_config->{'Qstart'}; substr($line,$where-1,$length)=$answer; - Apache->request->print('a:
'.$line.''); } 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'}; + my ($scan_data,$key,$value,$delete)=@_; + my $filename=$env{'form.scantron_selectfile'}; if (defined($value)) { $scan_data->{$filename.'_'.$key} = $value; } @@ -3317,15 +5761,117 @@ sub scan_data { 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 + + (
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; } -#FIXME I think I am doing this in the wrong order, I think it would be -#better to make a several passes analyzing all of the lines in the -#file for common errors wrong/invalid PID/username duplicated -#PID/username, missing bubbles, double bubbles, missing/invalid CODE -#and then get the instructor to fix all of these errors, then grade -#the corrected one, I'll still need to catch error conditions, but -#maybe most will taken care even before we start +=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 %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,$which); + 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'}) { + 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'}; + } 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,'ID', - $newid); - } elsif ($ENV{'form.scantron_corrections'} =~ /^(missing|double)bubble$/) { - foreach my $question (split(',',$ENV{'form.scantron_questions'})) { + &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, - 'answer',$question, - $ENV{"form.scantron_correct_Q_$question"}); + $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:"); + $r->print("Unable to accept last correction, an error occurred :$errmsg:"); } else { - &scantron_put_line($scanlines,$which,$line,$skip); + &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('Please double check the information below before clicking on \'[_1]\'',&mt($button_text)).' +
+'.&mt('Sequence to be Graded:').' | '.$title.' |
'.&mt('Data File that will be used:').' | '.$env{'form.scantron_selectfile'}.' |
'.&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.').'
+ +".&mt('You have forgotten 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 the format of the student's response data.").'
'); + } + } else { + my $warning=&scantron_warning_screen('Grading: Validate Records'); + $r->print(' +'.$warning.' + + +'); + } + $r->print("'.&mt('Gathering necessary information.').'
');$r->rflush(); #get the student pick code ready $r->print(&Apache::loncommon::studentbrowser_javascript()); - my $result= <".&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').'".&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) = @_; @@ -3579,128 +6969,627 @@ sub scantron_validate_ID { my %idmap=&username_to_idmap($classlist); #get scantron line setup - my %scantron_config=&get_scantron_config($ENV{'form.scantron_format'}); + 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,$i); - if (!$line) { next; } - my $scan_record=&scantron_parse_scanline($line,\%scantron_config,$scan_data); + 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'}; - $r->print("Checking ID ".$$scan_record{'scantron.ID'}. - " on paper ID ".$$scan_record{'scantron.PaperID'}."
\n"); my $found; foreach my $checkid (keys(%idmap)) { - if (lc($checkid) eq lc($id)) { - if ($checkid ne $id) { - $r->print("Using $checkid for encoded $id
\n"); - } - $found=$checkid;last; - } + if (lc($checkid) eq lc($id)) { $found=$checkid;last; } } if ($found) { + my $username=$idmap{$found}; if ($found{'ids'}{$found}) { - #FIXME store away line we prviously saw the ID on &scantron_get_correction($r,$i,$scan_record,\%scantron_config, $line,'duplicateID',$found); - return(1); - } else { - $found{'ids'}{$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 { - &scantron_get_correction($r,$i,$scan_record,\%scantron_config, - $line,'incorrectID'); - return(1); + 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, probaly need +#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 - $r->print("This scantron record has an error ($error). "); - if ( defined($$scan_record{'scantron.PaperID'}) ) { - $r->print("The current PaperID is ". - $$scan_record{'scantron.PaperID'}." \n"); + if ( $$scan_record{'scantron.PaperID'} =~ /\S/) { + $r->print( + '
' + .&mt('An error was detected ([_1]) for PaperID [_2]', + "$error", + ''.$$scan_record{'scantron.PaperID'}.'') + ."
\n"); } else { - $r->print("The current scanline is". - $line."\n"); - } + $r->print( + '
' + .&mt('An error was detected ([_1]) in scanline [_2] [_3]', + "$error", $i, "
$line") + ." \n"); + } + my $message = + '
'
+ .&mt('The ID on the form is [_1]',
+ "$$scan_record{'scantron.ID'}")
+ .'
'
+ .&mt('The name on the paper is [_1], [_2]',
+ $$scan_record{'scantron.LastName'},
+ $$scan_record{'scantron.FirstName'})
+ .'
'.&mt("The encoded ID is not in the classlist"). + "
\n"); } elsif ($error eq 'duplicateID') { - $r->print("The encoded ID has also been used by a previous paper $arg\n"); + $r->print(''.&mt("The encoded ID has also been used by a previous paper [_1]",$arg)."
\n"); } - $r->print("Original ID is ".$$scan_record{'scantron.ID'}.
- "
\n");
- $r->print("Name on paper is ".$$scan_record{'scantron.LastName'}.",".
- $$scan_record{'scantron.FirstName'}."
Please correct
\n");
- $r->print("\n
".&mt("How should I handle this?")."
\n");
+ $r->print("\n
'.&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'}'") + ."
\n"); + $r->print($message); + $r->print("".&mt("How should I handle this?")."
\n"); + $r->print("\n'.&mt("There have been multiple bubbles scanned for some question(s)")."
\n"); + + # The form field scantron_questions is acutally a list of line numbers. + # represented by this form so: + + my $line_list = &questions_to_line_list($arg); + $r->print(''); + $line_list.'" />'); + $r->print($message); + $r->print("".&mt("Please indicate which bubble should be used for grading")."
"); foreach my $question (@{$arg}) { - my $selected=$$scan_record{"scantron.$question.answer"}; - $r->print(" For question $question, selected bubbles were ".
- join(" ",split('',$selected)).
- "
Please pick which one should be used for grading
");
- &scantron_bubble_selector($r,$scan_config,$question);
+ my @linenums = &prompt_for_corrections($r,$question,$scan_config,
+ $scan_record, $error);
+ push(@lines_to_correct,@linenums);
}
+ $r->print(&verify_bubbles_checked(@lines_to_correct));
} elsif ($error eq 'missingbubble') {
- $r->print("Some questions have no scanned bubbles\n");
+ $r->print('
'.&mt("There have been [_1]no[_2] bubbles scanned for some question(s)",'','')."
\n"); + $r->print($message); + $r->print("".&mt("Please indicate which bubble should be used for grading.")."
"); + $r->print(&mt("Some questions have no scanned bubbles.")."\n"); + + # The form field scantron_questions is actually a list of line numbers not + # a list of question numbers. Therefore: + # + + my $line_list = &questions_to_line_list($arg); + $r->print(''); + $line_list.'" />'); foreach my $question (@{$arg}) { - my $selected=$$scan_record{"scantron.$question.answer"}; - $r->print("Question $question, Please select a bubble to use "); - &scantron_bubble_selector($r,$scan_config,$question); + my @linenums = &prompt_for_corrections($r,$question,$scan_config, + $scan_record, $error); + push(@lines_to_correct,@linenums); } + $r->print(&verify_bubbles_checked(@lines_to_correct)); } else { $r->print("\n
line is'.$line.''); - my $scan_record=&scantron_parse_scanline($line,\%scantron_config,$scan_data); - my ($uname,$udom); - unless ($uname=&scantron_find_student($scan_record,\%idmap)) { - &scantron_add_delay(\@delayqueue,$line, - 'Unable to find a student that matches',1); - next; - } - if (exists $completedstudents{$uname}) { - &scantron_add_delay(\@delayqueue,$line, - 'Student '.$uname.' has multiple sheets',2); - next; + my $i=-1; + my $started; + + my $nav_error; + &scantron_get_maxbubble(\$nav_error); # Need the bubble lines array to parse. + if ($nav_error) { + $r->print(&navmap_errormsg()); + return ''; + } + + # If an ssi failed in scantron_get_maxbubble, put an error message out to + # the user and return. + + if ($ssi_error) { + $r->print(""); + &ssi_print_error($r); + $r->print(&show_grading_menu_form($symb)); + &Apache::lonnet::remove_lock($lock); + return ''; # Dunno why the other returns return '' rather than just returning. + } + + my %lettdig = &letter_to_digits(); + my $numletts = scalar(keys(%lettdig)); + + while ($i<$scanlines->{'count'}) { + ($uname,$udom)=('',''); + $i++; + my $line=&scantron_get_line($scanlines,$scan_data,$i); + if ($line=~/^[\s\cz]*$/) { next; } + if ($started) { + &Apache::lonhtmlcommon::Increment_PrgWin($r,\%prog_state, + 'last student'); + } + $started=1; + my $scan_record=&scantron_parse_scanline($line,$i,\%scantron_config, + $scan_data); + unless ($uname=&scantron_find_student($scan_record,$scan_data, + \%idmap,$i)) { + &scantron_add_delay(\@delayqueue,$line, + 'Unable to find a student that matches',1); + next; + } + if (exists $completedstudents{$uname}) { + &scantron_add_delay(\@delayqueue,$line, + 'Student '.$uname.' has multiple sheets',2); + next; + } + ($uname,$udom)=split(/:/,$uname); + + my (%partids_by_symb,$res_error); + foreach my $resource (@resources) { + my $ressymb; + if (ref($resource)) { + $ressymb = $resource->symb(); + } else { + $res_error = 1; + last; + } + if ((exists($grader_randomlists_by_symb{$ressymb})) || + (ref($grader_partids_by_symb{$ressymb}) ne 'ARRAY')) { + my ($analysis,$parts) = + &scantron_partids_tograde($resource,$env{'request.course.id'},$uname,$udom); + $partids_by_symb{$ressymb} = $parts; + } else { + $partids_by_symb{$ressymb} = $grader_partids_by_symb{$ressymb}; + } + } + + if ($res_error) { + &scantron_add_delay(\@delayqueue,$line, + 'An error occurred while grading student '.$uname,2); + next; + } + + &Apache::lonxml::clear_problem_counter(); + &Apache::lonnet::appenv($scan_record); + + if (&scantron_clear_skip($scanlines,$scan_data,$i)) { + &scantron_putfile($scanlines,$scan_data); } - $r->print('
doing studnet'.$uname.''); - ($uname,$udom)=split(/:/,$uname); - &Apache::lonnet::delenv('form.counter'); - &Apache::lonnet::appenv(%$scan_record); -# &Apache::lonhomework::showhash(%ENV); -# $Apache::lonxml::debug=1; -# &Apache::lonxml::debug("line is $line"); - my $i=0; - foreach my $resource (@resources) { - $i++; - my $result=&Apache::lonnet::ssi($resource->src(), - ('submitted' =>'scantron', - 'grade_target' =>'grade', - 'grade_username'=>$uname, - 'grade_domain' =>$udom, - 'grade_courseid'=>$ENV{'request.course.id'}, - 'grade_symb' =>$resource->symb())); -# my %score=&Apache::lonnet::restore($resource->symb(), -# $ENV{'request.course.id'}, -# $udom,$uname); -# foreach my $part ($resource->{PARTS}) { -# if ($score{'resource.'.$part.'.solved'} =~ /^correct/) { -# $studentcorrect++; -# $totalcorrect++; -# } else { -# $studentincorrect++; -# $totalincorrect++; -# } -# } -# $r->print('
'. -# $resource->symb().'-'. -# $resource->src().'-'.'result is'.$result); -# &Apache::lonhomework::showhash(%score); - # if ($i eq 3) {last;} - } + my $scancode; + if ((exists($scan_record->{'scantron.CODE'})) && + (&Apache::lonnet::validCODE($scan_record->{'scantron.CODE'}))) { + $scancode = $scan_record->{'scantron.CODE'}; + } else { + $scancode = ''; + } + + if (&grade_student_bubbles($r,$uname,$udom,$scan_record,$scancode, + \@resources,\%partids_by_symb) eq 'ssi_error') { + $ssi_error = 0; # So end of handler error message does not trigger. + $r->print(""); + &ssi_print_error($r); + $r->print(&show_grading_menu_form($symb)); + &Apache::lonnet::remove_lock($lock); + return ''; # Why return ''? Beats me. + } + $completedstudents{$uname}={'line'=>$line}; + if ($env{'form.verifyrecord'}) { + my $lastpos = $env{'form.scantron_maxbubble'}*$scantron_config{'Qlength'}; + my $studentdata = substr($line,$scantron_config{'Qstart'}-1,$lastpos); + chomp($studentdata); + $studentdata =~ s/\r$//; + my $studentrecord = ''; + my $counter = -1; + foreach my $resource (@resources) { + my $ressymb = $resource->symb(); + ($counter,my $recording) = + &verify_scantron_grading($resource,$udom,$uname,$env{'request.course.id'}, + $counter,$studentdata,$partids_by_symb{$ressymb}, + \%scantron_config,\%lettdig,$numletts); + $studentrecord .= $recording; + } + if ($studentrecord ne $studentdata) { + &Apache::lonxml::clear_problem_counter(); + if (&grade_student_bubbles($r,$uname,$udom,$scan_record,$scancode, + \@resources,\%partids_by_symb) eq 'ssi_error') { + $ssi_error = 0; # So end of handler error message does not trigger. + $r->print(""); + &ssi_print_error($r); + $r->print(&show_grading_menu_form($symb)); + &Apache::lonnet::remove_lock($lock); + delete($completedstudents{$uname}); + return ''; + } + $counter = -1; + $studentrecord = ''; + foreach my $resource (@resources) { + my $ressymb = $resource->symb(); + ($counter,my $recording) = + &verify_scantron_grading($resource,$udom,$uname,$env{'request.course.id'}, + $counter,$studentdata,$partids_by_symb{$ressymb}, + \%scantron_config,\%lettdig,$numletts); + $studentrecord .= $recording; + } + if ($studentrecord ne $studentdata) { + $r->print('
');
+ if ($scancode eq '') {
+ $r->print(&mt('Mismatch grading bubblesheet for user: [_1] with ID: [_2].',
+ $uname.':'.$udom,$scan_record->{'scantron.ID'}));
+ } else {
+ $r->print(&mt('Mismatch grading bubblesheet for user: [_1] with ID: [_2] and CODE: [_3].',
+ $uname.':'.$udom,$scan_record->{'scantron.ID'},$scancode));
+ }
+ $r->print('
'.&Apache::loncommon::start_data_table()."\n".
+ &Apache::loncommon::start_data_table_header_row()."\n".
+ '
took $lasttime
"); + &Apache::lonnet::remove_lock($lock); +# my $lasttime = &Time::HiRes::time()-$start; +# $r->print("took $lasttime
"); - #$Apache::lonxml::debug=0; - foreach my $delay (@delayqueue) { - #FIXME - #print out each delayed student with interface to select how - # to repair student provided info - #Expected errors include - # 1 bad/no stuid/username - # 2 invalid bubblings - + $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('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(' +'. + &mt('Comparison of bubblesheet data (including corrections) with corresponding submission records (most recent submission) for [_1][quant,_2,student][_3] ([quant,_4,bubblesheet line] per student).', + '', + $numstudents, + '', + $env{'form.scantron_maxbubble'}). + '
' + ); + $r->print(''.&mt('Exact matches for [quant,_1,student].',$passed).'
'.&mt('Discrepancies detected for [quant,_1,student].',$failed).'
'."\n".
- '
|
'."\n";
+ $result.='
|
'.&mt('Correctness determined by the following IDs').'';
+ foreach my $id (sort(keys(%correct_ids))) {
+ $result.='
'.$id.' - ';
+ if ($correct_ids{$id} eq 'specified') {
+ $result.=&mt('specified');
+ } else {
+ my ($uname,$udom)=split(/\:/,$correct_ids{$id});
+ $result.=&Apache::loncommon::plainname($uname,$udom);
+ }
+ $number++;
+ }
+ $result.="
+
|
'.&mt('Access Denied ([_1])',$command).'
'); } } - &send_footer($request); - 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('