--- loncom/homework/grades.pm 2012/05/02 17:57:25 1.596.2.12.2.7 +++ loncom/homework/grades.pm 2012/12/10 15:00:08 1.596.2.12.2.11 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA # The LON-CAPA Grading handler # -# $Id: grades.pm,v 1.596.2.12.2.7 2012/05/02 17:57:25 raeburn Exp $ +# $Id: grades.pm,v 1.596.2.12.2.11 2012/12/10 15:00: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 @@ -263,6 +264,7 @@ sub showResourceInfo { sub reset_caches { &reset_analyze_cache(); &reset_perm(); + &reset_old_essays(); } { @@ -746,7 +748,11 @@ sub compute_points { # sub most_similar { - my ($uname,$udom,$uessay,$old_essays)=@_; + my ($uname,$udom,$symb,$uessay)=@_; + + unless ($symb) { return ''; } + + unless (ref($old_essays{$symb}) eq 'HASH') { return ''; } # ignore spaces and punctuation @@ -763,11 +769,11 @@ sub most_similar { my $scrsid=''; my $sessay=''; # go through all essays ... - foreach my $tkey (keys(%$old_essays)) { + foreach my $tkey (keys(%{$old_essays{$symb}})) { my ($tname,$tdom,$tcrsid)=map {&unescape($_)} (split(/\./,$tkey)); # ... except the same student next if (($tname eq $uname) && ($tdom eq $udom)); - my $tessay=$old_essays->{$tkey}; + my $tessay=$old_essays{$symb}{$tkey}; $tessay=~s/\W+/ /gs; # String similarity gives up if not even limit my $tsimilar=&String::Similarity::similarity($uessay,$tessay,$limit); @@ -777,7 +783,7 @@ sub most_similar { $sname=$tname; $sdom=$tdom; $scrsid=$tcrsid; - $sessay=$old_essays->{$tkey}; + $sessay=$old_essays{$symb}{$tkey}; } } if ($limit>0.6) { @@ -2027,7 +2033,6 @@ sub submission { '" src="'.$request->dir_config('lonIconsURL'). '/check.gif" height="16" border="0" />'; - my %old_essays; # header info if ($counter == 0) { &sub_page_js($request); @@ -2143,7 +2148,7 @@ KEYWORDS my ($adom,$aname,$apath)=($essayurl=~/^($LONCAPA::domain_re)\/($LONCAPA::username_re)\/(.*)$/); $apath=&escape($apath); $apath=~s/\W/\_/gs; - %old_essays=&Apache::lonnet::dump('nohist_essay_'.$apath,$adom,$aname); + &init_old_essays($symb,$apath,$adom,$aname); } } @@ -2280,7 +2285,7 @@ KEYWORDS } if($env{'form.checkPlag'}){ my ($oname,$odom,$ocrsid,$oessay,$osim)= - &most_similar($uname,$udom,$subval,\%old_essays); + &most_similar($uname,$udom,$symb,$subval); if ($osim) { $osim=int($osim*100.0); my %old_course_desc = @@ -7170,7 +7175,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); } } @@ -8069,6 +8079,8 @@ 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); @@ -8078,15 +8090,21 @@ sub scantron_process_students { return ''; } my $map=$navmap->getResourceByUrl($sequence); + my $randomorder; + if (ref($map)) { + $randomorder = $map->randomorder(); + } my @resources=$navmap->retrieveResources($map,\&scantron_filter,1,0); - my (%grader_partids_by_symb,%grader_randomlists_by_symb); + my (%grader_partids_by_symb,%grader_randomlists_by_symb,%ordered); &graders_resources_pass(\@resources,\%grader_partids_by_symb, - \%grader_randomlists_by_symb); - my $resource_error; + \%grader_randomlists_by_symb,$bubbles_per_row); + my ($resource_error,%symb_to_resource,@master_seq); foreach my $resource (@resources) { my $ressymb; if (ref($resource)) { $ressymb = $resource->symb(); + push(@master_seq,$ressymb); + $symb_to_resource{$ressymb} = $resource; } else { $resource_error = 1; last; @@ -8173,10 +8191,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) { + @mapresources = + &users_order($user,$scancode,$sequence,\@master_seq,\%ordered, + \%symb_to_resource); + } my (%partids_by_symb,$res_error); - foreach my $resource (@resources) { + foreach my $resource (@mapresources) { my $ressymb; if (ref($resource)) { $ressymb = $resource->symb(); @@ -8208,16 +8242,8 @@ 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, + \@mapresources,\%partids_by_symb, $bubbles_per_row) eq 'ssi_error') { $ssi_error = 0; # So end of handler error message does not trigger. $r->print(""); @@ -8235,7 +8261,7 @@ SCANTRONFORM $studentdata =~ s/\r$//; my $studentrecord = ''; my $counter = -1; - foreach my $resource (@resources) { + foreach my $resource (@mapresources) { my $ressymb = $resource->symb(); ($counter,my $recording) = &verify_scantron_grading($resource,$udom,$uname,$env{'request.course.id'}, @@ -8246,7 +8272,7 @@ SCANTRONFORM if ($studentrecord ne $studentdata) { &Apache::lonxml::clear_problem_counter(); if (&grade_student_bubbles($r,$uname,$udom,$scan_record,$scancode, - \@resources,\%partids_by_symb, + \@mapresources,\%partids_by_symb, $bubbles_per_row) eq 'ssi_error') { $ssi_error = 0; # So end of handler error message does not trigger. $r->print(""); @@ -8258,7 +8284,7 @@ SCANTRONFORM } $counter = -1; $studentrecord = ''; - foreach my $resource (@resources) { + foreach my $resource (@mapresources) { my $ressymb = $resource->symb(); ($counter,my $recording) = &verify_scantron_grading($resource,$udom,$uname,$env{'request.course.id'}, @@ -8312,7 +8338,8 @@ SCANTRONFORM } sub graders_resources_pass { - my ($resources,$grader_partids_by_symb,$grader_randomlists_by_symb) = @_; + my ($resources,$grader_partids_by_symb,$grader_randomlists_by_symb, + $bubbles_per_row) = @_; if ((ref($resources) eq 'ARRAY') && (ref($grader_partids_by_symb)) && (ref($grader_randomlists_by_symb) eq 'HASH')) { foreach my $resource (@{$resources}) { @@ -8333,6 +8360,53 @@ sub graders_resources_pass { return; } +=pod + +=item users_order + + Returns array of resources in current map, ordered based on either CODE, + if this is a CODEd exam, or based on student's identity if this is a + "NAMEd" exam. + + Should be used when randomorder applied when the corresponding exam was + printed, prior to students completing bubblesheets for the version of the + exam the student received. + +=cut + +sub users_order { + my ($user,$scancode,$mapurl,$master_seq,$ordered,$symb_to_resource) = @_; + my @mapresources; + unless ((ref($ordered) eq 'HASH') && (ref($symb_to_resource) eq 'HASH')) { + return @mapresources; + } + if (($scancode) && (ref($ordered->{$scancode}) eq 'ARRAY')) { + @mapresources = @{$ordered->{$scancode}}; + } elsif ($scancode) { + $env{'form.CODE'} = $scancode; + my $actual_seq = + &Apache::lonprintout::master_seq_to_person_seq($mapurl, + $master_seq, + $user,$scancode); + if (ref($actual_seq) eq 'ARRAY') { + @{$ordered->{$scancode}} = + map { $symb_to_resource->{$_}; } @{$actual_seq}; + @mapresources = @{$ordered->{$scancode}}; + } + delete($env{'form.CODE'}); + } else { + my $actual_seq = + &Apache::lonprintout::master_seq_to_person_seq($mapurl, + $master_seq, + $user); + if (ref($actual_seq) eq 'ARRAY') { + @mapresources = + map { $symb_to_resource->{$_}; } @{$actual_seq}; + } + } + return @mapresources; +} + sub grade_student_bubbles { my ($r,$uname,$udom,$scan_record,$scancode,$resources,$parts,$bubbles_per_row) = @_; if (ref($resources) eq 'ARRAY') { @@ -8638,6 +8712,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); @@ -8647,10 +8722,21 @@ sub checkscantron_results { return ''; } my $map=$navmap->getResourceByUrl($sequence); + my ($randomorder,@master_seq,%symb_to_resource); + if (ref($map)) { + $randomorder=$map->randomorder(); + } my @resources=$navmap->retrieveResources($map,\&scantron_filter,1,0); + foreach my $resource (@resources) { + if (ref($resource)) { + my $ressymb = $resource->symb(); + push(@master_seq,$ressymb); + $symb_to_resource{$ressymb} = $resource; + } + } my (%grader_partids_by_symb,%grader_randomlists_by_symb); - &graders_resources_pass(\@resources,\%grader_partids_by_symb, \%grader_randomlists_by_symb); - + &graders_resources_pass(\@resources,\%grader_partids_by_symb, + \%grader_randomlists_by_symb,$bubbles_per_row); my ($uname,$udom); my (%scandata,%lastname,%bylast); $r->print(' @@ -8661,7 +8747,7 @@ sub checkscantron_results { my $count=&Apache::grades::get_todo_count($scanlines,$scan_data); my %prog_state=&Apache::lonhtmlcommon::Create_PrgWin($r,$count); - my ($username,$domain,$started); + my ($username,$domain,$started,%ordered); my $nav_error; &scantron_get_maxbubble(\$nav_error,\%scantron_config); # Need the bubble lines array to parse. if ($nav_error) { @@ -8705,9 +8791,26 @@ sub checkscantron_results { $scandata{$pid} = substr($line,$scantron_config{'Qstart'}-1,$lastpos); chomp($scandata{$pid}); $scandata{$pid} =~ s/\r$//; + 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; + if ($randomorder) { + @mapresources = + &users_order($user,$scancode,$sequence,\@master_seq,\%ordered, + \%symb_to_resource); + } my $counter = -1; - foreach my $resource (@resources) { + foreach my $resource (@mapresources) { my $parts; my $ressymb = $resource->symb(); if ((exists($grader_randomlists_by_symb{$ressymb})) || @@ -9268,6 +9371,21 @@ sub init_perm { } } +sub init_old_essays { + my ($symb,$apath,$adom,$aname) = @_; + if ($symb ne '') { + my %essays = &Apache::lonnet::dump('nohist_essay_'.$apath,$adom,$aname); + if (keys(%essays) > 0) { + $old_essays{$symb} = \%essays; + } + } + return; +} + +sub reset_old_essays { + undef(%old_essays); +} + sub gather_clicker_ids { my %clicker_ids;