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

Diff for /loncom/homework/grades.pm between versions 1.302.2.1 and 1.316

version 1.302.2.1, 2006/01/25 22:58:26 version 1.316, 2006/02/26 00:30:17
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 1386  SUBJAVASCRIPT Line 1414  SUBJAVASCRIPT
 #--- displays the grading box, used in essay type problem and grading by page/sequence  #--- displays the grading box, used in essay type problem and grading by page/sequence
 sub gradeBox {  sub gradeBox {
     my ($request,$symb,$uname,$udom,$counter,$partid,$record) = @_;      my ($request,$symb,$uname,$udom,$counter,$partid,$record) = @_;
   
     my $checkIcon = '<img src="'.$request->dir_config('lonIconsURL').      my $checkIcon = '<img src="'.$request->dir_config('lonIconsURL').
  '/check.gif" height="16" border="0" />';   '/check.gif" height="16" border="0" />';
   
     my $wgt    = &Apache::lonnet::EXT('resource.'.$partid.'.weight',$symb,$udom,$uname);      my $wgt    = &Apache::lonnet::EXT('resource.'.$partid.'.weight',$symb,$udom,$uname);
     my $wgtmsg = ($wgt > 0 ? '(problem weight)' :       my $wgtmsg = ($wgt > 0 ? '(problem weight)' : 
   '<font color="red">problem weight assigned by computer</font>');    '<font color="red">problem weight assigned by computer</font>');
Line 1397  sub gradeBox { Line 1423  sub gradeBox {
     my $score  = ($$record{'resource.'.$partid.'.awarded'} eq '' ?      my $score  = ($$record{'resource.'.$partid.'.awarded'} eq '' ?
   '' : $$record{'resource.'.$partid.'.awarded'}*$wgt);    '' : $$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'},
        [$partid]);         [$partid]);
     my $aggtries = $$record{'resource.'.$partid.'.tries'};      my $aggtries = $$record{'resource.'.$partid.'.tries'};
     if ($last_resets{$partid}) {      if ($last_resets{$partid}) {
         $aggtries = &get_num_tries($record,$last_resets{$partid},$partid);          $aggtries = &get_num_tries($record,$last_resets{$partid},$partid);
     }      }
   
     $result.='<table border="0"><tr><td>'.      $result.='<table border="0"><tr><td>'.
  '<b>Part: </b>'.$display_part.' <b>Points: </b></td><td>'."\n";   '<b>Part: </b>'.$display_part.' <b>Points: </b></td><td>'."\n";
   
     my $ctr = 0;      my $ctr = 0;
     $result.='<table border="0"><tr>'."\n";  # display radio buttons in a nice table 10 across      $result.='<table border="0"><tr>'."\n";  # display radio buttons in a nice table 10 across
     while ($ctr<=$wgt) {      while ($ctr<=$wgt) {
Line 1421  sub gradeBox { Line 1443  sub gradeBox {
  $ctr++;   $ctr++;
     }      }
     $result.='</tr></table>';      $result.='</tr></table>';
   
     $result.='</td><td>&nbsp;<b>or</b>&nbsp;</td>'."\n";      $result.='</td><td>&nbsp;<b>or</b>&nbsp;</td>'."\n";
     $result.='<td><input type="text" name="GD_BOX'.$counter.'_'.$partid.'"'.      $result.='<td><input type="text" name="GD_BOX'.$counter.'_'.$partid.'"'.
  ($score ne ''? ' value = "'.$score.'"':'').' size="4" '.   ($score ne ''? ' value = "'.$score.'"':'').' size="4" '.
Line 1430  sub gradeBox { Line 1451  sub gradeBox {
     $result.='<td>/'.$wgt.' '.$wgtmsg.      $result.='<td>/'.$wgt.' '.$wgtmsg.
  ($$record{'resource.'.$partid.'.solved'} eq 'correct_by_student' ? '&nbsp;'.$checkIcon : '').   ($$record{'resource.'.$partid.'.solved'} eq 'correct_by_student' ? '&nbsp;'.$checkIcon : '').
  ' </td><td>'."\n";   ' </td><td>'."\n";
   
     $result.='<select name="GD_SEL'.$counter.'_'.$partid.'" '.      $result.='<select name="GD_SEL'.$counter.'_'.$partid.'" '.
  'onChange="javascript:clearRadBox(this.form,\''.$counter.'_'.$partid.'\')" >'."\n";   'onChange="javascript:clearRadBox(this.form,\''.$counter.'_'.$partid.'\')" >'."\n";
     if ($$record{'resource.'.$partid.'.solved'} eq 'excused') {      if ($$record{'resource.'.$partid.'.solved'} eq 'excused') {
Line 1451  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);
       if (@$files) {
           my $file_counter = 0;
    foreach my $file (@$files) {
               $result.=' Return commented document to student. <input type="file" name="part'.$partid.'_returndoc';
               $result.=$file_counter.'" />'."\n";
               $result.='<input type="hidden" name="respid" value="'.$counter.'" />';
               $result.='<input type="hidden" name="returndocorig'.$file_counter.'" value="'.$file.'" />';
           }
       }
   
       
     return $result;      return $result;
 }  }
   
Line 1577  sub submission { Line 1609  sub submission {
  }   }
  my $overRideScore = $env{'form.overRideScore'} eq '' ? 'no' : $env{'form.overRideScore'};   my $overRideScore = $env{'form.overRideScore'} eq '' ? 'no' : $env{'form.overRideScore'};
   
  $request->print('<form action="/adm/grades" method="post" name="SCORE">'."\n".   $request->print('<form action="/adm/grades" method="post" name="SCORE" enctype="multipart/form-data">'."\n".
  '<input type="hidden" name="command"    value="handgrade" />'."\n".   '<input type="hidden" name="command"    value="handgrade" />'."\n".
  '<input type="hidden" name="saveState"  value="'.$env{'form.saveState'}.'" />'."\n".   '<input type="hidden" name="saveState"  value="'.$env{'form.saveState'}.'" />'."\n".
  '<input type="hidden" name="Status"     value="'.$env{'form.Status'}.'" />'."\n".   '<input type="hidden" name="Status"     value="'.$env{'form.Status'}.'" />'."\n".
Line 1792  KEYWORDS Line 1824  KEYWORDS
  $lastsubonly.='<tr><td bgcolor="#ffffe6"><b>Part:</b> '.   $lastsubonly.='<tr><td bgcolor="#ffffe6"><b>Part:</b> '.
     $display_part.' <font color="#999999">( ID '.$respid.      $display_part.' <font color="#999999">( ID '.$respid.
     ' )</font>&nbsp; &nbsp;';      ' )</font>&nbsp; &nbsp;';
  my @files;   my $files=&get_submitted_files($udom,$uname,$partid,$respid,\%record);
  if ($record{"resource.$partid.$respid.portfiles"}) {  # if ($record{"resource.$partid.$respid.portfiles"}) {
     my $file_url = '/uploaded/'.$udom.'/'.$uname.'/portfolio';  #    my $file_url = '/uploaded/'.$udom.'/'.$uname.'/portfolio';
     foreach my $file (split(',',$record{"resource.$partid.$respid.portfiles"})) {  #    foreach my $file (split(',',$record{"resource.$partid.$respid.portfiles"})) {
  push(@files,$file_url.$file);  # 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 ($record{"resource.$partid.$respid.uploadedurl"}) {   if (@$files) {
     push(@files,$record{"resource.$partid.$respid.uploadedurl"});  
  }  
  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 />';
     foreach my $file (@files) {      my $file_counter = 0;
       foreach my $file (@$files) {
           $file_counter ++;
  &Apache::lonnet::allowuploaded('/adm/grades',$file);   &Apache::lonnet::allowuploaded('/adm/grades',$file);
  $lastsubonly.='<br /><a href="'.$file.'" target="lonGRDs"><img src="'.&Apache::loncommon::icon($file).'" border=0"> '.$file.'</a>';   $lastsubonly.='<br /><a href="'.$file.'" target="lonGRDs"><img src="'.&Apache::loncommon::icon($file).'" border="0"> '.$file.'</a>';
     }      }
     $lastsubonly.='<br />';      $lastsubonly.='<br />';
  }   }
Line 2024  sub processHandGrade { Line 2055  sub processHandGrade {
  my @collabstrs=&Apache::loncommon::get_env_multiple("form.collaborator$ctr");   my @collabstrs=&Apache::loncommon::get_env_multiple("form.collaborator$ctr");
  foreach my $collabstr (@collabstrs) {   foreach my $collabstr (@collabstrs) {
     my ($part,@collaborators) = split(/:/,$collabstr);      my ($part,@collaborators) = split(/:/,$collabstr);
     foreach (@collaborators) {      foreach my $collaborator (@collaborators) {
  my ($errorflag,$pts,$wgt) =    my ($errorflag,$pts,$wgt) = 
     &saveHandGrade($request,$url,$symb,$_,$udom,$ctr,      &saveHandGrade($request,$url,$symb,$collaborator,$udom,$ctr,
    $env{'form.unamedom'.$ctr},$part);     $env{'form.unamedom'.$ctr},$part);
  if ($errorflag eq 'not_allowed') {   if ($errorflag eq 'not_allowed') {
     $request->print("<font color=\"red\">Not allowed to modify grades for $_:$udom</font>");      $request->print("<font color=\"red\">Not allowed to modify grades for $collaborator:$udom</font>");
     next;      next;
  } else {   } else {
     if ($message ne '') {      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);
     }      }
       
  }   }
     }      }
  }   }
Line 2287  sub saveHandGrade { Line 2317  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'}) {
               # if multiple files are uploaded names will be 'returndoc2','returndoc3'
              
               my $portfolio_root = &Apache::loncommon::propath($domain,
       $stuname).
       '/userfiles/portfolio';
                   $request->print('<br>'.$portfolio_root.'<br>');
                   
       #                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("<br />".$fname." will be the uploaded file name");
                   $request->print("<font color=\"red\">Will upload document</font>".$env{'form.returndocorig'.$file_counter});
                   $file_counter++;
               }
           }
   
  # unless problem has been graded, set flag to version the submitted files   # 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);      push (@v_flag,$new_part);
  }   }
     }      }
Line 2320  sub saveHandGrade { Line 2375  sub saveHandGrade {
     }      }
     return ('',$pts,$wgt);      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.  # ----------- 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 2382  sub get_last_resets { Line 2450  sub get_last_resets {
   
 # ----------- Handles creating versions for portfolio files as answers  # ----------- Handles creating versions for portfolio files as answers
 sub version_portfiles {  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 $version_parts = join('|',@$v_flag);
     my $parts = join('|', @$parts_graded);      my $parts = join('|', @$parts_graded);
     my $portfolio_root = &Apache::loncommon::propath($domain,      my $portfolio_root = &Apache::loncommon::propath($domain,
  $stuname).   $stu_name).
  '/userfiles/portfolio';   '/userfiles/portfolio';
     foreach my $key (keys(%$record)) {      foreach my $key (keys(%$record)) {
         my $new_portfiles;          my $new_portfiles;
   
         if ($key =~ /^resource\.($version_parts)\./ && $key =~ /\.portfiles$/ ) {          if ($key =~ /^resource\.($version_parts)\./ && $key =~ /\.portfiles$/ ) {
             my @v_portfiles;              my @v_portfiles;
             my @portfiles = split(/,/,$$record{$key});              my @portfiles = split(/,/,$$record{$key});
             &Apache::lonnet::logthis("should be unmarking and remarking $key",@portfiles);  
             foreach my $file (@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 ($directory,$answer_file) =($file =~ /^(.*?)([^\/]*)$/);
                 my $version = 0;                  my $version = 0;
  my ($answer_name,$answer_ver,$answer_ext) =   my ($answer_name,$answer_ver,$answer_ext) =
     &file_name_version_ext($answer_file);      &file_name_version_ext($answer_file);
                 my @dir_list = &Apache::lonnet::dirlist($directory,$domain,$stuname,$portfolio_root);                  my @dir_list = &Apache::lonnet::dirlist($directory,$domain,$stu_name,$portfolio_root);
                 foreach my $row (@dir_list) {                  $version = &get_next_version($answer_name, $answer_ext, \@dir_list);
                     my ($file) = split(/\&/,$row,2);                  my $new_answer = &version_selected_portfile($domain, $stu_name, $directory, $answer_file, $version);
     my ($file_name,$file_version,$file_ext) =                  if ($new_answer ne 'problem getting file') {
  &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);  
                     push(@v_portfiles, $directory.$new_answer);                      push(@v_portfiles, $directory.$new_answer);
                     &Apache::lonnet::mark_as_readonly($domain,$stuname,                      &Apache::lonnet::mark_as_readonly($domain,$stu_name,
                                 ['/portfolio'.$directory.$new_answer],                          ['/portfolio'.$directory.$new_answer],
                                 [$symb,$env{'request.course.id'},'graded']);                          [$symb,$env{'request.course.id'},'graded']);
                 }                  }
                   
             }              }
             $$record{$key} = join(',',@v_portfiles);              $$record{$key} = join(',',@v_portfiles);
         }          }
     }       } 
     return 'ok';         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 {  sub file_name_version_ext {
Line 3291  sub csvuploadmap { Line 3376  sub csvuploadmap {
     unshift(@fields,['none','']);      unshift(@fields,['none','']);
     $i=&Apache::loncommon::csv_samples_select_table($request,\@records,      $i=&Apache::loncommon::csv_samples_select_table($request,\@records,
     \@fields);      \@fields);
     my %sone=&Apache::loncommon::record_sep($records[0]);              foreach my $rec (@records) {
     $keyfields=join(',',sort(keys(%sone)));                  my %temp = &Apache::loncommon::record_sep($rec);
                   if (%temp) {
                       $keyfields=join(',',sort(keys(%temp)));
                       last;
                   }
               }
  }   }
     }      }
     &csvuploadmap_footer($request,$i,$keyfields);      &csvuploadmap_footer($request,$i,$keyfields);
Line 4058  sub scantron_CODElist { Line 4148  sub scantron_CODElist {
 sub scantron_CODEunique {  sub scantron_CODEunique {
     my $result='<nobr>      my $result='<nobr>
                  <label><input type="radio" name="scantron_CODEunique"                   <label><input type="radio" name="scantron_CODEunique"
                         value="Yes" checked="on" /> Yes </label>                          value="yes" checked="checked" /> Yes </label>
                 </nobr>                  </nobr>
                 <nobr>                  <nobr>
                  <label><input type="radio" name="scantron_CODEunique"                   <label><input type="radio" name="scantron_CODEunique"
                         value="No" /> No </label>                          value="no" /> No </label>
                 </nobr>';                  </nobr>';
     return $result;      return $result;
 }  }
Removed from v.1.302.2.1  
changed lines
  Added in v.1.316

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