+'.&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).
+'
| \n"; @@ -1759,9 +1843,9 @@ sub download_all_link { join("\n",&Apache::loncommon::get_env_multiple('form.vPart')); my $identifier = &Apache::loncommon::get_cgi_id(); - &Apache::lonnet::appenv('cgi.'.$identifier.'.students' => $all_students, - 'cgi.'.$identifier.'.symb' => $symb, - 'cgi.'.$identifier.'.parts' => $parts,); + &Apache::lonnet::appenv({'cgi.'.$identifier.'.students' => $all_students, + 'cgi.'.$identifier.'.symb' => $symb, + 'cgi.'.$identifier.'.parts' => $parts,}); $r->print(''. &mt('Download All Submitted Documents').''); return @@ -2142,8 +2226,8 @@ KEYWORDS $seen{$partid}++; next if ($$handgrade{$part_resp} ne 'yes' && $env{'form.lastSub'} eq 'hdgrade'); - push @partlist,$partid; - push @gradePartRespid,$partid.'.'.$respid; + push(@partlist,$partid); + push(@gradePartRespid,$partid.'.'.$respid); $request->print(&gradeBox($request,$symb,$uname,$udom,$counter,$partid,\%record)); } $request->print(''); @@ -2274,7 +2358,7 @@ sub get_last_submission { $$returnhash{$version.':keys'}))) { $lasthash{$key}=$$returnhash{$version.':'.$key}; $timestamp = - scalar(localtime($$returnhash{$version.':timestamp'})); + &Apache::lonlocal::locallocaltime($$returnhash{$version.':timestamp'}); } } foreach my $key (keys(%lasthash)) { @@ -2470,7 +2554,7 @@ sub processHandGrade { my (@parsedlist,@nextlist); my ($nextflg) = 0; - foreach (sort + foreach my $item (sort { if (lc($$fullname{$a}) ne lc($$fullname{$b})) { return (lc($$fullname{$a}) cmp lc($$fullname{$b})); @@ -2478,12 +2562,12 @@ sub processHandGrade { return $a cmp $b; } (keys(%$fullname))) { if ($nextflg == 1 && $button =~ /Next$/) { - push @parsedlist,$_; + push(@parsedlist,$item); } - $nextflg = 1 if ($_ eq $laststu); + $nextflg = 1 if ($item eq $laststu); if ($button eq 'Previous') { - last if ($_ eq $firststu); - push @parsedlist,$_; + last if ($item eq $firststu); + push(@parsedlist,$item); } } $ctr = 0; @@ -2506,11 +2590,11 @@ sub processHandGrade { my $submitted = 0; my $ungraded = 0; my $incorrect = 0; - foreach (keys(%status)) { - $submitted = 1 if ($status{$_} ne 'nothing'); - $ungraded = 1 if ($status{$_} =~ /^ungraded/); - $incorrect = 1 if ($status{$_} =~ /^incorrect/); - my ($foo,$partid,$foo1) = split(/\./,$_); + foreach my $item (keys(%status)) { + $submitted = 1 if ($status{$item} ne 'nothing'); + $ungraded = 1 if ($status{$item} =~ /^ungraded/); + $incorrect = 1 if ($status{$item} =~ /^incorrect/); + my ($foo,$partid,$foo1) = split(/\./,$item); if ($status{'resource.'.$partid.'.submitted_by'} ne '') { $submitted = 0; } @@ -2521,7 +2605,7 @@ sub processHandGrade { next if (!$ungraded && ($submitonly eq 'graded')); next if (!$incorrect && $submitonly eq 'incorrect'); } - push @nextlist,$student if ($ctr < $ntstu); + push(@nextlist,$student) if ($ctr < $ntstu); last if ($ctr == $ntstu); $ctr++; } @@ -2529,7 +2613,7 @@ sub processHandGrade { $ctr = 0; my $total = scalar(@nextlist)-1; - foreach (sort @nextlist) { + foreach (sort(@nextlist)) { my ($uname,$udom,$submitter) = split(/:/); $env{'form.student'} = $uname; $env{'form.userdom'} = $udom; @@ -2575,7 +2659,7 @@ sub saveHandGrade { } } elsif ($dropMenu eq 'reset status' && exists($record{'resource.'.$new_part.'.solved'})) { #don't bother if no old records -> no attempts - foreach my $key (keys (%record)) { + foreach my $key (keys(%record)) { if ($key=~/^resource\.\Q$new_part\E\./) { $newrecord{$key} = ''; } } $newrecord{'resource.'.$new_part.'.regrader'}= @@ -2610,7 +2694,7 @@ sub saveHandGrade { &handback_files($request,$symb,$stuname,$domain,$newflg,$new_part,\%newrecord); next; } else { - push @parts_graded, $new_part; + push(@parts_graded,$new_part); } if ($record{'resource.'.$new_part.'.awarded'} ne $partial) { $newrecord{'resource.'.$new_part.'.awarded'} = $partial; @@ -2637,7 +2721,7 @@ sub saveHandGrade { $record{'resource.'.$new_part.'.solved'} eq 'incorrect_by_override' || $dropMenu eq 'reset status') { - push (@version_parts,$new_part); + push(@version_parts,$new_part); } } my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'}; @@ -2685,7 +2769,7 @@ sub check_and_remove_from_queue { sub handback_files { my ($request,$symb,$stuname,$domain,$newflg,$new_part,$newrecord) = @_; - my $portfolio_root = &propath($domain,$stuname).'/userfiles/portfolio'; + my $portfolio_root = '/userfiles/portfolio'; my ($partlist,$handgrade,$responseType) = &response_type($symb); my @part_response_id = &flatten_responseType($responseType); @@ -2703,7 +2787,8 @@ sub handback_files { my ($answer_name,$answer_ver,$answer_ext) = &file_name_version_ext($answer_file); my ($portfolio_path) = ($directory =~ /^.+$stuname\/portfolio(.*)/); - my @dir_list = &Apache::lonnet::dirlist($portfolio_path,$domain,$stuname,$portfolio_root); + my $getpropath = 1; + my @dir_list = &Apache::lonnet::dirlist($portfolio_root.$portfolio_path,$domain,$stuname,$getpropath); my $version = &get_next_version($answer_name, $answer_ext, \@dir_list); # fix file name my ($save_file_name) = (($directory.$answer_name.".$version.".$answer_ext) =~ /^.+\/${stuname}\/(.*)/); @@ -2711,8 +2796,10 @@ sub handback_files { $newflg.'_'.$part_resp.'_returndoc'.$file_counter, $save_file_name); if ($result !~ m|^/uploaded/|) { - $request->print('An error occurred ('.$result. - ') while trying to upload '.$newflg.'_'.$part_resp.'_returndoc'.$file_counter.' | '.
@@ -3364,7 +3451,7 @@ sub editgrades {
my $header;
while ($ctr < $env{'form.totalparts'}) {
my $partid = $env{'form.partid_'.$ctr};
- push @partid,$partid;
+ push(@partid,$partid);
$weight{$partid} = $env{'form.weight_'.$partid};
$ctr++;
}
@@ -3960,31 +4047,31 @@ sub csvuploadassign {
$grades{$store_key}=$entries{$fields{$dest}};
}
}
- if (! %grades) { push(@skipped,"$username:$domain no data to save"); }
- $grades{"resource.regrader"}="$env{'user.name'}:$env{'user.domain'}";
- my $result=&Apache::lonnet::cstore(\%grades,$symb,
+ 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(" - - Failed to save student $username:$domain. - Message when trying to save was ($result) - - " ); - } - $request->rflush(); - $countdone++; + 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("Saved $countdone students\n"); + $request->print(' '.&mt("Saved [_1] students",$countdone)."\n"); if (@skipped) { - $request->print(' Skipped Students'); + $request->print(''.&mt('Skipped Students').' '); foreach my $student (@skipped) { $request->print("$student\n"); } } if (@notallowed) { - $request->print(' Students Not Allowed to Modify '); + $request->print(''.&mt('Students Not Allowed to Modify').' '); foreach my $student (@notallowed) { $request->print("$student\n"); } } $request->print(" \n"); @@ -4326,6 +4413,7 @@ sub displaySubByDates { } my $interaction; + my $no_increment = 1; for ($version=1;$version<=$$record{'version'};$version++) { my $timestamp = &Apache::lonlocal::locallocaltime($$record{$version.':timestamp'}); @@ -4369,7 +4457,8 @@ sub displaySubByDates { if (!exists($orders{$partid})) { $orders{$partid}={}; } if (!exists($orders{$partid}->{$responseId})) { $orders{$partid}->{$responseId}= - &get_order($partid,$responseId,$symb,$uname,$udom); + &get_order($partid,$responseId,$symb,$uname,$udom, + $no_increment); } $displaySub[0].=' '. &cleanRecord($$record{$version.':'.$matchKey},$responseType,$symb,$partid,$responseId,$record,$orders{$partid}->{$responseId},"$version:",$uname,$udom).' '; @@ -4422,12 +4511,12 @@ sub updateGradeByPage { my ($uname,$udom) = split(/:/,$env{'form.student'}); my $usec=$classlist->{$env{'form.student'}}[5]; if (!&canmodify($usec)) { - $request->print('Unable to modify requested student.('.$env{'form.student'}.''); + $request->print(''.&mt('Unable to modify requested student ([_1])',$env{'form.student'}).''); $request->print(&show_grading_menu_form($env{'form.symb'})); return; } my $result=' '.$env{'form.title'}.''; - $result.=' Student: '.&nameUserString(undef,$env{'form.fullname'},$uname,$udom).
+ $result.='\n";
} else {
- $Str .=' ('.&mt('[quant,_1, parts]',scalar(@{$parts})) - ).') "); } elsif ($error eq 'doublebubble') { - $r->print(" "); + $r->print(&mt('The group of bubble lines below responds to a single question.').' '); + if (($responsetype_per_response{$question-1} eq 'essayresponse') || + ($responsetype_per_response{$question-1} eq 'formularesponse') || + ($responsetype_per_response{$question-1} eq 'stringresponse') || + ($responsetype_per_response{$question-1} eq 'imageresponse') || + ($responsetype_per_response{$question-1} eq 'reactionresponse') || + ($responsetype_per_response{$question-1} eq 'organicresponse')) { + $r->print(&mt("Although this particular question type requires handgrading, the instructions for this question in the exam directed students to leave [quant,_1,line] blank on their scantron sheets.",$lines).' '.&mt('A non-zero score can be assigned to the student during scantron grading by selecting a bubble in at least one line.').' '.&mt('The score for this question will be a sum of the numeric values for the selected bubbles from each line, where A=1 point, B=2 points etc.').' '.&mt("To assign a score of zero for this question, mark all lines as 'No bubble'.").' '); + } else { + $r->print(&mt("Select at most one bubble in a single line and select 'No Bubble' in all the other lines. ")." "); + } } for (my $i =0; $i < $lines; $i++) { - my $selected = $$scan_record{"scantron.$current_line.answer"}; - &scantron_bubble_selector($r, $scan_config, $current_line, - split('', $selected)); + my $selected = $$scan_record{"scantron.$current_line.answer"}; + &scantron_bubble_selector($r,$scan_config,$current_line, + $questionnum,$error,split('', $selected)); + push(@linenums,$current_line); $current_line++; } if ($lines > 1) { $r->print(" "); } + return @linenums; } =pod @@ -6697,34 +7050,46 @@ sub prompt_for_corrections { $r - Apache request object $scan_config - hash from &get_scantron_config() $line - Number of the line being displayed. + $questionnum - Question number (may include subquestion) + $error - Type of error. @selected - Array of bubbles picked on this line. =cut sub scantron_bubble_selector { - my ($r,$scan_config,$line,@selected)=@_; + my ($r,$scan_config,$line,$questionnum,$error,@selected)=@_; my $max=$$scan_config{'Qlength'}; my $scmode=$$scan_config{'Qon'}; if ($scmode eq 'number' || $scmode eq 'letter') { $max=10; } my @alphabet=('A'..'Z'); - $r->print("
'."\n".' | ');
+ $r->print(&Apache::loncommon::end_data_table_row().
+ &Apache::loncommon::end_data_table());
}
=pod
@@ -6881,7 +7246,7 @@ sub scantron_validate_CODE {
$line,'duplicateCODE',$usedCODEs{$CODE});
return(1,$currentphase);
}
- push (@{$usedCODEs{$CODE}},$$scan_record{'scantron.PaperID'});
+ push(@{$usedCODEs{$CODE}},$$scan_record{'scantron.PaperID'});
}
return (0,$currentphase+1);
}
@@ -6904,7 +7269,6 @@ sub scantron_validate_doublebubble {
#get scantron line setup
my %scantron_config=&get_scantron_config($env{'form.scantron_format'});
my ($scanlines,$scan_data)=&scantron_getfile();
-
&scantron_get_maxbubble(); # parse needs the bubble line array.
for (my $i=0;$i<=$scanlines->{'count'};$i++) {
@@ -6931,14 +7295,17 @@ sub scantron_validate_doublebubble {
for what the current value of the problem counter is.
Caches the results to $env{'form.scantron_maxbubble'},
- $env{'form.scantron.bubble_lines.n'} and
- $env{'form.scantron.first_bubble_line.n'}
+ $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 reponse n and number of the first bubble line for response n.
+ 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.
=cut
-sub scantron_get_maxbubble {
+sub scantron_get_maxbubble {
if (defined($env{'form.scantron_maxbubble'}) &&
$env{'form.scantron_maxbubble'}) {
&restore_bubble_lines();
@@ -6960,42 +7327,67 @@ sub scantron_get_maxbubble {
my $total_lines = 0;
%bubble_lines_per_response = ();
%first_bubble_line = ();
-
+ %subdivided_bubble_lines = ();
+ %responsetype_per_response = ();
my $response_number = 0;
my $bubble_line = 0;
foreach my $resource (@resources) {
- my $symb = $resource->symb();
- my $result=&Apache::lonnet::ssi($resource->src(),
- ('symb' => $resource->symb()),
- ('grade_target' => 'analyze'),
- ('grade_courseid' => $cid),
- ('grade_domain' => $udom),
- ('grade_username' => $uname));
- my (undef, $an) =
- split(/_HASH_REF__/,$result, 2);
-
- my %analysis = &Apache::lonnet::str2hash($an);
-
-
-
- foreach my $part_id (@{$analysis{'parts'}}) {
-
- my $lines = $analysis{"$part_id.bubble_lines"};;
-
-
-
- # TODO - make this a persistent hash not an array.
-
-
- $first_bubble_line{$response_number} = $bubble_line;
- $bubble_lines_per_response{$response_number} = $lines;
- $response_number++;
+ my ($analysis,$parts) = &scantron_partids_tograde($resource,$cid,$uname,$udom);
+ if ((ref($analysis) eq 'HASH') && (ref($parts) eq 'ARRAY')) {
+ foreach my $part_id (@{$parts}) {
+
+ my $lines;
+
+ # TODO - make this a persistent hash not an array.
+
+ # optionresponse, matchresponse and rankresponse type items
+ # render as separate sub-questions in exam mode.
+ if (($analysis->{$part_id.'.type'} eq 'optionresponse') ||
+ ($analysis->{$part_id.'.type'} eq 'matchresponse') ||
+ ($analysis->{$part_id.'.type'} eq 'rankresponse')) {
+ my ($numbub,$numshown);
+ if ($analysis->{$part_id.'.type'} eq 'optionresponse') {
+ if (ref($analysis->{$part_id.'.options'}) eq 'ARRAY') {
+ $numbub = scalar(@{$analysis->{$part_id.'.options'}});
+ }
+ } elsif ($analysis->{$part_id.'.type'} eq 'matchresponse') {
+ if (ref($analysis->{$part_id.'.items'}) eq 'ARRAY') {
+ $numbub = scalar(@{$analysis->{$part_id.'.items'}});
+ }
+ } elsif ($analysis->{$part_id.'.type'} eq 'rankresponse') {
+ if (ref($analysis->{$part_id.'.foils'}) eq 'ARRAY') {
+ $numbub = scalar(@{$analysis->{$part_id.'.foils'}});
+ }
+ }
+ if (ref($analysis->{$part_id.'.shown'}) eq 'ARRAY') {
+ $numshown = scalar(@{$analysis->{$part_id.'.shown'}});
+ }
+ my $bubbles_per_line = 10;
+ my $inner_bubble_lines = int($numbub/$bubbles_per_line);
+ if (($numbub % $bubbles_per_line) != 0) {
+ $inner_bubble_lines++;
+ }
+ for (my $i=0; $i<$numshown; $i++) {
+ $subdivided_bubble_lines{$response_number} .=
+ $inner_bubble_lines.',';
+ }
+ $subdivided_bubble_lines{$response_number} =~ s/,$//;
+ $lines = $numshown * $inner_bubble_lines;
+ } else {
+ $lines = $analysis->{"$part_id.bubble_lines"};
+ }
- $bubble_line += $lines;
- $total_lines += $lines;
- }
+ $first_bubble_line{$response_number} = $bubble_line;
+ $bubble_lines_per_response{$response_number} = $lines;
+ $responsetype_per_response{$response_number} =
+ $analysis->{$part_id.'.type'};
+ $response_number++;
+ $bubble_line += $lines;
+ $total_lines += $lines;
+ }
+ }
}
&Apache::lonnet::delenv('scantron\.');
@@ -7005,6 +7397,33 @@ sub scantron_get_maxbubble {
return $env{'form.scantron_maxbubble'};
}
+sub scantron_partids_tograde {
+ my ($resource,$cid,$uname,$udom) = @_;
+ my (%analysis,@parts);
+
+ if (ref($resource)) {
+ my $symb = $resource->symb();
+ my $result=&ssi_with_retries($resource->src(), $ssi_retries,
+ ('symb' => $symb,
+ 'grade_target' => 'analyze',
+ 'grade_courseid' => $cid,
+ 'grade_domain' => $udom,
+ 'grade_username' => $uname));
+ my (undef, $an) = split(/_HASH_REF__/,$result, 2);
+ %analysis = &Apache::lonnet::str2hash($an);
+
+ 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);
+}
+
=pod
=item scantron_validate_missingbubbles
@@ -7037,7 +7456,25 @@ sub scantron_validate_missingbubbles {
# Probably here's where the error is...
foreach my $missing (@{$$scan_record{'scantron.missingerror'}}) {
- if ($missing > $max_bubble) { next; }
+ my $lastbubble;
+ if ($missing =~ /^(\d+)\.(\d+)$/) {
+ my $question = $1;
+ my $subquestion = $2;
+ if (!defined($first_bubble_line{$question -1})) { next; }
+ my $first = $first_bubble_line{$question-1};
+ my @subans = split(/,/,$subdivided_bubble_lines{$question-1});
+ my $subcount = 1;
+ while ($subcount<$subquestion) {
+ $first += $subans[$subcount-1];
+ $subcount ++;
+ }
+ my $count = $subans[$subquestion-1];
+ $lastbubble = $first + $count;
+ } else {
+ if (!defined($first_bubble_line{$missing - 1})) { next; }
+ $lastbubble = $first_bubble_line{$missing - 1} + $bubble_lines_per_response{$missing - 1};
+ }
+ if ($lastbubble > $max_bubble) { next; }
push(@to_correct,$missing);
}
if (@to_correct) {
@@ -7076,9 +7513,12 @@ sub scantron_validate_missingbubbles {
sub scantron_process_students {
my ($r) = @_;
+
my (undef,undef,$sequence)=&Apache::lonnet::decode_symb($env{'form.selectpage'});
my ($symb)=&get_symb($r);
- if (!$symb) {return '';}
+ if (!$symb) {
+ return '';
+ }
my $default_form_data=&defaultFormData($symb);
my %scantron_config=&get_scantron_config($env{'form.scantron_format'});
@@ -7088,6 +7528,14 @@ sub scantron_process_students {
my $navmap=Apache::lonnavmaps::navmap->new();
my $map=$navmap->getResourceByUrl($sequence);
my @resources=$navmap->retrieveResources($map,\&scantron_filter,1,0);
+
+ my ($uname,$udom,%partids_by_symb);
+ foreach my $resource (@resources) {
+ my $ressymb = $resource->symb();
+ my ($analysis,$parts) =
+ &scantron_partids_tograde($resource,$env{'request.course.id'},$uname,$udom);
+ $partids_by_symb{$ressymb} = $parts;
+ }
# $r->print("geto ".scalar(@resources).""); my $result= < '); my $start=&Time::HiRes::time(); my $i=-1; - my ($uname,$udom,$started); + my $started; &scantron_get_maxbubble(); # Need the bubble lines array to parse. + + + # 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)=('',''); @@ -7137,40 +7602,92 @@ SCANTRONFORM ($uname,$udom)=split(/:/,$uname); &Apache::lonxml::clear_problem_counter(); - &Apache::lonnet::appenv(%$scan_record); + &Apache::lonnet::appenv($scan_record); if (&scantron_clear_skip($scanlines,$scan_data,$i)) { &scantron_putfile($scanlines,$scan_data); } - - my $i=0; - foreach my $resource (@resources) { - $i++; - my %form=('submitted' =>'scantron', - 'grade_target' =>'grade', - 'grade_username'=>$uname, - 'grade_domain' =>$udom, - 'grade_courseid'=>$env{'request.course.id'}, - 'grade_symb' =>$resource->symb()); - if (exists($scan_record->{'scantron.CODE'}) - && - &Apache::lonnet::validCODE($scan_record->{'scantron.CODE'})) { - $form{'CODE'}=$scan_record->{'scantron.CODE'}; - } else { - $form{'CODE'}=''; - } - my $result=&Apache::lonnet::ssi($resource->src(),%form); - if ($result ne '') { - } - if (&Apache::loncommon::connection_aborted($r)) { 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) 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) { + ($counter,my $recording) = + &verify_scantron_grading($resource,$udom,$uname,$env{'request.course.id'}, + $counter,$studentdata,\%partids_by_symb, + \%scantron_config,\%lettdig,$numletts); + $studentrecord .= $recording; + } + if ($studentrecord ne $studentdata) { + $counter = -1; + $studentrecord = ''; + foreach my $resource (@resources) { + ($counter,my $recording) = + &verify_scantron_grading($resource,$udom,$uname,$env{'request.course.id'}, + $counter,$studentdata,\%partids_by_symb, + \%scantron_config,\%lettdig,$numletts); + $studentrecord .= $recording; + } + if ($studentrecord ne $studentdata) { + $r->print(' ');
+ 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('Source').' | '.&mt('Bubbled responses').' | '.
+ &Apache::loncommon::end_data_table_header_row()."\n".
+ &Apache::loncommon::start_data_table_row().
+ ''.&mt('Bubble Sheet').' | '.
+ ''.$studentdata.' | '.
+ &Apache::loncommon::end_data_table_row().
+ &Apache::loncommon::start_data_table_row().
+ 'Stored submissions | '.
+ ''.$studentrecord.' | '."\n".
+ &Apache::loncommon::end_data_table_row().
+ &Apache::loncommon::end_data_table().'');
+ } else {
+ $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 "); @@ -7179,6 +7696,23 @@ SCANTRONFORM return ''; } +sub grade_student_bubbles { + my ($r,$uname,$udom,$scan_record,$scancode,@resources) = @_; + foreach my $resource (@resources) { + my %form = ('submitted' => 'scantron', + 'grade_target' => 'grade', + 'grade_username'=> $uname, + 'grade_domain' => $udom, + 'grade_courseid'=> $env{'request.course.id'}, + 'grade_symb' => $resource->symb(), + 'code' => $scancode); + my $result=&ssi_with_retries($resource->src(),$ssi_retries,%form); + return 'ssi_error' if ($ssi_error); + last if (&Apache::loncommon::connection_aborted($r)); + } + return; +} + =pod =item scantron_upload_scantron_data @@ -7361,6 +7895,285 @@ sub scantron_download_scantron_data { 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(); + my $map=$navmap->getResourceByUrl($sequence); + my @resources=$navmap->retrieveResources($map,undef,1,0); + my ($uname,$udom,%partids_by_symb); + foreach my $resource (@resources) { + my $ressymb = $resource->symb(); + my ($analysis,$parts) = + &scantron_partids_tograde($resource,$env{'request.course.id'},$uname,$udom); + $partids_by_symb{$ressymb} = $parts; + } + my (%scandata,%lastname,%bylast); + $r->print(' +'.$grading_menu_button); + return; +} + +sub verify_scantron_grading { + my ($resource,$domain,$username,$cid,$counter,$scandata,$partids_by_symb, + $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_by_symb) ne 'HASH'); + return ($counter,$record) if (ref($partids_by_symb->{$symb}) ne 'ARRAY'); + foreach my $part_id (@{$partids_by_symb->{$symb}}) { + $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_by_symb->{$symb}}) { + 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; +} + =pod =back @@ -7420,25 +8233,25 @@ sub grading_menu { }); $fields{'command'} = 'csvform'; $url = &Apache::lonhtmlcommon::build_url('grades/',\%fields); - push (@menu, { url => $url, + push(@menu, { url => $url, name => &mt('Upload Scores'), short_description => &mt('Specify a file containing the class scores for current resource.')}); $fields{'command'} = 'processclicker'; $url = &Apache::lonhtmlcommon::build_url('grades/',\%fields); - push (@menu, { url => $url, + push(@menu, { url => $url, name => &mt('Process Clicker'), short_description => &mt('Specify a file containing the clicker information for this resource.')}); $fields{'command'} = 'scantron_selectphase'; $url = &Apache::lonhtmlcommon::build_url('grades/',\%fields); - push (@menu, { url => $url, - name => &mt('Grade/Manage Scantron Forms'), + push(@menu, { url => $url, + name => &mt('Grade/Manage/Review Scantron Forms'), short_description => - &mt('')}); + &mt('Grade scantron exams, upload/download scantron data files, and review previously graded scantron exams.')}); $fields{'command'} = 'verify'; $url = &Apache::lonhtmlcommon::build_url('grades/',\%fields); - push (@menu, { url => "", + push(@menu, { url => "", name => &mt('Verify Receipt'), short_description => &mt('')}); @@ -7463,14 +8276,12 @@ sub grading_menu { $menudata->{'url'}.'" >'. $menudata->{'name'}." |
|---|