Annotation of loncom/homework/grades.pm, revision 1.29

1.17      albertel    1: # The LearningOnline Network with CAPA
1.13      albertel    2: # The LON-CAPA Grading handler
1.17      albertel    3: #
1.29    ! albertel    4: # $Id: grades.pm,v 1.28 2002/06/20 21:21:16 ng Exp $
1.17      albertel    5: #
                      6: # Copyright Michigan State University Board of Trustees
                      7: #
                      8: # This file is part of the LearningOnline Network with CAPA (LON-CAPA).
                      9: #
                     10: # LON-CAPA is free software; you can redistribute it and/or modify
                     11: # it under the terms of the GNU General Public License as published by
                     12: # the Free Software Foundation; either version 2 of the License, or
                     13: # (at your option) any later version.
                     14: #
                     15: # LON-CAPA is distributed in the hope that it will be useful,
                     16: # but WITHOUT ANY WARRANTY; without even the implied warranty of
                     17: # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
                     18: # GNU General Public License for more details.
                     19: #
                     20: # You should have received a copy of the GNU General Public License
                     21: # along with LON-CAPA; if not, write to the Free Software
                     22: # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
                     23: #
                     24: # /home/httpd/html/adm/gpl.txt
                     25: #
                     26: # http://www.lon-capa.org/
                     27: #
1.13      albertel   28: # 2/9,2/13 Guy Albertelli
1.8       www        29: # 6/8 Gerd Kortemeyer
1.13      albertel   30: # 7/26 H.K. Ng
1.14      www        31: # 8/20 Gerd Kortemeyer
1.1       albertel   32: 
                     33: package Apache::grades;
                     34: use strict;
                     35: use Apache::style;
                     36: use Apache::lonxml;
                     37: use Apache::lonnet;
1.3       albertel   38: use Apache::loncommon;
1.1       albertel   39: use Apache::lonhomework;
                     40: use Apache::Constants qw(:common);
                     41: 
1.2       albertel   42: sub moreinfo {
1.13      albertel   43:   my ($request,$reason) = @_;
                     44:   $request->print("Unable to process request: $reason");
                     45:   if ( $Apache::grades::viewgrades eq 'F' ) {
                     46:     $request->print('<form action="/adm/grades" method="post">'."\n");
1.16      albertel   47:     if ($ENV{'form.url'}) {
                     48:       $request->print('<input type="hidden" name="url" value="'.$ENV{'form.url'}.'" />'."\n");
                     49:     }
                     50:     if ($ENV{'form.symb'}) {
                     51:       $request->print('<input type="hidden" name="symb" value="'.$ENV{'form.symb'}.'" />'."\n");
                     52:     }
                     53:     $request->print('<input type="hidden" name="command" value="'.$ENV{'form.command'}.'" />'."\n");
                     54:     $request->print("Student:".'<input type="text" name="student" value="'.$ENV{'form.student'}.'" />'."<br />\n");
                     55:     $request->print("Domain:".'<input type="text" name="domain" value="'.$ENV{'user.domain'}.'" />'."<br />\n");
                     56:     $request->print('<input type="submit" name="submit" value="ReSubmit" />'."<br />\n");
1.13      albertel   57:     $request->print('</form>');
                     58:   }
                     59:   return '';
1.2       albertel   60: }
                     61: 
1.23      www        62: sub verifyreceipt {
                     63:     my $request=shift;
                     64:     my $courseid=$ENV{'request.course.id'};
                     65:     my $cdom=$ENV{"course.$courseid.domain"};
                     66:     my $cnum=$ENV{"course.$courseid.num"};
                     67:     my $receipt=unpack("%32C*",$Apache::lonnet::perlvar{'lonHostID'}).'-'.
                     68:                 $ENV{'form.receipt'};
                     69:     $receipt=~s/[^\-\d]//g;
                     70:     my $symb=$ENV{'form.symb'};
                     71:     unless ($symb) {
                     72: 	$symb=&Apache::lonnet::symbread($ENV{'form.url'});
                     73:     }
                     74:     if ((&Apache::lonnet::allowed('mgr',$courseid)) && ($symb)) {
                     75:         $request->print('<h1>Verifying Submission Receipt '.$receipt.'</h1>');
                     76:         my $matches=0;
1.24      albertel   77:         my (%classlist) = &getclasslist($cdom,$cnum,'0');
1.23      www        78:         foreach my $student ( sort(@{ $classlist{'allids'} }) ) {
                     79:             my ($uname,$udom)=split(/\:/,$student);
                     80:             if ($receipt eq 
                     81:              &Apache::lonnet::ireceipt($uname,$udom,$courseid,$symb)) {
                     82:                $request->print('Matching '.$student.'<br>');
                     83:                $matches++;
                     84: 	   }
                     85:         }
                     86:         $request->print('<p>'.$matches.' match(es)</p>');
                     87:     }
                     88:     return '';
                     89: }
1.13      albertel   90: 
1.10      ng         91: sub listStudents {
1.13      albertel   92:   my ($request) = shift;
1.23      www        93:   my $cdom=$ENV{"course.$ENV{'request.course.id'}.domain"};
                     94:   my $cnum=$ENV{"course.$ENV{'request.course.id'}.num"};
                     95:   my $hostver=unpack("%32C*",$Apache::lonnet::perlvar{'lonHostID'});
                     96:   $request->print(<<ENDHEADER);
1.28      ng         97: <h2><font color="#339933">Verify a Submission Receipt Issued by this Server</font></h2>
1.23      www        98: <form action="/adm/grades" method="post">
                     99: <tt>$hostver-<input type="text" name="receipt" size="4"></tt>
                    100: <input type="submit" name="submit" value="Verify">
                    101: <input type="hidden" name="command" value="verify">
                    102: ENDHEADER
                    103: 	  if ($ENV{'form.url'}) {
                    104: 	    $request->print(
                    105:     '<input type="hidden" name="url" value="'.$ENV{'form.url'}.'" />');
                    106: 	  }
                    107: 	  if ($ENV{'form.symb'}) {
                    108: 	    $request->print(
                    109:     '<input type="hidden" name="symb" value="'.$ENV{'form.symb'}.'" />');
                    110: 	  }
                    111:   $request->print(<<ENDTABLEST);
                    112: </form>
1.28      ng        113: <h2><font color="#339933">Show Student Submissions on Assessment</font></h2>
                    114: 
1.29    ! albertel  115: <table border="0"><tr><td bgcolor="#000000">
        !           116: <table border="0">
        !           117: <tr bgcolor="#e6ffff"><td><b>Username</b></td><td><b>Name</b></td><td><b>Domain</b></td><td>&nbsp;</td></tr>
1.23      www       118: ENDTABLEST
1.24      albertel  119:   my (%classlist) = &getclasslist($cdom,$cnum,'0');
1.13      albertel  120:   foreach my $student ( sort(@{ $classlist{'allids'} }) ) {
                    121:       my ($sname,$sdom) = split(/:/,$student);
                    122: 
1.25      albertel  123:       my %name=&Apache::lonnet::get('environment', ['lastname','generation',
                    124: 						    'firstname','middlename'],
                    125: 				    $sdom,$sname);
                    126:       my $fullname;
                    127:       my ($tmp) = keys(%name);
                    128:       if ($tmp !~ /^(con_lost|error|no_such_host)/i) {
                    129: 	$fullname=$name{'lastname'}.$name{'generation'};
1.28      ng        130: 	if ($fullname =~ /[^\s]+/) { $fullname.=', '; }
1.25      albertel  131: 	$fullname.=$name{'firstname'}.' '.$name{'middlename'};
                    132:       }
1.13      albertel  133:       if ( $Apache::grades::viewgrades eq 'F' ) {
1.28      ng        134: 	  $request->print("\n".'<tr bgcolor=#ffffe6>'."<td>$sname</td><td>$fullname</td><td>$sdom</td><td>".
1.21      albertel  135: 			  '<form action="/adm/grades" method="post">');
1.16      albertel  136: 	  if ($ENV{'form.url'}) {
1.19      www       137: 	    $request->print(
                    138:     '<input type="hidden" name="url" value="'.$ENV{'form.url'}.'" />');
1.16      albertel  139: 	  }
                    140: 	  if ($ENV{'form.symb'}) {
1.19      www       141: 	    $request->print(
                    142:     '<input type="hidden" name="symb" value="'.$ENV{'form.symb'}.'" />');
1.16      albertel  143: 	  }
1.19      www       144: 	  $request->print(
                    145:     '<input type="hidden" name="command" value="'.$ENV{'form.command'}.'" />');
                    146: 	  $request->print(
                    147:              '<input type="hidden" name="student" value="'.$sname.'" />');
                    148: 	  $request->print(
1.28      ng        149:              '<input type="hidden" name="fullname" value="'.$fullname.'" />');
                    150: 	  $request->print(
1.19      www       151:              '<input type="hidden" name="domain" value="'.$sdom.'" />');
                    152: 	  $request->print(
                    153:                          '<input type="submit" name="submit" value="View" />');
1.28      ng        154: 	  $request->print('</td></tr></form>');
                    155: #	  $request->print('</form></td></tr>');
1.13      albertel  156:       }
                    157:   }
1.28      ng        158:   $request->print('</table></td></tr></table>');
1.10      ng        159: }
                    160: 
1.13      albertel  161: 
1.7       albertel  162: #FIXME - needs to handle multiple matches
1.2       albertel  163: sub finduser {
1.13      albertel  164:   my ($name) = @_;
                    165:   my $domain = '';
                    166: 
                    167:   if ( $Apache::grades::viewgrades eq 'F' ) {
                    168:     #get classlist
                    169:     my ($cdom,$cnum) = split(/_/,$ENV{'request.course.id'});
1.24      albertel  170:     #print "Found $cdom:$cnum<br />";
                    171:     my (%classlist) = &getclasslist($cdom,$cnum,'0');
1.13      albertel  172:     foreach my $student ( sort(@{ $classlist{'allids'} }) ) {
                    173:       my ($posname,$posdomain) = split(/:/,$student);
                    174:       if ($posname =~ $name) { $name=$posname; $domain=$posdomain; last; }
1.7       albertel  175:     }
1.13      albertel  176:     return ($name,$domain);
                    177:   } else {
                    178:     return ($ENV{'user.name'},$ENV{'user.domain'});
                    179:   }
1.5       albertel  180: }
                    181: 
                    182: sub getclasslist {
1.24      albertel  183:   my ($coursedomain,$coursenum,$hideexpired) = @_;
                    184:   my %classlist=&Apache::lonnet::dump('classlist',$coursedomain,$coursenum);
1.13      albertel  185:   my $now = time;
1.24      albertel  186:   foreach my $student (keys(%classlist)) {
                    187:     my ($end,$start)=split(/:/,$classlist{$student});
1.13      albertel  188:     # still a student?
                    189:     if (($hideexpired) && ($end) && ($end < $now)) {
1.15      albertel  190:       #print "Skipping:$name:$end:$now<br />\n";
1.13      albertel  191:       next;
                    192:     }
1.15      albertel  193:     #print "record=$record<br>";
1.24      albertel  194:     push( @{ $classlist{'allids'} }, $student);
1.13      albertel  195:   }
                    196:   return (%classlist);
1.5       albertel  197: }
                    198: 
                    199: sub getpartlist {
1.13      albertel  200:   my ($url) = @_;
                    201:   my @parts =();
                    202:   my (@metakeys) = split(/,/,&Apache::lonnet::metadata($url,'keys'));
                    203:   foreach my $key (@metakeys) {
                    204:     if ( $key =~ m/stores_([0-9]+)_.*/ ) {
                    205:       push(@parts,$key);
1.6       albertel  206:     }
1.13      albertel  207:   }
                    208:   return @parts;
1.5       albertel  209: }
                    210: 
                    211: sub viewstudentgrade {
1.13      albertel  212:   my ($url,$symb,$courseid,$student,@parts) = @_;
                    213:   my $result ='';
                    214:   my $cellclr = '"#ffffdd"';
1.28      ng        215:   my ($username,$domain) = split(/:/,$student);
1.13      albertel  216: 
1.28      ng        217:   my (@requests) = ('lastname','firstname','middlename','generation');
                    218:   my (%name) = &Apache::lonnet::get('environment',\@requests,$domain,$username);
                    219:   my %record=&Apache::lonnet::restore($symb,$courseid,$domain,$username);
                    220:   my $fullname=$name{'lastname'}.$name{'generation'};
                    221:   if ($fullname =~ /[^\s]+/) { $fullname.=', '; }
                    222:   $fullname.=$name{'firstname'}.' '.$name{'middlename'};
1.13      albertel  223: 
1.28      ng        224:   $result.="<tr bgcolor=$cellclr><td>$username</td><td>$fullname</td><td align=\"middle\">$domain</td>\n";
1.13      albertel  225:   foreach my $part (@parts) {
                    226:     my ($temp,$part,$type)=split(/_/,$part);
                    227:     #print "resource.$part.$type = ".$record{"resource.$part.$type"}." <br />\n";
                    228:     if ($type eq 'awarded') {
                    229:       my $score=$record{"resource.$part.$type"};
1.28      ng        230:       $result.="<td align=\"middle\"><input type=\"text\" name=\"GRADE.$student.$part.$type\" value=\"$score\" size=\"4\" /></td>\n";
1.13      albertel  231:     } elsif ($type eq 'tries') {
                    232:       my $score=$record{"resource.$part.$type"};
1.28      ng        233:       $result.="<td align=\"middle\"><input type=\"text\" name=\"GRADE.$student.$part.$type\" value=\"$score\" size=\"4\" /></td>\n"
1.13      albertel  234:     } elsif ($type eq 'solved') {
                    235:       my $score=$record{"resource.$part.$type"};
1.28      ng        236:       $result.="<td align=\"middle\"><select name=\"GRADE.$student.$part.$type\">\n";
1.13      albertel  237:       if ($score =~ /^correct/) {
                    238: 	$result.="<option selected=\"on\">correct</option>\n<option>incorrect</option>\n<option>excused</option>\n<option>ungraded</option>\n<option>nothing</option>\n";
                    239:       } elsif ($score =~ /^incorrect/) {
                    240: 	$result.="<option>correct</option>\n<option selected=\"on\">incorrect</option>\n<option>excused</option>\n<option>ungraded</option>\n<option>nothing</option>\n";
                    241:       } elsif ($score eq '') {
                    242: 	$result.="<option>correct</option>\n<option>incorrect</option>\n<option>excused</option>\n<option>ungraded</option>\n<option selected=\"on\">nothing</option>\n";
                    243:       } elsif ($score =~ /^excused/) {
                    244: 	$result.="<option>correct</option>\n<option>incorrect</option>\n<option selected=\"on\">excused</option>\n<option>ungraded</option>\n<option>nothing</option>\n";
                    245:       } elsif ($score =~ /^ungraded/) {
                    246: 	$result.="<option>correct</option>\n<option>incorrect</option>\n<option>excused</option>\n<option selected=\"on\">ungraded</option>\n<option>nothing</option>\n";
                    247:       }
                    248:       $result.="</select></td>\n";
                    249:     }
                    250:   }
1.29    ! albertel  251:   $result.='<td></td></tr>';
1.13      albertel  252:   return $result;
1.5       albertel  253: }
1.13      albertel  254: #FIXME need to look at the meatdata <stores> spec on what type of data to accept and provide an
1.6       albertel  255: #interface based on that, also do that to above function.
1.5       albertel  256: sub setstudentgrade {
1.13      albertel  257:   my ($url,$symb,$courseid,$student,@parts) = @_;
                    258: 
                    259:   my $result ='';
                    260: 
                    261:   my ($stuname,$domain) = split(/:/,$student);
                    262: 
                    263:   my %record=&Apache::lonnet::restore($symb,$courseid,$domain,$stuname);
                    264: 
                    265:   my %newrecord;
                    266: 
                    267:   foreach my $part (@parts) {
                    268:     my ($temp,$part,$type)=split(/_/,$part);
                    269:     my $oldscore=$record{"resource.$part.$type"};
                    270:     my $newscore=$ENV{"form.GRADE.$student.$part.$type"};
                    271:     if ($type eq 'solved') {
                    272:       my $update=0;
                    273:       if ($newscore eq 'nothing' ) {
                    274: 	if ($oldscore ne '') {
                    275: 	  $update=1;
                    276: 	  $newscore = '';
1.6       albertel  277: 	}
1.13      albertel  278:       } elsif ($oldscore !~ m/^$newscore/) {
                    279: 	$update=1;
                    280: 	$result.="Updating $stuname to $newscore<br />\n";
                    281: 	if ($newscore eq 'correct') { $newscore = 'correct_by_override'; }
                    282: 	if ($newscore eq 'incorrect') { $newscore = 'incorrect_by_override'; }
                    283: 	if ($newscore eq 'excused') { $newscore = 'excused'; }
                    284: 	if ($newscore eq 'ungraded') { $newscore = 'ungraded_attempted'; }
                    285:       } else {
                    286: 	#$result.="$stuname:$part:$type:unchanged  $oldscore to $newscore:<br />\n";
                    287:       }
                    288:       if ($update) { $newrecord{"resource.$part.$type"}=$newscore; }
                    289:     } else {
                    290:       if ($oldscore ne $newscore) {
                    291: 	$newrecord{"resource.$part.$type"}=$newscore;
                    292: 	$result.="Updating $student"."'s status for $part.$type to $newscore<br />\n";
                    293:       } else {
                    294: 	#$result.="$stuname:$part:$type:unchanged  $oldscore to $newscore:<br />\n";
                    295:       }
                    296:     }
                    297:   }
                    298:   if ( scalar(keys(%newrecord)) > 0 ) {
                    299:     $newrecord{"resource.regrader"}="$ENV{'user.name'}:$ENV{'user.domain'}";
                    300:     &Apache::lonnet::cstore(\%newrecord,$symb,$courseid,$domain,$stuname);
                    301: 
                    302:     $result.="Stored away ".scalar(keys(%newrecord))." elements.<br />\n";
                    303:   }
                    304:   return $result;
1.2       albertel  305: }
                    306: 
                    307: sub submission {
1.13      albertel  308:   my ($request) = @_;
                    309:   my $url=$ENV{'form.url'};
                    310:   $url=~s-^http://($ENV{'SERVER_NAME'}|$ENV{'HTTP_HOST'})--;
                    311:   if ($ENV{'form.student'} eq '') { &moreinfo($request,"Need student login id"); return ''; }
1.10      ng        312: #  if ($ENV{'form.student'} eq '') { &listStudents($request); return ''; }
1.13      albertel  313:   my ($uname,$udom) = &finduser($ENV{'form.student'});
                    314:   if ($uname eq '') { &moreinfo($request,"Unable to find student"); return ''; }
1.16      albertel  315:   my $symb;
                    316:   if ($ENV{'form.symb'}) {
                    317:     $symb=$ENV{'form.symb'};
                    318:   } else {
                    319:     $symb=&Apache::lonnet::symbread($url);
                    320:   }
1.13      albertel  321:   if ($symb eq '') { $request->print("Unable to handle ambiguous references:$url:."); return ''; }
                    322:   my $answer=&Apache::loncommon::get_previous_attempt($symb,$uname,$udom,
                    323: 						      $ENV{'request.course.id'});
1.28      ng        324:   my $result='<h2><font color="#339933">Submission Record</font></h2>';
                    325:   $result.='<b>Username : </b>'.$uname.'<br><b>Fullname : </b>'.$ENV{'form.fullname'}.'<br><b>Domain : </b>'.$udom.'<br><b>Resource : </b>'.$url.' <br />'.$answer;
1.17      albertel  326:   my $rendered=&Apache::loncommon::get_student_view($symb,$uname,$udom,
                    327: 						   $ENV{'request.course.id'});
1.22      albertel  328:   $result.="Student's view of the problem:<br /> $rendered <br /> Correct answer:<br />";
1.18      albertel  329: 
1.22      albertel  330:   $answer=&Apache::loncommon::get_student_answers($symb,$uname,$udom,
1.18      albertel  331: 						  $ENV{'request.course.id'});
                    332:   $result.=$answer;
1.13      albertel  333:   return $result;
1.2       albertel  334: }
                    335: 
1.26      albertel  336: sub get_symb_and_url {
                    337:  my ($request) = @_;
1.13      albertel  338:   my $url=$ENV{'form.url'};
                    339:   $url=~s-^http://($ENV{'SERVER_NAME'}|$ENV{'HTTP_HOST'})--;
                    340:   my $symb=$ENV{'form.symb'};
                    341:   if (!$symb) { $symb=&Apache::lonnet::symbread($url); }
                    342:   if ($symb eq '') { $request->print("Unable to handle ambiguous references:$url:."); return ''; }
1.26      albertel  343:  return ($symb,$url);
                    344: }
1.13      albertel  345: 
1.29    ! albertel  346: sub view_edit_entire_class_form {
        !           347:   my ($symb,$url)=@_;
        !           348:   my $result.='<form action="/adm/grades" method="post">'."\n".
        !           349:     '<input type="hidden" name="symb" value="'.$symb.'" />'."\n".
        !           350:       '<input type="hidden" name="url" value="'.$url.'" />'."\n".
        !           351: 	'<input type="hidden" name="command" value="viewgrades" />'."\n".
        !           352: 	  '<input type="submit" name="submit" value="View/Edit Entire Class" />'."\n".
        !           353: 	    '</form>'."\n";
        !           354:   return $result;
        !           355: }
        !           356: 
        !           357: sub show_grading_menu_form {
        !           358:   my ($symb,$url)=@_;
        !           359:   my $result.='<form action="/adm/grades" method="post">'."\n".
        !           360:     '<input type="hidden" name="symb" value="'.$symb.'" />'."\n".
        !           361:       '<input type="hidden" name="url" value="'.$url.'" />'."\n".
        !           362: 	'<input type="hidden" name="command" value="gradingmenu" />'."\n".
        !           363: 	  '<input type="submit" name="submit" value="Grading Menu" />'."\n".
        !           364: 	    '</form>'."\n";
        !           365:   return $result;
        !           366: }
        !           367: 
1.26      albertel  368: sub gradingmenu {
                    369:   my ($request) = @_;
                    370:   my ($symb,$url)=&get_symb_and_url($request);
                    371:   if (!$symb) {return '';}
1.28      ng        372: 
                    373:   my $result='<h2>&nbsp;<font color="#339933">Select a Grading Method</font></h2><br />';
1.29    ! albertel  374:   $result.='<table width=100% border=0><tr><td bgcolor=#000000>'."\n";
1.28      ng        375:   $result.='<table width=100% border=0><tr><td bgcolor=#e6ffff>'."\n";
                    376:   $result.='&nbsp;<b>Resource :</b> '.$url.'</td></tr>'."\n";
                    377:   $result.='<tr bgcolor=#ffffe6><td>'."\n";
1.29    ! albertel  378:   $result.=&view_edit_entire_class_form($symb,$url);
1.26      albertel  379:   $result.='<form action="/adm/grades" method="post">'."\n".
                    380:      '<input type="hidden" name="symb" value="'.$symb.'" />'."\n".
                    381:       '<input type="hidden" name="url" value="'.$url.'" />'."\n".
                    382: 	'<input type="hidden" name="command" value="csvupload" />'."\n".
                    383: 	  '<input type="submit" name="submit" value="Upload Scores" />'."\n".
1.28      ng        384: 	    '</form>'."\n";
1.26      albertel  385:   $result.='<form action="/adm/grades" method="post">'."\n".
                    386:      '<input type="hidden" name="symb" value="'.$symb.'" />'."\n".
                    387:       '<input type="hidden" name="url" value="'.$url.'" />'."\n".
                    388: 	'<input type="hidden" name="command" value="submission" />'."\n".
                    389: 	  '<input type="submit" name="submit" value="View/Edit Student" />'."\n".
1.28      ng        390: 	    '</form>'."\n";
                    391:   $result.='</td></tr></table>'."\n";
                    392:   $result.='</td></tr></table>'."\n";
1.26      albertel  393:   return $result;
                    394: }
                    395: 
                    396: sub viewgrades {
                    397:   my ($request) = @_;
                    398:   my $result='';
                    399: 
                    400:   #get resource reference
                    401:   my ($symb,$url)=&get_symb_and_url($request);
                    402:   if (!$symb) {return '';}
1.13      albertel  403:   #get classlist
                    404:   my ($cdom,$cnum) = split(/_/,$ENV{'request.course.id'});
1.24      albertel  405:   #print "Found $cdom:$cnum<br />";
                    406:   my (%classlist) = &getclasslist($cdom,$cnum,'0');
1.13      albertel  407:   my $headerclr = '"#ccffff"';
                    408:   my $cellclr = '"#ffffcc"';
                    409: 
                    410:   #get list of parts for this problem
1.29    ! albertel  411:   my (@parts) = sort(&getpartlist($url));
1.13      albertel  412: 
1.28      ng        413:   $request->print ("<h2><font color=\"#339933\">Manual Grading</font></h2>");
1.13      albertel  414: 
                    415:   #start the form
                    416:   $result = '<form action="/adm/grades" method="post">'."\n".
1.16      albertel  417:     '<input type="hidden" name="symb" value="'.$symb.'" />'."\n".
                    418:       '<input type="hidden" name="url" value="'.$url.'" />'."\n".
1.13      albertel  419: 	'<input type="hidden" name="command" value="editgrades" />'."\n".
                    420: 	  '<input type="submit" name="submit" value="Submit Changes" />'."\n".
1.29    ! albertel  421: 	    '<table border=0><tr><td bgcolor="#000000">'."\n".
1.13      albertel  422: 	     '<table border=0>'."\n".
1.28      ng        423: 	      '<tr bgcolor='.$headerclr.'><td><b>Username</b></td><td><b>Name</b></td><td><b>Domain</b></td>'."\n";
1.29    ! albertel  424:   foreach my $part (@parts) {
1.13      albertel  425:      my $display=&Apache::lonnet::metadata($url,$part.'.display');
                    426:      if  (!$display) { $display = &Apache::lonnet::metadata($url,$part.'.name'); }
1.28      ng        427:      $result.='<td><b>'.$display.'</b></td>'."\n";
1.13      albertel  428:    }
1.28      ng        429:   $result.='</tr>';
1.13      albertel  430:   #get info for each student
                    431:   foreach my $student ( sort(@{ $classlist{'allids'} }) ) {
                    432:     $result.=&viewstudentgrade($url,$symb,$ENV{'request.course.id'},$student,@parts);
                    433:   }
                    434:   $result.='</table></td></tr></table><input type="submit" name="submit" value="Submit Changes" /></form>';
1.29    ! albertel  435:   $result.=&show_grading_menu_form($symb,$url);
1.13      albertel  436:   return $result;
1.5       albertel  437: }
                    438: 
                    439: sub editgrades {
1.13      albertel  440:   my ($request) = @_;
                    441:   my $result='';
1.5       albertel  442: 
1.13      albertel  443:   my $symb=$ENV{'form.symb'};
                    444:   if ($symb eq '') { $request->print("Unable to handle ambiguous references:$symb:$ENV{'form.url'}"); return ''; }
                    445:   my $url=$ENV{'form.url'};
                    446:   #get classlist
                    447:   my ($cdom,$cnum) = split(/_/,$ENV{'request.course.id'});
1.24      albertel  448:   #print "Found $cdom:$cnum<br />";
                    449:   my (%classlist) = &getclasslist($cdom,$cnum,'0');
1.13      albertel  450: 
                    451:   #get list of parts for this problem
                    452:   my (@parts) = &getpartlist($url);
                    453: 
                    454:   $result.='<form action="/adm/grades" method="post">'."\n".
                    455:     '<input type="hidden" name="symb" value="'.$symb.'" />'."\n".
                    456:       '<input type="hidden" name="url" value="'.$url.'" />'."\n".
                    457: 	'<input type="hidden" name="command" value="viewgrades" />'."\n".
                    458: 	  '<input type="submit" name="submit" value="See Grades" /> <br />'."\n";
                    459: 
                    460:   foreach my $student ( sort(@{ $classlist{'allids'} }) ) {
                    461:     $result.=&setstudentgrade($url,$symb,$ENV{'request.course.id'},$student,@parts);
                    462:   }
1.5       albertel  463: 
1.13      albertel  464:   $result.='<input type="submit" name="submit" value="See Grades" /></table></form>';
                    465:   return $result;
1.5       albertel  466: }
                    467: 
1.26      albertel  468: sub csvupload {
                    469:   my ($request)= @_;
                    470:   my $result;
                    471:   my ($symb,$url)=&get_symb_and_url($request);
                    472:   if (!$symb) {return '';}
                    473:   my $upfile_select=&Apache::loncommon::upfile_select_html();
                    474:   $result.=<<ENDUPFORM;
                    475: <form method="post" enctype="multipart/form-data" action="/adm/grades" name="gradesupload">
                    476: <input type="hidden" name="symb" value="$symb" />
                    477: <input type="hidden" name="url" value="$url" />
                    478: <input type="hidden" name="command" value="csvuploadmap" />
                    479: <hr />
                    480: <h3>Specify a file containing the class grades for resource $url</h3>
                    481: $upfile_select
                    482: <p><input type="submit" name="submit" value="Upload Grades" />
                    483: ENDUPFORM
                    484:   return $result;
                    485: }
                    486: 
1.27      albertel  487: sub csvupload_javascript_reverse_associate {
                    488:   return(<<ENDPICK);
                    489:   function verify(vf) {
                    490:     var foundsomething=0;
                    491:     var founduname=0;
                    492:     var founddomain=0;
                    493:     for (i=0;i<=vf.nfields.value;i++) {
                    494:       tw=eval('vf.f'+i+'.selectedIndex');
                    495:       if (i==0 && tw!=0) { founduname=1; }
                    496:       if (i==1 && tw!=0) { founddomain=1; }
                    497:       if (i!=0 && i!=1 && tw!=0) { foundsomething=1; }
                    498:     }
                    499:     if (founduname==0 || founddomain==0) {
                    500:       alert('You need to specify at both the username and domain');
                    501:       return;
                    502:     }
                    503:     if (foundsomething==0) {
                    504:       alert('You need to specify at least one grading field');
                    505:       return;
                    506:     }
                    507:     vf.submit();
                    508:   }
                    509:   function flip(vf,tf) {
                    510:     var nw=eval('vf.f'+tf+'.selectedIndex');
                    511:     var i;
                    512:     for (i=0;i<=vf.nfields.value;i++) {
                    513:       //can not pick the same destination field for both name and domain
                    514:       if (((i ==0)||(i ==1)) && 
                    515:           ((tf==0)||(tf==1)) && 
                    516:           (i!=tf) &&
                    517:           (eval('vf.f'+i+'.selectedIndex')==nw)) {
                    518:         eval('vf.f'+i+'.selectedIndex=0;')
                    519:       }
                    520:     }
                    521:   }
                    522: ENDPICK
                    523: }
                    524: 
                    525: sub csvupload_javascript_forward_associate {
                    526:   return(<<ENDPICK);
                    527:   function verify(vf) {
                    528:     var foundsomething=0;
                    529:     var founduname=0;
                    530:     var founddomain=0;
                    531:     for (i=0;i<=vf.nfields.value;i++) {
                    532:       tw=eval('vf.f'+i+'.selectedIndex');
                    533:       if (tw==1) { founduname=1; }
                    534:       if (tw==2) { founddomain=1; }
                    535:       if (tw>2) { foundsomething=1; }
                    536:     }
                    537:     if (founduname==0 || founddomain==0) {
                    538:       alert('You need to specify at both the username and domain');
                    539:       return;
                    540:     }
                    541:     if (foundsomething==0) {
                    542:       alert('You need to specify at least one grading field');
                    543:       return;
                    544:     }
                    545:     vf.submit();
                    546:   }
                    547:   function flip(vf,tf) {
                    548:     var nw=eval('vf.f'+tf+'.selectedIndex');
                    549:     var i;
                    550:     //can not pick the same destination field twice
                    551:     for (i=0;i<=vf.nfields.value;i++) {
                    552:       if ((i!=tf) && (eval('vf.f'+i+'.selectedIndex')==nw)) {
                    553:         eval('vf.f'+i+'.selectedIndex=0;')
                    554:       }
                    555:     }
                    556:   }
                    557: ENDPICK
                    558: }
                    559: 
1.26      albertel  560: sub csvuploadmap_header {
                    561:   my ($request,$symb,$url,$datatoken,$distotal)= @_;
                    562:   my $result;
                    563:   my $javascript;
                    564:   if ($ENV{'form.upfile_associate'} eq 'reverse') {
1.27      albertel  565:     $javascript=&csvupload_javascript_reverse_associate();
1.26      albertel  566:   } else {
1.27      albertel  567:     $javascript=&csvupload_javascript_forward_associate();
1.26      albertel  568:   }
                    569:   $request->print(<<ENDPICK);
                    570: <form method="post" enctype="multipart/form-data" action="/adm/grades" name="gradesupload">
                    571: <h3>Uploading Class Grades for resource $url</h3>
                    572: <hr>
                    573: <h3>Identify fields</h3>
                    574: Total number of records found in file: $distotal <hr />
                    575: Enter as many fields as you can. The system will inform you and bring you back
                    576: to this page if the data selected is insufficient to run your class.<hr />
                    577: <input type="button" value="Reverse Association" onClick="javascript:this.form.associate.value='Reverse Association';submit(this.form);" />
                    578: <input type="hidden" name="associate"  value="" />
                    579: <input type="hidden" name="phase"      value="three" />
                    580: <input type="hidden" name="datatoken"  value="$datatoken" />
                    581: <input type="hidden" name="fileupload" value="$ENV{'form.fileupload'}" />
                    582: <input type="hidden" name="upfiletype" value="$ENV{'form.upfiletype'}" />
                    583: <input type="hidden" name="upfile_associate" 
                    584:                                        value="$ENV{'form.upfile_associate'}" />
                    585: <input type="hidden" name="symb"       value="$symb" />
                    586: <input type="hidden" name="url"        value="$url" />
                    587: <input type="hidden" name="command"    value="csvuploadassign" />
                    588: <hr />
                    589: <script type="text/javascript" language="Javascript">
                    590: $javascript
                    591: </script>
                    592: ENDPICK
                    593:   return '';
                    594: 
                    595: }
                    596: 
                    597: sub csvupload_fields {
                    598:   my ($url) = @_;
                    599:   my (@parts) = &getpartlist($url);
1.27      albertel  600:   my @fields=(['username','Student Username'],['domain','Student Domain']);
                    601:   foreach my $part (sort(@parts)) {
1.26      albertel  602:     my @datum;
                    603:     my $display=&Apache::lonnet::metadata($url,$part.'.display');
1.27      albertel  604:     my $name=$part;
1.26      albertel  605:     if  (!$display) { $display = $name; }
                    606:     @datum=($name,$display);
                    607:     push(@fields,\@datum);
                    608:   }
                    609:   return (@fields);
                    610: }
                    611: 
                    612: sub csvuploadmap_footer {
                    613:   my ($request,$i,$keyfields) =@_;
                    614:   $request->print(<<ENDPICK);
                    615: </table>
                    616: <input type="hidden" name="nfields" value="$i" />
                    617: <input type="hidden" name="keyfields" value="$keyfields" />
                    618: <input type="button" onClick="javascript:verify(this.form)" value="Assign Grades" /><br />
                    619: </form>
                    620: ENDPICK
                    621: }
                    622: 
                    623: sub csvuploadmap {
                    624:   my ($request)= @_;
                    625:   my ($symb,$url)=&get_symb_and_url($request);
                    626:   if (!$symb) {return '';}
                    627:   my $datatoken;
                    628:   if (!$ENV{'form.datatoken'}) {
                    629:     $datatoken=&Apache::loncommon::upfile_store($request);
                    630:   } else {
                    631:     $datatoken=$ENV{'form.datatoken'};
                    632:     &Apache::loncommon::load_tmp_file($request);
                    633:   }
                    634:   my @records=&Apache::loncommon::upfile_record_sep();
                    635:   &csvuploadmap_header($request,$symb,$url,$datatoken,$#records+1);
                    636:   my $i;
                    637:   my $keyfields;
                    638:   if (@records) {
                    639:     my @fields=&csvupload_fields($url);
                    640:     if ($ENV{'form.upfile_associate'} eq 'reverse') {	
                    641:       &Apache::loncommon::csv_print_samples($request,\@records);
                    642:       $i=&Apache::loncommon::csv_print_select_table($request,\@records,
                    643: 						    \@fields);
                    644:       foreach (@fields) { $keyfields.=$_->[0].','; }
                    645:       chop($keyfields);
                    646:     } else {
                    647:       unshift(@fields,['none','']);
                    648:       $i=&Apache::loncommon::csv_samples_select_table($request,\@records,
                    649: 						      \@fields);
                    650:       my %sone=&Apache::loncommon::record_sep($records[0]);
                    651:       $keyfields=join(',',sort(keys(%sone)));
                    652:     }
                    653:   }
                    654:   &csvuploadmap_footer($request,$i,$keyfields);
                    655:   return '';
1.27      albertel  656: }
                    657: 
                    658: sub csvuploadassign {
                    659:   my ($request)= @_;
                    660:   my ($symb,$url)=&get_symb_and_url($request);
                    661:   if (!$symb) {return '';}
                    662:   &Apache::loncommon::load_tmp_file($request);
                    663:   my @gradedata=&Apache::loncommon::upfile_record_sep();
                    664:   my @keyfields = split(/\,/,$ENV{'form.keyfields'});
                    665:   my %fields=();
                    666:   for (my $i=0; $i<=$ENV{'form.nfields'}; $i++) {
                    667:     if ($ENV{'form.upfile_associate'} eq 'reverse') {
                    668:       if ($ENV{'form.f'.$i} ne 'none') {
                    669: 	$fields{$keyfields[$i]}=$ENV{'form.f'.$i};
                    670:       }
                    671:     } else {
                    672:       if ($ENV{'form.f'.$i} ne 'none') {
                    673: 	$fields{$ENV{'form.f'.$i}}=$keyfields[$i];
                    674:       }
                    675:     }
                    676:   }
                    677:   $request->print('<h3>Assigning Grades</h3>');
                    678:   my $courseid=$ENV{'request.course.id'};
                    679:   my $cdom=$ENV{"course.$courseid.domain"};
                    680:   my $cnum=$ENV{"course.$courseid.num"};
                    681:   my (%classlist) = &getclasslist($cdom,$cnum,'1');
1.29    ! albertel  682:   my @skipped;
        !           683:   my $countdone=0;
        !           684:   foreach my $grade (@gradedata) {
        !           685:     my %entries=&Apache::loncommon::record_sep($grade);
        !           686:     my $username=$entries{$fields{'username'}};
        !           687:     my $domain=$entries{$fields{'domain'}};
        !           688:     if (!exists($classlist{"$username:$domain"})) {
        !           689:       push(@skipped,"$username:$domain");
        !           690:       next;
1.27      albertel  691:     }
1.29    ! albertel  692:     my %grades;
        !           693:     foreach my $dest (keys(%fields)) {
        !           694:       if ($dest eq 'username' || $dest eq 'domain') { next; }
        !           695:       if ($entries{$fields{$dest}} eq '') { next; }
        !           696:       my $store_key=$dest;
        !           697:       $store_key=~s/^stores/resource/;
        !           698:       $store_key=~s/_/\./g;
        !           699:       $grades{$store_key}=$entries{$fields{$dest}};
        !           700:     }
        !           701:     $grades{"resource.regrader"}="$ENV{'user.name'}:$ENV{'user.domain'}";
        !           702:     &Apache::lonnet::cstore(\%grades,$symb,$ENV{'request.course.id'},
        !           703: 			    $domain,$username);
        !           704:     $request->print('.');
        !           705:     $request->rflush();
        !           706:     $countdone++;
        !           707:   }
        !           708:   $request->print("<br />Stored $countdone students\n");
        !           709:   if (@skipped) {
        !           710:     $request->print('<br /><font size="+1"><b>Skipped Students</b></font><br />');
        !           711:     foreach my $student (@skipped) { $request->print("<br />$student"); }
1.27      albertel  712:   }
1.29    ! albertel  713:   $request->print(&view_edit_entire_class_form($symb,$url));
        !           714:   $request->print(&show_grading_menu_form($symb,$url));
        !           715:   return '';
1.26      albertel  716: }
                    717: 
1.2       albertel  718: sub send_header {
1.13      albertel  719:   my ($request)= @_;
                    720:   $request->print(&Apache::lontexconvert::header());
1.6       albertel  721: #  $request->print("
                    722: #<script>
                    723: #remotewindow=open('','homeworkremote');
                    724: #remotewindow.close();
                    725: #</script>"); 
1.13      albertel  726:   $request->print('<body bgcolor="#FFFFFF">');
1.2       albertel  727: }
                    728: 
                    729: sub send_footer {
1.13      albertel  730:   my ($request)= @_;
1.2       albertel  731:   $request->print('</body>');
                    732:   $request->print(&Apache::lontexconvert::footer());
                    733: }
                    734: 
1.1       albertel  735: sub handler {
1.13      albertel  736:   my $request=$_[0];
                    737: 
                    738:   if ($ENV{'browser.mathml'}) {
                    739:     $request->content_type('text/xml');
                    740:   } else {
                    741:     $request->content_type('text/html');
                    742:   }
                    743:   $request->send_http_header;
                    744:   return OK if $request->header_only;
1.16      albertel  745:   &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'});
1.13      albertel  746:   my $url=$ENV{'form.url'};
                    747:   my $symb=$ENV{'form.symb'};
                    748:   my $command=$ENV{'form.command'};
1.16      albertel  749:   if (!$url) {
                    750:     my ($temp1,$temp2);
                    751:     ($temp1,$temp2,$ENV{'form.url'})=split(/___/,$symb);
                    752:     $url = $ENV{'form.url'};
                    753:   }
1.13      albertel  754:   &send_header($request);
                    755:   if ($url eq '' && $symb eq '') {
1.14      www       756:      if ($ENV{'user.adv'}) {
                    757:          if (($ENV{'form.codeone'}) && ($ENV{'form.codetwo'}) &&
                    758:              ($ENV{'form.codethree'})) {
                    759:              my $token=$ENV{'form.codeone'}.'*'.$ENV{'form.codetwo'}.'*'.
                    760: 		        $ENV{'form.codethree'};
                    761:              my ($tsymb,$tuname,$tudom,$tcrsid)=
                    762: 		 &Apache::lonnet::checkin($token);
                    763:              if ($tsymb) {
                    764:                 my ($map,$id,$url)=split(/\_\_\_/,$tsymb);
                    765:                 if (&Apache::lonnet::allowed('mgr',$tcrsid)) {
                    766:                    $request->print(
                    767:                      &Apache::lonnet::ssi('/res/'.$url,
                    768:                         ('grade_username' => $tuname,
                    769:                          'grade_domain' => $tudom,
                    770:                          'grade_courseid' => $tcrsid,
                    771:                          'grade_symb' => $tsymb)));
                    772:                 } else {
                    773:                    $request->print('<h1>Not authorized: '.$token.'</h1>');
                    774:                 }           
                    775: 	    } else {
                    776:                 $request->print('<h1>Not a valid DocID: '.$token.'</h1>');
                    777:             }
                    778: 	 } else {
                    779:              $request->print(&Apache::lonxml::tokeninputfield());
                    780:          }
                    781:      }
1.13      albertel  782:   } else {
1.29    ! albertel  783:     #&Apache::lonhomework::showhashsubset(\%ENV,'^form');
1.13      albertel  784:     $Apache::grades::viewgrades=&Apache::lonnet::allowed('vgr',$ENV{'request.course.id'});
                    785:     if ($command eq 'submission') {
1.20      albertel  786:       &listStudents($request) if ($ENV{'form.student'} eq '');
1.13      albertel  787:       $request->print(&submission($request)) if ($ENV{'form.student'} ne '');
1.26      albertel  788:     } elsif ($command eq 'gradingmenu') {
                    789:       $request->print(&gradingmenu($request));
1.13      albertel  790:     } elsif ($command eq 'viewgrades') {
                    791:       $request->print(&viewgrades($request));
                    792:     } elsif ($command eq 'editgrades') {
                    793:       $request->print(&editgrades($request));
1.23      www       794:     } elsif ($command eq 'verify') {
                    795:       $request->print(&verifyreceipt($request));
1.26      albertel  796:     } elsif ($command eq 'csvupload') {
                    797:       $request->print(&csvupload($request));
                    798:     } elsif ($command eq 'csvuploadmap') {
                    799:       $request->print(&csvuploadmap($request));
                    800:     } elsif ($command eq 'csvuploadassign') {
                    801:       if ($ENV{'form.associate'} ne 'Reverse Association') {
                    802: 	$request->print(&csvuploadassign($request));
                    803:       } else {
                    804: 	if ( $ENV{'form.upfile_associate'} ne 'reverse' ) {
                    805: 	  $ENV{'form.upfile_associate'} = 'reverse';
                    806: 	} else {
                    807: 	  $ENV{'form.upfile_associate'} = 'forward';
                    808: 	}
                    809: 	$request->print(&csvuploadmap($request));
                    810:       }
1.12      harris41  811:     } else {
1.23      www       812:       $request->print("Unknown action: $command:");
1.2       albertel  813:     }
1.13      albertel  814:   }
                    815:   &send_footer($request);
                    816:   return OK;
1.1       albertel  817: }
                    818: 
                    819: 1;
                    820: 
1.13      albertel  821: __END__;

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