[BACK]Return to grades.pm CVS log [TXT] [DIR] Up to [LON-CAPA] / loncom / homework

Diff for /loncom/homework/grades.pm between versions 1.314 and 1.322

version 1.314, 2006/02/14 19:41:06 version 1.322, 2006/02/27 21:23:52
Line 40  use Apache::lonmsg qw(:user_normal_msg); Line 40  use Apache::lonmsg qw(:user_normal_msg);
 use Apache::Constants qw(:common);  use Apache::Constants qw(:common);
 use Apache::lonlocal;  use Apache::lonlocal;
 use String::Similarity;  use String::Similarity;
   use POSIX qw(floor);
   
 my %oldessays=();  my %oldessays=();
 my %perm=();  my %perm=();
Line 467  sub jscriptNform { Line 468  sub jscriptNform {
     return $jscript;      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 --------------------  #------------------ End of general use routines --------------------
   
 #  #
Line 1393  sub gradeBox { Line 1421  sub gradeBox {
   '<font color="red">problem weight assigned by computer</font>');    '<font color="red">problem weight assigned by computer</font>');
     $wgt       = ($wgt > 0 ? $wgt : '1');      $wgt       = ($wgt > 0 ? $wgt : '1');
     my $score  = ($$record{'resource.'.$partid.'.awarded'} eq '' ?      my $score  = ($$record{'resource.'.$partid.'.awarded'} eq '' ?
   '' : $$record{'resource.'.$partid.'.awarded'}*$wgt);    '' : &compute_points($$record{'resource.'.$partid.'.awarded'},$wgt));
     my $result='<input type="hidden" name="WGT'.$counter.'_'.$partid.'" value="'.$wgt.'" />'."\n";      my $result='<input type="hidden" name="WGT'.$counter.'_'.$partid.'" value="'.$wgt.'" />'."\n";
     my $display_part=&get_display_part($partid,undef,$symb);      my $display_part=&get_display_part($partid,undef,$symb);
     my %last_resets = &get_last_resets($symb,$env{'request.course.id'},      my %last_resets = &get_last_resets($symb,$env{'request.course.id'},
Line 1443  sub gradeBox { Line 1471  sub gradeBox {
         '<input type="hidden" name="aggtries'.$counter.'_'.$partid.'" value="'.          '<input type="hidden" name="aggtries'.$counter.'_'.$partid.'" value="'.
         $aggtries.'" />'."\n";          $aggtries.'" />'."\n";
     $result.='</td></tr></table>'."\n";      $result.='</td></tr></table>'."\n";
     my $files=&get_submitted_files($udom,$uname,$partid,$counter,$record);      $result.=&handback_box($uname,$udom,$counter,$partid,$record);
     if (@$files) {      return $result;
         my $file_counter = 0;  }
   
   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) {   foreach my $file (@$files) {
             $result.=' Return commented document to student. <input type="file" name="part'.$partid.'_returndoc';      my ($file_disp) = ($file =~ m|.+/(.+)$|);
             $result.=$file_counter.'" />'."\n";      $result.=&mt('Return commented version of [_1] to student.',
             $result.='<input type="hidden" name="respid" value="'.$counter.'" />';   '<span class="filename">'.$file_disp.'</span>');
             $result.='<input type="hidden" name="returndocorig'.$file_counter.'" value="'.$file.'" />';      $result.='<input type="file"   name="'.$prefix.'_returndoc'.$file_counter.'" />'."\n";
         }      $result.='<input type="hidden" name="'.$prefix.'_origdoc'.$file_counter.'" value="'.$file.'" /><br />';
       $file_counter++;
    }
     }      }
       return $result;    
       
     return $result;  
 }  }
   
 sub show_problem {  sub show_problem {
Line 1797  KEYWORDS Line 1834  KEYWORDS
     $display_part.' <font color="#999999">( ID '.$respid.      $display_part.' <font color="#999999">( ID '.$respid.
     ' )</font>&nbsp; &nbsp;';      ' )</font>&nbsp; &nbsp;';
  my $files=&get_submitted_files($udom,$uname,$partid,$respid,\%record);   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) {   if (@$files) {
     $lastsubonly.='<br /><font color="red" size="1">Like all files provided by users, this file may contain virusses</font><br />';      $lastsubonly.='<br /><font color="red" size="1">Like all files provided by users, this file may contain virusses</font><br />';
     my $file_counter = 0;      my $file_counter = 0;
Line 1890  KEYWORDS Line 1918  KEYWORDS
     my %seen = ();      my %seen = ();
     my @partlist;      my @partlist;
     my @gradePartRespid;      my @gradePartRespid;
     for (sort keys(%$handgrade)) {      for my $part_resp (sort(keys(%$handgrade))) {
  my ($partid,$respid) = split(/_/);   my ($partid,$respid) = split(/_/, $part_resp);
  next if ($seen{$partid} > 0);   next if ($seen{$partid} > 0);
  $seen{$partid}++;   $seen{$partid}++;
  next if ($$handgrade{$_} =~ /:no$/ && $env{'form.lastSub'} =~ /^(hdgrade)$/);   next if ($$handgrade{$part_resp} =~ /:no$/ && $env{'form.lastSub'} =~ /^(hdgrade)$/);
  push @partlist,$partid;   push @partlist,$partid;
  push @gradePartRespid,$partid.'.'.$respid;   push @gradePartRespid,$partid.'.'.$respid;
   
  $request->print(&gradeBox($request,$symb,$uname,$udom,$counter,$partid,\%record));   $request->print(&gradeBox($request,$symb,$uname,$udom,$counter,$partid,\%record));
     }      }
     $result='<input type="hidden" name="partlist'.$counter.      $result='<input type="hidden" name="partlist'.$counter.
Line 2289  sub saveHandGrade { Line 2316  sub saveHandGrade {
     $newrecord{'resource.'.$new_part.'.regrader'}=      $newrecord{'resource.'.$new_part.'.regrader'}=
  "$env{'user.name'}:$env{'user.domain'}";   "$env{'user.name'}:$env{'user.domain'}";
  }   }
         if ($env{'form.part'.$new_part.'_returndoc1'}) {   my ($partlist,$handgrade,$responseType) = &response_type($url,$symb);
             # if multiple files are uploaded names will be 'returndoc2','returndoc3'   my $portfolio_root = &Apache::loncommon::propath($domain,
                      $stuname).
             my $portfolio_root = &Apache::loncommon::propath($domain,          '/userfiles/portfolio';
     $stuname).   foreach my $part_resp (sort(keys(%$handgrade))) {
     '/userfiles/portfolio';      my ($part_id, $resp_id) = split(/_/,$part_resp);
                 $request->print('<br>'.$portfolio_root.'<br>');              if ($env{'form.'.$part_resp.'_returndoc1'} && ($new_part eq $part_id)) {
                                   # if multiple files are uploaded names will be 'returndoc2','returndoc3'
     #                my $result=&Apache::lonnet::userfileupload('uploaddoc','',                  my $file_counter = 1;
     #         'portfolio'.$env{'form.currentpath'});                  while ($env{'form.'.$part_resp.'_returndoc'.$file_counter}) {
                           my $fname=$env{'form.returndoc'.$file_counter.'.filename'};
             my $file_counter = 1;                      $newrecord{"resource.$new_part.$resp_id.handback"} = $env{'form.returndocorig'.$file_counter};
             my $respid = $env{'form.respid'};                      $request->print("<br />".$fname." will be the uploaded file name");
             while ($env{'form.part'.$new_part.'_returndoc'.$file_counter}) {                      $request->print("<font color=\"red\">Will upload document</font>".$env{'form.returndocorig'.$file_counter});
                 my $fname=$env{'form.returndoc'.$file_counter.'.filename'};                      $file_counter++;
                 $newrecord{"resource.$new_part.$respid.handback"} = $env{'form.returndocorig'.$file_counter};                  }
                 $request->print("<br />".$fname." will be the uploaded file name");  
                 $request->print("<font color=\"red\">Will upload document</font>".$env{'form.returndocorig'.$file_counter});  
                 $file_counter++;  
             }              }
         }          }
   
Line 2347  sub saveHandGrade { Line 2371  sub saveHandGrade {
     }      }
     return ('',$pts,$wgt);      return ('',$pts,$wgt);
 }  }
   
 sub get_submitted_files {  sub get_submitted_files {
     my ($udom,$uname,$partid,$respid,$record) = @_;      my ($udom,$uname,$partid,$respid,$record) = @_;
     my @files;      my @files;
Line 2361  sub get_submitted_files { Line 2386  sub get_submitted_files {
     }      }
     return (\@files);      return (\@files);
 }  }
   
 # ----------- Provides number of tries since last reset.  # ----------- Provides number of tries since last reset.
 sub get_num_tries {  sub get_num_tries {
     my ($record,$last_reset,$part) = @_;      my ($record,$last_reset,$part) = @_;
Line 2866  sub viewstudentgrade { Line 2892  sub viewstudentgrade {
             $aggregates{$part} = 1;              $aggregates{$part} = 1;
         }          }
  if ($type eq 'awarded') {   if ($type eq 'awarded') {
     my $pts = $score eq '' ? '' : $score*$$weight{$part};      my $pts = $score eq '' ? '' : &compute_points($score,$$weight{$part});
     $result.='<input type="hidden" name="'.      $result.='<input type="hidden" name="'.
  'GD_'.$student.'_'.$part.'_awarded_s" value="'.$pts.'" />'."\n";   'GD_'.$student.'_'.$part.'_awarded_s" value="'.$pts.'" />'."\n";
     $result.='<input type="text" name="'.      $result.='<input type="text" name="'.
Removed from v.1.314  
changed lines
  Added in v.1.322

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>