Diff for /loncom/homework/grades.pm between versions 1.332 and 1.348

version 1.332, 2006/03/11 00:08:48 version 1.348, 2006/04/09 20:53:27
Line 118  sub response_type { Line 118  sub response_type {
     my %seen = ();      my %seen = ();
     my (@partlist,%handgrade,%responseType);      my (@partlist,%handgrade,%responseType);
     foreach (split(/,/,&Apache::lonnet::metadata($url,'packages'))) {      foreach (split(/,/,&Apache::lonnet::metadata($url,'packages'))) {
  if (/^\w+response_.*/) {   if (/^\w+response_.*/ || /^Task_/) {
     my ($responsetype,$part) = split(/_/,$_,2);      my ($responsetype,$part) = split(/_/,$_,2);
     my ($partid,$respid) = split(/_/,$part);      my ($partid,$respid) = split(/_/,$part);
       if ($responsetype eq 'Task') { $respid='0'; }
     if (&Apache::loncommon::check_if_partid_hidden($partid,$symb)) {      if (&Apache::loncommon::check_if_partid_hidden($partid,$symb)) {
  next;   next;
     }      }
Line 205  sub get_order { Line 206  sub get_order {
     return ($analyze{"$partid.$respid.shown"});      return ($analyze{"$partid.$respid.shown"});
 }  }
 #--- Clean response type for display  #--- Clean response type for display
 #--- Currently filters option/rank/radiobutton/match/essay response types only.  #--- Currently filters option/rank/radiobutton/match/essay/Task
   #        response types only.
 sub cleanRecord {  sub cleanRecord {
     my ($answer,$response,$symb,$partid,$respid,$record,$order,$version) = @_;      my ($answer,$response,$symb,$partid,$respid,$record,$order,$version,
    $uname,$udom) = @_;
     my $grayFont = '<font color="#999999">';      my $grayFont = '<font color="#999999">';
     if ($response =~ /^(option|rank)$/) {      if ($response =~ /^(option|rank)$/) {
  my %answer=&Apache::lonnet::str2hash($answer);   my %answer=&Apache::lonnet::str2hash($answer);
Line 288  sub cleanRecord { Line 291  sub cleanRecord {
  my $jme=$record->{$version."resource.$partid.$respid.molecule"};   my $jme=$record->{$version."resource.$partid.$respid.molecule"};
  $result.=&Apache::chemresponse::jme_img($jme,$answer,400);   $result.=&Apache::chemresponse::jme_img($jme,$answer,400);
  return $result;   return $result;
       } elsif ( $response eq 'Task') {
    if ( $answer eq 'SUBMITTED') {
       my $files = $record->{$version."resource.$respid.$partid.bridgetask.portfiles"};
       my $result = &Apache::bridgetask::file_list($files,$uname,$udom);
       return $result;
    } elsif ( grep(/^\Q$version\E.*?\.instance$/, keys(%{$record})) ) {
       my @matches = grep(/^\Q$version\E.*?\.instance$/,
          keys(%{$record}));
       return join('<br />',($version,@matches));
          
          
    } else {
       my $result =
    '<p>'
    .&mt('Overall result: [_1]',
        $record->{$version."resource.$respid.$partid.status"})
    .'</p>';
       
       $result .= '<ul>';
       my @grade = grep(/^\Q${version}resource.$respid.$partid.\E[^.]*[.]status$/,
        keys(%{$record}));
       foreach my $grade (sort(@grade)) {
    my ($dim) = ($grade =~/[.]([^.]+)[.]status$/);
    $result.= '<li>'.&mt("Dimension: [_1], status [_2] ",
        $dim, $record->{$grade}).
     '</li>';
       }
       $result.='</ul>';
       return $result;
    }
          
     }      }
     return $answer;      return $answer;
 }  }
Line 688  LISTJAVASCRIPT Line 722  LISTJAVASCRIPT
     $gradeTable.='<label><input type="radio" name="lastSub" value="lastonly" '.$checklastsub.' /> last submission only </label>'."\n".      $gradeTable.='<label><input type="radio" name="lastSub" value="lastonly" '.$checklastsub.' /> last submission only </label>'."\n".
  '<label><input type="radio" name="lastSub" value="last" /> last submission & parts info </label>'."\n".   '<label><input type="radio" name="lastSub" value="last" /> last submission & parts info </label>'."\n".
  '<label><input type="radio" name="lastSub" value="datesub" /> by dates and submissions </label>'."\n".   '<label><input type="radio" name="lastSub" value="datesub" /> by dates and submissions </label>'."\n".
  '<label><input type="radio" name="lastSub" value="all" /> all details</label>'."\n".   '<label><input type="radio" name="lastSub" value="all" /> all details</label><br />'."\n".
           '&nbsp;<b>Grading Increments:</b> <select name="increment">'.
           '<option value="1">Whole Points</option>'.
           '<option value=".5">Half Points</option>'.
           '<option value=".25">Quarter Points</options>'.
           '<option values=".1">Tenths of a Point</option>'.
           '</select>'.
   
  '<input type="hidden" name="section"     value="'.$getsec.'" />'."\n".   '<input type="hidden" name="section"     value="'.$getsec.'" />'."\n".
  '<input type="hidden" name="submitonly"  value="'.$submitonly.'" />'."\n".   '<input type="hidden" name="submitonly"  value="'.$submitonly.'" />'."\n".
  '<input type="hidden" name="handgrade"   value="'.$env{'form.handgrade'}.'" /><br />'."\n".   '<input type="hidden" name="handgrade"   value="'.$env{'form.handgrade'}.'" /><br />'."\n".
Line 1402  sub sub_page_kw_js { Line 1443  sub sub_page_kw_js {
 SUBJAVASCRIPT  SUBJAVASCRIPT
 }  }
   
   sub getIncrement
   {
       my $increment = $env{'form.increment'};
       if ($increment != 1 && $increment != .5 && $increment != .25 &&
           $increment != .1) {
           $increment = 1;
       }
       return $increment;
   }
   
 #--- 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) = @_;
Line 1424  sub gradeBox { Line 1475  sub gradeBox {
     $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;
       my $thisweight = 0;
       my $increment = getIncrement();
     $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 ($thisweight<=$wgt) {
  $result.= '<td><nobr><label><input type="radio" name="RADVAL'.$counter.'_'.$partid.'" '.   $result.= '<td><nobr><label><input type="radio" name="RADVAL'.$counter.'_'.$partid.'" '.
     'onclick="javascript:writeBox(this.form,\''.$counter.'_'.$partid.'\','.      'onclick="javascript:writeBox(this.form,\''.$counter.'_'.$partid.'\','.
     $ctr.')" value="'.$ctr.'" '.      $thisweight.')" value="'.$thisweight.'" '.
     ($score eq $ctr ? 'checked':'').' /> '.$ctr."</label></nobr></td>\n";      ($score eq $thisweight ? 'checked':'').' /> '.$thisweight."</label></nobr></td>\n";
  $result.=(($ctr+1)%10 == 0 ? '</tr><tr>' : '');   $result.=(($ctr+1)%10 == 0 ? '</tr><tr>' : '');
           $thisweight += $increment;
  $ctr++;   $ctr++;
     }      }
     $result.='</tr></table>';      $result.='</tr></table>';
Line 1483  sub handback_box { Line 1537  sub handback_box {
  next if (!@$files);   next if (!@$files);
  my $file_counter = 1;   my $file_counter = 1;
  foreach my $file (@$files) {   foreach my $file (@$files) {
     my ($file_disp) = ($file =~ m|.+/(.+)$|);      my ($file_path, $file_disp) = ($file =~ m|(.+/)(.+)$|);
       my ($name,$version,$ext) = &file_name_version_ext($file_disp);
       $file_disp = "$name.$ext";
       $file = $file_path.$file_disp;
     $result.=&mt('Return commented version of [_1] to student.',      $result.=&mt('Return commented version of [_1] to student.',
  '<span class="filename">'.$file_disp.'</span>');   '<span class="filename">'.$file_disp.'</span>');
     $result.='<input type="file"   name="'.$prefix.'returndoc'.$file_counter.'" />'."\n";      $result.='<input type="file"   name="'.$prefix.'returndoc'.$file_counter.'" />'."\n";
Line 1841  KEYWORDS Line 1898  KEYWORDS
     foreach my $file (@$files) {      foreach my $file (@$files) {
         $file_counter ++;          $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.'?rawmode=1" target="lonGRDs"><img src="'.&Apache::loncommon::icon($file).'" border=0"> '.$file.'</a>';
     }      }
     $lastsubonly.='<br />';      $lastsubonly.='<br />';
  }   }
Line 1958  KEYWORDS Line 2015  KEYWORDS
     '<input type="button" value="Next" '.      '<input type="button" value="Next" '.
     'onClick="javascript:checksubmit(this.form,\'Next\');" TARGET=_self> &nbsp;';      'onClick="javascript:checksubmit(this.form,\'Next\');" TARGET=_self> &nbsp;';
  $endform.='(Next and Previous (student) do not save the scores.)'."\n" ;   $endform.='(Next and Previous (student) do not save the scores.)'."\n" ;
           $endform.="<input type='hidden' value='" . getIncrement() .
               "' name='increment' />";
  $endform.='</td><tr></table></form>';   $endform.='</td><tr></table></form>';
  $endform.=&show_grading_menu_form($symb);   $endform.=&show_grading_menu_form($symb);
  $request->print($endform);   $request->print($endform);
Line 2235  sub processHandGrade { Line 2294  sub processHandGrade {
 #---- Save the score and award for each student, if changed  #---- Save the score and award for each student, if changed
 sub saveHandGrade {  sub saveHandGrade {
     my ($request,$symb,$stuname,$domain,$newflg,$submitter,$part) = @_;      my ($request,$symb,$stuname,$domain,$newflg,$submitter,$part) = @_;
     my @v_flag;      my @version_parts;
     my $usec = &Apache::lonnet::getsection($domain,$stuname,      my $usec = &Apache::lonnet::getsection($domain,$stuname,
    $env{'request.course.id'});     $env{'request.course.id'});
     if (!&canmodify($usec)) { return('not_allowed'); }      if (!&canmodify($usec)) { return('not_allowed'); }
     my %record     = &Apache::lonnet::restore($symb,$env{'request.course.id'},$domain,$stuname);      my %record = &Apache::lonnet::restore($symb,$env{'request.course.id'},$domain,$stuname);
     my @parts_graded;      my @parts_graded;
     my %newrecord  = ();      my %newrecord  = ();
     my ($pts,$wgt) = ('','');      my ($pts,$wgt) = ('','');
     my %aggregate = ();      my %aggregate = ();
     my $aggregateflag = 0;      my $aggregateflag = 0;
   
     my @parts = split(/:/,$env{'form.partlist'.$newflg});      my @parts = split(/:/,$env{'form.partlist'.$newflg});
     foreach my $new_part (@parts) {      foreach my $new_part (@parts) {
  #collaborator may vary for different parts   #collaborator ($submi may vary for different parts
  if ($submitter && $new_part ne $part) { next; }   if ($submitter && $new_part ne $part) { next; }
  my $dropMenu = $env{'form.GD_SEL'.$newflg.'_'.$new_part};   my $dropMenu = $env{'form.GD_SEL'.$newflg.'_'.$new_part};
  if ($dropMenu eq 'excused') {   if ($dropMenu eq 'excused') {
Line 2293  sub saveHandGrade { Line 2351  sub saveHandGrade {
     my $partial= $pts/$wgt;      my $partial= $pts/$wgt;
     if ($partial eq $record{'resource.'.$new_part.'.awarded'}) {      if ($partial eq $record{'resource.'.$new_part.'.awarded'}) {
  #do not update score for part if not changed.   #do not update score for part if not changed.
                   &handback_files($request,$symb,$stuname,$domain,$newflg,$new_part,\%newrecord);
  next;   next;
     } else {      } else {
         push @parts_graded, $new_part;          push @parts_graded, $new_part;
Line 2316  sub saveHandGrade { Line 2375  sub saveHandGrade {
     }      }
     $newrecord{'resource.'.$new_part.'.regrader'}=      $newrecord{'resource.'.$new_part.'.regrader'}=
  "$env{'user.name'}:$env{'user.domain'}";   "$env{'user.name'}:$env{'user.domain'}";
               &handback_files($request,$symb,$stuname,$domain,$newflg,$new_part,\%newrecord);
  }   }
  my ($partlist,$handgrade,$responseType) = &response_type($symb);  
  foreach my $part_resp (sort(keys(%$handgrade))) {  
     my ($part_id, $resp_id) = split(/_/,$part_resp);  
             if (($env{'form.'.$newflg.'_'.$part_resp.'_returndoc1'}) && ($new_part == $part_id)) {  
                 # if multiple files are uploaded names will be 'returndoc2','returndoc3'  
                 my $file_counter = 1;  
                 while ($env{'form.'.$newflg.'_'.$part_resp.'_returndoc'.$file_counter}) {  
                     my $fname=$env{'form.'.$newflg.'_'.$part_resp.'_returndoc'.$file_counter.'.filename'};  
                     $newrecord{"resource.$new_part.$resp_id.handback"} = $env{'form.returndocorig'.$file_counter};  
                     # set the filename to match the submitted file name  
                     $env{'form.'.$newflg.'_'.$part_resp.'_returndoc1.filename'} = $env{'form.'.$newflg.'_'.$part_resp.'_origdoc'.$file_counter};  
                     my $result=&Apache::lonnet::userfileupload($newflg.'_'.$part_resp.'_returndoc'.$file_counter,'',  
          'portfolio',undef,undef,undef,$stuname,$domain);  
                    if ($result !~ m|^/uploaded/|) {  
                         $request->print('<font color="red"> An errror occured ('.$result.  
                     ') while trying to upload '.&display_file().'</font><br />');  
                 # $request->print(&done('Back'));  
             }  
                     $request->print("<br />".$fname." will be the uploaded file name");  
                     $request->print("<font color=\"red\">Will upload document</font>".$env{'form.'.$newflg.'_'.$part_resp.'_origdoc'.$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_/  ||    unless ($record{'resource.'.$new_part.'.solved'} =~ /^correct_/  || 
         $record{'resource.'.$new_part.'.solved'} eq 'incorrect_by_override' ||          $record{'resource.'.$new_part.'.solved'} eq 'incorrect_by_override' ||
         $dropMenu eq 'reset status')          $dropMenu eq 'reset status')
    {     {
     push (@v_flag,$new_part);      push (@version_parts,$new_part);
  }   }
     }      }
     my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};      my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
     my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};      my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
   
     if (scalar(keys(%newrecord)) > 0) {      if (%newrecord) {
         if (scalar(@v_flag)) {          if (@version_parts) {
             &version_portfiles(\%record, \@parts_graded, $env{'request.course.id'}, $symb, $domain, $stuname, \@v_flag);              my @changed_keys = &version_portfiles(\%record, \@parts_graded, $env{'request.course.id'}, $symb, $domain, $stuname, \@version_parts);
       @newrecord{@changed_keys} = @record{@changed_keys};
         }          }
  &Apache::lonnet::cstore(\%newrecord,$symb,   &Apache::lonnet::cstore(\%newrecord,$symb,
  $env{'request.course.id'},$domain,$stuname);   $env{'request.course.id'},$domain,$stuname);
   
  my @ungraded_parts;   my @ungraded_parts;
  foreach my $part (@parts) {   foreach my $part (@parts) {
     if ( !defined($record{'resource.'.$part.'.awarded'})      if ( !defined($record{'resource.'.$part.'.awarded'})
Line 2379  sub saveHandGrade { Line 2414  sub saveHandGrade {
     return ('',$pts,$wgt);      return ('',$pts,$wgt);
 }  }
   
   sub handback_files {
       my ($request,$symb,$stuname,$domain,$newflg,$new_part,$newrecord) = @_;
       my $portfolio_root = &Apache::loncommon::propath($domain,
    $stuname).
    '/userfiles/portfolio';
    my ($partlist,$handgrade,$responseType) = &response_type($symb);
           foreach my $part_resp (sort(keys(%$handgrade))) {
               my ($part_id, $resp_id) = split(/_/,$part_resp);
               if (($env{'form.'.$newflg.'_'.$part_resp.'_returndoc1'}) && ($new_part == $part_id)) {
                   # if multiple files are uploaded names will be 'returndoc2','returndoc3'
                   my $file_counter = 1;
                   while ($env{'form.'.$newflg.'_'.$part_resp.'_returndoc'.$file_counter}) {
                       my $fname=$env{'form.'.$newflg.'_'.$part_resp.'_returndoc'.$file_counter.'.filename'};
                       my ($directory,$answer_file) = 
                           ($env{'form.'.$newflg.'_'.$part_resp.'_origdoc'.$file_counter} =~ /^(.*?)([^\/]*)$/);
                       my ($answer_name,$answer_ver,$answer_ext) =
           &file_name_version_ext($answer_file);
       $directory =~ /^.+$stuname\/portfolio(.*)/;
       my $portfolio_path = $1;
       my @dir_list = &Apache::lonnet::dirlist($portfolio_path,$domain,$stuname,$portfolio_root);
       my $version = &get_next_version($answer_name, $answer_ext, \@dir_list);
       my $new_answer = &version_selected_portfile($domain, $stuname, $portfolio_path, $answer_file, $version);
                       $$newrecord{"resource.$new_part.$resp_id.handback"} = $new_answer;
                       # set the filename to match the submitted file name
                       $env{'form.'.$newflg.'_'.$part_resp.'_returndoc1.filename'} = $env{'form.'.$newflg.'_'.$part_resp.'_origdoc'.$file_counter};
                       my $result=&Apache::lonnet::userfileupload($newflg.'_'.$part_resp.'_returndoc'.$file_counter,'',
                  'portfolio',undef,undef,undef,$stuname,$domain);
                       if ($result !~ m|^/uploaded/|) {
                           $request->print('<font color="red"> An errror occured ('.$result.
                           ') while trying to upload '.&display_file().'</font><br />');
                       # $request->print(&done('Back'));
                       }
                       $request->print("<br />".$fname." will be the uploaded file name");
                       $request->print("<font color=\"red\">Will upload document </font>".$env{'form.'.$newflg.'_'.$part_resp.'_origdoc'.$file_counter});
                       $file_counter++;
                   }
               }
           }
       return;
   }
   
 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 2457  sub get_last_resets { Line 2533  sub get_last_resets {
 sub version_portfiles {  sub version_portfiles {
     my ($record, $parts_graded, $courseid, $symb, $domain, $stu_name, $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 @returned_keys;
     my $parts = join('|', @$parts_graded);      my $parts = join('|', @$parts_graded);
     my $portfolio_root = &Apache::loncommon::propath($domain,      my $portfolio_root = &Apache::loncommon::propath($domain,
  $stu_name).   $stu_name).
Line 2464  sub version_portfiles { Line 2541  sub version_portfiles {
     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 @versioned_portfiles;
             my @portfiles = split(/,/,$$record{$key});              my @portfiles = split(/,/,$$record{$key});
             foreach my $file (@portfiles) {              foreach my $file (@portfiles) {
                 &Apache::lonnet::unmark_as_readonly($domain,$stu_name,[$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 ($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,$stu_name,$portfolio_root);                  my @dir_list = &Apache::lonnet::dirlist($directory,$domain,$stu_name,$portfolio_root);
                 $version = &get_next_version($answer_name, $answer_ext, \@dir_list);                  my $version = &get_next_version($answer_name, $answer_ext, \@dir_list);
                 my $new_answer = &version_selected_portfile($domain, $stu_name, $directory, $answer_file, $version);                  my $new_answer = &version_selected_portfile($domain, $stu_name, $directory, $answer_file, $version);
                 if ($new_answer ne 'problem getting file') {                  if ($new_answer ne 'problem getting file') {
                     push(@v_portfiles, $directory.$new_answer);                      push(@versioned_portfiles, $directory.$new_answer);
                     &Apache::lonnet::mark_as_readonly($domain,$stu_name,                      &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(',',@versioned_portfiles);
               push(@returned_keys,$key);
         }          }
     }       } 
     return 'ok';         return (@returned_keys);   
 }  }
   
 sub get_next_version {  sub get_next_version {
     my ($answer_name, $answer_ext, $dir_list);      my ($answer_name, $answer_ext, $dir_list) = @_;
     my $version;      my $version;
     foreach my $row (@$dir_list) {      foreach my $row (@$dir_list) {
         my ($file) = split(/\&/,$row,2);          my ($file) = split(/\&/,$row,2);
Line 3460  sub csvuploadassign { Line 3536  sub csvuploadassign {
     my ($request)= @_;      my ($request)= @_;
     my ($symb)=&get_symb($request);      my ($symb)=&get_symb($request);
     if (!$symb) {return '';}      if (!$symb) {return '';}
       my $error_msg = '';
     &Apache::loncommon::load_tmp_file($request);      &Apache::loncommon::load_tmp_file($request);
     my @gradedata = &Apache::loncommon::upfile_record_sep();      my @gradedata = &Apache::loncommon::upfile_record_sep();
     if ($env{'form.noFirstLine'}) { shift(@gradedata); }      if ($env{'form.noFirstLine'}) { shift(@gradedata); }
Line 3512  sub csvuploadassign { Line 3589  sub csvuploadassign {
  my $part=$1;   my $part=$1;
  my $wgt =&Apache::lonnet::EXT('resource.'.$part.'.weight',   my $wgt =&Apache::lonnet::EXT('resource.'.$part.'.weight',
       $symb,$domain,$username);        $symb,$domain,$username);
  $entries{$fields{$dest}}=~s/\s//g;                  if ($wgt) {
  my $pcr=$entries{$fields{$dest}} / $wgt;                      $entries{$fields{$dest}}=~s/\s//g;
  my $award='correct_by_override';                      my $pcr=$entries{$fields{$dest}} / $wgt;
  $grades{"resource.$part.awarded"}=$pcr;                      my $award='correct_by_override';
  $grades{"resource.$part.solved"}=$award;                      $grades{"resource.$part.awarded"}=$pcr;
  $points{$part}=1;                      $grades{"resource.$part.solved"}=$award;
                       $points{$part}=1;
                   } else {
                       $error_msg = "<br />" .
                           &mt("Some point values were assigned"
                               ." for problems with a weight "
                               ."of zero. These values were "
                               ."ignored.");
                   }
     } else {      } else {
  if ($dest=~/stores_(.*)_awarded/) { if ($points{$1}) {next;} }   if ($dest=~/stores_(.*)_awarded/) { if ($points{$1}) {next;} }
  if ($dest=~/stores_(.*)_solved/)  { if ($points{$1}) {next;} }   if ($dest=~/stores_(.*)_solved/)  { if ($points{$1}) {next;} }
Line 3557  sub csvuploadassign { Line 3642  sub csvuploadassign {
     }      }
     $request->print("<br />\n");      $request->print("<br />\n");
     $request->print(&show_grading_menu_form($symb));      $request->print(&show_grading_menu_form($symb));
     return '';      return $error_msg;
 }  }
 #------------- end of section for handling csv file upload ---------  #------------- end of section for handling csv file upload ---------
 #  #
Line 3842  sub displayPage { Line 3927  sub displayPage {
 sub displaySubByDates {  sub displaySubByDates {
     my ($symb,$record,$parts,$responseType,$checkIcon,$uname,$udom) = @_;      my ($symb,$record,$parts,$responseType,$checkIcon,$uname,$udom) = @_;
     my $isCODE=0;      my $isCODE=0;
       my $isTask = ($symb =~/\.task$/);
     if (exists($record->{'resource.CODE'})) { $isCODE=1; }      if (exists($record->{'resource.CODE'})) { $isCODE=1; }
     my $studentTable='<table border="0" width="100%"><tr><td bgcolor="#777777">'.      my $studentTable='<table border="0" width="100%"><tr><td bgcolor="#777777">'.
  '<table border="0" width="100%"><tr bgcolor="#e6ffff">'.   '<table border="0" width="100%"><tr bgcolor="#e6ffff">'.
Line 3856  sub displaySubByDates { Line 3942  sub displaySubByDates {
     if (!exists($$record{'1:timestamp'})) {      if (!exists($$record{'1:timestamp'})) {
  return '<br />&nbsp;<font color="red">Nothing submitted - no attempts</font><br />';   return '<br />&nbsp;<font color="red">Nothing submitted - no attempts</font><br />';
     }      }
   
       my $interaction;
     for ($version=1;$version<=$$record{'version'};$version++) {      for ($version=1;$version<=$$record{'version'};$version++) {
  my $timestamp = scalar(localtime($$record{$version.':timestamp'}));   my $timestamp = scalar(localtime($$record{$version.':timestamp'}));
    if (exists($$record{$version.':resource.0.version'})) {
       $interaction = $$record{$version.':resource.0.version'};
    }
   
    my $where = ($isTask ? "$version:resource.$interaction"
                : "$version:resource");
    #&Apache::lonnet::logthis(" got $where");
  $studentTable.='<tr bgcolor="#ffffff" valign="top"><td>'.$timestamp.'</td>';   $studentTable.='<tr bgcolor="#ffffff" valign="top"><td>'.$timestamp.'</td>';
  if ($isCODE) {   if ($isCODE) {
     $studentTable.='<td>'.$record->{$version.':resource.CODE'}.'</td>';      $studentTable.='<td>'.$record->{$version.':resource.CODE'}.'</td>';
Line 3865  sub displaySubByDates { Line 3960  sub displaySubByDates {
  my @versionKeys = split(/\:/,$$record{$version.':keys'});   my @versionKeys = split(/\:/,$$record{$version.':keys'});
  my @displaySub = ();   my @displaySub = ();
  foreach my $partid (@{$parts}) {   foreach my $partid (@{$parts}) {
     my @matchKey = sort(grep /^resource\.\Q$partid\E\..*?\.submission$/,@versionKeys);      my @matchKey = ($isTask ? sort(grep /^resource\.\d+\.\Q$partid\E\.award$/,@versionKeys)
               : sort(grep /^resource\.\Q$partid\E\..*?\.submission$/,@versionKeys));
       
   
 #    next if ($$record{"$version:resource.$partid.solved"} eq '');  #    next if ($$record{"$version:resource.$partid.solved"} eq '');
     my $display_part=&get_display_part($partid,$symb);      my $display_part=&get_display_part($partid,$symb);
     foreach my $matchKey (@matchKey) {      foreach my $matchKey (@matchKey) {
  if (exists($$record{$version.':'.$matchKey}) &&   if (exists($$record{$version.':'.$matchKey}) &&
     $$record{$version.':'.$matchKey} ne '') {      $$record{$version.':'.$matchKey} ne '') {
     my ($responseId)=($matchKey=~ /^resource\.\Q$partid\E\.(.*?)\.submission$/);  
       my ($responseId)= ($isTask ? ($matchKey=~ /^resource\.(.*?)\.\Q$partid\E\.award$/)
                  : ($matchKey=~ /^resource\.\Q$partid\E\.(.*?)\.submission$/));
       #&Apache::lonnet::logthis("match $matchKey $responseId (".$$record{$version.':'.$matchKey});
     $displaySub[0].='<b>Part:</b>&nbsp;'.$display_part.'&nbsp;';      $displaySub[0].='<b>Part:</b>&nbsp;'.$display_part.'&nbsp;';
     $displaySub[0].='<font color="#999999">(ID&nbsp;'.      $displaySub[0].='<font color="#999999">(ID&nbsp;'.
  $responseId.')</font>&nbsp;<b>';   $responseId.')</font>&nbsp;<b>';
     if ($$record{"$version:resource.$partid.tries"} eq '') {      if ($$record{"$where.$partid.tries"} eq '') {
  $displaySub[0].='Trial&nbsp;not&nbsp;counted';   $displaySub[0].='Trial&nbsp;not&nbsp;counted';
     } else {      } else {
  $displaySub[0].='Trial&nbsp;'.   $displaySub[0].='Trial&nbsp;'.
     $$record{"$version:resource.$partid.tries"};      $$record{"$where.$partid.tries"};
     }      }
     my $responseType=$responseType->{$partid}->{$responseId};      my $responseType=($isTask ? 'Task'
                                                 : $responseType->{$partid}->{$responseId});
     if (!exists($orders{$partid})) { $orders{$partid}={}; }      if (!exists($orders{$partid})) { $orders{$partid}={}; }
     if (!exists($orders{$partid}->{$responseId})) {      if (!exists($orders{$partid}->{$responseId})) {
  $orders{$partid}->{$responseId}=   $orders{$partid}->{$responseId}=
     &get_order($partid,$responseId,$symb,$uname,$udom);      &get_order($partid,$responseId,$symb,$uname,$udom);
     }      }
     $displaySub[0].='</b>&nbsp; '.      $displaySub[0].='</b>&nbsp; '.
  &cleanRecord($$record{$version.':'.$matchKey},$responseType,$symb,$partid,$responseId,$record,$orders{$partid}->{$responseId},"$version:").'<br />';   &cleanRecord($$record{$version.':'.$matchKey},$responseType,$symb,$partid,$responseId,$record,$orders{$partid}->{$responseId},"$version:",$uname,$udom).'<br />';
  }   }
     }      }
     if (exists $$record{"$version:resource.$partid.award"}) {      if (exists($$record{"$where.$partid.checkedin"})) {
    $displaySub[1].='Checked in by '.
       $$record{"$where.$partid.checkedin"}.' into slot '.
       $$record{"$where.$partid.checkedin.slot"}.
       '<br />';
       }
       if (exists $$record{"$where.$partid.award"}) {
  $displaySub[1].='<b>Part:</b>&nbsp;'.$display_part.' &nbsp;'.   $displaySub[1].='<b>Part:</b>&nbsp;'.$display_part.' &nbsp;'.
     lc($$record{"$version:resource.$partid.award"}).' '.      lc($$record{"$where.$partid.award"}).' '.
     $mark{$$record{"$version:resource.$partid.solved"}}.      $mark{$$record{"$where.$partid.solved"}}.
     '<br />';      '<br />';
     }      }
     if (exists $$record{"$version:resource.$partid.regrader"}) {      if (exists $$record{"$where.$partid.regrader"}) {
  $displaySub[2].=$$record{"$version:resource.$partid.regrader"}.   $displaySub[2].=$$record{"$where.$partid.regrader"}.
       ' (<b>'.&mt('Part').':</b> '.$display_part.')';
       } elsif ($$record{"$version:resource.$partid.regrader"} =~ /\S/) {
    $displaySub[2].=
       $$record{"$version:resource.$partid.regrader"}.
     ' (<b>'.&mt('Part').':</b> '.$display_part.')';      ' (<b>'.&mt('Part').':</b> '.$display_part.')';
     }      }
  }   }
Line 4637  sub remember_current_skipped { Line 4749  sub remember_current_skipped {
     $to_remember{$i}=1;      $to_remember{$i}=1;
  }   }
     }      }
     &Apache::lonnet::logthis('remembering '.join(':',%to_remember));  
     &scan_data($scan_data,'remember_skipping',join(':',%to_remember));      &scan_data($scan_data,'remember_skipping',join(':',%to_remember));
     &scantron_putfile(undef,$scan_data);      &scantron_putfile(undef,$scan_data);
 }  }
Line 4764  sub scantron_validate_file { Line 4875  sub scantron_validate_file {
     my $result=&scantron_form_start($max_bubble).$default_form_data;      my $result=&scantron_form_start($max_bubble).$default_form_data;
     $r->print($result);      $r->print($result);
           
     my @validate_phases=( 'ID',      my @validate_phases=( 'sequence',
     'ID',
   'CODE',    'CODE',
   'doublebubble',    'doublebubble',
   'missingbubbles');    'missingbubbles');
Line 4797  STUFF Line 4909  STUFF
  $r->print("<input type='hidden' name='validatepass' value='".$currentphase."' />");   $r->print("<input type='hidden' name='validatepass' value='".$currentphase."' />");
     }      }
     if ($stop) {      if ($stop) {
  $r->print('<input type="submit" name="submit" value="Continue ->" />');   if ($validate_phases[$currentphase] eq 'sequence') {
  $r->print(' using corrected info <br />');      $r->print('<input type="submit" name="submit" value="Ignore -> " />');
  $r->print("<input type='submit' value='Skip' name='scantron_skip_record' />");      $r->print(' this error <br />');
  $r->print(" this scanline saving it for later.");  
       $r->print(" <p>Or click the 'Grading Menu' button to start over.</p>");
    } else {
       $r->print('<input type="submit" name="submit" value="Continue ->" />');
       $r->print(' using corrected info <br />');
       $r->print("<input type='submit' value='Skip' name='scantron_skip_record' />");
       $r->print(" this scanline saving it for later.");
    }
     }      }
     $r->print(" </form><br />".&show_grading_menu_form($symb).      $r->print(" </form><br />".&show_grading_menu_form($symb).
       "</body></html>");        "</body></html>");
Line 4933  sub scantron_put_line { Line 5052  sub scantron_put_line {
     $scanlines->{'corrected'}[$i]=$newline;      $scanlines->{'corrected'}[$i]=$newline;
 }  }
   
   sub scantron_filter_not_exam {
       my ($curres)=@_;
       
       if (ref($curres) && $curres->is_problem() && !$curres->is_exam()) {
    # if the user has asked to not have either hidden
    # or 'randomout' controlled resources to be graded
    # don't include them
    if ($env{'form.scantron_options_hidden'} eq 'ignore_hidden'
       && $curres->randomout) {
       return 0;
    }
    return 1;
       }
       return 0;
   }
   
   sub scantron_validate_sequence {
       my ($r,$currentphase) = @_;
   
       my $navmap=Apache::lonnavmaps::navmap->new();
       my (undef,undef,$sequence)=
    &Apache::lonnet::decode_symb($env{'form.selectpage'});
   
       my $map=$navmap->getResourceByUrl($sequence);
   
       $r->print('<input type="hidden" name="validate_sequence_exam"
                                       value="ignore" />');
       if ($env{'form.validate_sequence_exam'} ne 'ignore') {
    my @resources=
       $navmap->retrieveResources($map,\&scantron_filter_not_exam,1,0);
    if (@resources) {
       $r->print("<p>".&mt('Some resource in the sequece currently are not set to exam mode. Grading these resources currently may not work correctly.')."</p>");
       return (1,$currentphase);
    }
       }
   
       return (0,$currentphase+1);
   }
   
 sub scantron_validate_ID {  sub scantron_validate_ID {
     my ($r,$currentphase) = @_;      my ($r,$currentphase) = @_;
           
Line 5003  sub scantron_get_correction { Line 5161  sub scantron_get_correction {
 #the previous one or the current one  #the previous one or the current one
   
     $r->print("<p><b>An error was detected ($error)</b>");      $r->print("<p><b>An error was detected ($error)</b>");
     if ( defined($$scan_record{'scantron.PaperID'}) ) {      if ( $$scan_record{'scantron.PaperID'} =~ /\S/) {
  $r->print(" for PaperID <tt>".   $r->print(" for PaperID <tt>".
   $$scan_record{'scantron.PaperID'}."</tt> \n");    $$scan_record{'scantron.PaperID'}."</tt> \n");
     } else {      } else {
Line 5512  sub scantron_upload_scantron_data_save { Line 5670  sub scantron_upload_scantron_data_save {
 sub valid_file {  sub valid_file {
     my ($requested_file)=@_;      my ($requested_file)=@_;
     foreach my $filename (sort(&scantron_filenames())) {      foreach my $filename (sort(&scantron_filenames())) {
  &Apache::lonnet::logthis("$requested_file  $filename");  
  if ($requested_file eq $filename) { return 1; }   if ($requested_file eq $filename) { return 1; }
     }      }
     return 0;      return 0;
Line 5865  sub handler { Line 6022  sub handler {
   
 sub send_header {  sub send_header {
     my ($request)= @_;      my ($request)= @_;
     $request->print(&Apache::lontexconvert::header());      &Apache::lontexconvert::init_tth();
 #  $request->print("      $request->print(&Apache::loncommon::start_page('Grading'));
 #<script>  
 #remotewindow=open('','homeworkremote');  
 #remotewindow.close();  
 #</script>");   
     $request->print(&Apache::loncommon::bodytag('Grading'));  
     $request->rflush();      $request->rflush();
 }  }
   
 sub send_footer {  sub send_footer {
     my ($request)= @_;      my ($request)= @_;
     $request->print('</body></html>');      $request->print(&Apache::loncommon::end_page());
 }  }
   
 1;  1;

Removed from v.1.332  
changed lines
  Added in v.1.348


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