--- loncom/homework/grades.pm 2011/10/10 18:27:34 1.596.2.5 +++ loncom/homework/grades.pm 2013/08/14 03:33:54 1.596.2.12.2.18 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA # The LON-CAPA Grading handler # -# $Id: grades.pm,v 1.596.2.5 2011/10/10 18:27:34 raeburn Exp $ +# $Id: grades.pm,v 1.596.2.12.2.18 2013/08/14 03:33:54 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.='
".&mt("There have been multiple bubbles scanned for some question(s)")."
\n"); + $r->print(''.&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); + my $line_list = &questions_to_line_list($arg,$randomorder,$randompick, + $respnumlookup,$startline); $r->print(''); @@ -7161,12 +7530,14 @@ 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)); } elsif ($error eq 'missingbubble') { - $r->print("".&mt("There have been no bubbles scanned for some question(s)")."
\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"); @@ -7175,13 +7546,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)); @@ -7234,12 +7608,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}) { @@ -7248,8 +7630,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]; @@ -7257,8 +7647,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)); @@ -7280,6 +7678,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. @@ -7304,15 +7710,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]; @@ -7320,25 +7737,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.').''.
+ &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?','
').
+ '
');
+ $r->print(' ');
if ($scancode eq '') {
- $r->print(&mt('Mismatch grading bubble sheet for user: [_1] with ID: [_2].',
+ $r->print(&mt('Mismatch grading bubblesheet 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].',
+ $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".
@@ -7982,11 +8593,11 @@ SCANTRONFORM
'
- '.&mt('The requested file name was invalid.').' + '.&mt('The requested filename was invalid.').'
'); - $r->print(&show_grading_menu_form(&get_symb($r,1))); + $r->print(&show_grading_menu_form($symb)); return; } my $orig='/uploaded/'.$cdom.'/'.$cname.'/scantron_orig_'.$file; @@ -8313,7 +8997,7 @@ sub scantron_download_scantron_data { '','').' '); - $r->print(&show_grading_menu_form(&get_symb($r,1))); + $r->print(&show_grading_menu_form($symb)); return ''; } @@ -8331,6 +9015,7 @@ sub checkscantron_results { my %record; my %scantron_config = &Apache::grades::get_scantron_config($env{'form.scantron_format'}); + my $bubbles_per_row = &bubblesheet_bubbles_per_row(\%scantron_config); my ($scanlines,$scan_data)=&Apache::grades::scantron_getfile(); my $classlist=&Apache::loncoursedata::get_classlist(); my %idmap=&Apache::grades::username_to_idmap($classlist); @@ -8340,10 +9025,20 @@ sub checkscantron_results { return ''; } my $map=$navmap->getResourceByUrl($sequence); + my ($randomorder,$randompick,@master_seq,%symb_to_resource,%grader_partids_by_symb, + %grader_randomlists_by_symb,%orderedforcode); + if (ref($map)) { + $randomorder=$map->randomorder(); + $randompick=$map->randompick(); + } 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 $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 (%scandata,%lastname,%bylast); $r->print(' @@ -8352,13 +9047,10 @@ sub checkscantron_results { my @delayqueue; my %completedstudents; - my $count=&Apache::grades::get_todo_count($scanlines,$scan_data); - my %prog_state=&Apache::lonhtmlcommon::Create_PrgWin($r,'Bubblesheet/Submissions Comparison Status', - 'Progress of Bubblesheet Data/Submission Records Comparison',$count, - 'inline',undef,'checkscantron'); - my ($username,$domain,$started); - my $nav_error; - &scantron_get_maxbubble(\$nav_error); # Need the bubble lines array to parse. + my $count=&get_todo_count($scanlines,$scan_data); + my %prog_state=&Apache::lonhtmlcommon::Create_PrgWin($r,$count); + my ($username,$domain,$started,%ordered); + &scantron_get_maxbubble(\$nav_error,\%scantron_config); # Need the bubble lines array to parse. if ($nav_error) { $r->print(&navmap_errormsg()); return ''; @@ -8382,8 +9074,8 @@ sub checkscantron_results { my $scan_record= &Apache::grades::scantron_parse_scanline($line,$i,\%scantron_config, $scan_data); - unless ($uname=&Apache::grades::scantron_find_student($scan_record,$scan_data, - \%idmap,$i)) { + unless ($uname=&scantron_find_student($scan_record,$scan_data, + \%idmap,$i)) { &Apache::grades::scantron_add_delay(\@delayqueue,$line, 'Unable to find a student that matches',1); next; @@ -8396,26 +9088,57 @@ sub checkscantron_results { my $pid = $scan_record->{'scantron.ID'}; $lastname{$pid} = $scan_record->{'scantron.LastName'}; push(@{$bylast{$lastname{$pid}}},$pid); + my $usec = $classlist->{$uname}->[&Apache::loncoursedata::CL_SECTION]; + my $user = $uname.':'.$usec; + ($username,$domain)=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; my $lastpos = $env{'form.scantron_maxbubble'}*$scantron_config{'Qlength'}; + my %respnumlookup=(); + my %startline=(); + if ($randomorder || $randompick) { + @mapresources = + &users_order($user,$scancode,$sequence,\@master_seq,\%symb_to_resource, + \%orderedforcode); + my $total = &get_respnum_lookups($sequence,$scan_data,\%idmap,$line, + $scan_record,\@master_seq,\%symb_to_resource, + \%grader_partids_by_symb,\%orderedforcode, + \%respnumlookup,\%startline); + if ($randompick && $total) { + $lastpos = $total*$scantron_config{'Qlength'}; + } + } $scandata{$pid} = substr($line,$scantron_config{'Qstart'}-1,$lastpos); chomp($scandata{$pid}); $scandata{$pid} =~ s/\r$//; - ($username,$domain)=split(/:/,$uname); + my $counter = -1; - foreach my $resource (@resources) { + foreach my $resource (@mapresources) { my $parts; my $ressymb = $resource->symb(); 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'},$username,$domain); + &scantron_partids_tograde($resource,$env{'request.course.id'}, + $username,$domain,undef, + $bubbles_per_row); } else { $parts = $grader_partids_by_symb{$ressymb}; } ($counter,my $recording) = &verify_scantron_grading($resource,$domain,$username,$cid,$counter, $scandata{$pid},$parts, - \%scantron_config,\%lettdig,$numletts); + \%scantron_config,\%lettdig,$numletts, + $randomorder,$randompick, + \%respnumlookup,\%startline); $record{$pid} .= $recording; } } @@ -8454,14 +9177,18 @@ sub checkscantron_results { } } $r->print(''. - &mt('Comparison of bubblesheet data (including corrections) with corresponding submission records (most recent submission) for [_1][quant,_2,student][_3] ([_4] bubblesheet lines/student).', + &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).'
'
+ .&mt('Exact matches for [_1][quant,_2,student][_3].','',$passed,'')
+ .'
'
+ .&mt('Discrepancies detected for [_1][quant,_2,student][_3].','',$failed,'')
+ .'