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

Diff for /loncom/homework/grades.pm between versions 1.55 and 1.58

version 1.55, 2002/10/16 19:13:57 version 1.58, 2002/11/10 15:44:38
Line 111  sub response_type { Line 111  sub response_type {
 #--- section, ids and fullnames for each user.  #--- section, ids and fullnames for each user.
 sub getclasslist {  sub getclasslist {
     my ($getsec,$hideexpired) = @_;      my ($getsec,$hideexpired) = @_;
     my $now = time;      my $classlist=&Apache::loncoursedata::get_classlist();
     my %classlist=&Apache::lonnet::dump('classlist',  
  $ENV{'course.'.$ENV{'request.course.id'}.'.domain'},  
  $ENV{'course.'.$ENV{'request.course.id'}.'.num'});  
     my ($tmp) = keys(%classlist);  
     # Bail out if we were unable to get the classlist      # Bail out if we were unable to get the classlist
     return if ($tmp =~ /^(con_lost|error|no_such_host)/i);      return if (! defined($classlist));
       #
     # codes to check for fields in the classlist      my %sections;
     # should contain end:start:id:section:fullname      my %fullnames;
     for (keys %classlist) {      foreach (keys(%$classlist)) {
  my (@fields) = split(/:/,$classlist{$_});          # the following undefs are for 'domain', and 'username' respectively.
  %classlist   = &reformat_classlist(\%classlist) if (scalar(@fields) <= 2);   my (undef,undef,$end,$start,$id,$section,$fullname,$status)=
  last;              @{$classlist->{$_}};
     }  
   
     my (@holdsec,@sections,%allids,%stusec,%fullname);  
     foreach (keys(%classlist)) {  
  my ($end,$start,$id,$section,$fullname)=split(/:/,$classlist{$_});  
  # still a student?   # still a student?
  if (($hideexpired) && ($end) && ($end < $now)) {   if (($hideexpired) && ($status ne 'Active')) {
     next;              delete ($classlist->{$_});
  }              next;
           }
  $section = ($section ne '' ? $section : 'no');   $section = ($section ne '' ? $section : 'no');
  push @holdsec,$section;  
  if ($getsec eq 'all' || $getsec eq $section) {   if ($getsec eq 'all' || $getsec eq $section) {
     push (@{ $classlist{$getsec} }, $_);              $sections{$section}++;
     $allids{$_}  =$id;              $fullnames{$_}=$fullname;
     $stusec{$_}  =$section;          } else {
     $fullname{$_}=$fullname;              delete($classlist->{$_});
  }          }
     }      }
     my %seen = ();      my %seen = ();
     foreach my $item (@holdsec) {      my @sections = sort(keys(%sections));
  push (@sections, $item) unless $seen{$item}++;      return ($classlist,\@sections,\%fullnames);
     }  
     return (\%classlist,\@sections,\%allids,\%stusec,\%fullname);  
 }  
   
 # add id, section and fullname to the classlist.db  
 # done to maintain backward compatibility with older versions  
 sub reformat_classlist {  
     my ($classlist) = shift;  
     foreach (sort keys(%$classlist)) {  
  my ($unam,$udom) = split(/:/);  
  my $section      = &Apache::lonnet::usection($udom,$unam,$ENV{'request.course.id'});  
  my $fullname     = &get_fullname ($unam,$udom);  
  my %userid       = &Apache::lonnet::idrget($udom,($unam));  
  $$classlist{$_}  = $$classlist{$_}.':'.$userid{$unam}.':'.$section.':'.$fullname;  
     }  
     my $putresult = &Apache::lonnet::put  
  ('classlist',\%$classlist,  
  $ENV{'course.'.$ENV{'request.course.id'}.'.domain'},  
  $ENV{'course.'.$ENV{'request.course.id'}.'.num'});  
   
     return %$classlist;  
 }  }
   
 #find user domain  #find user domain
Line 267  sub verifyreceipt { Line 237  sub verifyreceipt {
  '<font size=+1><b>Resource: </b>'.$ENV{'form.url'}.'</font><br><br>'."\n";   '<font size=+1><b>Resource: </b>'.$ENV{'form.url'}.'</font><br><br>'."\n";
   
     my ($string,$contents,$matches) = ('','',0);      my ($string,$contents,$matches) = ('','',0);
     my ($classlist,$seclist,$ids,$stusec,$fullname) = &getclasslist('all','0');      my (undef,undef,$fullname) = &getclasslist('all','0');
       
     foreach (sort {lc($$fullname{$a}) cmp lc($$fullname{$b}) } keys %$fullname) {      foreach (sort {lc($$fullname{$a}) cmp lc($$fullname{$b}) } keys %$fullname) {
  my ($uname,$udom)=split(/\:/);   my ($uname,$udom)=split(/\:/);
  if ($receipt eq    if ($receipt eq 
Line 369  LISTJAVASCRIPT Line 339  LISTJAVASCRIPT
     my $checklastsub = $ENV{'form.handgrade'} eq 'yes' ? '' : 'checked';      my $checklastsub = $ENV{'form.handgrade'} eq 'yes' ? '' : 'checked';
   
     my $gradeTable='<form action="/adm/grades" method="post" name="gradesub">'."\n".      my $gradeTable='<form action="/adm/grades" method="post" name="gradesub">'."\n".
  '&nbsp;<b>View Problem: </b><input type="radio" name="vProb" value="no" checked> no '."\n".   '&nbsp;<b>View Problem: </b><input type="radio" name="vProb" value="no" /> no '."\n".
  '<input type="radio" name="vProb" value="yes"> yes <br />'."\n".   '<input type="radio" name="vProb" value="yes" checked /> one student '."\n".
    '<input type="radio" name="vProb" value="all" /> all students <br />'."\n".
  '&nbsp;<b>Submissions: </b>'."\n";   '&nbsp;<b>Submissions: </b>'."\n";
     if ($ENV{'form.handgrade'} eq 'yes') {      if ($ENV{'form.handgrade'} eq 'yes') {
  $gradeTable.='<input type="radio" name="lastSub" value="hdgrade" '.$checkhdgrade.' /> handgrade only'."\n";   $gradeTable.='<input type="radio" name="lastSub" value="hdgrade" '.$checkhdgrade.' /> handgrade only'."\n";
Line 393  LISTJAVASCRIPT Line 364  LISTJAVASCRIPT
  'onClick="javascript:checkSelect(this.form.stuinfo);" '."\n".   'onClick="javascript:checkSelect(this.form.stuinfo);" '."\n".
  'value="'.$viewgrade.'" />'."\n";   'value="'.$viewgrade.'" />'."\n";
     
     my ($classlist,$seclist,$ids,$stusec,$fullname) = &getclasslist($getsec,'0');      my (undef,undef,$fullname) = &getclasslist($getsec,'0');
           
     $gradeTable.='<table border="0"><tr><td bgcolor="#777777">'.      $gradeTable.='<table border="0"><tr><td bgcolor="#777777">'.
  '<table border="0"><tr bgcolor="#e6ffff">'.   '<table border="0"><tr bgcolor="#e6ffff">'.
Line 825  SUBJAVASCRIPT Line 796  SUBJAVASCRIPT
 }  }
   
   
   sub show_problem {
       my ($request,$symb,$uname,$udom,$removeform) = @_;
       my $rendered=&Apache::loncommon::get_student_view($symb,$uname,$udom,
         $ENV{'request.course.id'});
       if ($removeform) {
    $rendered=~s|<form(.*?)>||g;
    $rendered=~s|</form>||g;
    $rendered=~s|name="submit"|name="would_have_been_submit"|g;
       }
       my $companswer=&Apache::loncommon::get_student_answers($symb,$uname,$udom,
      $ENV{'request.course.id'});
       if ($removeform) {
    $companswer=~s|<form(.*?)>||g;
    $companswer=~s|</form>||g;
    $rendered=~s|name="submit"|name="would_have_been_submit"|g;
       }
       my $result.='<table border="0" width="100%"><tr><td bgcolor="#777777">';
       $result.='<table border="0" width="100%"><tr><td bgcolor="#e6ffff">';
       $result.='<b> View of the problem - '.$ENV{'form.fullname'}.
    '</b></td></tr><tr><td bgcolor="#ffffff">'.$rendered.'<br />';
       $result.='<b>Correct answer:</b><br />'.$companswer;
       $result.='</td></tr></table>';
       $result.='</td></tr></table><br />';
       $request->print($result);
   }
   
 # --------------------------- show submissions of a student, option to grade   # --------------------------- show submissions of a student, option to grade 
 sub submission {  sub submission {
     my ($request,$counter,$total) = @_;      my ($request,$counter,$total) = @_;
Line 839  sub submission { Line 836  sub submission {
     my $symb=($ENV{'form.symb'} ne '' ? $ENV{'form.symb'} : (&Apache::lonnet::symbread($url)));      my $symb=($ENV{'form.symb'} ne '' ? $ENV{'form.symb'} : (&Apache::lonnet::symbread($url)));
     if ($symb eq '') { $request->print("Unable to handle ambiguous references:$url:."); return ''; }      if ($symb eq '') { $request->print("Unable to handle ambiguous references:$url:."); return ''; }
     my $last = ($ENV{'form.lastSub'} eq 'last' ? 'last' : '');      my $last = ($ENV{'form.lastSub'} eq 'last' ? 'last' : '');
     $ENV{'form.vProb'} = $ENV{'form.vProb'} ne '' ? $ENV{'form.vProb'} : 'yes';  #    $ENV{'form.vProb'} = $ENV{'form.vProb'} ne '' ? $ENV{'form.vProb'} : 'yes';
     my ($classlist,$seclist,$ids,$stusec,$fullname);  
   
     # header info      # header info
     if ($counter == 0) {      if ($counter == 0) {
Line 851  sub submission { Line 847  sub submission {
  # option to display problem, only once else it cause problems    # option to display problem, only once else it cause problems 
         # with the form later since the problem has a form.          # with the form later since the problem has a form.
  if ($ENV{'form.vProb'} eq 'yes') {   if ($ENV{'form.vProb'} eq 'yes') {
     my $rendered=&Apache::loncommon::get_student_view($symb,$uname,$udom,      &show_problem($request,$symb,$uname,$udom,0);
       $ENV{'request.course.id'});  
     my $companswer=&Apache::loncommon::get_student_answers($symb,$uname,$udom,  
    $ENV{'request.course.id'});  
     my $result.='<table border="0" width="100%"><tr><td bgcolor="#777777">';  
     $result.='<table border="0" width="100%"><tr><td bgcolor="#e6ffff">';  
     $result.='<b> View of the problem - '.$ENV{'form.fullname'}.  
  '</b></td></tr><tr><td bgcolor="#ffffff">'.$rendered.'<br />';  
     $result.='<b>Correct answer:</b><br />'.$companswer;  
     $result.='</td></tr></table>';  
     $result.='</td></tr></table><br />';  
     $request->print($result);  
  }   }
   
  # kwclr is the only variable that is guaranteed to be non blank    # kwclr is the only variable that is guaranteed to be non blank 
Line 925  KEYWORDS Line 910  KEYWORDS
         }          }
     }      }
   
       if ($ENV{'form.vProb'} eq 'all') {
    $request->print('<br /><br /><br />');
    &show_problem($request,$symb,$uname,$udom,1);
       }
   
     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);      my ($partlist,$handgrade) = &response_type($url);
   
Line 941  KEYWORDS Line 931  KEYWORDS
   
     # If this is handgraded, then check for collaborators      # If this is handgraded, then check for collaborators
     my @col_fullnames;      my @col_fullnames;
       my ($classlist,$fullname);
     if ($ENV{'form.handgrade'} eq 'yes') {      if ($ENV{'form.handgrade'} eq 'yes') {
  my @col_list;   my @col_list;
  ($classlist,$seclist,$ids,$stusec,$fullname) = &getclasslist('all','0');   ($classlist,undef,$fullname) = &getclasslist('all','0');
  for (keys (%$handgrade)) {   for (keys (%$handgrade)) {
     my $ncol = &Apache::lonnet::EXT('resource.'.$_.      my $ncol = &Apache::lonnet::EXT('resource.'.$_.
     '.maxcollaborators',$symb,$udom,$uname);      '.maxcollaborators',
     if ($ncol > 0) {                                              $symb,$udom,$uname);
  s/\_/\./g;      next if ($ncol <= 0);
  if ($record{'resource.'.$_.'.collaborators'} ne '') {              s/\_/\./g;
     my (@collaborators) = split(/,?\s+/,              next if ($record{'resource.'.$_.'.collaborators'} eq '');
  $record{'resource.'.$_.'.collaborators'});              my (@collaborators) = split(/,?\s+/,
     my (@badcollaborators);                                     $record{'resource.'.$_.'.collaborators'});
     if (scalar(@collaborators) != 0) {              my (@badcollaborators);
  $result.='<b>Collaborators: </b>';              if (scalar(@collaborators) != 0) {
  foreach my $collaborator (@collaborators) {                  $result.='<b>Collaborators: </b>';
     $collaborator = $collaborator =~ /\@|:/ ?                   foreach my $collaborator (@collaborators) {
  (split(/@|:/,$collaborator))[0] : $collaborator;                      my ($co_name,$co_dom) = split /\@|:/,$collaborator;
     next if ($collaborator eq $uname);                      $co_dom = $udom if (! defined($co_dom));
     if (!grep /^$collaborator:/i,keys %$classlist) {                      next if ($co_name eq $uname && $co_dom eq $udom);
  push @badcollaborators,$collaborator;                      # Doing this grep allows 'fuzzy' specification
  next;                      my @Matches = grep /^$co_name:$co_dom/i,
     }                      keys %$classlist;
     push @col_list, $collaborator;                      if (! scalar(@Matches)) {
     my ($lastname,$givenn) = split(/,/,$$fullname{$collaborator.':'.$udom});                          push @badcollaborators,$collaborator;
     push @col_fullnames, $givenn.' '.$lastname;                          next;
     $result.=$$fullname{$collaborator.':'.$udom}.'&nbsp; &nbsp; &nbsp;';                      }
  }                      push @col_list, @Matches;
  $result.='<br />'."\n";                      foreach (@Matches) {
  $result.='<table border="0"><tr bgcolor="#ffbbbb"><td>'.                          my ($lastname,$givenn) = split(/,/,$$fullname{$_});
     'This student has submitted '.                          push @col_fullnames, $givenn.' '.$lastname;
     (scalar (@badcollaborators) > 1 ? '' : 'an').                          $result.=$$fullname{$_}.'&nbsp; &nbsp; &nbsp;';
     ' invalid collaborator'.(scalar (@badcollaborators) > 1 ? 's. ' : '. ').                      }
     (join ', ',@badcollaborators).'</td></tr></table>'                   }
     if (scalar(@badcollaborators) > 0);                  $result.='<br />'."\n";
                   if (scalar(@badcollaborators) > 0) {
  $result.='<table border="0"><tr bgcolor="#ffbbbb"><td>'.                      $result.='<table border="0"><tr bgcolor="#ffbbbb"><td>';
     'This student has submitted too many collaborators. Maximum is '.                      $result.='This student has submitted ';
     $ncol.'.</td></tr></table>' if (scalar(@collaborators) > $ncol);                      if (scalar(@badcollaborators) == 1) {
  $result.='<input type="hidden" name="collaborator'.$counter.                          $result .= 'an invalid collaborator';
     '" value="'.(join ':',@col_list).'" />'."\n";                      } else {
     }                          $result .= 'invalid collaborators';
  }                      }
     }                      $result .= ': '.join(', ',@badcollaborators);
                       
                   }
                   if (scalar(@collaborators > $ncol)) {
                       $result .= '<table border="0"><tr bgcolor="#ffbbbb"><td>';
                       $result .= 'This student has sumbitted too many '.
                           'collaborators.  Maximum is '.$ncol;
                       $result .= '</td></tr></table>';
                   }
                   $result.='<input type="hidden" name="collaborator'.$counter.
                       '" value="'.(join ':',@col_list).'" />'."\n";
               }
  }   }
     }      }
     $request->print($result."\n");      $request->print($result."\n");
Line 1107  KEYWORDS Line 1109  KEYWORDS
     'onChange="javascript:clearRadBox(this.form.RADVAL'.$counter.'_'.$partid.      'onChange="javascript:clearRadBox(this.form.RADVAL'.$counter.'_'.$partid.
     ',this.form.GD_BOX'.$counter.'_'.$partid.      ',this.form.GD_BOX'.$counter.'_'.$partid.
     ',this.form.GD_SEL'.$counter.'_'.$partid.      ',this.form.GD_SEL'.$counter.'_'.$partid.
     ',this.form.stores'.$counter.'_'.$partid.')" />'."\n".      ',this.form.stores'.$counter.'_'.$partid.')" >'."\n";
     '<option selected="on"> </option>'.   if ($record{'resource.'.$partid.'.solved'} eq 'excused') {
     '<option>excused</option></select>'."&nbsp&nbsp\n";      $result.='<option> </option>'.
    '<option selected="on">excused</option></select>';
    } else {
       $result.='<option selected="on"> </option>'.
    '<option>excused</option></select>';
    }
    $result.="&nbsp&nbsp\n";
  $result.='<input type="hidden" name="stores'.$counter.'_'.$partid.'" value="0" />';   $result.='<input type="hidden" name="stores'.$counter.'_'.$partid.'" value="0" />';
  $result.='</td></tr></table>'."\n";   $result.='</td></tr></table>'."\n";
  $request->print($result);   $request->print($result);
Line 1193  sub keywords_highlight { Line 1201  sub keywords_highlight {
     foreach (@keylist) {      foreach (@keylist) {
  $string =~ s/\b$_(\b|\.)/\<font color\=$ENV{'form.kwclr'} $size\>$styleon$_$styleoff\<\/font\>/gi;   $string =~ s/\b$_(\b|\.)/\<font color\=$ENV{'form.kwclr'} $size\>$styleon$_$styleoff\<\/font\>/gi;
     }      }
       # This is not really the right place to do this, but I cannot find a
       # better one at this time.  So here we go - the m in the s:::mg causes
       # ^ to match the beginning of a new line.  So we replace(???) the beginning
       # of the line with <br /> to make things formatted a little better.
       $string =~ s:^:<br />:mg;
     return $string;      return $string;
 }  }
   
Line 1301  sub processHandGrade { Line 1314  sub processHandGrade {
  $laststu = $firststu if ($ctr > $ngrade);   $laststu = $firststu if ($ctr > $ngrade);
     }      }
   
     my ($classlist,$seclist,$ids,$stusec,$fullname) = &getclasslist($ENV{'form.section'},'0');      my (undef,undef,$fullname) = &getclasslist($ENV{'form.section'},'0');
     my (@parsedlist,@nextlist);      my (@parsedlist,@nextlist);
     my ($nextflg) = 0;      my ($nextflg) = 0;
     foreach (sort {lc($$fullname{$a}) cmp lc($$fullname{$b}) } keys %$fullname) {      foreach (sort {lc($$fullname{$a}) cmp lc($$fullname{$b}) } keys %$fullname) {
Line 1363  sub saveHandGrade { Line 1376  sub saveHandGrade {
     my %newrecord;      my %newrecord;
     foreach (split(/:/,$ENV{'form.partlist'.$newflg})) {      foreach (split(/:/,$ENV{'form.partlist'.$newflg})) {
  if ($ENV{'form.GD_SEL'.$newflg.'_'.$_} eq 'excused') {   if ($ENV{'form.GD_SEL'.$newflg.'_'.$_} eq 'excused') {
     $newrecord{'resource.'.$_.'.solved'} = 'excused'       if ($record{'resource.'.$_.'.solved'} ne 'excused') {
  if ($record{'resource.'.$_.'.solved'} ne 'excused');   $newrecord{'resource.'.$_.'.solved'} = 'excused';
    if (exists($record{'resource.'.$_.'.awarded'})) {
       $newrecord{'resource.'.$_.'.awarded'} = '';
    }
       }
  } else {   } else {
     my $pts = ($ENV{'form.GD_BOX'.$newflg.'_'.$_} ne '' ?       my $pts = ($ENV{'form.GD_BOX'.$newflg.'_'.$_} ne '' ? 
        $ENV{'form.GD_BOX'.$newflg.'_'.$_} :          $ENV{'form.GD_BOX'.$newflg.'_'.$_} : 
Line 1682  sub viewgrades { Line 1699  sub viewgrades {
   
     #get info for each student      #get info for each student
     #list all the students - with points and grade status      #list all the students - with points and grade status
     my ($classlist,$seclist,$ids,$stusec,$fullname) = &getclasslist($ENV{'form.section'},'0');      my (undef,undef,$fullname) = &getclasslist($ENV{'form.section'},'0');
     my $ctr = 0;      my $ctr = 0;
     foreach (sort {lc($$fullname{$a}) cmp lc($$fullname{$b}) } keys %$fullname) {      foreach (sort {lc($$fullname{$a}) cmp lc($$fullname{$b}) } keys %$fullname) {
  my ($uname,$udom) = split(/:/);   my ($uname,$udom) = split(/:/);
Line 1767  sub editgrades { Line 1784  sub editgrades {
     'ungraded' =>'ungraded_attempted',      'ungraded' =>'ungraded_attempted',
     'nothing'  => '',      'nothing'  => '',
     );      );
     my ($classlist,$seclist,$ids,$stusec,$fullname) = &getclasslist($ENV{'form.section'},'0');      my ($classlist,undef,$fullname) = &getclasslist($ENV{'form.section'},'0');
   
     my (@partid);      my (@partid);
     my %weight = ();      my %weight = ();
Line 2185  sub gradingmenu { Line 2202  sub gradingmenu {
 #--- Menu for grading a section or the whole class ---  #--- Menu for grading a section or the whole class ---
 sub view_edit_entire_class_form {  sub view_edit_entire_class_form {
     my ($symb,$url)=@_;      my ($symb,$url)=@_;
     my ($classlist,$sections) = &getclasslist('all','0');      my ($classlist,$sections,undef) = &getclasslist('all','0');
     my $result.='<table width=100% border=0><tr><td bgcolor=#777777>'."\n";      my $result.='<table width=100% border=0><tr><td bgcolor=#777777>'."\n";
     $result.='<table width=100% border=0><tr bgcolor="#e6ffff"><td>'."\n";      $result.='<table width=100% border=0><tr bgcolor="#e6ffff"><td>'."\n";
     $result.='&nbsp;<b>Grade Entire Section or Class</b></td></tr>'."\n";      $result.='&nbsp;<b>Grade Entire Section or Class</b></td></tr>'."\n";
Removed from v.1.55  
changed lines
  Added in v.1.58

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