--- loncom/homework/grades.pm 2006/01/25 22:56:25 1.304 +++ loncom/homework/grades.pm 2006/02/25 20:25:02 1.315 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA # The LON-CAPA Grading handler # -# $Id: grades.pm,v 1.304 2006/01/25 22:56:25 albertel Exp $ +# $Id: grades.pm,v 1.315 2006/02/25 20:25:02 bowersj2 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,35 @@ 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 -------------------- # @@ -1386,10 +1416,8 @@ SUBJAVASCRIPT #--- displays the grading box, used in essay type problem and grading by page/sequence sub gradeBox { my ($request,$symb,$uname,$udom,$counter,$partid,$record) = @_; - my $checkIcon = ''; - my $wgt = &Apache::lonnet::EXT('resource.'.$partid.'.weight',$symb,$udom,$uname); my $wgtmsg = ($wgt > 0 ? '(problem weight)' : 'problem weight assigned by computer'); @@ -1397,19 +1425,15 @@ sub gradeBox { my $score = ($$record{'resource.'.$partid.'.awarded'} eq '' ? '' : $$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'}, [$partid]); my $aggtries = $$record{'resource.'.$partid.'.tries'}; if ($last_resets{$partid}) { $aggtries = &get_num_tries($record,$last_resets{$partid},$partid); } - $result.=''."\n"; $result.='
'. 'Part: '.$display_part.' Points: '."\n"; - my $ctr = 0; $result.=''."\n"; # display radio buttons in a nice table 10 across while ($ctr<=$wgt) { @@ -1421,7 +1445,6 @@ sub gradeBox { $ctr++; } $result.='
'; - $result.='
 or '."\n"; - $result.=''."\n"; $result.='
'."\n"; + my $files=&get_submitted_files($udom,$uname,$partid,$counter,$record); + if (@$files) { + my $file_counter = 0; + foreach my $file (@$files) { + $result.=' Return commented document to student. '."\n"; + $result.=''; + $result.=''; + } + } + + return $result; } @@ -1792,29 +1826,23 @@ KEYWORDS $lastsubonly.='Part: '. $display_part.' ( ID '.$respid. ' )   '; - my @files; - 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); - - &Apache::lonnet::logthis("found a portfolio file".$record{"resource.$partid.$respid.portfiles"}); - &Apache::lonnet::logthis("uploaded URL file".$record{"resource.$partid.$respid.uploadedurl"}); - } - } - if ($record{"resource.$partid.$respid.uploadedurl"}) { - push(@files,$record{"resource.$partid.$respid.uploadedurl"}); - } - if (@files) { + 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) { + foreach my $file (@$files) { $file_counter ++; &Apache::lonnet::allowuploaded('/adm/grades',$file); - $lastsubonly.='
'.$file.''; - $lastsubonly.='Return commented document to student. '."\n"; - $lastsubonly.=''; - + $lastsubonly.='
'.$file.''; } $lastsubonly.='
'; } @@ -2029,30 +2057,21 @@ sub processHandGrade { my @collabstrs=&Apache::loncommon::get_env_multiple("form.collaborator$ctr"); foreach my $collabstr (@collabstrs) { my ($part,@collaborators) = split(/:/,$collabstr); - foreach (@collaborators) { + foreach my $collaborator (@collaborators) { my ($errorflag,$pts,$wgt) = - &saveHandGrade($request,$url,$symb,$_,$udom,$ctr, + &saveHandGrade($request,$url,$symb,$collaborator,$udom,$ctr, $env{'form.unamedom'.$ctr},$part); if ($errorflag eq 'not_allowed') { - $request->print("Not allowed to modify grades for $_:$udom"); + $request->print("Not allowed to modify grades for $collaborator:$udom"); next; } else { if ($message ne '') { - $msgstatus = &Apache::lonmsg::user_normal_msg($_,$udom,$env{'form.msgsub'},$message); + $msgstatus = &Apache::lonmsg::user_normal_msg($collaborator,$udom,$env{'form.msgsub'},$message); } - } } } } - if ($env{'form.returndoc1'}) { - # if multiple files are uploaded names will be 'returndoc2', 'returndoc3' - my $file_counter = 1; - while ($env{'form.returndoc'.$file_counter}) { - $request->print("Will upload document".$env{'form.returndocorig'.$file_counter}); - $file_counter ++; - } - } $ctr++; } } @@ -2300,8 +2319,33 @@ sub saveHandGrade { $newrecord{'resource.'.$new_part.'.regrader'}= "$env{'user.name'}:$env{'user.domain'}"; } + if ($env{'form.part'.$new_part.'_returndoc1'}) { + # if multiple files are uploaded names will be 'returndoc2','returndoc3' + + my $portfolio_root = &Apache::loncommon::propath($domain, + $stuname). + '/userfiles/portfolio'; + $request->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++; + } + } + # unless problem has been graded, set flag to version the submitted files - unless ($record{'resource.'.$new_part.'.solved'} =~ /^correct_/ || $record{'resource.'.$new_part.'.solved'} eq 'incorrect_by_override') { + unless ($record{'resource.'.$new_part.'.solved'} =~ /^correct_/ || + $record{'resource.'.$new_part.'.solved'} eq 'incorrect_by_override' || + $dropMenu eq 'reset status') + { push (@v_flag,$new_part); } } @@ -2333,7 +2377,20 @@ sub saveHandGrade { } return ('',$pts,$wgt); } - +sub get_submitted_files { + my ($udom,$uname,$partid,$respid,$record) = @_; + my @files; + 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"}); + } + return (\@files); +} # ----------- Provides number of tries since last reset. sub get_num_tries { my ($record,$last_reset,$part) = @_; @@ -2395,61 +2452,78 @@ sub get_last_resets { # ----------- Handles creating versions for portfolio files as answers sub version_portfiles { - my ($record, $parts_graded, $courseid, $symb, $domain, $stuname, $v_flag) = @_; + my ($record, $parts_graded, $courseid, $symb, $domain, $stu_name, $v_flag) = @_; my $version_parts = join('|',@$v_flag); my $parts = join('|', @$parts_graded); my $portfolio_root = &Apache::loncommon::propath($domain, - $stuname). + $stu_name). '/userfiles/portfolio'; foreach my $key (keys(%$record)) { my $new_portfiles; - if ($key =~ /^resource\.($version_parts)\./ && $key =~ /\.portfiles$/ ) { my @v_portfiles; my @portfiles = split(/,/,$$record{$key}); - &Apache::lonnet::logthis("should be unmarking and remarking $key",@portfiles); foreach my $file (@portfiles) { - &Apache::lonnet::unmark_as_readonly($domain,$stuname,[$symb,$env{'request.course.id'}],$file); + &Apache::lonnet::unmark_as_readonly($domain,$stu_name,[$symb,$env{'request.course.id'}],$file); my ($directory,$answer_file) =($file =~ /^(.*?)([^\/]*)$/); my $version = 0; my ($answer_name,$answer_ver,$answer_ext) = &file_name_version_ext($answer_file); - my @dir_list = &Apache::lonnet::dirlist($directory,$domain,$stuname,$portfolio_root); - foreach my $row (@dir_list) { - my ($file) = split(/\&/,$row,2); - my ($file_name,$file_version,$file_ext) = - &file_name_version_ext($file); - if (($file_name eq $answer_name) && - ($file_ext eq $answer_ext)) { - # gets here if filename and extension match, regardless of version - if ($file_version ne '') { - # a versioned file is found so save it for later - if ($file_version > $version) { - $version = $file_version; - } - } - } - } - $version++; - $env{'form.copy'} = &Apache::lonnet::getfile("/uploaded/$domain/$stuname/portfolio$directory$answer_file"); - if($env{'form.copy'} eq '-1') { - &Apache::lonnet::logthis('problem getting file '.$directory.$answer_file); - } else { - my $new_answer = $answer_name.'.'.$version.'.'.$answer_ext; - my $copy_result = &Apache::lonnet::finishuserfileupload( - $stuname,$domain,'copy', - '/portfolio'.$directory.$new_answer); + my @dir_list = &Apache::lonnet::dirlist($directory,$domain,$stu_name,$portfolio_root); + $version = &get_next_version($answer_name, $answer_ext, \@dir_list); + my $new_answer = &version_selected_portfile($domain, $stu_name, $directory, $answer_file, $version); + if ($new_answer ne 'problem getting file') { push(@v_portfiles, $directory.$new_answer); - &Apache::lonnet::mark_as_readonly($domain,$stuname, - ['/portfolio'.$directory.$new_answer], - [$symb,$env{'request.course.id'},'graded']); + &Apache::lonnet::mark_as_readonly($domain,$stu_name, + ['/portfolio'.$directory.$new_answer], + [$symb,$env{'request.course.id'},'graded']); } + } $$record{$key} = join(',',@v_portfiles); } } return 'ok'; - +} + +sub get_next_version { + my ($answer_name, $answer_ext, $dir_list); + my $version; + foreach my $row (@$dir_list) { + my ($file) = split(/\&/,$row,2); + my ($file_name,$file_version,$file_ext) = + &file_name_version_ext($file); + if (($file_name eq $answer_name) && + ($file_ext eq $answer_ext)) { + # gets here if filename and extension match, regardless of version + if ($file_version ne '') { + # a versioned file is found so save it for later + if ($file_version > $version) { + $version = $file_version; + } + } + } + } + $version ++; + return($version); +} + +sub version_selected_portfile { + my ($domain,$stu_name,$directory,$file_name,$version) = @_; + my ($answer_name,$answer_ver,$answer_ext) = + &file_name_version_ext($file_name); + my $new_answer; + $env{'form.copy'} = &Apache::lonnet::getfile("/uploaded/$domain/$stu_name/portfolio$directory$file_name"); + if($env{'form.copy'} eq '-1') { + &Apache::lonnet::logthis('problem getting file '.$file_name); + $new_answer = 'problem getting file'; + } else { + $new_answer = $answer_name.'.'.$version.'.'.$answer_ext; + my $copy_result = &Apache::lonnet::finishuserfileupload( + $stu_name,$domain,'copy', + '/portfolio'.$directory.$new_answer); + } + return ($new_answer); } sub file_name_version_ext { @@ -3304,8 +3378,13 @@ sub csvuploadmap { unshift(@fields,['none','']); $i=&Apache::loncommon::csv_samples_select_table($request,\@records, \@fields); - my %sone=&Apache::loncommon::record_sep($records[0]); - $keyfields=join(',',sort(keys(%sone))); + foreach my $rec (@records) { + my %temp = &Apache::loncommon::record_sep($rec); + if (%temp) { + $keyfields=join(',',sort(keys(%temp))); + last; + } + } } } &csvuploadmap_footer($request,$i,$keyfields); @@ -4071,11 +4150,11 @@ sub scantron_CODElist { sub scantron_CODEunique { my $result=' + value="yes" checked="checked" /> Yes + value="no" /> No '; return $result; }