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

Diff for /loncom/homework/grades.pm between versions 1.146 and 1.148

version 1.146, 2003/11/04 19:38:09 version 1.148, 2003/11/07 08:56:52
Line 133  sub response_type { Line 133  sub response_type {
     $symb=($ENV{'form.symb'} ne '' ? $ENV{'form.symb'} : (&Apache::lonnet::symbread($url))) if ($symb eq '');      $symb=($ENV{'form.symb'} ne '' ? $ENV{'form.symb'} : (&Apache::lonnet::symbread($url))) if ($symb eq '');
     my $allkeys = &Apache::lonnet::metadata($url,'keys');      my $allkeys = &Apache::lonnet::metadata($url,'keys');
     my %seen = ();      my %seen = ();
     my (@partlist,%handgrade);      my (@partlist,%handgrade,%responseType);
     foreach (split(/,/,&Apache::lonnet::metadata($url,'packages'))) {      foreach (split(/,/,&Apache::lonnet::metadata($url,'packages'))) {
  if (/^\w+response_\w+.*/) {   if (/^\w+response_.*/) {
     my ($responsetype,$part) = split(/_/,$_,2);      my ($responsetype,$part) = split(/_/,$_,2);
     my ($partid,$respid) = split(/_/,$part);      my ($partid,$respid) = split(/_/,$part);
     if (&Apache::loncommon::check_if_partid_hidden($partid,$symb)) {      if (&Apache::loncommon::check_if_partid_hidden($partid,$symb)) {
Line 143  sub response_type { Line 143  sub response_type {
     }      }
     $responsetype =~ s/response$//; # make it compatible w/ navmaps - should move to that!!      $responsetype =~ s/response$//; # make it compatible w/ navmaps - should move to that!!
     my ($value) = &Apache::lonnet::EXT('resource.'.$part.'.handgrade',$symb);      my ($value) = &Apache::lonnet::EXT('resource.'.$part.'.handgrade',$symb);
     $handgrade{$part} = $responsetype.':'.($value eq 'yes' ? 'yes' : 'no');       $handgrade{$part} = ($value eq 'yes' ? 'yes' : 'no'); 
       if (!exists($responseType{$partid})) { $responseType{$partid}={}; }
       $responseType{$partid}->{$respid}=$responsetype;
     next if ($seen{$partid} > 0);      next if ($seen{$partid} > 0);
     $seen{$partid}++;      $seen{$partid}++;
     push @partlist,$partid;      push @partlist,$partid;
  }   }
     }      }
     return \@partlist,\%handgrade;      return \@partlist,\%handgrade,\%responseType;
 }  }
   
 #--- Show resource title  #--- Show resource title
Line 158  sub showResourceInfo { Line 160  sub showResourceInfo {
     my ($url,$probTitle) = @_;      my ($url,$probTitle) = @_;
     my $result ='<table border="0">'.      my $result ='<table border="0">'.
  '<tr><td colspan=3><font size=+1><b>Current Resource: </b>'.$probTitle.'</font></td></tr>'."\n";   '<tr><td colspan=3><font size=+1><b>Current Resource: </b>'.$probTitle.'</font></td></tr>'."\n";
     my ($partlist,$handgrade) = &response_type($url);      my ($partlist,$handgrade,$responseType) = &response_type($url);
     my %resptype = ();      my %resptype = ();
     my $hdgrade='no';      my $hdgrade='no';
     for (sort keys(%$handgrade)) {      for my $part_resID (sort keys(%$handgrade)) {
  my ($responsetype,$handgrade)=split(/:/,$$handgrade{$_});   my $handgrade=$$handgrade{$part_resID};
  my $partID = (split(/_/))[0];   my ($partID,$resID) = split(/_/,$part_resID);
  $resptype{$partID} = $responsetype;   my $responsetype = $responseType->{$partID}->{$resID};
  $hdgrade = $handgrade if ($handgrade eq 'yes');   $hdgrade = $handgrade if ($handgrade eq 'yes');
  $result.='<tr><td><b>Part </b>'.$partID.'</td>'.   $result.='<tr><td><b>Part </b>'.$partID.' <font color="#999999">'.
       $resID.'</font></td>'.
     '<td><b>Type: </b>'.$responsetype.'</td></tr>';      '<td><b>Type: </b>'.$responsetype.'</td></tr>';
 #    '<td><b>Handgrade: </b>'.$handgrade.'</td></tr>';  #    '<td><b>Handgrade: </b>'.$handgrade.'</td></tr>';
     }      }
     $result.='</table>'."\n";      $result.='</table>'."\n";
     return $result,\%resptype,$hdgrade,$partlist,$handgrade;      return $result,$responseType,$hdgrade,$partlist,$handgrade;
 }  }
   
   
   sub get_order {
       my ($partid,$respid,$symb,$uname,$udom)=@_;
       my (undef,undef,$url)=&Apache::lonnet::decode_symb($symb);
       $url=&Apache::lonnet::clutter($url);
       my $subresult=&Apache::lonnet::ssi($url,
          ('grade_target' => 'analyze'),
          ('grade_domain' => $udom),
          ('grade_symb' => $symb),
          ('grade_courseid' => 
           $ENV{'request.course.id'}),
          ('grade_username' => $uname));
       (my $debug,$subresult)=split(/_HASH_REF__/,$subresult,2);
       Apache->request->print($debug);
       my %analyze=&Apache::lonnet::str2hash($subresult);
       return ($analyze{"$partid.$respid.shown"});
   }
 #--- Clean response type for display  #--- Clean response type for display
 #--- Currently filters option response type only.  #--- Currently filters option/rank/radiobutton/match/essay response types only.
 sub cleanRecord {  sub cleanRecord {
     my ($answer,$response,$symb) = @_;      my ($answer,$response,$symb,$partid,$respid,$record,$order,$version) = @_;
     if ($response eq 'option') {      my $grayFont = '<font color="#999999">';
  my (@IDs,@ans);      if ($response =~ /^(option|rank)$/) {
  foreach (split(/\&/,&Apache::lonnet::unescape($answer))) {   my %answer=&Apache::lonnet::str2hash($answer);
     my ($optionID,$ans) = split(/=/);   my %grading=&Apache::lonnet::str2hash($record->{$version."resource.$partid.$respid.submissiongrading"});
     push @IDs,$optionID.'</font>';   my ($toprow,$bottomrow);
     push @ans,$ans;   foreach my $foil (@$order) {
       if ($grading{$foil} == 1) {
    $toprow.='<td><b>'.$answer{$foil}.'&nbsp;</b></td>';
       } else {
    $toprow.='<td><i>'.$answer{$foil}.'&nbsp;</i></td>';
       }
       $bottomrow.='<td>'.$grayFont.$foil.'</font>&nbsp;</td>';
  }   }
  my $grayFont = '<font color="#999999">';  
  return '<blockquote><table border="1">'.   return '<blockquote><table border="1">'.
     '<tr valign="top"><td>Answer</td><td>'.      '<tr valign="top"><td>Answer</td>'.$toprow.'</tr>'.
     (join '</td><td>',@ans).'</td></tr>'.      '<tr valign="top"><td>'.$grayFont.'Option ID</font></td>'.
     '<tr valign="top"><td>'.$grayFont.'Option ID</font></td><td>'.$grayFont.      $grayFont.$bottomrow.'</tr>'.'</table></blockquote>';
     (join '</td><td>'.$grayFont,@IDs).'</font></td></tr>'.      } elsif ($response eq 'match') {
     '</table></blockquote>';   my %answer=&Apache::lonnet::str2hash($answer);
     }   my %grading=&Apache::lonnet::str2hash($record->{$version."resource.$partid.$respid.submissiongrading"});
     if ($response eq 'essay') {   my @items=&Apache::lonnet::str2array($record->{$version."resource.$partid.$respid.submissionitems"});
    my ($toprow,$middlerow,$bottomrow);
    foreach my $foil (@$order) {
       my $item=shift(@items);
       if ($grading{$foil} == 1) {
    $toprow.='<td><b>'.$item.'&nbsp;</b></td>';
    $middlerow.='<td><b>'.$grayFont.$answer{$foil}.'&nbsp;</font></b></td>';
       } else {
    $toprow.='<td><i>'.$item.'&nbsp;</i></td>';
    $middlerow.='<td><i>'.$grayFont.$answer{$foil}.'&nbsp;</font></i></td>';
       }
       $bottomrow.='<td>'.$grayFont.$foil.'</font>&nbsp;</td>';
    }
    return '<blockquote><table border="1">'.
       '<tr valign="top"><td>Answer</td>'.$toprow.'</tr>'.
       '<tr valign="top"><td>'.$grayFont.'Item ID</font></td>'.
       $middlerow.'</tr>'.
       '<tr valign="top"><td>'.$grayFont.'Option ID</font></td>'.
       $bottomrow.'</tr>'.'</table></blockquote>';
       } elsif ($response eq 'radiobutton') {
    my %answer=&Apache::lonnet::str2hash($answer);
    my ($toprow,$bottomrow);
    my $correct=($order->[0])+1;
    for (my $i=1;$i<=$#$order;$i++) {
       my $foil=$order->[$i];
       if (exists($answer{$foil})) {
    if ($i == $correct) {
       $toprow.='<td><b>true</b></td>';
    } else {
       $toprow.='<td><i>true</i></td>';
    }
       } else {
    $toprow.='<td>false</td>';
       }
       $bottomrow.='<td>'.$grayFont.$foil.'</font>&nbsp;</td>';
    }
    return '<blockquote><table border="1">'.
       '<tr valign="top"><td>Answer</td>'.$toprow.'</tr>'.
       '<tr valign="top"><td>'.$grayFont.'Option ID</font></td>'.
       $grayFont.$bottomrow.'</tr>'.'</table></blockquote>';
       } elsif ($response eq 'essay') {
  if (! exists ($ENV{'form.'.$symb})) {   if (! exists ($ENV{'form.'.$symb})) {
     my (%keyhash) = &Apache::lonnet::dump('nohist_handgrade',      my (%keyhash) = &Apache::lonnet::dump('nohist_handgrade',
   $ENV{'course.'.$ENV{'request.course.id'}.'.domain'},    $ENV{'course.'.$ENV{'request.course.id'}.'.domain'},
Line 1421  KEYWORDS Line 1486  KEYWORDS
   
     my %record = &Apache::lonnet::restore($symb,$ENV{'request.course.id'},$udom,$uname);      my %record = &Apache::lonnet::restore($symb,$ENV{'request.course.id'},$udom,$uname);
   
     my ($partlist,$handgrade) = &response_type($url,$symb);      my ($partlist,$handgrade,$responseType) = &response_type($url,$symb);
   
     # Display student info      # Display student info
     $request->print(($counter == 0 ? '' : '<br />'));      $request->print(($counter == 0 ? '' : '<br />'));
Line 1504  KEYWORDS Line 1569  KEYWORDS
  $$fullname{$ENV{'form.'.$uname.':'.$udom.':submitted_by'}}.'</a>';   $$fullname{$ENV{'form.'.$uname.':'.$udom.':submitted_by'}}.'</a>';
     $request->print($submitby);      $request->print($submitby);
  } else {   } else {
     my ($string,$timestamp)= &get_last_submission (\%record);      my ($string,$timestamp)= &get_last_submission(\%record);
     my $lastsubonly=''.      my $lastsubonly=''.
  ($$timestamp eq '' ? '' : '<b>Date Submitted:</b> '.   ($$timestamp eq '' ? '' : '<b>Date Submitted:</b> '.
  $$timestamp)."</td></tr>\n";   $$timestamp)."</td></tr>\n";
Line 1512  KEYWORDS Line 1577  KEYWORDS
  $lastsubonly.='<tr><td bgcolor="#ffffe6">'.$$string[0];    $lastsubonly.='<tr><td bgcolor="#ffffe6">'.$$string[0]; 
     } else {      } else {
  for my $part (sort keys(%$handgrade)) {   for my $part (sort keys(%$handgrade)) {
     my ($responsetype,$foo) = split(/:/,$$handgrade{$part});  
     my ($partid,$respid) = split(/_/,$part);      my ($partid,$respid) = split(/_/,$part);
       my $responsetype = $responseType->{$partid}->{$respid};
     if (!exists($record{'resource.'.$partid.'.'.$respid.'.submission'})) {      if (!exists($record{'resource.'.$partid.'.'.$respid.'.submission'})) {
  $lastsubonly.='<tr><td bgcolor="#ffffe6"><b>Part '.   $lastsubonly.='<tr><td bgcolor="#ffffe6"><b>Part '.
     $partid.'</b> <font color="#999999">( ID '.$respid.      $partid.'</b> <font color="#999999">( ID '.$respid.
Line 1521  KEYWORDS Line 1586  KEYWORDS
     '<font color="red">Nothing submitted - no attempts</font><br /><br />';      '<font color="red">Nothing submitted - no attempts</font><br /><br />';
      } else {       } else {
  foreach (@$string) {   foreach (@$string) {
     my ($partid,$respid) = /^resource\.(\w+)\.(\w+)\.submission/;      my ($partid,$respid) = /^resource\.([^\.]*)\.([^\.]*)\.submission/;
     if ($part eq ($partid.'_'.$respid)) {      if ($part eq ($partid.'_'.$respid)) {
  my ($ressub,$subval) = split(/:/,$_,2);   my ($ressub,$subval) = split(/:/,$_,2);
                             # Similarity check                              # Similarity check
Line 1541  KEYWORDS Line 1606  KEYWORDS
     &keywords_highlight($oessay).'</i></blockquote><hr />';      &keywords_highlight($oessay).'</i></blockquote><hr />';
     }      }
  }   }
    my $order=&get_order($partid,$respid,$symb,$uname,$udom);
  $lastsubonly.='<tr><td bgcolor="#ffffe6"><b>Part '.   $lastsubonly.='<tr><td bgcolor="#ffffe6"><b>Part '.
     $partid.'</b> <font color="#999999">( ID '.$respid.      $partid.'</b> <font color="#999999">( ID '.$respid.
     ' )</font>&nbsp; &nbsp;'.      ' )</font>&nbsp; &nbsp;'.
Line 1551  KEYWORDS Line 1617  KEYWORDS
      '<font color="red" size="1">Like all files provided by users, '.       '<font color="red" size="1">Like all files provided by users, '.
      'this file may contain virusses</font><br />':'').       'this file may contain virusses</font><br />':'').
      '<b>Submitted Answer: </b>'.       '<b>Submitted Answer: </b>'.
      &cleanRecord($subval,$responsetype,$symb).       &cleanRecord($subval,$responsetype,$symb,$partid,$respid,\%record,$order).
      '<br /><br />'.$similar."\n"       '<br /><br />'.$similar."\n"
      if ($ENV{'form.lastSub'} eq 'lastonly' ||        if ($ENV{'form.lastSub'} eq 'lastonly' || 
  ($ENV{'form.lastSub'} eq 'hdgrade' &&    ($ENV{'form.lastSub'} eq 'hdgrade' && 
Line 1566  KEYWORDS Line 1632  KEYWORDS
  }   }
     } elsif ($ENV{'form.lastSub'} eq 'datesub') {      } elsif ($ENV{'form.lastSub'} eq 'datesub') {
  my (undef,$responseType,undef,$parts) = &showResourceInfo($url);   my (undef,$responseType,undef,$parts) = &showResourceInfo($url);
  $request->print(&displaySubByDates(\$symb,\%record,$parts,$responseType,$checkIcon));   $request->print(&displaySubByDates($symb,\%record,$parts,$responseType,$checkIcon,$uname,$udom));
     } elsif ($ENV{'form.lastSub'} =~ /^(last|all)$/) {      } elsif ($ENV{'form.lastSub'} =~ /^(last|all)$/) {
  $request->print(&Apache::loncommon::get_previous_attempt($symb,$uname,$udom,   $request->print(&Apache::loncommon::get_previous_attempt($symb,$uname,$udom,
  $ENV{'request.course.id'},   $ENV{'request.course.id'},
Line 2172  sub viewgrades { Line 2238  sub viewgrades {
  my ($partid,$respid) = split (/_/,$_,2);   my ($partid,$respid) = split (/_/,$_,2);
  next if $seen{$partid};   next if $seen{$partid};
  $seen{$partid}++;   $seen{$partid}++;
  my ($responsetype,$handgrade)=split(/:/,$$handgrade{$_});   my $handgrade=$$handgrade{$_};
  my $wgt = &Apache::lonnet::EXT('resource.'.$partid.'.weight',$symb);   my $wgt = &Apache::lonnet::EXT('resource.'.$partid.'.weight',$symb);
  $weight{$partid} = $wgt eq '' ? '1' : $wgt;   $weight{$partid} = $wgt eq '' ? '1' : $wgt;
   
Line 2991  sub displayPage { Line 3057  sub displayPage {
  } else {   } else {
     my %responseType = ();      my %responseType = ();
     foreach my $partid (@{$parts}) {      foreach my $partid (@{$parts}) {
  $responseType{$partid} = $curRes->responseType($partid);   my @responseIds =$curRes->responseIds($partid);
    my @responseType =$curRes->responseType($partid);
    my %responseIds;
    for (my $i=0;$i<=$#responseIds;$i++) {
       $responseIds{$responseIds[$i]}=$responseType[$i];
    }
    $responseType{$partid} = \%responseIds;
     }      }
     $studentTable.= &displaySubByDates(\$symbx,\%record,$parts,\%responseType,$checkIcon);      $studentTable.= &displaySubByDates($symbx,\%record,$parts,\%responseType,$checkIcon,$uname,$udom);
   
  }   }
     } elsif ($ENV{'form.lastSub'} eq 'all') {      } elsif ($ENV{'form.lastSub'} eq 'all') {
  my $last = ($ENV{'form.lastSub'} eq 'last' ? 'last' : '');   my $last = ($ENV{'form.lastSub'} eq 'last' ? 'last' : '');
Line 3028  sub displayPage { Line 3101  sub displayPage {
 }  }
   
 sub displaySubByDates {  sub displaySubByDates {
     my ($symbx,$record,$parts,$responseType,$checkIcon) = @_;      my ($symb,$record,$parts,$responseType,$checkIcon,$uname,$udom) = @_;
     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">'.
  '<td><b>Date/Time</b></td>'.   '<td><b>Date/Time</b></td>'.
Line 3036  sub displaySubByDates { Line 3109  sub displaySubByDates {
  '<td><b>Status&nbsp;</b></td></tr>';   '<td><b>Status&nbsp;</b></td></tr>';
     my ($version);      my ($version);
     my %mark;      my %mark;
       my %orders;
     $mark{'correct_by_student'} = $checkIcon;      $mark{'correct_by_student'} = $checkIcon;
     return '<br />&nbsp;<font color="red">Nothing submitted - no attempts</font><br />'       if (!exists($$record{'1:timestamp'})) {
  if (!exists($$record{'1:timestamp'}));   return '<br />&nbsp;<font color="red">Nothing submitted - no attempts</font><br />';
       }
     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'}));
  $studentTable.='<tr bgcolor="#ffffff" valign="top"><td>'.$timestamp.'</td>';   $studentTable.='<tr bgcolor="#ffffff" valign="top"><td>'.$timestamp.'</td>';
  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 = grep /^resource\.$partid\..*?\.submission$/,@versionKeys;      my @matchKey = sort(grep /^resource\.\Q$partid\E\..*?\.submission$/,@versionKeys);
 #    next if ($$record{"$version:resource.$partid.solved"} eq '');  #    next if ($$record{"$version:resource.$partid.solved"} eq '');
     $displaySub[0].=(exists $$record{$version.':'.$matchKey[0]}) ?       foreach my $matchKey (@matchKey) {
  '<b>Part&nbsp;'.$partid.'&nbsp;'.   if (exists $$record{$version.':'.$matchKey}) {
  ($$record{"$version:resource.$partid.tries"} eq '' ? 'Trial&nbsp;not&nbsp;counted' :      my ($responseId)=($matchKey=~ /^resource\.\Q$partid\E\.(.*?)\.submission$/);
  'Trial&nbsp;'.$$record{"$version:resource.$partid.tries"}).'</b>&nbsp; '.      $displaySub[0].='<b>Part&nbsp;'.$partid.'&nbsp;';
  &cleanRecord($$record{$version.':'.$matchKey[0]},$$responseType{$partid},$$symbx).'<br />' : '';      $displaySub[0].='<font color="#999999">(ID&nbsp;'.
     $displaySub[1].=(exists $$record{"$version:resource.$partid.award"}) ?   $responseId.')</font>&nbsp;';
  '<b>Part&nbsp;'.$partid.'</b> &nbsp;'.      if ($$record{"$version:resource.$partid.tries"} eq '') {
  lc($$record{"$version:resource.$partid.award"}).' '.   $displaySub[0].='Trial&nbsp;not&nbsp;counted';
  $mark{$$record{"$version:resource.$partid.solved"}}.'<br />' : '';      } else {
     $displaySub[2].=(exists $$record{"$version:resource.$partid.regrader"}) ?   $displaySub[0].='Trial&nbsp;'.
  $$record{"$version:resource.$partid.regrader"}.' (<b>Part:</b> '.$partid.')' : '';      $$record{"$version:resource.$partid.tries"};
  }      }
  $displaySub[2].=(exists $$record{"$version:resource.regrader"}) ?      my $responseType=$responseType->{$partid}->{$responseId};
     $$record{"$version:resource.regrader"} : ''; # needed because old essay regrader has not parts info      if (!exists($orders{$partid})) { $orders{$partid}={}; }
  $studentTable.='<td>'.$displaySub[0].'&nbsp;</td><td>'.$displaySub[1].      if (!exists($orders{$partid}->{$responseId})) {
     ($displaySub[2] eq '' ? '' : 'Manually graded by '.$displaySub[2]).'&nbsp;</td></tr>';   $orders{$partid}->{$responseId}=
       &get_order($partid,$responseId,$symb,$uname,$udom);
       }
       $displaySub[0].='</b>&nbsp; '.
    &cleanRecord($$record{$version.':'.$matchKey},$responseType,$symb,$partid,$responseId,$record,$orders{$partid}->{$responseId},"$version:").'<br />';
    }
       }
       if (exists $$record{"$version:resource.$partid.award"}) {
    $displaySub[1].='<b>Part&nbsp;'.$partid.'</b> &nbsp;'.
       lc($$record{"$version:resource.$partid.award"}).' '.
       $mark{$$record{"$version:resource.$partid.solved"}}.
       '<br />';
       }
       if (exists $$record{"$version:resource.$partid.regrader"}) {
    $displaySub[2].=$$record{"$version:resource.$partid.regrader"}.
       ' (<b>Part:</b> '.$partid.')';
       }
    }
    # needed because old essay regrader has not parts info
    if (exists $$record{"$version:resource.regrader"}) {
       $displaySub[2].=$$record{"$version:resource.regrader"};
    }
    $studentTable.='<td>'.$displaySub[0].'&nbsp;</td><td>'.$displaySub[1];
    if ($displaySub[2]) {
       $studentTable.='Manually graded by '.$displaySub[2];
    }
    $studentTable.='&nbsp;</td></tr>';
       
     }      }
     $studentTable.='</table></td></tr></table>';      $studentTable.='</table></td></tr></table>';
     return $studentTable;      return $studentTable;
Removed from v.1.146  
changed lines
  Added in v.1.148

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