1: # The LearningOnline Network with CAPA
2: # The LON-CAPA Grading handler
3: #
4: # $Id: grades.pm,v 1.32 2002/06/26 21:25:31 ng Exp $
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: #
28: # 2/9,2/13 Guy Albertelli
29: # 6/8 Gerd Kortemeyer
30: # 7/26 H.K. Ng
31: # 8/20 Gerd Kortemeyer
32: # Year 2002
33: # June 2002 H.K. Ng
34: #
35:
36: package Apache::grades;
37: use strict;
38: use Apache::style;
39: use Apache::lonxml;
40: use Apache::lonnet;
41: use Apache::loncommon;
42: use Apache::lonhomework;
43: use Apache::Constants qw(:common);
44:
45: sub moreinfo {
46: my ($request,$reason) = @_;
47: $request->print("Unable to process request: $reason");
48: if ( $Apache::grades::viewgrades eq 'F' ) {
49: $request->print('<form action="/adm/grades" method="post">'."\n");
50: if ($ENV{'form.url'}) {
51: $request->print('<input type="hidden" name="url" value="'.$ENV{'form.url'}.'" />'."\n");
52: }
53: if ($ENV{'form.symb'}) {
54: $request->print('<input type="hidden" name="symb" value="'.$ENV{'form.symb'}.'" />'."\n");
55: }
56: $request->print('<input type="hidden" name="command" value="'.$ENV{'form.command'}.'" />'."\n");
57: $request->print("Student:".'<input type="text" name="student" value="'.$ENV{'form.student'}.'" />'."<br />\n");
58: $request->print("Domain:".'<input type="text" name="domain" value="'.$ENV{'user.domain'}.'" />'."<br />\n");
59: $request->print('<input type="submit" name="submit" value="ReSubmit" />'."<br />\n");
60: $request->print('</form>');
61: }
62: return '';
63: }
64:
65: sub verifyreceipt {
66: my $request=shift;
67: my $courseid=$ENV{'request.course.id'};
68: my $cdom=$ENV{"course.$courseid.domain"};
69: my $cnum=$ENV{"course.$courseid.num"};
70: my $receipt=unpack("%32C*",$Apache::lonnet::perlvar{'lonHostID'}).'-'.
71: $ENV{'form.receipt'};
72: $receipt=~s/[^\-\d]//g;
73: my $symb=$ENV{'form.symb'};
74: unless ($symb) {
75: $symb=&Apache::lonnet::symbread($ENV{'form.url'});
76: }
77: if ((&Apache::lonnet::allowed('mgr',$courseid)) && ($symb)) {
78: $request->print('<h1>Verifying Submission Receipt '.$receipt.'</h1>');
79: my $matches=0;
80: my (%classlist) = &getclasslist($cdom,$cnum,'0');
81: foreach my $student ( sort(@{ $classlist{'allids'} }) ) {
82: my ($uname,$udom)=split(/\:/,$student);
83: if ($receipt eq
84: &Apache::lonnet::ireceipt($uname,$udom,$courseid,$symb)) {
85: $request->print('Matching '.$student.'<br>');
86: $matches++;
87: }
88: }
89: $request->printf('<p>'.$matches." match%s</p>",$matches <= 1 ? '' : 'es');
90: }
91: return '';
92: }
93:
94: sub receiptInput {
95: my ($request) = shift;
96: my $cdom=$ENV{"course.$ENV{'request.course.id'}.domain"};
97: my $cnum=$ENV{"course.$ENV{'request.course.id'}.num"};
98: my $hostver=unpack("%32C*",$Apache::lonnet::perlvar{'lonHostID'});
99: $request->print(<<ENDHEADER);
100: <h2><font color="#339933">Verify a Submission Receipt Issued by this Server</font></h2>
101: <form action="/adm/grades" method="post">
102: <tt>$hostver-<input type="text" name="receipt" size="4"></tt>
103: <input type="submit" name="submit" value="Verify">
104: <input type="hidden" name="command" value="verify">
105: ENDHEADER
106: if ($ENV{'form.url'}) {
107: $request->print(
108: '<input type="hidden" name="url" value="'.$ENV{'form.url'}.'" />');
109: }
110: if ($ENV{'form.symb'}) {
111: $request->print(
112: '<input type="hidden" name="symb" value="'.$ENV{'form.symb'}.'" />');
113: }
114: # $request->print(<<ENDTABLEST);
115: $request->print('</form>');
116: return '';
117: }
118:
119: sub student_gradeStatus {
120: my ($url,$udom,$uname) = @_;
121: my $symb=($ENV{'form.symb'} ne '' ? $ENV{'form.symb'} : (&Apache::lonnet::symbread($url)));
122: my %record= &Apache::lonnet::restore($symb,$ENV{'request.course.id'},$udom,$uname);
123: foreach my $part (&getpartlist($url)) {
124: my ($temp,$part,$type)=split(/_/,$part);
125: if ($type eq 'solved') {
126: my ($status,$foo)=split(/_/,$record{"resource.$part.$type"},2);
127: $status = 'nothing' if ($status eq '');
128: return $type,$status;
129: }
130: }
131: return '';
132: }
133:
134: sub listStudents {
135: my ($request) = shift;
136: my $cdom=$ENV{"course.$ENV{'request.course.id'}.domain"};
137: my $cnum=$ENV{"course.$ENV{'request.course.id'}.num"};
138:
139: $request->print(<<ENDTABLEST);
140: <h2><font color="#339933">Show Student Submissions on Assessment</font></h2>
141:
142: <table border="0"><tr><td bgcolor="#777777">
143: <table border="0">
144: <tr bgcolor="#e6ffff"><td colspan="7"><b>Resource: </b> $ENV{'form.url'}</td></tr>
145: <tr bgcolor="#e6ffff"><td><b>Username</b></td><td><b>Name</b></td><td><b>Domain</b></td>
146: <td><b>View Problem</b></td><td><b>Submissions</b></td>
147: <td><b>Grade Status</b></td><td><b>Action</b></td></tr>
148: ENDTABLEST
149: my (%classlist) = &getclasslist($cdom,$cnum,'0');
150: foreach my $student ( sort(@{ $classlist{'allids'} }) ) {
151: my ($sname,$sdom) = split(/:/,$student);
152:
153: my %name=&Apache::lonnet::get('environment', ['lastname','generation',
154: 'firstname','middlename'],
155: $sdom,$sname);
156: my $fullname;
157: my ($tmp) = keys(%name);
158: if ($tmp !~ /^(con_lost|error|no_such_host)/i) {
159: $fullname=$name{'lastname'}.$name{'generation'};
160: if ($fullname =~ /[^\s]+/) { $fullname.=', '; }
161: $fullname.=$name{'firstname'}.' '.$name{'middlename'};
162: }
163: if ( $Apache::grades::viewgrades eq 'F' ) {
164: $request->print("\n".'<tr bgcolor=#ffffe6>'."<td>$sname</td><td>$fullname</td><td align=\"middle\">$sdom</td>".
165: '<form action="/adm/grades" method="post">');
166: if ($ENV{'form.url'}) {
167: $request->print(
168: '<input type="hidden" name="url" value="'.$ENV{'form.url'}.'" />');
169: }
170: if ($ENV{'form.symb'}) {
171: $request->print(
172: '<input type="hidden" name="symb" value="'.$ENV{'form.symb'}.'" />');
173: }
174: $request->print(
175: '<input type="hidden" name="command" value="'.$ENV{'form.command'}.'" />');
176: $request->print(
177: '<input type="hidden" name="student" value="'.$sname.'" />');
178: $request->print(
179: '<input type="hidden" name="fullname" value="'.$fullname.'" />');
180: $request->print(
181: '<input type="hidden" name="domain" value="'.$sdom.'" />');
182: $request->print('<td>'.
183: '<input type="radio" name="vProb" value="no" checked> no '.
184: '<input type="radio" name="vProb" value="yes"> yes </td>');
185: $request->print('<td>'.
186: '<input type="radio" name="submission" value="last" checked> last '.
187: '<input type="radio" name="submission" value="all"> all </td>');
188: my ($type,$status) = &student_gradeStatus($ENV{'form.url'},$cdom,$sname);
189: $request->print(
190: '<td align="middle">'.$status.' </td>');
191: $request->print(
192: '<td><input type="submit" name="submit" value="View/Grade" />');
193: $request->print('</td></tr></form>');
194: # $request->print('</form></td></tr>');
195: }
196: }
197: $request->print('</table></td></tr></table>');
198: }
199:
200:
201: #FIXME - needs to handle multiple matches
202: sub finduser {
203: my ($name) = @_;
204: my $domain = '';
205:
206: if ( $Apache::grades::viewgrades eq 'F' ) {
207: #get classlist
208: my ($cdom,$cnum) = split(/_/,$ENV{'request.course.id'});
209: #print "Found $cdom:$cnum<br />";
210: my (%classlist) = &getclasslist($cdom,$cnum,'0');
211: foreach my $student ( sort(@{ $classlist{'allids'} }) ) {
212: my ($posname,$posdomain) = split(/:/,$student);
213: if ($posname =~ $name) { $name=$posname; $domain=$posdomain; last; }
214: }
215: return ($name,$domain);
216: } else {
217: return ($ENV{'user.name'},$ENV{'user.domain'});
218: }
219: }
220:
221: sub getclasslist {
222: my ($coursedomain,$coursenum,$hideexpired) = @_;
223: my %classlist=&Apache::lonnet::dump('classlist',$coursedomain,$coursenum);
224: my $now = time;
225: foreach my $student (keys(%classlist)) {
226: my ($end,$start)=split(/:/,$classlist{$student});
227: # still a student?
228: if (($hideexpired) && ($end) && ($end < $now)) {
229: #print "Skipping:$name:$end:$now<br />\n";
230: next;
231: }
232: #print "record=$record<br>";
233: push( @{ $classlist{'allids'} }, $student);
234: }
235: return (%classlist);
236: }
237:
238: sub getpartlist {
239: my ($url) = @_;
240: my @parts =();
241: my (@metakeys) = split(/,/,&Apache::lonnet::metadata($url,'keys'));
242: foreach my $key (@metakeys) {
243: if ( $key =~ m/stores_([0-9]+)_.*/) {
244: push(@parts,$key);
245: }
246: }
247: return @parts;
248: }
249:
250: sub viewstudentgrade {
251: my ($url,$symb,$courseid,$student,@parts) = @_;
252: my $result ='';
253: my $cellclr = '"#ffffdd"';
254: my ($username,$domain) = split(/:/,$student);
255:
256: my (@requests) = ('lastname','firstname','middlename','generation');
257: my (%name) = &Apache::lonnet::get('environment',\@requests,$domain,$username);
258: my %record=&Apache::lonnet::restore($symb,$courseid,$domain,$username);
259:
260: my $fullname=$name{'lastname'}.$name{'generation'};
261: if ($fullname =~ /[^\s]+/) { $fullname.=', '; }
262: $fullname.=$name{'firstname'}.' '.$name{'middlename'};
263:
264: $result.="<tr bgcolor=$cellclr><td>$username</td><td>$fullname</td><td align=\"middle\">$domain</td>\n";
265: foreach my $part (@parts) {
266: my ($temp,$part,$type)=split(/_/,$part);
267: my $score=$record{"resource.$part.$type"};
268: if ($type eq 'awarded' || $type eq 'tries') {
269: $result.='<td align="middle"><input type="text" name="GRADE.'.$student.'.'.$part.'.'.$type.
270: '" value="'.$score.'" size="4" /></td>'."\n";
271: } elsif ($type eq 'solved') {
272: my ($status,$foo)=split(/_/,$score,2);
273: $result.="<td align=\"middle\"><select name=\"GRADE.$student.$part.$type\">\n";
274: my $optsel = '<option>correct</option><option>incorrect</option><option>excused</option>'.
275: '<option>ungraded</option><option>handgraded</option><option>nothing</option>'."\n";
276: $status = 'nothing' if ($status eq '');
277: $optsel =~ s/<option>$status/<option selected="on">$status/;
278: $result.=$optsel;
279: $result.="</select></td>\n";
280: }
281: }
282: $result.='<td></td></tr>';
283: return $result;
284: }
285:
286: #FIXME need to look at the metadata <stores> spec on what type of data to accept and provide an
287: #interface based on that, also do that to above function.
288: sub setstudentgrade {
289: my ($url,$symb,$courseid,$student,@parts) = @_;
290:
291: my $result ='';
292: my ($stuname,$domain) = split(/:/,$student);
293: my %record=&Apache::lonnet::restore($symb,$courseid,$domain,$stuname);
294: my %newrecord;
295:
296: foreach my $part (@parts) {
297: my ($temp,$part,$type)=split(/_/,$part);
298: my $oldscore=$record{"resource.$part.$type"};
299: my $newscore=$ENV{"form.GRADE.$student.$part.$type"};
300: print "old=$oldscore:new=$newscore:<br>";
301: if ($type eq 'solved') {
302: my $update=0;
303: if ($newscore eq 'nothing' ) {
304: if ($oldscore ne '') {
305: $update=1;
306: $newscore = '';
307: }
308: } elsif ($oldscore !~ m/^$newscore/) {
309: $update=1;
310: $result.="Updating $stuname to $newscore<br />\n";
311: if ($newscore eq 'correct') { $newscore = 'correct_by_override'; }
312: if ($newscore eq 'incorrect') { $newscore = 'incorrect_by_override'; }
313: if ($newscore eq 'excused') { $newscore = 'excused'; }
314: if ($newscore eq 'ungraded') { $newscore = 'ungraded_attempted'; }
315: } else {
316: #$result.="$stuname:$part:$type:unchanged $oldscore to $newscore:<br />\n";
317: }
318: if ($update) { $newrecord{"resource.$part.$type"}=$newscore; }
319: } else {
320: if ($oldscore ne $newscore) {
321: $newrecord{"resource.$part.$type"}=$newscore;
322: $result.="Updating $student"."'s status for $part.$type to $newscore<br />\n";
323: } else {
324: #$result.="$stuname:$part:$type:unchanged $oldscore to $newscore:<br />\n";
325: }
326: }
327: }
328: if ( scalar(keys(%newrecord)) > 0 ) {
329: $newrecord{'resource.regrader'}="$ENV{'user.name'}:$ENV{'user.domain'}";
330: print "grader=$newrecord{'resource.regrader'}:<br>records<br>";
331: while (my ($k,$v) = each %newrecord) {
332: print "k=$k:v=$v:<br>\n";
333: }
334: &Apache::lonnet::cstore(\%newrecord,$symb,$courseid,$domain,$stuname);
335:
336: $result.="Stored away ".scalar(keys(%newrecord))." elements.<br />\n";
337: }
338: return $result;
339: }
340:
341: # --------------------------- show submissions of a student, option to grade --------
342: #
343: sub submission {
344: my ($request) = @_;
345: $request->print(<<JAVASCRIPT);
346: <script type="text/javascript" language="javascript">
347: function updateRadio() {
348: var pts = document.SCORE.GRADE_BOX.value;
349: var radioButton = document.SCORE.radval;
350: var checked =true;
351: var unchecked=false;
352: var resetbox =false;
353: if (isNaN(pts) || pts < 0) {
354: alert("A number equal or greater than 0 is expected. Entered value = "+pts);
355: for (var i=0; i<radioButton.length; i++) {
356: if (radioButton[i].checked) {
357: document.SCORE.GRADE_BOX.value = i;
358: resetbox = true;
359: }
360: }
361: if (!resetbox) {
362: document.SCORE.GRADE_BOX.value = "";
363: }
364: return;
365: }
366:
367: for (var i=0; i<radioButton.length; i++) {
368: radioButton[i].checked=unchecked;
369: if (pts == i) {
370: radioButton[i].checked=checked;
371: }
372: }
373: }
374:
375: </script>
376: JAVASCRIPT
377: my $url=$ENV{'form.url'};
378: $url=~s-^http://($ENV{'SERVER_NAME'}|$ENV{'HTTP_HOST'})--;
379: if ($ENV{'form.student'} eq '') { &moreinfo($request,"Need student login id"); return ''; }
380: my ($uname,$udom) = &finduser($ENV{'form.student'});
381: if ($uname eq '') { &moreinfo($request,"Unable to find student"); return ''; }
382:
383: my $symb=($ENV{'form.symb'} ne '' ? $ENV{'form.symb'} : (&Apache::lonnet::symbread($url)));
384: if ($symb eq '') { $request->print("Unable to handle ambiguous references:$url:."); return ''; }
385: #
386: # header info
387: my $result='<h2><font color="#339933">Submission Record</font></h2>';
388: $result.='<table border="0"><tr><td><b>Username: </b>'.$uname.'</td><td><b>Fullname: </b>'.$ENV{'form.fullname'}.'</td><td><b>Domain: </b>'.$udom.'</td></tr>';
389: $result.='<tr><td colspan=3><b>Resource: </b>'.$url.'</td></tr></table>';
390: #
391: # option to display problem
392: if ($ENV{'form.vProb'} eq 'yes') {
393: my $rendered=&Apache::loncommon::get_student_view($symb,$uname,$udom,
394: $ENV{'request.course.id'});
395: my $companswer=&Apache::loncommon::get_student_answers($symb,$uname,$udom,
396: $ENV{'request.course.id'});
397: $result.='<table border="0"><tr><td bgcolor="#777777">';
398: $result.='<table border="0"><tr><td bgcolor="#e6ffff">';
399: $result.='<b>Student\'s view of the problem</b></td></tr><tr><td bgcolor="#ffffff">'.$rendered.'<br />';
400: $result.='<b>Correct answer:</b><br />'.$companswer;
401: $result.='</td></tr></table>';
402: $result.='</td></tr></table><br />';
403: }
404: my $last = '';
405: $last = 'last' if ($ENV{'form.submission'} eq 'last');
406: my $answer=&Apache::loncommon::get_previous_attempt($symb,$uname,$udom,
407: $ENV{'request.course.id'},$last);
408: $result.=$answer;
409:
410: my $wgt = &Apache::lonnet::EXT('resource.partid.weight',$symb,$udom,$uname);
411: my %record= &Apache::lonnet::restore($symb,$ENV{'request.course.id'},$udom,$uname);
412: my $score = $record{'resource.0.awarded'}*$wgt;
413:
414: $result.= '<form action="/adm/grades" method="post" name="SCORE">'."\n".
415: '<input type="hidden" name="symb" value="'.$symb.'" />'."\n".
416: '<input type="hidden" name="url" value="'.$url.'" />'."\n".
417: '<input type="hidden" name="command" value="handgrade" />'."\n";
418:
419: $result.='<table border="0"><tr><td><b>Points</b></td><td>';
420: my $ctr = 0;
421: while ($ctr<=$wgt) {
422: $result.= '<input type="radio" name="radval" '.
423: # 'onclick="javascript:writeBox(\'GRADE_'.$ENV{'form.student'}.'\',\''.$ctr.'\')" '.
424: 'onclick="javascript:SCORE.GRADE_BOX.value='.$ctr.'" '.
425: ($score == $ctr? 'checked':'').' /> '.$ctr."\n";
426: $ctr++;
427: }
428: $result.='</td><td> <b>or</b> </td>';
429: $result.='<td><input type="text" name="GRADE_BOX"'.
430: ($score ne ''? ' value = "'.$score.'"':'').' size="4" '.
431: 'onChange="javascript:updateRadio()" /></td>'."\n";
432: $result.='<td>/'.$wgt.' (problem weight)</td></tr>';
433:
434: $result.='<input type="hidden" name="GRADE_'.$uname.':'.$udom.'" value="handgraded" />'."\n";
435: $result.='<tr><td colspan="5"><input type="submit" name="gradeOpt" value="Save & Next" /> ';
436: $result.='<input type="submit" name="gradeOpt" value="Next" /> ';
437: $result.='<input type="submit" name="gradeOpt" value="Previous" /> ';
438: $result.='</td><tr></table></form>';
439: return $result;
440: }
441:
442: sub processHandGrade {
443: my ($url,$symb,$courseid,$student,@parts) = @_;
444:
445: my ($stuname,$domain) = split(/:/,$student);
446: my %record=&Apache::lonnet::restore($symb,$courseid,$domain,$stuname);
447: my %newrecord;
448:
449: foreach my $part (@parts) {
450: my ($temp,$part,$type)=split(/_/,$part);
451: my $oldscore=$record{"resource.$part.$type"};
452: my $newscore=($ENV{'form.GRADE_BOX'} ne '' ? $ENV{"form.GRADE_BOX"} : $ENV{'form.radval'});
453: if ($type eq 'solved') {
454: my $update=0;
455: if ($newscore eq 'nothing' ) {
456: if ($oldscore ne '') {
457: $update=1;
458: $newscore = '';
459: }
460: } elsif ($oldscore !~ m/^$newscore/) {
461: $update=1;
462: if ($newscore eq 'correct') { $newscore = 'correct_by_override'; }
463: if ($newscore eq 'incorrect') { $newscore = 'incorrect_by_override'; }
464: if ($newscore eq 'excused') { $newscore = 'excused'; }
465: if ($newscore eq 'ungraded') { $newscore = 'ungraded_attempted'; }
466: if ($newscore eq 'handgraded') { $newscore = 'handgraded_by_grader'; }
467: }
468: if ($update) { $newrecord{"resource.$part.$type"}=$newscore; }
469: } else {
470: if ($oldscore ne $newscore) {
471: $newrecord{"resource.$part.$type"}=$newscore;
472: }
473: }
474: if ( scalar(keys(%newrecord)) > 0 ) {
475: $newrecord{'resource.regrader'}="$ENV{'user.name'}:$ENV{'user.domain'}";
476: print "grader=$newrecord{'resource.regrader'}:<br>records<br>";
477: while (my ($k,$v) = each %newrecord) {
478: print "k=$k:v=$v:<br>\n";
479: }
480: &Apache::lonnet::cstore(\%newrecord,$symb,$courseid,$domain,$stuname);
481: }
482: return '';
483: }
484:
485: sub get_symb_and_url {
486: my ($request) = @_;
487: my $url=$ENV{'form.url'};
488: $url=~s-^http://($ENV{'SERVER_NAME'}|$ENV{'HTTP_HOST'})--;
489: # my $symb=$ENV{'form.symb'};
490: # if (!$symb) { $symb=&Apache::lonnet::symbread($url); }
491: my $symb=($ENV{'form.symb'} ne '' ? $ENV{'form.symb'} : (&Apache::lonnet::symbread($url)));
492: if ($symb eq '') { $request->print("Unable to handle ambiguous references:$url:."); return ''; }
493: return ($symb,$url);
494: }
495:
496: sub view_edit_entire_class_form {
497: my ($symb,$url)=@_;
498: my $result.='<form action="/adm/grades" method="post">'."\n".
499: '<input type="hidden" name="symb" value="'.$symb.'" />'."\n".
500: '<input type="hidden" name="url" value="'.$url.'" />'."\n".
501: '<input type="hidden" name="command" value="viewgrades" />'."\n".
502: '<input type="submit" name="submit" value="View/Grade Entire Class" />'."\n".
503: '</form>'."\n";
504: return $result;
505: }
506:
507: sub show_grading_menu_form {
508: my ($symb,$url)=@_;
509: my $result.='<form action="/adm/grades" method="post">'."\n".
510: '<input type="hidden" name="symb" value="'.$symb.'" />'."\n".
511: '<input type="hidden" name="url" value="'.$url.'" />'."\n".
512: '<input type="hidden" name="command" value="gradingmenu" />'."\n".
513: '<input type="submit" name="submit" value="Grading Menu" />'."\n".
514: '</form>'."\n";
515: return $result;
516: }
517:
518: sub gradingmenu {
519: my ($request) = @_;
520: my ($symb,$url)=&get_symb_and_url($request);
521: if (!$symb) {return '';}
522:
523: my $result='<h2> <font color="#339933">Select a Grading Method</font></h2><br />';
524: $result.='<table width=100% border=0><tr><td bgcolor=#777777>'."\n";
525: $result.='<table width=100% border=0><tr><td bgcolor=#e6ffff>'."\n";
526: $result.=' <b>Resource :</b> '.$url.'</td></tr>'."\n";
527: $result.='<tr bgcolor=#ffffe6><td>'."\n";
528: $result.=&view_edit_entire_class_form($symb,$url);
529: $result.='<form action="/adm/grades" method="post">'."\n".
530: '<input type="hidden" name="symb" value="'.$symb.'" />'."\n".
531: '<input type="hidden" name="url" value="'.$url.'" />'."\n".
532: '<input type="hidden" name="command" value="csvupload" />'."\n".
533: '<input type="submit" name="submit" value="Upload Scores" />'."\n".
534: '</form>'."\n";
535: $result.='<form action="/adm/grades" method="post">'."\n".
536: '<input type="hidden" name="symb" value="'.$symb.'" />'."\n".
537: '<input type="hidden" name="url" value="'.$url.'" />'."\n".
538: '<input type="hidden" name="command" value="submission" />'."\n".
539: '<input type="submit" name="submit" value="View/Grade A Student" />'."\n".
540: '</form>'."\n";
541: $result.='<form action="/adm/grades" method="post">'."\n".
542: '<input type="hidden" name="symb" value="'.$symb.'" />'."\n".
543: '<input type="hidden" name="url" value="'.$url.'" />'."\n".
544: '<input type="hidden" name="command" value="receiptInput" />'."\n".
545: '<input type="submit" name="submit" value="Verify Receipt" />'."\n".
546: '</form>'."\n";
547: $result.='</td></tr></table>'."\n";
548: $result.='</td></tr></table>'."\n";
549: return $result;
550: }
551:
552: sub viewgrades {
553: my ($request) = @_;
554: my $result='';
555:
556: #get resource reference
557: my ($symb,$url)=&get_symb_and_url($request);
558: if (!$symb) {return '';}
559: #get classlist
560: my ($cdom,$cnum) = split(/_/,$ENV{'request.course.id'});
561: #print "Found $cdom:$cnum<br />";
562: my (%classlist) = &getclasslist($cdom,$cnum,'0');
563: my $headerclr = '"#ccffff"';
564: my $cellclr = '"#ffffcc"';
565:
566: #get list of parts for this problem
567: my (@parts) = sort(&getpartlist($url));
568:
569: $request->print ("<h2><font color=\"#339933\">Manual Grading</font></h2>");
570:
571: #start the form
572: $result = '<form action="/adm/grades" method="post">'."\n".
573: '<input type="hidden" name="symb" value="'.$symb.'" />'."\n".
574: '<input type="hidden" name="url" value="'.$url.'" />'."\n".
575: '<input type="hidden" name="command" value="editgrades" />'."\n".
576: '<input type="submit" name="submit" value="Submit Changes" />'."\n".
577: '<table border=0><tr><td bgcolor="#777777">'."\n".
578: '<table border=0>'."\n".
579: '<tr bgcolor='.$headerclr.'><td><b>Username</b></td><td><b>Name</b></td><td><b>Domain</b></td>'."\n";
580: foreach my $part (@parts) {
581: my $display=&Apache::lonnet::metadata($url,$part.'.display');
582: if (!$display) { $display = &Apache::lonnet::metadata($url,$part.'.name'); }
583: print "Manual grading:$url:$part:$display:<br>";
584: $result.='<td><b>'.$display.'</b></td>'."\n";
585: }
586: $result.='</tr>';
587: #get info for each student
588: foreach my $student ( sort(@{ $classlist{'allids'} }) ) {
589: my $display=&viewstudentgrade($url,$symb,$ENV{'request.course.id'},$student,@parts);
590: # print "ID=$ENV{'request.course.id'}:STU=$student:DIS=$display:<br>\n";
591: $result.=&viewstudentgrade($url,$symb,$ENV{'request.course.id'},$student,@parts);
592: }
593: $result.='</table></td></tr></table>';
594: $result.='<input type="submit" name="submit" value="Submit Changes" /></form>';
595: $result.=&show_grading_menu_form($symb,$url);
596: return $result;
597: }
598:
599: sub editgrades {
600: my ($request) = @_;
601: my $result='';
602:
603: my $symb=$ENV{'form.symb'};
604: if ($symb eq '') { $request->print("Unable to handle ambiguous references:$symb:$ENV{'form.url'}"); return ''; }
605: my $url=$ENV{'form.url'};
606: #get classlist
607: my ($cdom,$cnum) = split(/_/,$ENV{'request.course.id'});
608: #print "Found $cdom:$cnum<br />";
609: my (%classlist) = &getclasslist($cdom,$cnum,'0');
610:
611: #get list of parts for this problem
612: my (@parts) = &getpartlist($url);
613:
614: $result.='<form action="/adm/grades" method="post">'."\n".
615: '<input type="hidden" name="symb" value="'.$symb.'" />'."\n".
616: '<input type="hidden" name="url" value="'.$url.'" />'."\n".
617: '<input type="hidden" name="command" value="viewgrades" />'."\n".
618: '<input type="submit" name="submit" value="See Grades" /> <br />'."\n";
619:
620: foreach my $student ( sort(@{ $classlist{'allids'} }) ) {
621: $result.=&setstudentgrade($url,$symb,$ENV{'request.course.id'},$student,@parts);
622: }
623:
624: $result.='<input type="submit" name="submit" value="See Grades" /></table></form>';
625: return $result;
626: }
627:
628: sub csvupload {
629: my ($request)= @_;
630: my $result;
631: my ($symb,$url)=&get_symb_and_url($request);
632: if (!$symb) {return '';}
633: my $upfile_select=&Apache::loncommon::upfile_select_html();
634: $result.=<<ENDUPFORM;
635: <form method="post" enctype="multipart/form-data" action="/adm/grades" name="gradesupload">
636: <input type="hidden" name="symb" value="$symb" />
637: <input type="hidden" name="url" value="$url" />
638: <input type="hidden" name="command" value="csvuploadmap" />
639: <hr />
640: <h3>Specify a file containing the class grades for resource $url</h3>
641: $upfile_select
642: <p><input type="submit" name="submit" value="Upload Grades" />
643: ENDUPFORM
644: return $result;
645: }
646:
647: sub csvupload_javascript_reverse_associate {
648: return(<<ENDPICK);
649: function verify(vf) {
650: var foundsomething=0;
651: var founduname=0;
652: var founddomain=0;
653: for (i=0;i<=vf.nfields.value;i++) {
654: tw=eval('vf.f'+i+'.selectedIndex');
655: if (i==0 && tw!=0) { founduname=1; }
656: if (i==1 && tw!=0) { founddomain=1; }
657: if (i!=0 && i!=1 && tw!=0) { foundsomething=1; }
658: }
659: if (founduname==0 || founddomain==0) {
660: alert('You need to specify at both the username and domain');
661: return;
662: }
663: if (foundsomething==0) {
664: alert('You need to specify at least one grading field');
665: return;
666: }
667: vf.submit();
668: }
669: function flip(vf,tf) {
670: var nw=eval('vf.f'+tf+'.selectedIndex');
671: var i;
672: for (i=0;i<=vf.nfields.value;i++) {
673: //can not pick the same destination field for both name and domain
674: if (((i ==0)||(i ==1)) &&
675: ((tf==0)||(tf==1)) &&
676: (i!=tf) &&
677: (eval('vf.f'+i+'.selectedIndex')==nw)) {
678: eval('vf.f'+i+'.selectedIndex=0;')
679: }
680: }
681: }
682: ENDPICK
683: }
684:
685: sub csvupload_javascript_forward_associate {
686: return(<<ENDPICK);
687: function verify(vf) {
688: var foundsomething=0;
689: var founduname=0;
690: var founddomain=0;
691: for (i=0;i<=vf.nfields.value;i++) {
692: tw=eval('vf.f'+i+'.selectedIndex');
693: if (tw==1) { founduname=1; }
694: if (tw==2) { founddomain=1; }
695: if (tw>2) { foundsomething=1; }
696: }
697: if (founduname==0 || founddomain==0) {
698: alert('You need to specify at both the username and domain');
699: return;
700: }
701: if (foundsomething==0) {
702: alert('You need to specify at least one grading field');
703: return;
704: }
705: vf.submit();
706: }
707: function flip(vf,tf) {
708: var nw=eval('vf.f'+tf+'.selectedIndex');
709: var i;
710: //can not pick the same destination field twice
711: for (i=0;i<=vf.nfields.value;i++) {
712: if ((i!=tf) && (eval('vf.f'+i+'.selectedIndex')==nw)) {
713: eval('vf.f'+i+'.selectedIndex=0;')
714: }
715: }
716: }
717: ENDPICK
718: }
719:
720: sub csvuploadmap_header {
721: my ($request,$symb,$url,$datatoken,$distotal)= @_;
722: my $result;
723: my $javascript;
724: if ($ENV{'form.upfile_associate'} eq 'reverse') {
725: $javascript=&csvupload_javascript_reverse_associate();
726: } else {
727: $javascript=&csvupload_javascript_forward_associate();
728: }
729: $request->print(<<ENDPICK);
730: <form method="post" enctype="multipart/form-data" action="/adm/grades" name="gradesupload">
731: <h3>Uploading Class Grades for resource $url</h3>
732: <hr>
733: <h3>Identify fields</h3>
734: Total number of records found in file: $distotal <hr />
735: Enter as many fields as you can. The system will inform you and bring you back
736: to this page if the data selected is insufficient to run your class.<hr />
737: <input type="button" value="Reverse Association" onClick="javascript:this.form.associate.value='Reverse Association';submit(this.form);" />
738: <input type="hidden" name="associate" value="" />
739: <input type="hidden" name="phase" value="three" />
740: <input type="hidden" name="datatoken" value="$datatoken" />
741: <input type="hidden" name="fileupload" value="$ENV{'form.fileupload'}" />
742: <input type="hidden" name="upfiletype" value="$ENV{'form.upfiletype'}" />
743: <input type="hidden" name="upfile_associate"
744: value="$ENV{'form.upfile_associate'}" />
745: <input type="hidden" name="symb" value="$symb" />
746: <input type="hidden" name="url" value="$url" />
747: <input type="hidden" name="command" value="csvuploadassign" />
748: <hr />
749: <script type="text/javascript" language="Javascript">
750: $javascript
751: </script>
752: ENDPICK
753: return '';
754:
755: }
756:
757: sub csvupload_fields {
758: my ($url) = @_;
759: my (@parts) = &getpartlist($url);
760: my @fields=(['username','Student Username'],['domain','Student Domain']);
761: foreach my $part (sort(@parts)) {
762: my @datum;
763: my $display=&Apache::lonnet::metadata($url,$part.'.display');
764: my $name=$part;
765: if (!$display) { $display = $name; }
766: @datum=($name,$display);
767: push(@fields,\@datum);
768: }
769: return (@fields);
770: }
771:
772: sub csvuploadmap_footer {
773: my ($request,$i,$keyfields) =@_;
774: $request->print(<<ENDPICK);
775: </table>
776: <input type="hidden" name="nfields" value="$i" />
777: <input type="hidden" name="keyfields" value="$keyfields" />
778: <input type="button" onClick="javascript:verify(this.form)" value="Assign Grades" /><br />
779: </form>
780: ENDPICK
781: }
782:
783: sub csvuploadmap {
784: my ($request)= @_;
785: my ($symb,$url)=&get_symb_and_url($request);
786: if (!$symb) {return '';}
787: my $datatoken;
788: if (!$ENV{'form.datatoken'}) {
789: $datatoken=&Apache::loncommon::upfile_store($request);
790: } else {
791: $datatoken=$ENV{'form.datatoken'};
792: &Apache::loncommon::load_tmp_file($request);
793: }
794: my @records=&Apache::loncommon::upfile_record_sep();
795: &csvuploadmap_header($request,$symb,$url,$datatoken,$#records+1);
796: my $i;
797: my $keyfields;
798: if (@records) {
799: my @fields=&csvupload_fields($url);
800: if ($ENV{'form.upfile_associate'} eq 'reverse') {
801: &Apache::loncommon::csv_print_samples($request,\@records);
802: $i=&Apache::loncommon::csv_print_select_table($request,\@records,
803: \@fields);
804: foreach (@fields) { $keyfields.=$_->[0].','; }
805: chop($keyfields);
806: } else {
807: unshift(@fields,['none','']);
808: $i=&Apache::loncommon::csv_samples_select_table($request,\@records,
809: \@fields);
810: my %sone=&Apache::loncommon::record_sep($records[0]);
811: $keyfields=join(',',sort(keys(%sone)));
812: }
813: }
814: &csvuploadmap_footer($request,$i,$keyfields);
815: return '';
816: }
817:
818: sub csvuploadassign {
819: my ($request)= @_;
820: my ($symb,$url)=&get_symb_and_url($request);
821: if (!$symb) {return '';}
822: &Apache::loncommon::load_tmp_file($request);
823: my @gradedata=&Apache::loncommon::upfile_record_sep();
824: my @keyfields = split(/\,/,$ENV{'form.keyfields'});
825: my %fields=();
826: for (my $i=0; $i<=$ENV{'form.nfields'}; $i++) {
827: if ($ENV{'form.upfile_associate'} eq 'reverse') {
828: if ($ENV{'form.f'.$i} ne 'none') {
829: $fields{$keyfields[$i]}=$ENV{'form.f'.$i};
830: }
831: } else {
832: if ($ENV{'form.f'.$i} ne 'none') {
833: $fields{$ENV{'form.f'.$i}}=$keyfields[$i];
834: }
835: }
836: }
837: $request->print('<h3>Assigning Grades</h3>');
838: my $courseid=$ENV{'request.course.id'};
839: my $cdom=$ENV{"course.$courseid.domain"};
840: my $cnum=$ENV{"course.$courseid.num"};
841: my (%classlist) = &getclasslist($cdom,$cnum,'1');
842: my @skipped;
843: my $countdone=0;
844: foreach my $grade (@gradedata) {
845: my %entries=&Apache::loncommon::record_sep($grade);
846: my $username=$entries{$fields{'username'}};
847: my $domain=$entries{$fields{'domain'}};
848: if (!exists($classlist{"$username:$domain"})) {
849: push(@skipped,"$username:$domain");
850: next;
851: }
852: my %grades;
853: foreach my $dest (keys(%fields)) {
854: if ($dest eq 'username' || $dest eq 'domain') { next; }
855: if ($entries{$fields{$dest}} eq '') { next; }
856: my $store_key=$dest;
857: $store_key=~s/^stores/resource/;
858: $store_key=~s/_/\./g;
859: $grades{$store_key}=$entries{$fields{$dest}};
860: }
861: $grades{"resource.regrader"}="$ENV{'user.name'}:$ENV{'user.domain'}";
862: &Apache::lonnet::cstore(\%grades,$symb,$ENV{'request.course.id'},
863: $domain,$username);
864: $request->print('.');
865: $request->rflush();
866: $countdone++;
867: }
868: $request->print("<br />Stored $countdone students\n");
869: if (@skipped) {
870: $request->print('<br /><font size="+1"><b>Skipped Students</b></font><br />');
871: foreach my $student (@skipped) { $request->print("<br />$student"); }
872: }
873: $request->print(&view_edit_entire_class_form($symb,$url));
874: $request->print(&show_grading_menu_form($symb,$url));
875: return '';
876: }
877:
878: sub send_header {
879: my ($request)= @_;
880: $request->print(&Apache::lontexconvert::header());
881: # $request->print("
882: #<script>
883: #remotewindow=open('','homeworkremote');
884: #remotewindow.close();
885: #</script>");
886: $request->print('<body bgcolor="#FFFFFF">');
887: }
888:
889: sub send_footer {
890: my ($request)= @_;
891: $request->print('</body>');
892: $request->print(&Apache::lontexconvert::footer());
893: }
894:
895: sub handler {
896: my $request=$_[0];
897:
898: if ($ENV{'browser.mathml'}) {
899: $request->content_type('text/xml');
900: } else {
901: $request->content_type('text/html');
902: }
903: $request->send_http_header;
904: return OK if $request->header_only;
905: &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'});
906: my $url=$ENV{'form.url'};
907: my $symb=$ENV{'form.symb'};
908: my $command=$ENV{'form.command'};
909: if (!$url) {
910: my ($temp1,$temp2);
911: ($temp1,$temp2,$ENV{'form.url'})=split(/___/,$symb);
912: $url = $ENV{'form.url'};
913: }
914: &send_header($request);
915: if ($url eq '' && $symb eq '') {
916: if ($ENV{'user.adv'}) {
917: if (($ENV{'form.codeone'}) && ($ENV{'form.codetwo'}) &&
918: ($ENV{'form.codethree'})) {
919: my $token=$ENV{'form.codeone'}.'*'.$ENV{'form.codetwo'}.'*'.
920: $ENV{'form.codethree'};
921: my ($tsymb,$tuname,$tudom,$tcrsid)=
922: &Apache::lonnet::checkin($token);
923: if ($tsymb) {
924: my ($map,$id,$url)=split(/\_\_\_/,$tsymb);
925: if (&Apache::lonnet::allowed('mgr',$tcrsid)) {
926: $request->print(
927: &Apache::lonnet::ssi('/res/'.$url,
928: ('grade_username' => $tuname,
929: 'grade_domain' => $tudom,
930: 'grade_courseid' => $tcrsid,
931: 'grade_symb' => $tsymb)));
932: } else {
933: $request->print('<h1>Not authorized: '.$token.'</h1>');
934: }
935: } else {
936: $request->print('<h1>Not a valid DocID: '.$token.'</h1>');
937: }
938: } else {
939: $request->print(&Apache::lonxml::tokeninputfield());
940: }
941: }
942: } else {
943: #&Apache::lonhomework::showhashsubset(\%ENV,'^form');
944: $Apache::grades::viewgrades=&Apache::lonnet::allowed('vgr',$ENV{'request.course.id'});
945: if ($command eq 'submission') {
946: &listStudents($request) if ($ENV{'form.student'} eq '');
947: $request->print(&submission($request)) if ($ENV{'form.student'} ne '');
948: } elsif ($command eq 'gradingmenu') {
949: $request->print(&gradingmenu($request));
950: } elsif ($command eq 'viewgrades') {
951: $request->print(&viewgrades($request));
952: } elsif ($command eq 'editgrades') {
953: $request->print(&editgrades($request));
954: } elsif ($command eq 'verify') {
955: $request->print(&verifyreceipt($request));
956: } elsif ($command eq 'csvupload') {
957: $request->print(&csvupload($request));
958: } elsif ($command eq 'csvuploadmap') {
959: $request->print(&csvuploadmap($request));
960: } elsif ($command eq 'receiptInput') {
961: &receiptInput($request);
962: } elsif ($command eq 'csvuploadassign') {
963: if ($ENV{'form.associate'} ne 'Reverse Association') {
964: $request->print(&csvuploadassign($request));
965: } else {
966: if ( $ENV{'form.upfile_associate'} ne 'reverse' ) {
967: $ENV{'form.upfile_associate'} = 'reverse';
968: } else {
969: $ENV{'form.upfile_associate'} = 'forward';
970: }
971: $request->print(&csvuploadmap($request));
972: }
973: } else {
974: $request->print("Unknown action: $command:");
975: }
976: }
977: &send_footer($request);
978: return OK;
979: }
980:
981: 1;
982:
983: __END__;
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/back.gif){kind=icon}
Return to grades.pm CVS log ![[TXT]](/icons/text.gif){kind=icon}
![[DIR]](/icons/dir.gif){kind=icon}
Up to [LON-CAPA] / loncom / homework