--- loncom/homework/grades.pm 2004/04/29 04:47:47 1.191 +++ loncom/homework/grades.pm 2004/05/07 17:40:51 1.198 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA # The LON-CAPA Grading handler # -# $Id: grades.pm,v 1.191 2004/04/29 04:47:47 albertel Exp $ +# $Id: grades.pm,v 1.198 2004/05/07 17:40:51 albertel Exp $ # # Copyright Michigan State University Board of Trustees # @@ -2049,11 +2049,11 @@ sub saveHandGrade { } } elsif ($dropMenu eq 'reset status' && exists($record{'resource.'.$_.'.solved'})) { #don't bother if no old records -> no attempts - $newrecord{'resource.'.$_.'.tries'} = 0; - $newrecord{'resource.'.$_.'.solved'} = ''; - $newrecord{'resource.'.$_.'.award'} = ''; - $newrecord{'resource.'.$_.'.awarded'} = 0; - $newrecord{'resource.'.$_.'.regrader'}="$ENV{'user.name'}:$ENV{'user.domain'}"; + foreach my $key (keys (%record)) { + if ($key=~/^resource\.\Q$_\E\./) { $newrecord{$key} = ''; } + } + $newrecord{'resource.'.$_.'.regrader'}= + "$ENV{'user.name'}:$ENV{'user.domain'}"; } elsif ($dropMenu eq '') { $pts = ($ENV{'form.GD_BOX'.$newflg.'_'.$_} ne '' ? $ENV{'form.GD_BOX'.$newflg.'_'.$_} : @@ -3108,7 +3108,7 @@ sub displayPage { ' Prob. '. ' '.($ENV{'form.vProb'} eq 'no' ? 'Title' : 'Problem Text').'/Grade'; - my ($depth,$question) = (1,1); + my ($depth,$question,$prob) = (1,1,1); $iterator->next(); # skip the first BEGIN_MAP my $curRes = $iterator->next(); # for "current resource" while ($depth > 0) { @@ -3119,7 +3119,7 @@ sub displayPage { my $parts = $curRes->parts(); my $title = $curRes->compTitle(); my $symbx = $curRes->symb(); - $studentTable.=''.$question. + $studentTable.=''.$prob. (scalar(@{$parts}) == 1 ? '' : '
('.scalar(@{$parts}).' parts)').''; $studentTable.=''; if ($ENV{'form.vProb'} eq 'yes' ) { @@ -3169,6 +3169,7 @@ sub displayPage { $studentTable.=''."\n"; $question++; } + $prob++; } $studentTable.=''; @@ -3211,7 +3212,8 @@ sub displaySubByDates { my @matchKey = sort(grep /^resource\.\Q$partid\E\..*?\.submission$/,@versionKeys); # next if ($$record{"$version:resource.$partid.solved"} eq ''); foreach my $matchKey (@matchKey) { - if (exists $$record{$version.':'.$matchKey}) { + if (exists($$record{$version.':'.$matchKey}) && + $$record{$version.':'.$matchKey} ne '') { my ($responseId)=($matchKey=~ /^resource\.\Q$partid\E\.(.*?)\.submission$/); $displaySub[0].='Part '.$partid.' '; $displaySub[0].='(ID '. @@ -3295,7 +3297,7 @@ sub updateGradeByPage { $iterator->next(); # skip the first BEGIN_MAP my $curRes = $iterator->next(); # for "current resource" - my ($depth,$question,$changeflag)= (1,1,0); + my ($depth,$question,$prob,$changeflag)= (1,1,1,0); while ($depth > 0) { if($curRes == $iterator->BEGIN_MAP) { $depth++; } if($curRes == $iterator->END_MAP) { $depth--; } @@ -3304,7 +3306,7 @@ sub updateGradeByPage { my $parts = $curRes->parts(); my $title = $curRes->compTitle(); my $symbx = $curRes->symb(); - $studentTable.=''.$question. + $studentTable.=''.$prob. (scalar(@{$parts}) == 1 ? '' : '
('.scalar(@{$parts}).' parts)').''; $studentTable.=' '.$title.' '; @@ -3365,6 +3367,7 @@ sub updateGradeByPage { ''.$displayPts[1].''. ''; + $prob++; } $curRes = $iterator->next(); } @@ -3517,8 +3520,8 @@ sub scantron_selectphase { Options: - Redo skipped records
- Ignore Original Corrections + Do only skipped records
+ Remove any exisiting corrections @@ -3685,9 +3688,11 @@ sub scantron_fixup_scanline { $args->{'username'}.':'.$args->{'domain'}); } } elsif ($field eq 'CODE') { - if ($args->{'CODE'} eq 'use_unfound') { - &scan_data($scan_data,"$whichline.useCODE",'1'); - } else { + if ($args->{'CODE_ignore_dup'}) { + &scan_data($scan_data,"$whichline.CODE_ignore_dup",'1'); + } + &scan_data($scan_data,"$whichline.useCODE",'1'); + if ($args->{'CODE'} ne 'use_unfound') { if (length($args->{'CODE'}) > $$scantron_config{'CODElength'}) { return ($line,1,'New CODE value too large'); } @@ -3696,9 +3701,6 @@ sub scantron_fixup_scanline { } substr($line,$$scantron_config{'CODEstart'}-1, $$scantron_config{'CODElength'})=$args->{'CODE'}; -# if ($args->{'CODE'}=~/^\s*$/) { -# &scan_data($scan_data,"$whichline.CODE",$args->{'CODE'}); -# } } } elsif ($field eq 'answer') { my $length=$scantron_config->{'Qlength'}; @@ -3730,7 +3732,7 @@ sub scan_data { } sub scantron_parse_scanline { - my ($line,$whichline,$scantron_config,$scan_data,$justCODE)=@_; + my ($line,$whichline,$scantron_config,$scan_data,$justHeader)=@_; my %record; my $questions=substr($line,$$scantron_config{'Qstart'}-1); my $data=substr($line,0,$$scantron_config{'Qstart'}-1); @@ -3742,11 +3744,13 @@ sub scantron_parse_scanline { if (&scan_data($scan_data,"$whichline.useCODE")) { $record{'scantron.useCODE'}=1; } + if (&scan_data($scan_data,"$whichline.CODE_ignore_dup")) { + $record{'scantron.CODE_ignore_dup'}=1; + } } else { #FIXME interpret first N questions } } - if ($justCODE) { return \%record; } $record{'scantron.ID'}=substr($data,$$scantron_config{'IDstart'}-1, $$scantron_config{'IDlength'}); $record{'scantron.PaperID'}= @@ -3758,6 +3762,8 @@ sub scantron_parse_scanline { $record{'scantron.LastName'}= substr($data,$$scantron_config{'LastName'}-1, $$scantron_config{'LastNamelength'}); + if ($justHeader) { return \%record; } + my @alphabet=('A'..'Z'); my $questnum=0; while ($questions) { @@ -3841,16 +3847,23 @@ sub scantron_process_corrections { } elsif ($ENV{'form.scantron_corrections'} =~ /^(duplicate|incorrect)CODE$/) { my $resolution=$ENV{'form.scantron_CODE_resolution'}; my $newCODE; + my %args; if ($resolution eq 'use_unfound') { $newCODE='use_unfound'; } elsif ($resolution eq 'use_found') { $newCODE=$ENV{'form.scantron_CODE_selectedvalue'}; } elsif ($resolution eq 'use_typed') { $newCODE=$ENV{'form.scantron_CODE_newvalue'}; + } elsif ($resolution =~ /^use_closest_(\d+)/) { + $newCODE=$ENV{"form.scantron_CODE_closest_$1"}; + } + if ($ENV{'form.scantron_corrections'} eq 'duplicateCODE') { + $args{'CODE_ignore_dup'}=1; } + $args{'CODE'}=$newCODE; ($line,$err,$errmsg)= &scantron_fixup_scanline(\%scantron_config,$scan_data,$line,$which, - 'CODE',{'CODE'=>$newCODE}); + 'CODE',\%args); } elsif ($ENV{'form.scantron_corrections'} =~ /^(missing|double)bubble$/) { foreach my $question (split(',',$ENV{'form.scantron_questions'})) { ($line,$err,$errmsg)= @@ -3875,7 +3888,13 @@ sub scantron_validate_file { my ($symb,$url)=&get_symb_and_url($r); if (!$symb) {return '';} my $default_form_data=&defaultFormData($symb,$url); - + if ($ENV{'form.scantron_options_ignore'} eq 'ignore_corrections') { + my $result=&scantron_remove('corrected'); + if ($result ne 'ok' && $result ne 'not_found' ) { + $r->print("An error occured ($result) when trying to Remove the existing corrections."); + } + $ENV{'form.scantron_options_ignore'}='done'; + } if ($ENV{'form.scantron_corrections'}) { &scantron_process_corrections($r); } @@ -3891,8 +3910,8 @@ sub scantron_validate_file { - - + + $default_form_data SCANTRONFORM $r->print($result); @@ -3902,14 +3921,10 @@ SCANTRONFORM 'doublebubble', 'missingbubbles'); if (!$ENV{'form.validatepass'}) { - $ENV{'form.valiadatepass'} = 0; + $ENV{'form.validatepass'} = 0; } - my $currentphase=$ENV{'form.valiadatepass'}; + my $currentphase=$ENV{'form.validatepass'}; - if ($ENV{'form.scantron_selectfile'}=~m-^/-) { - #first pass copy file to classdir - - } my $stop=0; while (!$stop && $currentphase < scalar(@validate_phases)) { $r->print("

Validating ".$validate_phases[$currentphase]."

"); @@ -3939,6 +3954,32 @@ SCANTRONFORM return ''; } +sub scantron_remove { + my ($which)=@_; + my $cname=$ENV{'course.'.$ENV{'request.course.id'}.'.num'}; + my $cdom=$ENV{'course.'.$ENV{'request.course.id'}.'.domain'}; + my $file='scantron_'; + if ($which eq 'corrected') { + $file.='corrected_'; + } else { + return 'refused'; + } + $file.=$ENV{'form.scantron_selectfile'}; + my $result=&Apache::lonnet::removeuserfile($cname,$cdom,$file); + my @keys=&Apache::lonnet::getkeys('nohist_scantrondata',$cdom,$cname); + my @todelete; + my $filename=$ENV{'form.scantron_selectfile'}; + foreach my $key (@keys) { + if ($key=~/^\Q$filename\E_/) { + push(@todelete,$key); + } + } + if (@todelete) { + &Apache::lonnet::del('nohist_scantrondata',\@todelete,$cdom,$cname); + } + return $result; +} + sub scantron_getfile { #FIXME really would prefer a scantron directory but tokenwrapper # doesn't allow access to subdirs of userfiles @@ -4044,11 +4085,11 @@ sub scantron_validate_ID { if ($found{'ids'}{$found}) { &scantron_get_correction($r,$i,$scan_record,\%scantron_config, $line,'duplicateID',$found); - return(1); + return(1,$currentphase); } elsif ($found{'usernames'}{$username}) { &scantron_get_correction($r,$i,$scan_record,\%scantron_config, $line,'duplicateID',$username); - return(1); + return(1,$currentphase); } #FIXME store away line we previously saw the ID on to use above $found{'ids'}{$found}++; @@ -4060,18 +4101,18 @@ sub scantron_validate_ID { &scantron_get_correction($r,$i,$scan_record, \%scantron_config, $line,'duplicateID',$username); - return(1); + return(1,$currentphase); } elsif (!defined($username)) { &scantron_get_correction($r,$i,$scan_record, \%scantron_config, $line,'incorrectID'); - return(1); + return(1,$currentphase); } $found{'usernames'}{$username}++; } else { &scantron_get_correction($r,$i,$scan_record,\%scantron_config, $line,'incorrectID'); - return(1); + return(1,$currentphase); } } } @@ -4122,7 +4163,7 @@ sub scantron_get_correction { if ($error eq 'incorrectCODE') { $r->print("

The encoded CODE is not in the list of possible CODEs

\n"); } elsif ($error eq 'duplicateCODE') { - $r->print("

The encoded CODE has also been used by a previous paper $arg, and CODEs were supposed to be unique

\n"); + $r->print("

The encoded CODE has also been used by a previous paper ".join(', ',@{$arg}).", and CODEs are supposed to be unique

\n"); } $r->print("

The CODE on the form is ". $$scan_record{'scantron.CODE'}."
\n"); @@ -4133,8 +4174,21 @@ sub scantron_get_correction { $$scan_record{'scantron.FirstName'}."

"); $r->print("

How should I handle this?
\n"); $r->print("\n
"); - $r->print(" Use the CODE ".$$scan_record{'scantron.CODE'}." that is was on the paper, ignoring the error."); + my $i=0; + if ($error eq 'incorrectCODE') { + my ($max,$closest)=&scantron_get_closely_matching_CODEs($arg,$$scan_record{'scantron.CODE'}); + foreach my $testcode (@{$closest}) { + my $checked=''; + if (!$i) { $checked=' checked="on" '; } + $r->print(" Use the similar CODE ".$testcode." instead."); + $r->print("\n
"); + $i++; + } + } + my $checked; if (!$i) { $checked=' checked="on" '; } + $r->print(" Use the CODE ".$$scan_record{'scantron.CODE'}." that is was on the paper, ignoring the error."); $r->print("\n
"); + $r->print(< function change_radio(field) { @@ -4157,7 +4211,6 @@ ENDSCRIPT $r->print(" Use as the CODE."); $r->print("\n

"); } elsif ($error eq 'doublebubble') { -#FIXME Need to print out who this is along with the paper info $r->print("

There have been multiple bubbles scanned for a some question(s)

\n"); $r->print(''); @@ -4204,9 +4257,38 @@ sub scantron_bubble_selector { $r->print(''); } +sub num_matches { + my ($orig,$code) = @_; + my @code=split(//,$code); + my @orig=split(//,$orig); + my $same=0; + for (my $i=0;$i{'count'};$i++) { @@ -4237,16 +4315,17 @@ sub scantron_validate_CODE { if (!exists($allcodes{$CODE}) && !$$scan_record{'scantron.useCODE'}) { &scantron_get_correction($r,$i,$scan_record, \%scantron_config, - $line,'incorrectCODE',$CODE); - return(1); + $line,'incorrectCODE',\%allcodes); + return(1,$currentphase); } - if (exists($usedCODEs{$CODE}) && $ENV{'form.scantron_CODEunique'}) { + if (exists($usedCODEs{$CODE}) && $ENV{'form.scantron_CODEunique'} + && !$$scan_record{'scantron.CODE_ignore_dup'}) { &scantron_get_correction($r,$i,$scan_record, \%scantron_config, - $line,'duplicateCODE',$CODE); - return(1); + $line,'duplicateCODE',$usedCODEs{$CODE}); + return(1,$currentphase); } - $usedCODEs{$CODE}++; + push (@{$usedCODEs{$CODE}},$$scan_record{'scantron.PaperID'}); } return (0,$currentphase+1); } @@ -4357,7 +4436,8 @@ SCANTRONFORM my %completedstudents; my %prog_state=&Apache::lonhtmlcommon::Create_PrgWin($r,'Scantron Status', - 'Scantron Progress',$scanlines->{'count'}); + 'Scantron Progress',$scanlines->{'count'}, + 'inline',undef,'scantronupload'); &Apache::lonhtmlcommon::Update_PrgWin($r,\%prog_state, 'Processing first student'); my $start=&Time::HiRes::time(); @@ -4388,13 +4468,18 @@ SCANTRONFORM my $i=0; foreach my $resource (@resources) { $i++; - my $result=&Apache::lonnet::ssi($resource->src(), - ('submitted' =>'scantron', - 'grade_target' =>'grade', - 'grade_username'=>$uname, - 'grade_domain' =>$udom, - 'grade_courseid'=>$ENV{'request.course.id'}, - 'grade_symb' =>$resource->symb())); + 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'}) && + $scan_record->{'scantron.CODE'}) { + $form{'CODE'}=$scan_record->{'scantron.CODE'}; + } + my $result=&Apache::lonnet::ssi($resource->src(),%form); + } $completedstudents{$uname}={'line'=>$line}; } continue {