--- loncom/homework/grades.pm 2013/08/16 15:36:08 1.596.2.12.2.19 +++ 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.596.2.12.2.19 2013/08/16 15:36:08 raeburn Exp $ +# $Id: grades.pm,v 1.596.2.13 2012/08/09 23:25:48 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # @@ -125,16 +125,13 @@ sub getpartlist { # --- Get the symbolic name of a problem and the url sub get_symb { my ($request,$silent) = @_; - 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 (); - } - } + (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 (); + } } &Apache::lonenc::check_decrypt(\$symb); return ($symb); @@ -253,7 +250,7 @@ sub showResourceInfo { $result.='
@@ -6729,11 +6389,11 @@ sub scantron_warning_screen { '.&mt('Sequence to be Graded:').''.$title.' '.&mt('Data File that will be used:').''.$env{'form.scantron_selectfile'}.' -'.$CODElist.$lastbubblepoints.' +'.$CODElist.' - '.&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.').' '); @@ -6769,9 +6429,8 @@ sub scantron_do_warning { } } else { my $warning=&scantron_warning_screen('Grading: Validate Records'); - my $bubbledbyhand=&hand_bubble_option(); $r->print(' -'.$warning.$bubbledbyhand.' +'.$warning.' '); @@ -6813,11 +6472,9 @@ SCANTRONFORM ''."\n"; $chunk .= ''."\n"; - $chunk .= - ''."\n"; $result .= $chunk; $line++; - } + } return $result; } @@ -6863,16 +6520,12 @@ sub scantron_validate_file { #get the student pick code ready $r->print(&Apache::loncommon::studentbrowser_javascript()); my $nav_error; - my %scantron_config=&get_scantron_config($env{'form.scantron_format'}); - my $max_bubble=&scantron_get_maxbubble(\$nav_error,\%scantron_config); + my $max_bubble=&scantron_get_maxbubble(\$nav_error); if ($nav_error) { $r->print(&navmap_errormsg()); return ''; } my $result=&scantron_form_start($max_bubble).$default_form_data; - if ($env{'form.scantron_lastbubblepoints'} ne '') { - $result .= ''; - } $r->print($result); my @validate_phases=( 'sequence', @@ -6890,7 +6543,6 @@ 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'; @@ -7299,12 +6951,7 @@ 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); } } @@ -7326,7 +6973,7 @@ sub scantron_validate_ID { my ($scanlines,$scan_data)=&scantron_getfile(); my $nav_error; - &scantron_get_maxbubble(\$nav_error,\%scantron_config); # parse needs the bubble_lines.. array. + &scantron_get_maxbubble(\$nav_error); # parse needs the bubble_lines.. array. if ($nav_error) { $r->print(&navmap_errormsg()); return(1,$currentphase); @@ -7385,8 +7032,7 @@ sub scantron_validate_ID { sub scantron_get_correction { - my ($r,$i,$scan_record,$scan_config,$line,$error,$arg, - $randomorder,$randompick,$respnumlookup,$startline)=@_; + my ($r,$i,$scan_record,$scan_config,$line,$error,$arg)=@_; #FIXME in the case of a duplicated ID the previous line, probably need #to show both the current line and the previous one and allow skipping #the previous one or the current one @@ -7436,7 +7082,7 @@ sub scantron_get_correction { $r->print(&Apache::loncommon::selectstudent_link('scantronupload', 'scantron_username','scantron_domain')); $r->print(": "); - $r->print("\n:\n". + $r->print("\n@". &Apache::loncommon::select_dom_form($env{'request.role.domain'},'scantron_domain')); $r->print(''); @@ -7522,8 +7168,7 @@ 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,$randomorder,$randompick, - $respnumlookup,$startline); + my $line_list = &questions_to_line_list($arg); $r->print(''); @@ -7531,9 +7176,7 @@ 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, - $randomorder,$randompick, - $respnumlookup,$startline); + $scan_record, $error); push(@lines_to_correct,@linenums); } $r->print(&verify_bubbles_checked(@lines_to_correct)); @@ -7547,16 +7190,13 @@ ENDSCRIPT # a list of question numbers. Therefore: # - my $line_list = &questions_to_line_list($arg,$randomorder,$randompick, - $respnumlookup,$startline); + my $line_list = &questions_to_line_list($arg); $r->print(''); foreach my $question (@{$arg}) { my @linenums = &prompt_for_corrections($r,$question,$scan_config, - $scan_record, $error, - $randomorder,$randompick, - $respnumlookup,$startline); + $scan_record, $error); push(@lines_to_correct,@linenums); } $r->print(&verify_bubbles_checked(@lines_to_correct)); @@ -7609,20 +7249,12 @@ 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,$randomorder,$randompick,$respnumlookup,$startline) = @_; + my ($questions) = @_; my @lines; foreach my $item (@{$questions}) { @@ -7631,16 +7263,8 @@ sub questions_to_line_list { if ($item =~ /^(\d+)\.(\d+)$/) { $question = $1; my $subquestion = $2; - 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}); + $first = $first_bubble_line{$question-1} + 1; + my @subans = split(/,/,$subdivided_bubble_lines{$question-1}); my $subcount = 1; while ($subcount<$subquestion) { $first += $subans[$subcount-1]; @@ -7648,16 +7272,8 @@ sub questions_to_line_list { } $count = $subans[$subquestion-1]; } else { - 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}; + $first = $first_bubble_line{$question-1} + 1; + $count = $bubble_lines_per_response{$question-1}; } $last = $first+$count-1; push(@lines, ($first..$last)); @@ -7679,14 +7295,6 @@ 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. @@ -7711,26 +7319,15 @@ for multi and missing bubble cases). =cut sub prompt_for_corrections { - my ($r, $question, $scan_config, $scan_record, $error, $randomorder, - $randompick, $respnumlookup, $startline) = @_; + my ($r, $question, $scan_config, $scan_record, $error) = @_; 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; - 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 @subans = split(/,/,$subdivided_bubble_lines{$question-1}); my $subcount = 1; while ($subcount<$subquestion) { $current_line += $subans[$subcount-1]; @@ -7738,34 +7335,25 @@ sub prompt_for_corrections { } $lines = $subans[$subquestion-1]; } else { - 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}; + $current_line = $first_bubble_line{$question-1} + 1 ; + $lines = $bubble_lines_per_response{$question-1}; } if ($lines > 1) { $r->print(&mt('The group of bubble lines below responds to a single question.').''); - 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'.").''); + 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'.").''); } 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++; @@ -7798,19 +7386,7 @@ sub scantron_bubble_selector { my $max=$$scan_config{'Qlength'}; my $scmode=$$scan_config{'Qon'}; - 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; - } - } + if ($scmode eq 'number' || $scmode eq 'letter') { $max=10; } my @alphabet=('A'..'Z'); $r->print(&Apache::loncommon::start_data_table(). @@ -7965,7 +7541,7 @@ sub scantron_validate_CODE { my %allcodes=&get_codes(); my $nav_error; - &scantron_get_maxbubble(\$nav_error,\%scantron_config); # parse needs the lines per response array. + &scantron_get_maxbubble(\$nav_error); # parse needs the lines per response array. if ($nav_error) { $r->print(&navmap_errormsg()); return(1,$currentphase); @@ -8019,43 +7595,12 @@ 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; - 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. + &scantron_get_maxbubble(\$nav_error); # parse needs the bubble line array. if ($nav_error) { $r->print(&navmap_errormsg()); return(1,$currentphase); @@ -8065,15 +7610,11 @@ 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,undef,\%idmap,$randomorder, - $randompick,$sequence,\@master_seq, - \%symb_to_resource,\%grader_partids_by_symb, - \%orderedforcode,\%respnumlookup,\%startline); + $scan_data); if (!defined($$scan_record{'scantron.doubleerror'})) { next; } &scantron_get_correction($r,$i,$scan_record,\%scantron_config,$line, 'doublebubble', - $$scan_record{'scantron.doubleerror'}, - $randomorder,$randompick,\%respnumlookup,\%startline); + $$scan_record{'scantron.doubleerror'}); return (1,$currentphase); } return (0,$currentphase+1); @@ -8081,7 +7622,7 @@ sub scantron_validate_doublebubble { sub scantron_get_maxbubble { - my ($nav_error,$scantron_config) = @_; + my ($nav_error) = @_; if (defined($env{'form.scantron_maxbubble'}) && $env{'form.scantron_maxbubble'}) { &restore_bubble_lines(); @@ -8100,7 +7641,6 @@ 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(); @@ -8112,14 +7652,11 @@ 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 $resid = $resource->id(); - my ($analysis,$parts) = &scantron_partids_tograde($resource,$cid,$uname, - $udom,undef,$bubbles_per_row); + 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; @@ -8148,10 +7685,9 @@ sub scantron_get_maxbubble { if (ref($analysis->{$part_id.'.shown'}) eq 'ARRAY') { $numshown = scalar(@{$analysis->{$part_id.'.shown'}}); } - 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) { + 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++) { @@ -8162,13 +7698,12 @@ 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; @@ -8184,76 +7719,26 @@ 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; - 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); + my $max_bubble=&scantron_get_maxbubble(\$nav_error); 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,undef,\%idmap, - $randomorder,$randompick,$sequence,\@master_seq, - \%symb_to_resource,\%grader_partids_by_symb, - \%orderedforcode,\%respnumlookup,\%startline); + my $scan_record=&scantron_parse_scanline($line,$i,\%scantron_config, + $scan_data); if (!defined($$scan_record{'scantron.missingerror'})) { next; } my @to_correct; @@ -8262,45 +7747,28 @@ sub scantron_validate_missingbubbles { foreach my $missing (@{$$scan_record{'scantron.missingerror'}}) { my $lastbubble; if ($missing =~ /^(\d+)\.(\d+)$/) { - 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; + 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 { - 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 (!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) { &scantron_get_correction($r,$i,$scan_record,\%scantron_config, - $line,'missingbubble',\@to_correct, - $randomorder,$randompick,\%respnumlookup, - \%startline); + $line,'missingbubble',\@to_correct); return (1,$currentphase); } @@ -8308,41 +7776,6 @@ 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) = @_; @@ -8355,7 +7788,6 @@ 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); @@ -8363,29 +7795,36 @@ sub scantron_process_students { unless (ref($navmap)) { $r->print(&navmap_errormsg()); return ''; - } + } 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 ''; + 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'}; + } } } - &graders_resources_pass(\@resources,\%grader_partids_by_symb, - \%grader_randomlists_by_symb,$bubbles_per_row); + if ($resource_error) { + $r->print(&navmap_errormsg()); + return ''; + } my ($uname,$udom); my $result= <print(''); @@ -8408,7 +7849,8 @@ SCANTRONFORM my $i=-1; my $started; - &scantron_get_maxbubble(\$nav_error,\%scantron_config); # Need the bubble lines array to parse. + my $nav_error; + &scantron_get_maxbubble(\$nav_error); # Need the bubble lines array to parse. if ($nav_error) { $r->print(&navmap_errormsg()); return ''; @@ -8427,7 +7869,6 @@ SCANTRONFORM my %lettdig = &letter_to_digits(); my $numletts = scalar(keys(%lettdig)); - my %orderedforcode; while ($i<$scanlines->{'count'}) { ($uname,$udom)=('',''); @@ -8439,15 +7880,8 @@ SCANTRONFORM 'last student'); } $started=1; - my %respnumlookup = (); - my %startline = (); - my $total; 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, - \$total); + $scan_data); unless ($uname=&scantron_find_student($scan_record,$scan_data, \%idmap,$i)) { &scantron_add_delay(\@delayqueue,$line, @@ -8459,26 +7893,10 @@ 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 (@mapresources) { + foreach my $resource (@resources) { my $ressymb; if (ref($resource)) { $ressymb = $resource->symb(); @@ -8489,8 +7907,7 @@ 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,undef,$bubbles_per_row); + &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}; @@ -8510,11 +7927,16 @@ 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, - \@mapresources,\%partids_by_symb, - $bubbles_per_row,$randomorder,$randompick, - \%respnumlookup,\%startline) - eq 'ssi_error') { + \@resources,\%partids_by_symb) 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 filename was invalid.').' + '.&mt('The requested file name was invalid.').'
' - .&mt('Exact matches for [_1][quant,_2,student][_3].','',$passed,'') - .'' - .&mt('Discrepancies detected for [_1][quant,_2,student][_3].','',$failed,'') - .'
'.&mt('Exact matches for [quant,_1,student].',$passed).''.&mt('Discrepancies detected for [quant,_1,student].',$failed).'