--- loncom/homework/grades.pm 2006/02/14 15:11:09 1.313 +++ loncom/homework/grades.pm 2006/02/27 21:23:52 1.322 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA # The LON-CAPA Grading handler # -# $Id: grades.pm,v 1.313 2006/02/14 15:11:09 banghart Exp $ +# $Id: grades.pm,v 1.322 2006/02/27 21:23:52 albertel Exp $ # # Copyright Michigan State University Board of Trustees # @@ -40,6 +40,7 @@ use Apache::lonmsg qw(:user_normal_msg); use Apache::Constants qw(:common); use Apache::lonlocal; use String::Similarity; +use POSIX qw(floor); my %oldessays=(); my %perm=(); @@ -467,6 +468,33 @@ sub jscriptNform { return $jscript; } +# Given the score (as a number [0-1] and the weight) what is the final +# point value? This function will round to the nearest tenth, third, +# or quarter if one of those is within the tolerance of .00001. +sub compute_points { + my ($score, $weight) = @_; + + my $tolerance = .00001; + my $points = $score * $weight; + + # Check for nearness to 1/x. + my $check_for_nearness = sub { + my ($factor) = @_; + my $num = ($points * $factor) + $tolerance; + my $floored_num = floor($num); + if ($num - $floored_num < 2 * $tolerance * $factor) { + return $floored_num / $factor; + } + return $points; + }; + + $points = $check_for_nearness->(10); + $points = $check_for_nearness->(3); + $points = $check_for_nearness->(4); + + return $points; +} + #------------------ End of general use routines -------------------- # @@ -1393,7 +1421,7 @@ sub gradeBox { 'problem weight assigned by computer'); $wgt = ($wgt > 0 ? $wgt : '1'); my $score = ($$record{'resource.'.$partid.'.awarded'} eq '' ? - '' : $$record{'resource.'.$partid.'.awarded'}*$wgt); + '' : &compute_points($$record{'resource.'.$partid.'.awarded'},$wgt)); my $result=''."\n"; my $display_part=&get_display_part($partid,undef,$symb); my %last_resets = &get_last_resets($symb,$env{'request.course.id'}, @@ -1443,19 +1471,28 @@ sub gradeBox { ''."\n"; $result.=''."\n"; - my $files=&get_submitted_files($udom,$uname,$partid,$counter,$record); - if (@$files) { - my $file_counter = 0; + $result.=&handback_box($uname,$udom,$counter,$partid,$record); + return $result; +} + +sub handback_box { + my ($uname,$udom,$counter,$partid,$record) = @_; + my $result; + foreach my $respid (undef) { + my $prefix = $counter.'_'.$partid.'_'.$respid.'_'; + my $files=&get_submitted_files($udom,$uname,$partid,$respid,$record); + next if (!@$files); + my $file_counter = 1; foreach my $file (@$files) { - $result.=' Return commented document to student. '."\n"; - $result.=''; - $result.=''; - } + my ($file_disp) = ($file =~ m|.+/(.+)$|); + $result.=&mt('Return commented version of [_1] to student.', + ''.$file_disp.''); + $result.=''."\n"; + $result.='
'; + $file_counter++; + } } - - - return $result; + return $result; } sub show_problem { @@ -1797,22 +1834,13 @@ KEYWORDS $display_part.' ( ID '.$respid. ' )   '; my $files=&get_submitted_files($udom,$uname,$partid,$respid,\%record); -# if ($record{"resource.$partid.$respid.portfiles"}) { -# my $file_url = '/uploaded/'.$udom.'/'.$uname.'/portfolio'; -# foreach my $file (split(',',$record{"resource.$partid.$respid.portfiles"})) { -# push(@files,$file_url.$file); -# } -# } -# if ($record{"resource.$partid.$respid.uploadedurl"}) { -# push(@files,$record{"resource.$partid.$respid.uploadedurl"}); -# } if (@$files) { $lastsubonly.='
Like all files provided by users, this file may contain virusses
'; my $file_counter = 0; foreach my $file (@$files) { $file_counter ++; &Apache::lonnet::allowuploaded('/adm/grades',$file); - $lastsubonly.='
'.$file.''; + $lastsubonly.='
'.$file.''; } $lastsubonly.='
'; } @@ -1890,14 +1918,13 @@ KEYWORDS my %seen = (); my @partlist; my @gradePartRespid; - for (sort keys(%$handgrade)) { - my ($partid,$respid) = split(/_/); + for my $part_resp (sort(keys(%$handgrade))) { + my ($partid,$respid) = split(/_/, $part_resp); next if ($seen{$partid} > 0); $seen{$partid}++; - next if ($$handgrade{$_} =~ /:no$/ && $env{'form.lastSub'} =~ /^(hdgrade)$/); + next if ($$handgrade{$part_resp} =~ /:no$/ && $env{'form.lastSub'} =~ /^(hdgrade)$/); push @partlist,$partid; push @gradePartRespid,$partid.'.'.$respid; - $request->print(&gradeBox($request,$symb,$uname,$udom,$counter,$partid,\%record)); } $result='print('
'.$portfolio_root.'
'); - - # my $result=&Apache::lonnet::userfileupload('uploaddoc','', - # 'portfolio'.$env{'form.currentpath'}); - - my $file_counter = 1; - my $respid = $env{'form.respid'}; - while ($env{'form.part'.$new_part.'_returndoc'.$file_counter}) { - my $fname=$env{'form.returndoc'.$file_counter.'.filename'}; - $newrecord{"resource.$new_part.$respid.handback"} = $env{'form.returndocorig'.$file_counter}; - $request->print("
".$fname." will be the uploaded file name"); - $request->print("Will upload document".$env{'form.returndocorig'.$file_counter}); - $file_counter++; + my ($partlist,$handgrade,$responseType) = &response_type($url,$symb); + my $portfolio_root = &Apache::loncommon::propath($domain, + $stuname). + '/userfiles/portfolio'; + foreach my $part_resp (sort(keys(%$handgrade))) { + my ($part_id, $resp_id) = split(/_/,$part_resp); + if ($env{'form.'.$part_resp.'_returndoc1'} && ($new_part eq $part_id)) { + # if multiple files are uploaded names will be 'returndoc2','returndoc3' + my $file_counter = 1; + while ($env{'form.'.$part_resp.'_returndoc'.$file_counter}) { + my $fname=$env{'form.returndoc'.$file_counter.'.filename'}; + $newrecord{"resource.$new_part.$resp_id.handback"} = $env{'form.returndocorig'.$file_counter}; + $request->print("
".$fname." will be the uploaded file name"); + $request->print("Will upload document".$env{'form.returndocorig'.$file_counter}); + $file_counter++; + } } } @@ -2347,6 +2371,7 @@ sub saveHandGrade { } return ('',$pts,$wgt); } + sub get_submitted_files { my ($udom,$uname,$partid,$respid,$record) = @_; my @files; @@ -2361,6 +2386,7 @@ sub get_submitted_files { } return (\@files); } + # ----------- Provides number of tries since last reset. sub get_num_tries { my ($record,$last_reset,$part) = @_; @@ -2866,7 +2892,7 @@ sub viewstudentgrade { $aggregates{$part} = 1; } if ($type eq 'awarded') { - my $pts = $score eq '' ? '' : $score*$$weight{$part}; + my $pts = $score eq '' ? '' : &compute_points($score,$$weight{$part}); $result.=''."\n"; $result.='