Diff for /loncom/homework/grades.pm between versions 1.5 and 1.6

version 1.5, 2001/04/16 23:34:11 version 1.6, 2001/04/17 21:07:38
Line 60  sub getpartlist { Line 60  sub getpartlist {
   my @parts =();    my @parts =();
   my (@metakeys) = split(/,/,&Apache::lonnet::metadata($url,'keys'));    my (@metakeys) = split(/,/,&Apache::lonnet::metadata($url,'keys'));
   foreach my $key (@metakeys) {    foreach my $key (@metakeys) {
     if ( $key =~ m/stores_([0-9]+)_.*/ ) { push(@parts,$key); }      if ( $key =~ m/stores_([0-9]+)_.*/ ) {
         push(@parts,$key);
       }
   }    }
   return @parts;    return @parts;
 }  }
Line 80  sub viewstudentgrade { Line 82  sub viewstudentgrade {
     #print "resource.$part.$type = ".$record{"resource.$part.$type"}." <br />\n";      #print "resource.$part.$type = ".$record{"resource.$part.$type"}." <br />\n";
     if ($type eq 'awarded') {      if ($type eq 'awarded') {
       my $score=$record{"resource.$part.$type"};        my $score=$record{"resource.$part.$type"};
       $result.="<td><input type=\"text\" name=\"GRADE.$stuname.$part.$type\" value=\"$score\" size=\"4\" /></td>\n";        $result.="<td><input type=\"text\" name=\"GRADE.$student.$part.$type\" value=\"$score\" size=\"4\" /></td>\n";
     } elsif ($type eq 'tries') {      } elsif ($type eq 'tries') {
       my $score=$record{"resource.$part.$type"};        my $score=$record{"resource.$part.$type"};
       $result.="<td><input type=\"text\" name=\"GRADE.$stuname.$part.$type\" value=\"$score\" size=\"4\" /></td>\n"        $result.="<td><input type=\"text\" name=\"GRADE.$student.$part.$type\" value=\"$score\" size=\"4\" /></td>\n"
     } elsif ($type eq 'solved') {      } elsif ($type eq 'solved') {
       my $score=$record{"resource.$part.$type"};        my $score=$record{"resource.$part.$type"};
       $result.="<td><select name=\"GRADE.$stuname.$part.$type\">\n";        $result.="<td><select name=\"GRADE.$student.$part.$type\">\n";
       if ($score =~ /^correct/) {        if ($score =~ /^correct/) {
  $result.="<option selected=\"on\">Correct</option>\n<option>Incorrect</option>\n<option>Excused</option>\n<option>Attempted</option>\n<option>Nothing</option>\n";   $result.="<option selected=\"on\">correct</option>\n<option>incorrect</option>\n<option>excused</option>\n<option>ungraded</option>\n<option>nothing</option>\n";
       } elsif ($score =~ /^incorrect/) {        } elsif ($score =~ /^incorrect/) {
  $result.="<option>Correct</option>\n<option selected=\"on\">Incorrect</option>\n<option>Excused</option>\n<option>Attempted</option>\n<option>Nothing</option>\n";   $result.="<option>correct</option>\n<option selected=\"on\">incorrect</option>\n<option>excused</option>\n<option>ungraded</option>\n<option>nothing</option>\n";
       } elsif ($score eq '') {        } elsif ($score eq '') {
  $result.="<option>Correct</option>\n<option>Incorrect</option>\n<option>Excused</option>\n<option>Attempted</option>\n<option selected=\"on\">Nothing</option>\n";   $result.="<option>correct</option>\n<option>incorrect</option>\n<option>excused</option>\n<option>ungraded</option>\n<option selected=\"on\">nothing</option>\n";
       } elsif ($score =~ /^excused/) {        } elsif ($score =~ /^excused/) {
  $result.="<option>Correct</option>\n<option>Incorrect</option>\n<option selected=\"on\">Excused</option>\n<option>Attempted</option>\n<option>Nothing</option>\n";   $result.="<option>correct</option>\n<option>incorrect</option>\n<option selected=\"on\">excused</option>\n<option>ungraded</option>\n<option>nothing</option>\n";
       } elsif ($score =~ /^ungraded/) {        } elsif ($score =~ /^ungraded/) {
  $result.="<option>Correct</option>\n<option>Incorrect</option>\n<option>Excused</option>\n<option selected=\"on\">Attempted</option>\n<option>Nothing</option>\n";   $result.="<option>correct</option>\n<option>incorrect</option>\n<option>excused</option>\n<option selected=\"on\">ungraded</option>\n<option>nothing</option>\n";
       }        }
       $result.="</select></td>\n";        $result.="</select></td>\n";
     }      }
Line 104  sub viewstudentgrade { Line 106  sub viewstudentgrade {
   $result.='</tr>';    $result.='</tr>';
   return $result;    return $result;
 }  }
   #FIXME need to look at the meatdata <stores> spec on what type of data to accept and provide an
   #interface based on that, also do that to above function.
 sub setstudentgrade {  sub setstudentgrade {
   my ($url,$symb,$courseid,$student,@parts) = @_;    my ($url,$symb,$courseid,$student,@parts) = @_;
   
   my $result ='Hi!';    my $result ='';
   
   my ($stuname,$domain) = split(/:/,$student);    my ($stuname,$domain) = split(/:/,$student);
   
   my %record=&Apache::lonnet::restore($symb,$courseid,$domain,$stuname,    my %record=&Apache::lonnet::restore($symb,$courseid,$domain,$stuname,
       &Apache::lonnet::homeserver($stuname,$domain));        &Apache::lonnet::homeserver($stuname,$domain));
   my %newrecord;    my %newrecord;
   
   foreach my $part (@parts) {    foreach my $part (@parts) {
     my ($temp,$part,$type)=split(/_/,$part);      my ($temp,$part,$type)=split(/_/,$part);
     my $oldscore=$record{"resource.$part.$type"};      my $oldscore=$record{"resource.$part.$type"};
     my $newscore=$ENV{"GRADE.$stuname.$part.$type"};      my $newscore=$ENV{"form.GRADE.$student.$part.$type"};
     if ($oldscore != $newscore) {      if ($type eq 'solved') {
       $result.="$stuname:$part:$type:changed from $oldscore to $newscore:<br />\n";        my $update=0;
         if ($newscore eq 'nothing' ) {
    if ($oldscore ne '') {
     $update=1;
     $newscore = '';
    }
         } elsif ($oldscore !~ m/^$newscore/) {
    $update=1;
    $result.="Updating $stuname to $newscore<br />\n";
    if ($newscore eq 'correct') { $newscore = 'correct_by_override'; }
    if ($newscore eq 'incorrect') { $newscore = 'incorrect_by_override'; }
    if ($newscore eq 'excused') { $newscore = 'excused'; }
    if ($newscore eq 'ungraded') { $newscore = 'ungraded_attempted'; }
         } else {
    #$result.="$stuname:$part:$type:unchanged  $oldscore to $newscore:<br />\n";
         }
         if ($update) { $newrecord{"resource.$part.$type"}=$newscore; }
     } else {      } else {
       $result.="$stuname:$part:$type:changed same $oldscore to $newscore:<br />\n";        if ($oldscore ne $newscore) {
    $newrecord{"resource.$part.$type"}=$newscore;
    $result.="Updating $student"."'s status for $part.$type to $newscore<br />\n";
         } else {
    #$result.="$stuname:$part:$type:unchanged  $oldscore to $newscore:<br />\n";
         }
     }      }
   }    }
     if ( scalar(keys(%newrecord)) > 0 ) {
       $newrecord{"resource.regrader"}="$ENV{'user.name'}:$ENV{'user.domain'}";
       &Apache::lonnet::cstore(\%newrecord,$symb,$courseid,$domain,$stuname,
       &Apache::lonnet::homeserver($stuname,$domain));
       $result.="Stored away ".scalar(keys(%newrecord))." elements.<br />\n";
     }
   return $result;    return $result;
 }  }
   
Line 167  sub viewgrades { Line 198  sub viewgrades {
   
   #start the form    #start the form
   $result = '<form action="/adm/grades" method="post">'."\n".    $result = '<form action="/adm/grades" method="post">'."\n".
     '<input type="hidden" name="symb" value="'.$symb.' "/>'."\n".      '<input type="hidden" name="symb" value="'.$symb.'"/>'."\n".
       '<input type="hidden" name="url" value="'.$url.' "/>'."\n".        '<input type="hidden" name="url" value="'.$url.'"/>'."\n".
  '<input type="hidden" name="command" value="editgrades" />'."\n".   '<input type="hidden" name="command" value="editgrades" />'."\n".
   '<input type="submit" name="submit" value="Submit Changes" />'."\n".    '<input type="submit" name="submit" value="Submit Changes" />'."\n".
     '<table>'."\n".      '<table>'."\n".
       '<tr><td>UserId</td><td>Domain</td><td>Portion Correct</td><td>Status</td><td>Tries</td></tr>'."\n";        '<tr><td>UserId</td><td>Domain</td>'."\n";
     foreach my $part (@parts) {
        my $display=&Apache::lonnet::metadata($url,$part.'.display');
        if  (!$display) { $display = &Apache::lonnet::metadata($url,$part.'.name'); }
        $result.="<td>$display</td>\n";
      }
     $result.="</tr>";
   #get info for each student    #get info for each student
   foreach my $student ( sort(@{ $classlist{'allids'} }) ) {    foreach my $student ( sort(@{ $classlist{'allids'} }) ) {
     $result.=&viewstudentgrade($url,$symb,$ENV{'request.course.id'},$student,@parts);      $result.=&viewstudentgrade($url,$symb,$ENV{'request.course.id'},$student,@parts);
Line 189  sub editgrades { Line 226  sub editgrades {
   my $symb=$ENV{'form.symb'};    my $symb=$ENV{'form.symb'};
   if ($symb eq '') { $request->print("Unable to handle ambiguous references:$symb:$ENV{'form.url'}"); return ''; }    if ($symb eq '') { $request->print("Unable to handle ambiguous references:$symb:$ENV{'form.url'}"); return ''; }
   my $url=$ENV{'form.url'};    my $url=$ENV{'form.url'};
   
   #get classlist    #get classlist
   my ($cdom,$cnum) = split(/_/,$ENV{'request.course.id'});    my ($cdom,$cnum) = split(/_/,$ENV{'request.course.id'});
   my $chome=$ENV{"course.$ENV{'request.course.id'}.home"};    my $chome=$ENV{"course.$ENV{'request.course.id'}.home"};
Line 203  sub editgrades { Line 239  sub editgrades {
     '<input type="hidden" name="symb" value="'.$symb.'" />'."\n".      '<input type="hidden" name="symb" value="'.$symb.'" />'."\n".
       '<input type="hidden" name="url" value="'.$url.'" />'."\n".        '<input type="hidden" name="url" value="'.$url.'" />'."\n".
  '<input type="hidden" name="command" value="viewgrades" />'."\n".   '<input type="hidden" name="command" value="viewgrades" />'."\n".
   '<input type="submit" name="submit" value="See Grades" />'."\n";    '<input type="submit" name="submit" value="See Grades" /> <br />'."\n";
   
   foreach my $student ( sort(@{ $classlist{'allids'} }) ) {    foreach my $student ( sort(@{ $classlist{'allids'} }) ) {
     $result.=&setstudentgrade($url,$symb,$ENV{'request.course.id'},$student,@parts);      $result.=&setstudentgrade($url,$symb,$ENV{'request.course.id'},$student,@parts);
Line 216  sub editgrades { Line 252  sub editgrades {
 sub send_header {  sub send_header {
   my ($request)= @_;    my ($request)= @_;
   $request->print(&Apache::lontexconvert::header());    $request->print(&Apache::lontexconvert::header());
   $request->print("  #  $request->print("
 <script>  #<script>
 remotewindow=open('','homeworkremote');  #remotewindow=open('','homeworkremote');
 remotewindow.close();  #remotewindow.close();
 </script>");   #</script>"); 
   $request->print('<body bgcolor="#FFFFFF">');    $request->print('<body bgcolor="#FFFFFF">');
 }  }
   

Removed from v.1.5  
changed lines
  Added in v.1.6


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