--- loncom/homework/grades.pm 2011/12/01 00:36:59 1.596.2.12 +++ loncom/homework/grades.pm 2013/08/16 15:36:08 1.596.2.12.2.19 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA # The LON-CAPA Grading handler # -# $Id: grades.pm,v 1.596.2.12 2011/12/01 00:36:59 raeburn Exp $ +# $Id: grades.pm,v 1.596.2.12.2.19 2013/08/16 15:36:08 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # @@ -52,6 +52,7 @@ use POSIX qw(floor); my %perm=(); +my %old_essays=(); # These variables are used to recover from ssi errors @@ -124,13 +125,16 @@ sub getpartlist { # --- Get the symbolic name of a problem and the url sub get_symb { my ($request,$silent) = @_; - (my $url=$env{'form.url'}) =~ s-^http://($ENV{'SERVER_NAME'}|$ENV{'HTTP_HOST'})--; - my $symb=($env{'form.symb'} ne '' ? $env{'form.symb'} : (&Apache::lonnet::symbread($url))); - if ($symb eq '') { - if (!$silent) { - $request->print(&mt("Unable to handle ambiguous references: [_1].",$url)); - return (); - } + my $symb=$env{'form.symb'}; + unless ($symb) { + (my $url=$env{'form.url'}) =~ s-^http://($ENV{'SERVER_NAME'}|$ENV{'HTTP_HOST'})--; + $symb = &Apache::lonnet::symbread($url); + if ($symb eq '') { + if (!$silent) { + $request->print(&mt("Unable to handle ambiguous references: [_1].",$url)); + return (); + } + } } &Apache::lonenc::check_decrypt(\$symb); return ($symb); @@ -249,7 +253,7 @@ sub showResourceInfo { $result.='
@@ -6384,11 +6729,11 @@ sub scantron_warning_screen { '.&mt('Sequence to be Graded:').''.$title.' '.&mt('Data File that will be used:').''.$env{'form.scantron_selectfile'}.' -'.$CODElist.' +'.$CODElist.$lastbubblepoints.' - '.&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("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.").' '); @@ -6424,8 +6769,9 @@ sub scantron_do_warning { } } else { my $warning=&scantron_warning_screen('Grading: Validate Records'); + my $bubbledbyhand=&hand_bubble_option(); $r->print(' -'.$warning.' +'.$warning.$bubbledbyhand.' '); @@ -6467,9 +6813,11 @@ SCANTRONFORM ''."\n"; $chunk .= ''."\n"; + $chunk .= + ''."\n"; $result .= $chunk; $line++; - } + } return $result; } @@ -6515,12 +6863,16 @@ sub scantron_validate_file { #get the student pick code ready $r->print(&Apache::loncommon::studentbrowser_javascript()); my $nav_error; - my $max_bubble=&scantron_get_maxbubble(\$nav_error); + my %scantron_config=&get_scantron_config($env{'form.scantron_format'}); + my $max_bubble=&scantron_get_maxbubble(\$nav_error,\%scantron_config); if ($nav_error) { $r->print(&navmap_errormsg()); return ''; } my $result=&scantron_form_start($max_bubble).$default_form_data; + if ($env{'form.scantron_lastbubblepoints'} ne '') { + $result .= ''; + } $r->print($result); my @validate_phases=( 'sequence', @@ -6538,6 +6890,7 @@ sub scantron_validate_file { 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'; @@ -6946,7 +7299,12 @@ sub scantron_validate_sequence { my @resources= $navmap->retrieveResources($map,\&scantron_filter_not_exam,1,0); if (@resources) { - $r->print("".&mt('Some resources in the sequence currently are not set to exam mode. Grading these resources currently may not work correctly.').""); + $r->print('' + .&mt('Some resources in the sequence currently are not set to' + .' exam mode. Grading these resources currently may not' + .' work correctly.') + .'' + ); return (1,$currentphase); } } @@ -6968,7 +7326,7 @@ sub scantron_validate_ID { my ($scanlines,$scan_data)=&scantron_getfile(); my $nav_error; - &scantron_get_maxbubble(\$nav_error); # parse needs the bubble_lines.. array. + &scantron_get_maxbubble(\$nav_error,\%scantron_config); # parse needs the bubble_lines.. array. if ($nav_error) { $r->print(&navmap_errormsg()); return(1,$currentphase); @@ -7027,7 +7385,8 @@ sub scantron_validate_ID { sub scantron_get_correction { - my ($r,$i,$scan_record,$scan_config,$line,$error,$arg)=@_; + my ($r,$i,$scan_record,$scan_config,$line,$error,$arg, + $randomorder,$randompick,$respnumlookup,$startline)=@_; #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 @@ -7077,7 +7436,7 @@ sub scantron_get_correction { $r->print(&Apache::loncommon::selectstudent_link('scantronupload', 'scantron_username','scantron_domain')); $r->print(": "); - $r->print("\n@". + $r->print("\n:\n". &Apache::loncommon::select_dom_form($env{'request.role.domain'},'scantron_domain')); $r->print(''); @@ -7163,7 +7522,8 @@ ENDSCRIPT # 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); + my $line_list = &questions_to_line_list($arg,$randomorder,$randompick, + $respnumlookup,$startline); $r->print(''); @@ -7171,7 +7531,9 @@ ENDSCRIPT $r->print("".&mt("Please indicate which bubble should be used for grading").""); foreach my $question (@{$arg}) { my @linenums = &prompt_for_corrections($r,$question,$scan_config, - $scan_record, $error); + $scan_record, $error, + $randomorder,$randompick, + $respnumlookup,$startline); push(@lines_to_correct,@linenums); } $r->print(&verify_bubbles_checked(@lines_to_correct)); @@ -7185,13 +7547,16 @@ ENDSCRIPT # a list of question numbers. Therefore: # - my $line_list = &questions_to_line_list($arg); + my $line_list = &questions_to_line_list($arg,$randomorder,$randompick, + $respnumlookup,$startline); $r->print(''); foreach my $question (@{$arg}) { my @linenums = &prompt_for_corrections($r,$question,$scan_config, - $scan_record, $error); + $scan_record, $error, + $randomorder,$randompick, + $respnumlookup,$startline); push(@lines_to_correct,@linenums); } $r->print(&verify_bubbles_checked(@lines_to_correct)); @@ -7244,12 +7609,20 @@ used to fill in the scantron_questions f Arguments: questions - Reference to an array of questions. + randomorder - True if randomorder in use. + randompick - True if randompick in use. + respnumlookup - Reference to HASH mapping question numbers in bubble lines + for current line to question number used for same question + in "Master Seqence" (as seen by Course Coordinator). + startline - Reference to hash where key is question number (0 is first) + and key is number of first bubble line for current student + or code-based randompick and/or randomorder. =cut sub questions_to_line_list { - my ($questions) = @_; + my ($questions,$randomorder,$randompick,$respnumlookup,$startline) = @_; my @lines; foreach my $item (@{$questions}) { @@ -7258,8 +7631,16 @@ sub questions_to_line_list { if ($item =~ /^(\d+)\.(\d+)$/) { $question = $1; my $subquestion = $2; - $first = $first_bubble_line{$question-1} + 1; - my @subans = split(/,/,$subdivided_bubble_lines{$question-1}); + my $responsenum = $question-1; + if (($randomorder || $randompick) && (ref($respnumlookup) eq 'HASH')) { + $responsenum = $respnumlookup->{$question-1}; + if (ref($startline) eq 'HASH') { + $first = $startline->{$question-1} + 1; + } + } else { + $first = $first_bubble_line{$responsenum} + 1; + } + my @subans = split(/,/,$subdivided_bubble_lines{$responsenum}); my $subcount = 1; while ($subcount<$subquestion) { $first += $subans[$subcount-1]; @@ -7267,8 +7648,16 @@ sub questions_to_line_list { } $count = $subans[$subquestion-1]; } else { - $first = $first_bubble_line{$question-1} + 1; - $count = $bubble_lines_per_response{$question-1}; + my $responsenum = $question-1; + if (($randomorder || $randompick) && (ref($respnumlookup) eq 'HASH')) { + $responsenum = $respnumlookup->{$question-1}; + if (ref($startline) eq 'HASH') { + $first = $startline->{$question-1} + 1; + } + } else { + $first = $first_bubble_line{$responsenum} + 1; + } + $count = $bubble_lines_per_response{$responsenum}; } $last = $first+$count-1; push(@lines, ($first..$last)); @@ -7290,6 +7679,14 @@ for multi and missing bubble cases). $scan_config - The scantron file configuration hash. $scan_record - Reference to the hash that has the the parsed scanlines. $error - Type of error + $randomorder - True if randomorder in use. + $randompick - True if randompick in use. + $respnumlookup - Reference to HASH mapping question numbers in bubble lines + for current line to question number used for same question + in "Master Seqence" (as seen by Course Coordinator). + $startline - Reference to hash where key is question number (0 is first) + and value is number of first bubble line for current student + or code-based randompick and/or randomorder. Implicit inputs: %bubble_lines_per_response - Starting line numbers for each question. @@ -7314,15 +7711,26 @@ for multi and missing bubble cases). =cut sub prompt_for_corrections { - my ($r, $question, $scan_config, $scan_record, $error) = @_; + my ($r, $question, $scan_config, $scan_record, $error, $randomorder, + $randompick, $respnumlookup, $startline) = @_; my ($current_line,$lines); my @linenums; my $questionnum = $question; + my ($first,$responsenum); if ($question =~ /^(\d+)\.(\d+)$/) { $question = $1; - $current_line = $first_bubble_line{$question-1} + 1 ; my $subquestion = $2; - my @subans = split(/,/,$subdivided_bubble_lines{$question-1}); + if (($randomorder || $randompick) && (ref($respnumlookup) eq 'HASH')) { + $responsenum = $respnumlookup->{$question-1}; + if (ref($startline) eq 'HASH') { + $first = $startline->{$question-1}; + } + } else { + $responsenum = $question-1; + $first = $first_bubble_line{$responsenum} + 1; + } + $current_line = $first + 1 ; + my @subans = split(/,/,$subdivided_bubble_lines{$responsenum}); my $subcount = 1; while ($subcount<$subquestion) { $current_line += $subans[$subcount-1]; @@ -7330,25 +7738,34 @@ sub prompt_for_corrections { } $lines = $subans[$subquestion-1]; } else { - $current_line = $first_bubble_line{$question-1} + 1 ; - $lines = $bubble_lines_per_response{$question-1}; + if (($randomorder || $randompick) && (ref($respnumlookup) eq 'HASH')) { + $responsenum = $respnumlookup->{$question-1}; + if (ref($startline) eq 'HASH') { + $first = $startline->{$question-1}; + } + } else { + $responsenum = $question-1; + $first = $first_bubble_line{$responsenum}; + } + $current_line = $first + 1; + $lines = $bubble_lines_per_response{$responsenum}; } if ($lines > 1) { $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 bubblesheets.",$lines).''.&mt('A non-zero score can be assigned to the student during bubblesheet 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'.").''); + if (($responsetype_per_response{$responsenum} eq 'essayresponse') || + ($responsetype_per_response{$responsenum} eq 'formularesponse') || + ($responsetype_per_response{$responsenum} eq 'stringresponse') || + ($responsetype_per_response{$responsenum} eq 'imageresponse') || + ($responsetype_per_response{$responsenum} eq 'reactionresponse') || + ($responsetype_per_response{$responsenum} eq 'organicresponse')) { + $r->print(&mt("Although this particular question type requires handgrading, the instructions for this question in the bubblesheet exam directed students to leave [quant,_1,line] blank on their bubblesheets.",$lines).''.&mt('A non-zero score can be assigned to the student during bubblesheet 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, + &scantron_bubble_selector($r,$scan_config,$current_line, $questionnum,$error,split('', $selected)); push(@linenums,$current_line); $current_line++; @@ -7381,7 +7798,19 @@ sub scantron_bubble_selector { my $max=$$scan_config{'Qlength'}; my $scmode=$$scan_config{'Qon'}; - if ($scmode eq 'number' || $scmode eq 'letter') { $max=10; } + if ($scmode eq 'number' || $scmode eq 'letter') { + if (($$scan_config{'BubblesPerRow'} =~ /^\d+$/) && + ($$scan_config{'BubblesPerRow'} > 0)) { + $max=$$scan_config{'BubblesPerRow'}; + if (($scmode eq 'number') && ($max > 10)) { + $max = 10; + } elsif (($scmode eq 'letter') && $max > 26) { + $max = 26; + } + } else { + $max = 10; + } + } my @alphabet=('A'..'Z'); $r->print(&Apache::loncommon::start_data_table(). @@ -7536,7 +7965,7 @@ sub scantron_validate_CODE { my %allcodes=&get_codes(); my $nav_error; - &scantron_get_maxbubble(\$nav_error); # parse needs the lines per response array. + &scantron_get_maxbubble(\$nav_error,\%scantron_config); # parse needs the lines per response array. if ($nav_error) { $r->print(&navmap_errormsg()); return(1,$currentphase); @@ -7590,12 +8019,43 @@ sub scantron_validate_doublebubble { #get student info my $classlist=&Apache::loncoursedata::get_classlist(); my %idmap=&username_to_idmap($classlist); + my (undef,undef,$sequence)= + &Apache::lonnet::decode_symb($env{'form.selectpage'}); #get scantron line setup my %scantron_config=&get_scantron_config($env{'form.scantron_format'}); my ($scanlines,$scan_data)=&scantron_getfile(); + + my $navmap = Apache::lonnavmaps::navmap->new(); + unless (ref($navmap)) { + $r->print(&navmap_errormsg()); + return(1,$currentphase); + } + my $map=$navmap->getResourceByUrl($sequence); + my @resources=$navmap->retrieveResources($map,\&scantron_filter,1,0); + my ($randomorder,$randompick,@master_seq,%symb_to_resource,%grader_partids_by_symb, + %grader_randomlists_by_symb,%orderedforcode,%respnumlookup,%startline); + my $bubbles_per_row = &bubblesheet_bubbles_per_row(\%scantron_config); + my $nav_error; - &scantron_get_maxbubble(\$nav_error); # parse needs the bubble line array. + if (ref($map)) { + $randomorder = $map->randomorder(); + $randompick = $map->randompick(); + if ($randomorder || $randompick) { + $nav_error = &get_master_seq(\@resources,\@master_seq,\%symb_to_resource); + if ($nav_error) { + $r->print(&navmap_errormsg()); + return(1,$currentphase); + } + &graders_resources_pass(\@resources,\%grader_partids_by_symb, + \%grader_randomlists_by_symb,$bubbles_per_row); + } + } else { + $r->print(&navmap_errormsg()); + return(1,$currentphase); + } + + &scantron_get_maxbubble(\$nav_error,\%scantron_config); # parse needs the bubble line array. if ($nav_error) { $r->print(&navmap_errormsg()); return(1,$currentphase); @@ -7605,11 +8065,15 @@ sub scantron_validate_doublebubble { 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); + $scan_data,undef,\%idmap,$randomorder, + $randompick,$sequence,\@master_seq, + \%symb_to_resource,\%grader_partids_by_symb, + \%orderedforcode,\%respnumlookup,\%startline); if (!defined($$scan_record{'scantron.doubleerror'})) { next; } &scantron_get_correction($r,$i,$scan_record,\%scantron_config,$line, 'doublebubble', - $$scan_record{'scantron.doubleerror'}); + $$scan_record{'scantron.doubleerror'}, + $randomorder,$randompick,\%respnumlookup,\%startline); return (1,$currentphase); } return (0,$currentphase+1); @@ -7617,7 +8081,7 @@ sub scantron_validate_doublebubble { sub scantron_get_maxbubble { - my ($nav_error) = @_; + my ($nav_error,$scantron_config) = @_; if (defined($env{'form.scantron_maxbubble'}) && $env{'form.scantron_maxbubble'}) { &restore_bubble_lines(); @@ -7636,6 +8100,7 @@ sub scantron_get_maxbubble { } my $map=$navmap->getResourceByUrl($sequence); my @resources=$navmap->retrieveResources($map,\&scantron_filter,1,0); + my $bubbles_per_row = &bubblesheet_bubbles_per_row($scantron_config); &Apache::lonxml::clear_problem_counter(); @@ -7647,11 +8112,14 @@ sub scantron_get_maxbubble { %first_bubble_line = (); %subdivided_bubble_lines = (); %responsetype_per_response = (); + %masterseq_id_responsenum = (); my $response_number = 0; my $bubble_line = 0; foreach my $resource (@resources) { - my ($analysis,$parts) = &scantron_partids_tograde($resource,$cid,$uname,$udom); + my $resid = $resource->id(); + my ($analysis,$parts) = &scantron_partids_tograde($resource,$cid,$uname, + $udom,undef,$bubbles_per_row); if ((ref($analysis) eq 'HASH') && (ref($parts) eq 'ARRAY')) { foreach my $part_id (@{$parts}) { my $lines; @@ -7680,9 +8148,10 @@ sub scantron_get_maxbubble { 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) { + my $bubbles_per_row = + &bubblesheet_bubbles_per_row($scantron_config); + my $inner_bubble_lines = int($numbub/$bubbles_per_row); + if (($numbub % $bubbles_per_row) != 0) { $inner_bubble_lines++; } for (my $i=0; $i<$numshown; $i++) { @@ -7693,12 +8162,13 @@ sub scantron_get_maxbubble { $lines = $numshown * $inner_bubble_lines; } else { $lines = $analysis->{"$part_id.bubble_lines"}; - } + } $first_bubble_line{$response_number} = $bubble_line; $bubble_lines_per_response{$response_number} = $lines; $responsetype_per_response{$response_number} = $analysis->{$part_id.'.type'}; + $masterseq_id_responsenum{$resid.'_'.$part_id} = $response_number; $response_number++; $bubble_line += $lines; @@ -7714,26 +8184,76 @@ sub scantron_get_maxbubble { return $env{'form.scantron_maxbubble'}; } +sub bubblesheet_bubbles_per_row { + my ($scantron_config) = @_; + my $bubbles_per_row; + if (ref($scantron_config) eq 'HASH') { + $bubbles_per_row = $scantron_config->{'BubblesPerRow'}; + } + if ((!$bubbles_per_row) || ($bubbles_per_row < 1)) { + $bubbles_per_row = 10; + } + return $bubbles_per_row; +} + sub scantron_validate_missingbubbles { my ($r,$currentphase) = @_; #get student info my $classlist=&Apache::loncoursedata::get_classlist(); my %idmap=&username_to_idmap($classlist); + my (undef,undef,$sequence)= + &Apache::lonnet::decode_symb($env{'form.selectpage'}); #get scantron line setup my %scantron_config=&get_scantron_config($env{'form.scantron_format'}); my ($scanlines,$scan_data)=&scantron_getfile(); + + my $navmap = Apache::lonnavmaps::navmap->new(); + unless (ref($navmap)) { + $r->print(&navmap_errormsg()); + return(1,$currentphase); + } + + my $map=$navmap->getResourceByUrl($sequence); + my @resources=$navmap->retrieveResources($map,\&scantron_filter,1,0); + my ($randomorder,$randompick,@master_seq,%symb_to_resource,%grader_partids_by_symb, + %grader_randomlists_by_symb,%orderedforcode,%respnumlookup,%startline); + my $bubbles_per_row = &bubblesheet_bubbles_per_row(\%scantron_config); + my $nav_error; - my $max_bubble=&scantron_get_maxbubble(\$nav_error); + if (ref($map)) { + $randomorder = $map->randomorder(); + $randompick = $map->randompick(); + if ($randomorder || $randompick) { + $nav_error = &get_master_seq(\@resources,\@master_seq,\%symb_to_resource); + if ($nav_error) { + $r->print(&navmap_errormsg()); + return(1,$currentphase); + } + &graders_resources_pass(\@resources,\%grader_partids_by_symb, + \%grader_randomlists_by_symb,$bubbles_per_row); + } + } else { + $r->print(&navmap_errormsg()); + return(1,$currentphase); + } + + + my $max_bubble=&scantron_get_maxbubble(\$nav_error,\%scantron_config); if ($nav_error) { + $r->print(&navmap_errormsg()); return(1,$currentphase); } + if (!$max_bubble) { $max_bubble=2**31; } 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 $scan_record = + &scantron_parse_scanline($line,$i,\%scantron_config,$scan_data,undef,\%idmap, + $randomorder,$randompick,$sequence,\@master_seq, + \%symb_to_resource,\%grader_partids_by_symb, + \%orderedforcode,\%respnumlookup,\%startline); if (!defined($$scan_record{'scantron.missingerror'})) { next; } my @to_correct; @@ -7742,28 +8262,45 @@ sub scantron_validate_missingbubbles { foreach my $missing (@{$$scan_record{'scantron.missingerror'}}) { 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; + my $question = $1; + my $subquestion = $2; + my ($first,$responsenum); + if ($randomorder || $randompick) { + $responsenum = $respnumlookup{$question-1}; + $first = $startline{$question-1}; + } else { + $responsenum = $question-1; + $first = $first_bubble_line{$responsenum}; + } + if (!defined($first)) { next; } + my @subans = split(/,/,$subdivided_bubble_lines{$responsenum}); + 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}; + my ($first,$responsenum); + if ($randomorder || $randompick) { + $responsenum = $respnumlookup{$missing-1}; + $first = $startline{$missing-1}; + } else { + $responsenum = $missing-1; + $first = $first_bubble_line{$responsenum}; + } + if (!defined($first)) { next; } + $lastbubble = $first + $bubble_lines_per_response{$responsenum}; } if ($lastbubble > $max_bubble) { next; } push(@to_correct,$missing); } if (@to_correct) { &scantron_get_correction($r,$i,$scan_record,\%scantron_config, - $line,'missingbubble',\@to_correct); + $line,'missingbubble',\@to_correct, + $randomorder,$randompick,\%respnumlookup, + \%startline); return (1,$currentphase); } @@ -7771,6 +8308,41 @@ sub scantron_validate_missingbubbles { return (0,$currentphase+1); } +sub hand_bubble_option { + my (undef, undef, $sequence) = + &Apache::lonnet::decode_symb($env{'form.selectpage'}); + return if ($sequence eq ''); + my $navmap = Apache::lonnavmaps::navmap->new(); + unless (ref($navmap)) { + return; + } + my $needs_hand_bubbles; + my $map=$navmap->getResourceByUrl($sequence); + my @resources=$navmap->retrieveResources($map,\&scantron_filter,1,0); + foreach my $res (@resources) { + if (ref($res)) { + if ($res->is_problem()) { + my $partlist = $res->parts(); + foreach my $part (@{ $partlist }) { + my @types = $res->responseType($part); + if (grep(/^(chem|essay|image|formula|math|string|functionplot)$/,@types)) { + $needs_hand_bubbles = 1; + last; + } + } + } + } + } + if ($needs_hand_bubbles) { + my %scantron_config=&get_scantron_config($env{'form.scantron_format'}); + my $bubbles_per_row = &bubblesheet_bubbles_per_row(\%scantron_config); + return &mt('The sequence to be graded contains response types which are handgraded.').''. + &mt('If you have already graded these by bubbling sheets to indicate points awarded, [_1]what point value is assigned to a filled last bubble in each row?',''). + ''.&mt('[quant,_1,point]',$bubbles_per_row).' '.&mt('or').' '. + '0 points'; + } + return; +} sub scantron_process_students { my ($r) = @_; @@ -7783,6 +8355,7 @@ sub scantron_process_students { my $default_form_data=&defaultFormData($symb); my %scantron_config=&get_scantron_config($env{'form.scantron_format'}); + my $bubbles_per_row = &bubblesheet_bubbles_per_row(\%scantron_config); my ($scanlines,$scan_data)=&scantron_getfile(); my $classlist=&Apache::loncoursedata::get_classlist(); my %idmap=&username_to_idmap($classlist); @@ -7790,36 +8363,29 @@ sub scantron_process_students { 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 $resource_error; - foreach my $resource (@resources) { - my $ressymb; - if (ref($resource)) { - $ressymb = $resource->symb(); - } else { - $resource_error = 1; - last; - } - 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'}; - } - } } - if ($resource_error) { + my $map=$navmap->getResourceByUrl($sequence); + my ($randomorder,$randompick,@master_seq,%symb_to_resource,%grader_partids_by_symb, + %grader_randomlists_by_symb); + if (ref($map)) { + $randomorder = $map->randomorder(); + $randompick = $map->randompick(); + } else { $r->print(&navmap_errormsg()); return ''; } + my $nav_error; + my @resources=$navmap->retrieveResources($map,\&scantron_filter,1,0); + my (%grader_partids_by_symb,%grader_randomlists_by_symb,%ordered); + if ($randomorder || $randompick) { + $nav_error = &get_master_seq(\@resources,\@master_seq,\%symb_to_resource); + if ($nav_error) { + $r->print(&navmap_errormsg()); + return ''; + } + } + &graders_resources_pass(\@resources,\%grader_partids_by_symb, + \%grader_randomlists_by_symb,$bubbles_per_row); my ($uname,$udom); my $result= <print(''); @@ -7844,8 +8408,7 @@ SCANTRONFORM my $i=-1; my $started; - my $nav_error; - &scantron_get_maxbubble(\$nav_error); # Need the bubble lines array to parse. + &scantron_get_maxbubble(\$nav_error,\%scantron_config); # Need the bubble lines array to parse. if ($nav_error) { $r->print(&navmap_errormsg()); return ''; @@ -7864,6 +8427,7 @@ SCANTRONFORM my %lettdig = &letter_to_digits(); my $numletts = scalar(keys(%lettdig)); + my %orderedforcode; while ($i<$scanlines->{'count'}) { ($uname,$udom)=('',''); @@ -7875,8 +8439,15 @@ SCANTRONFORM 'last student'); } $started=1; + my %respnumlookup = (); + my %startline = (); + my $total; my $scan_record=&scantron_parse_scanline($line,$i,\%scantron_config, - $scan_data); + $scan_data,undef,\%idmap,$randomorder, + $randompick,$sequence,\@master_seq, + \%symb_to_resource,\%grader_partids_by_symb, + \%orderedforcode,\%respnumlookup,\%startline, + \$total); unless ($uname=&scantron_find_student($scan_record,$scan_data, \%idmap,$i)) { &scantron_add_delay(\@delayqueue,$line, @@ -7888,10 +8459,26 @@ SCANTRONFORM 'Student '.$uname.' has multiple sheets',2); next; } + my $usec = $classlist->{$uname}->[&Apache::loncoursedata::CL_SECTION]; + my $user = $uname.':'.$usec; ($uname,$udom)=split(/:/,$uname); + my $scancode; + if ((exists($scan_record->{'scantron.CODE'})) && + (&Apache::lonnet::validCODE($scan_record->{'scantron.CODE'}))) { + $scancode = $scan_record->{'scantron.CODE'}; + } else { + $scancode = ''; + } + + my @mapresources = @resources; + if ($randomorder || $randompick) { + @mapresources = + &users_order($user,$scancode,$sequence,\@master_seq,\%symb_to_resource, + \%orderedforcode); + } my (%partids_by_symb,$res_error); - foreach my $resource (@resources) { + foreach my $resource (@mapresources) { my $ressymb; if (ref($resource)) { $ressymb = $resource->symb(); @@ -7902,7 +8489,8 @@ SCANTRONFORM 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); + &scantron_partids_tograde($resource,$env{'request.course.id'}, + $uname,$udom,undef,$bubbles_per_row); $partids_by_symb{$ressymb} = $parts; } else { $partids_by_symb{$ressymb} = $grader_partids_by_symb{$ressymb}; @@ -7922,16 +8510,11 @@ SCANTRONFORM &scantron_putfile($scanlines,$scan_data); } - 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') { + \@mapresources,\%partids_by_symb, + $bubbles_per_row,$randomorder,$randompick, + \%respnumlookup,\%startline) + eq 'ssi_error') { $ssi_error = 0; # So end of handler error message does not trigger. $r->print("
'.&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("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('Some resources in the sequence currently are not set to exam mode. Grading these resources currently may not work correctly.')."
' + .&mt('Some resources in the sequence currently are not set to' + .' exam mode. Grading these resources currently may not' + .' work correctly.') + .'
".&mt("Please indicate which bubble should be used for grading")."
'. + &mt('If you have already graded these by bubbling sheets to indicate points awarded, [_1]what point value is assigned to a filled last bubble in each row?',''). + ''.&mt('[quant,_1,point]',$bubbles_per_row).' '.&mt('or').' '. + '0 points
- '.&mt('The requested file name was invalid.').' + '.&mt('The requested filename was invalid.').'
'.&mt('Exact matches for [quant,_1,student].',$passed).''.&mt('Discrepancies detected for [quant,_1,student].',$failed).'
' + .&mt('Exact matches for [_1][quant,_2,student][_3].','',$passed,'') + .'' + .&mt('Discrepancies detected for [_1][quant,_2,student][_3].','',$failed,'') + .'