--- loncom/homework/grades.pm 2008/12/21 22:01:35 1.539 +++ loncom/homework/grades.pm 2009/04/22 17:19:06 1.563 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA # The LON-CAPA Grading handler # -# $Id: grades.pm,v 1.539 2008/12/21 22:01:35 riegler Exp $ +# $Id: grades.pm,v 1.563 2009/04/22 17:19:06 bisitz Exp $ # # Copyright Michigan State University Board of Trustees # @@ -234,28 +234,54 @@ sub reset_caches { { my %analyze_cache; + my %analyze_cache_formkeys; sub reset_analyze_cache { undef(%analyze_cache); + undef(%analyze_cache_formkeys); } sub get_analyze { - my ($symb,$uname,$udom,$no_increment)=@_; + my ($symb,$uname,$udom,$no_increment,$add_to_hash)=@_; my $key = "$symb\0$uname\0$udom"; - return $analyze_cache{$key} if (exists($analyze_cache{$key})); + if (exists($analyze_cache{$key})) { + my $getupdate = 0; + if (ref($add_to_hash) eq 'HASH') { + foreach my $item (keys(%{$add_to_hash})) { + if (ref($analyze_cache_formkeys{$key}) eq 'HASH') { + if (!exists($analyze_cache_formkeys{$key}{$item})) { + $getupdate = 1; + last; + } + } else { + $getupdate = 1; + } + } + } + if (!$getupdate) { + return $analyze_cache{$key}; + } + } my (undef,undef,$url)=&Apache::lonnet::decode_symb($symb); $url=&Apache::lonnet::clutter($url); - my $subresult=&ssi_with_retries($url, $ssi_retries, - ('grade_target' => 'analyze', - 'grade_domain' => $udom, - 'grade_symb' => $symb, - 'grade_courseid' => - $env{'request.course.id'}, - 'grade_username' => $uname, - 'grade_noincrement' => $no_increment)); + my %form = ('grade_target' => 'analyze', + 'grade_domain' => $udom, + 'grade_symb' => $symb, + 'grade_courseid' => $env{'request.course.id'}, + 'grade_username' => $uname, + 'grade_noincrement' => $no_increment); + if (ref($add_to_hash)) { + %form = (%form,%{$add_to_hash}); + } + my $subresult=&ssi_with_retries($url, $ssi_retries,%form); (undef,$subresult)=split(/_HASH_REF__/,$subresult,2); my %analyze=&Apache::lonnet::str2hash($subresult); + if (ref($add_to_hash) eq 'HASH') { + $analyze_cache_formkeys{$key} = $add_to_hash; + } else { + $analyze_cache_formkeys{$key} = {}; + } return $analyze_cache{$key} = \%analyze; } @@ -268,12 +294,41 @@ sub reset_caches { sub get_radiobutton_correct_foil { my ($partid,$respid,$symb,$uname,$udom)=@_; my $analyze = &get_analyze($symb,$uname,$udom); - foreach my $foil (@{&get_order($partid,$respid,$symb,$uname,$udom)}) { - if ($analyze->{"$partid.$respid.foil.value.$foil"} eq 'true') { - return $foil; + my $foils = &get_order($partid,$respid,$symb,$uname,$udom); + if (ref($foils) eq 'ARRAY') { + foreach my $foil (@{$foils}) { + if ($analyze->{"$partid.$respid.foil.value.$foil"} eq 'true') { + return $foil; + } } } } + + sub scantron_partids_tograde { + my ($resource,$cid,$uname,$udom,$check_for_randomlist) = @_; + my (%analysis,@parts); + if (ref($resource)) { + my $symb = $resource->symb(); + my $add_to_form; + if ($check_for_randomlist) { + $add_to_form = { 'check_parts_withrandomlist' => 1,}; + } + my $analyze = &get_analyze($symb,$uname,$udom,undef,$add_to_form); + if (ref($analyze) eq 'HASH') { + %analysis = %{$analyze}; + } + if (ref($analysis{'parts'}) eq 'ARRAY') { + foreach my $part (@{$analysis{'parts'}}) { + my ($id,$respid) = split(/\./,$part); + if (!&Apache::loncommon::check_if_partid_hidden($id,$symb,$udom,$uname)) { + push(@parts,$part); + } + } + } + } + return (\%analysis,\@parts); + } + } #--- Clean response type for display @@ -699,7 +754,7 @@ sub verifyreceipt { my $title.= '

'. - &mt('Verifying Submission Receipt [_1]',$receipt). + &mt('Verifying Receipt No. [_1]',$receipt). '

'."\n". '

'.&mt('Resource: [_1]',$env{'form.probTitle'}). '

'."\n"; @@ -779,22 +834,20 @@ sub listStudents { my $getsec = $env{'form.section'} eq '' ? 'all' : $env{'form.section'}; my $getgroup = $env{'form.group'} eq '' ? 'all' : $env{'form.group'}; my $submitonly= $env{'form.submitonly'} eq '' ? 'all' : $env{'form.submitonly'}; - my $viewgrade = $env{'form.showgrading'} eq 'yes' ? &mt('View/Grade/Regrade') : &mt('View'); + my $viewgrade = $env{'form.showgrading'} eq 'yes' ? 'View/Grade/Regrade' : 'View'; $env{'form.probTitle'} = $env{'form.probTitle'} eq '' ? &Apache::lonnet::gettitle($symb) : $env{'form.probTitle'}; - my $result='

 '.$viewgrade. - &mt(' Submissions for a Student or a Group of Students') + my $result='

 ' + .&mt("$viewgrade Submissions for a Student or a Group of Students") .'

'; my ($table,undef,$hdgrade,$partlist,$handgrade) = &showResourceInfo($symb,$env{'form.probTitle'},($env{'form.showgrading'} eq 'yes')); - my %lt = ( 'multiple' => - &mt("Please select a student or group of students before clicking on the Next button."), - 'single' => - &mt("Please select the student before clicking on the Next button."), - ); - %lt = &Apache::lonlocal::texthash(%lt); + my %lt = &Apache::lonlocal::texthash ( + 'multiple' => 'Please select a student or group of students before clicking on the Next button.', + 'single' => 'Please select the student before clicking on the Next button.', + ); $request->print(< function checkSelect(checkBox) { @@ -836,16 +889,17 @@ LISTJAVASCRIPT my $gradeTable='
'. "\n".$table; - $gradeTable .= - ' '.&mt('View Problem Text').': '. - ''."\n". - ''."\n". - '
'."\n"; - $gradeTable .= - ' '.&mt('View Answer').': '. - ''."\n". - ''."\n". - '
'."\n"; + $gradeTable .= &Apache::lonhtmlcommon::start_pick_box(); + $gradeTable .= &Apache::lonhtmlcommon::row_title(&mt('View Problem Text')) + .''."\n" + .''."\n" + .'
'."\n" + .&Apache::lonhtmlcommon::row_closure(); + $gradeTable .= &Apache::lonhtmlcommon::row_title(&mt('View Answer')) + .''."\n" + .''."\n" + .'
'."\n" + .&Apache::lonhtmlcommon::row_closure(); my $submission_options; if ($env{'form.handgrade'} eq 'yes' && scalar(@$partlist) > 1) { @@ -860,19 +914,20 @@ LISTJAVASCRIPT ''."\n". ''."\n". ''; - $gradeTable .= - ' '.&mt('Submissions').': '.$submission_options.'
'."\n"; + $gradeTable .= &Apache::lonhtmlcommon::row_title(&mt('Submissions')) + .$submission_options + .&Apache::lonhtmlcommon::row_closure(); + + $gradeTable .= &Apache::lonhtmlcommon::row_title(&mt('Grading Increments')) + .'' + .&Apache::lonhtmlcommon::row_closure(); $gradeTable .= - ' '.&mt('Grading Increments').': '. - ''; - - $gradeTable .= &build_section_inputs(). ''."\n". '
'."\n". @@ -883,14 +938,23 @@ LISTJAVASCRIPT ''."\n"; if (exists($env{'form.gradingMenu'}) && exists($env{'form.Status'})) { - $gradeTable.=''."\n"; + $gradeTable .= ''."\n"; } else { - $gradeTable.=&mt('Student Status: [_1]', - &Apache::lonhtmlcommon::StatusOptions($saveStatus,undef,1,'javascript:reLoadList(this.form);')).'
'; + $gradeTable .= &Apache::lonhtmlcommon::row_title(&mt('Student Status')) + .&Apache::lonhtmlcommon::StatusOptions( + $saveStatus,undef,1,'javascript:reLoadList(this.form);') + .&Apache::lonhtmlcommon::row_closure(); } - $gradeTable.=&mt('To [_1] a submission or a group of submissions, click on the check box(es) next to the student\'s name(s). Then click on the Next button.',lc($viewgrade)).'
'."\n". - ''."\n"; + $gradeTable .= &Apache::lonhtmlcommon::row_title(&mt('Check For Plagiarism')) + .'' + .&Apache::lonhtmlcommon::row_closure(1) + .&Apache::lonhtmlcommon::end_pick_box(); + + $gradeTable .= '

' + .&mt('To '.lc($viewgrade)." a submission or a group of submissions, click on the check box(es) next to the student's name(s). Then click on the Next button.")."\n" + .'' + .'

'; # checkall buttons $gradeTable.=&check_script('gradesub', 'stuinfo'); @@ -898,7 +962,6 @@ LISTJAVASCRIPT 'onClick="javascript:checkSelect(this.form.stuinfo);" '."\n". 'value="'.&mt('Next').' →" />
'."\n"; $gradeTable.=&check_buttons(); - $gradeTable.=''; my ($classlist, undef, $fullname) = &getclasslist($getsec,'1',$getgroup); $gradeTable.= &Apache::loncommon::start_data_table(). &Apache::loncommon::start_data_table_header_row(); @@ -981,7 +1044,7 @@ LISTJAVASCRIPT $gradeTable.= &Apache::loncommon::start_data_table_row(); } $gradeTable.=''.$ctr.' '. - ' - ".&mt("Selected CODE is [_1]","")); + ".&mt("Selected CODE is [_1]",'')); $r->print("\n
"); } $r->print(" @@ -7229,124 +7299,74 @@ sub scantron_get_maxbubble { &Apache::lonxml::clear_problem_counter(); - my $uname = $env{'form.student'}; - my $udom = $env{'form.userdom'}; + my $uname = $env{'user.name'}; + my $udom = $env{'user.domain'}; my $cid = $env{'request.course.id'}; 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 (@parts,@allparts,@possible_parts); - - # Need to retrieve part IDs and response IDs because essayresponse, - # reactionresponse and organicresponse items are not included in - # $analysis{'parts'} from lonnet::ssi. - if (ref($resource->parts()) eq 'ARRAY') { - foreach my $part (@{$resource->parts()}) { - if (!&Apache::loncommon::check_if_partid_hidden($part,$symb,$udom,$uname)) { - my @resp_ids = $resource->responseIds($part); - foreach my $id (@resp_ids) { - my $part_id = $part.'.'.$id; - push(@possible_parts,$part_id); + 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'}}); + } } - } - } - } - - 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); - - my %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); - } - } - } - # Add part_ids for any essayresponse, reactionresponse or - # organicresponse items. - foreach my $part_id (@possible_parts) { - if (grep(/^\Q$part_id\E$/,@parts)) { - push(@allparts,$part_id); - } else { - if (($analysis{$part_id.'.type'} eq 'essayresponse') || - ($analysis{$part_id.'.type'} eq 'reactionresponse') || - ($analysis{$part_id.'.type'} eq 'organicresponse')) { - push(@allparts,$part_id); - } - } - } - - foreach my $part_id (@allparts) { - 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'}}); + if (ref($analysis->{$part_id.'.shown'}) eq 'ARRAY') { + $numshown = scalar(@{$analysis->{$part_id.'.shown'}}); } - } elsif ($analysis{$part_id.'.type'} eq 'matchresponse') { - if (ref($analysis{$part_id.'.items'}) eq 'ARRAY') { - $numbub = scalar(@{$analysis{$part_id.'.items'}}); + my $bubbles_per_line = 10; + my $inner_bubble_lines = int($numbub/$bubbles_per_line); + if (($numbub % $bubbles_per_line) != 0) { + $inner_bubble_lines++; } - } elsif ($analysis{$part_id.'.type'} eq 'rankresponse') { - if (ref($analysis{$part_id.'.foils'}) eq 'ARRAY') { - $numbub = scalar(@{$analysis{$part_id.'.foils'}}); + for (my $i=0; $i<$numshown; $i++) { + $subdivided_bubble_lines{$response_number} .= + $inner_bubble_lines.','; } - } - 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"}; - } - - $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++; + $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\.'); + &Apache::lonnet::delenv('scantron.'); &save_bubble_lines(); $env{'form.scantron_maxbubble'} = @@ -7354,7 +7374,6 @@ sub scantron_get_maxbubble { return $env{'form.scantron_maxbubble'}; } - sub scantron_validate_missingbubbles { my ($r,$currentphase) = @_; #get student info @@ -7426,7 +7445,24 @@ sub scantron_process_students { my $navmap=Apache::lonnavmaps::navmap->new(); my $map=$navmap->getResourceByUrl($sequence); my @resources=$navmap->retrieveResources($map,\&scantron_filter,1,0); -# $r->print("geto ".scalar(@resources)."
"); + my (%grader_partids_by_symb,%grader_randomlists_by_symb); + &graders_resources_pass(\@resources,\%grader_partids_by_symb, + \%grader_randomlists_by_symb); + foreach my $resource (@resources) { + my $ressymb = $resource->symb(); + my ($analysis,$parts) = + &scantron_partids_tograde($resource,$env{'request.course.id'}, + $env{'user.name'},$env{'user.domain'},1); + $grader_partids_by_symb{$ressymb} = $parts; + if (ref($analysis) eq 'HASH') { + if (ref($analysis->{'parts_withrandomlist'}) eq 'ARRAY') { + $grader_randomlists_by_symb{$ressymb} = + $analysis->{'parts_withrandomlist'}; + } + } + } + + my ($uname,$udom); my $result= < @@ -7435,7 +7471,7 @@ SCANTRONFORM $r->print($result); my @delayqueue; - my %completedstudents; + my (%completedstudents,%scandata); my $lock=&Apache::lonnet::set_lock(&mt('Grading bubblesheet exam')); my $count=&get_todo_count($scanlines,$scan_data); @@ -7444,12 +7480,12 @@ SCANTRONFORM 'inline',undef,'scantronupload'); &Apache::lonhtmlcommon::Update_PrgWin($r,\%prog_state, 'Processing first student'); + $r->print('
'); 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. @@ -7462,6 +7498,9 @@ SCANTRONFORM return ''; # Dunno why the other returns return '' rather than just returning. } + my %lettdig = &letter_to_digits(); + my $numletts = scalar(keys(%lettdig)); + while ($i<$scanlines->{'count'}) { ($uname,$udom)=('',''); $i++; @@ -7487,6 +7526,19 @@ SCANTRONFORM } ($uname,$udom)=split(/:/,$uname); + my %partids_by_symb; + foreach my $resource (@resources) { + 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'},$uname,$udom); + $partids_by_symb{$ressymb} = $parts; + } else { + $partids_by_symb{$ressymb} = $grader_partids_by_symb{$ressymb}; + } + } + &Apache::lonxml::clear_problem_counter(); &Apache::lonnet::appenv($scan_record); @@ -7494,39 +7546,96 @@ SCANTRONFORM &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=&ssi_with_retries($resource->src(), $ssi_retries, %form); - if ($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. - } + my $scancode; + if ((exists($scan_record->{'scantron.CODE'})) && + (&Apache::lonnet::validCODE($scan_record->{'scantron.CODE'}))) { + $scancode = $scan_record->{'scantron.CODE'}; + } else { + $scancode = ''; + } + + if (&grade_student_bubbles($r,$uname,$udom,$scan_record,$scancode, + \@resources,\%partids_by_symb) eq 'ssi_error') { + $ssi_error = 0; # So end of handler error message does not trigger. + $r->print(""); + &ssi_print_error($r); + $r->print(&show_grading_menu_form($symb)); + &Apache::lonnet::remove_lock($lock); + return ''; # Why return ''? Beats me. + } - if (&Apache::loncommon::connection_aborted($r)) { last; } - } $completedstudents{$uname}={'line'=>$line}; - if (&Apache::loncommon::connection_aborted($r)) { last; } + if ($env{'form.verifyrecord'}) { + my $lastpos = $env{'form.scantron_maxbubble'}*$scantron_config{'Qlength'}; + my $studentdata = substr($line,$scantron_config{'Qstart'}-1,$lastpos); + chomp($studentdata); + $studentdata =~ s/\r$//; + my $studentrecord = ''; + my $counter = -1; + foreach my $resource (@resources) { + my $ressymb = $resource->symb(); + ($counter,my $recording) = + &verify_scantron_grading($resource,$udom,$uname,$env{'request.course.id'}, + $counter,$studentdata,$partids_by_symb{$ressymb}, + \%scantron_config,\%lettdig,$numletts); + $studentrecord .= $recording; + } + if ($studentrecord ne $studentdata) { + &Apache::lonxml::clear_problem_counter(); + if (&grade_student_bubbles($r,$uname,$udom,$scan_record,$scancode, + \@resources,\%partids_by_symb) eq 'ssi_error') { + $ssi_error = 0; # So end of handler error message does not trigger. + $r->print(""); + &ssi_print_error($r); + $r->print(&show_grading_menu_form($symb)); + &Apache::lonnet::remove_lock($lock); + delete($completedstudents{$uname}); + return ''; + } + $counter = -1; + $studentrecord = ''; + foreach my $resource (@resources) { + my $ressymb = $resource->symb(); + ($counter,my $recording) = + &verify_scantron_grading($resource,$udom,$uname,$env{'request.course.id'}, + $counter,$studentdata,$partids_by_symb{$ressymb}, + \%scantron_config,\%lettdig,$numletts); + $studentrecord .= $recording; + } + if ($studentrecord ne $studentdata) { + $r->print('

'); + if ($scancode eq '') { + $r->print(&mt('Mismatch grading 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('
'.&Apache::loncommon::start_data_table()."\n". + &Apache::loncommon::start_data_table_header_row()."\n". + ''.&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::lonnet::delenv('scantron.'); } &Apache::lonhtmlcommon::Close_PrgWin($r,\%prog_state); &Apache::lonnet::remove_lock($lock); @@ -7538,6 +7647,58 @@ SCANTRONFORM return ''; } +sub graders_resources_pass { + my ($resources,$grader_partids_by_symb,$grader_randomlists_by_symb) = @_; + if ((ref($resources) eq 'ARRAY') && (ref($grader_partids_by_symb)) && + (ref($grader_randomlists_by_symb) eq 'HASH')) { + foreach my $resource (@{$resources}) { + my $ressymb = $resource->symb(); + my ($analysis,$parts) = + &scantron_partids_tograde($resource,$env{'request.course.id'}, + $env{'user.name'},$env{'user.domain'},1); + $grader_partids_by_symb->{$ressymb} = $parts; + if (ref($analysis) eq 'HASH') { + if (ref($analysis->{'parts_withrandomlist'}) eq 'ARRAY') { + $grader_randomlists_by_symb->{$ressymb} = + $analysis->{'parts_withrandomlist'}; + } + } + } + } + return; +} + +sub grade_student_bubbles { + my ($r,$uname,$udom,$scan_record,$scancode,$resources,$parts) = @_; + if (ref($resources) eq 'ARRAY') { + my $count = 0; + foreach my $resource (@{$resources}) { + my $ressymb = $resource->symb(); + my %form = ('submitted' => 'scantron', + 'grade_target' => 'grade', + 'grade_username' => $uname, + 'grade_domain' => $udom, + 'grade_courseid' => $env{'request.course.id'}, + 'grade_symb' => $ressymb, + 'CODE' => $scancode + ); + if (ref($parts) eq 'HASH') { + if (ref($parts->{$ressymb}) eq 'ARRAY') { + foreach my $part (@{$parts->{$ressymb}}) { + $form{'scantron_questnum_start.'.$part} = + 1+$env{'form.scantron.first_bubble_line.'.$count}; + $count++; + } + } + } + my $result=&ssi_with_retries($resource->src(),$ssi_retries,%form); + return 'ssi_error' if ($ssi_error); + last if (&Apache::loncommon::connection_aborted($r)); + } + } + return; +} + sub scantron_upload_scantron_data { my ($r)=@_; $r->print(&Apache::loncommon::coursebrowser_javascript($env{'request.role.domain'})); @@ -7692,18 +7853,7 @@ sub checkscantron_results { if (!$symb) {return '';} my $grading_menu_button=&show_grading_menu_form($symb); my $cid = $env{'request.course.id'}; - my %lettdig = ( - A => 1, - B => 2, - C => 3, - D => 4, - E => 5, - F => 6, - G => 7, - H => 8, - I => 9, - J => 0, - ); + my %lettdig = &letter_to_digits(); my $numletts = scalar(keys(%lettdig)); my $cnum = $env{'course.'.$cid.'.num'}; my $cdom = $env{'course.'.$cid.'.domain'}; @@ -7716,7 +7866,11 @@ sub checkscantron_results { 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 @resources=$navmap->retrieveResources($map,\&scantron_filter,1,0); + my (%grader_partids_by_symb,%grader_randomlists_by_symb); + &graders_resources_pass(\@resources,\%grader_partids_by_symb, \%grader_randomlists_by_symb); + + my ($uname,$udom); my (%scandata,%lastname,%bylast); $r->print('
'."\n"); @@ -7728,9 +7882,9 @@ sub checkscantron_results { my %prog_state=&Apache::lonhtmlcommon::Create_PrgWin($r,'Scantron/Submissions Comparison Status', 'Progress of Scantron Data/Submission Records Comparison',$count, 'inline',undef,'checkscantron'); - my ($username,$domain,$uname,$started); + my ($username,$domain,$started); - &Apache::grades::scantron_get_maxbubble(); # Need the bubble lines array to parse. + &scantron_get_maxbubble(); # Need the bubble lines array to parse. &Apache::lonhtmlcommon::Update_PrgWin($r,\%prog_state, 'Processing first student'); @@ -7770,126 +7924,21 @@ sub checkscantron_results { $scandata{$pid} =~ s/\r$//; ($username,$domain)=split(/:/,$uname); my $counter = -1; - my (%expected,%startpos); foreach my $resource (@resources) { - next if (!$resource->is_problem()); - my $symb = $resource->symb(); - my $partsref = $resource->parts(); - my @parts; - my @part_ids = (); - if (ref($partsref) eq 'ARRAY') { - @parts = @{$partsref}; - foreach my $part (@parts) { - my @resp_ids = $resource->responseIds($part); - foreach my $resp (@resp_ids) { - $counter ++; - my $part_id = $part.'.'.$resp; - $expected{$part_id} = 0; - push(@part_ids,$part_id); - 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} .= $; - } - } - } 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{$pid},$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 (@part_ids) { - 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{$pid} .= $recorded{$part_id}; - } + 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); + } 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); + $record{$pid} .= $recording; } } &Apache::lonhtmlcommon::Close_PrgWin($r,\%prog_state); @@ -7951,6 +8000,137 @@ sub checkscantron_results { return; } +sub verify_scantron_grading { + my ($resource,$domain,$username,$cid,$counter,$scandata,$partids, + $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) ne 'ARRAY'); + foreach my $part_id (@{$partids}) { + $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}) { + 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; +} + #-------- end of section for handling grading scantron forms ------- # @@ -8796,7 +8976,7 @@ ENDHEADER } } # We are done - $result.='
'.&mt('Successfully stored grades for [_1] student(s).',$storecount). + $result.='
'.&mt('Successfully stored grades for [quant,_1,student].',$storecount). ''."\n". '

'."\n"; return $result.&show_grading_menu_form($symb); @@ -8922,7 +9102,7 @@ sub handler { } elsif ($command eq 'checksubmissions' && $perm{'vgr'}) { $request->print(&checkscantron_results($request)); } elsif ($command) { - $request->print("Access Denied ($command)"); + $request->print('

'.&mt('Access Denied ([_1])',$command).'

'); } } if ($ssi_error) { @@ -9090,7 +9270,7 @@ ssi_with_retries() =item scantron_validate_ID() : Validates all scanlines in the selected file to not have any - invalid or underspecified student IDs + invalid or underspecified student/employee IDs =back