1: # The LearningOnline Network with CAPA
2: # The LON-CAPA Grading handler
3: #
4: # $Id: grades.pm,v 1.24 2002/05/15 23:47:49 albertel 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:
33: package Apache::grades;
34: use strict;
35: use Apache::style;
36: use Apache::lonxml;
37: use Apache::lonnet;
38: use Apache::loncommon;
39: use Apache::lonhomework;
40: use Apache::Constants qw(:common);
41:
42: sub moreinfo {
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");
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");
57: $request->print('</form>');
58: }
59: return '';
60: }
61:
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;
77: my (%classlist) = &getclasslist($cdom,$cnum,'0');
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: }
90:
91: sub listStudents {
92: my ($request) = shift;
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);
97: <h1>Verify a Submission Receipt Issued by this Server</h1>
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>
113: <h1>Show Student Submissions on Assessment</h1>
114: <table border="1">
115: <tr><th>Username</th><th>Domain</th><th>Name</th><th> </th></tr>
116: ENDTABLEST
117: my (%classlist) = &getclasslist($cdom,$cnum,'0');
118: foreach my $student ( sort(@{ $classlist{'allids'} }) ) {
119: my ($sname,$sdom) = split(/:/,$student);
120:
121: my $reply=&Apache::lonnet::reply('get:'.$sdom.':'.$sname.
122: ':environment:lastname&generation&firstname&middlename',
123: &Apache::lonnet::homeserver($sname,$sdom));
124: #print "reply=$reply<br>";
125: my (@nameparts) = split /&/,$reply;
126: # my $sfullname = $Apache::lonnet::unescape($nameparts[0]);
127:
128: if ( $Apache::grades::viewgrades eq 'F' ) {
129: $request->print("\n".'<tr>'."<td>$sname</td><td>$sdom</td><td>@nameparts</td><td>".
130: '<form action="/adm/grades" method="post">');
131: if ($ENV{'form.url'}) {
132: $request->print(
133: '<input type="hidden" name="url" value="'.$ENV{'form.url'}.'" />');
134: }
135: if ($ENV{'form.symb'}) {
136: $request->print(
137: '<input type="hidden" name="symb" value="'.$ENV{'form.symb'}.'" />');
138: }
139: $request->print(
140: '<input type="hidden" name="command" value="'.$ENV{'form.command'}.'" />');
141: $request->print(
142: '<input type="hidden" name="student" value="'.$sname.'" />');
143: $request->print(
144: '<input type="hidden" name="domain" value="'.$sdom.'" />');
145: $request->print(
146: '<input type="submit" name="submit" value="View" />');
147: $request->print('</form></td></tr>');
148: }
149: }
150: $request->print('</table>');
151: }
152:
153:
154: #FIXME - needs to handle multiple matches
155: sub finduser {
156: my ($name) = @_;
157: my $domain = '';
158:
159: if ( $Apache::grades::viewgrades eq 'F' ) {
160: #get classlist
161: my ($cdom,$cnum) = split(/_/,$ENV{'request.course.id'});
162: #print "Found $cdom:$cnum<br />";
163: my (%classlist) = &getclasslist($cdom,$cnum,'0');
164: foreach my $student ( sort(@{ $classlist{'allids'} }) ) {
165: my ($posname,$posdomain) = split(/:/,$student);
166: if ($posname =~ $name) { $name=$posname; $domain=$posdomain; last; }
167: }
168: return ($name,$domain);
169: } else {
170: return ($ENV{'user.name'},$ENV{'user.domain'});
171: }
172: }
173:
174: sub getclasslist {
175: my ($coursedomain,$coursenum,$hideexpired) = @_;
176: my %classlist=&Apache::lonnet::dump('classlist',$coursedomain,$coursenum);
177: my $now = time;
178: foreach my $student (keys(%classlist)) {
179: my ($end,$start)=split(/:/,$classlist{$student});
180: # still a student?
181: if (($hideexpired) && ($end) && ($end < $now)) {
182: #print "Skipping:$name:$end:$now<br />\n";
183: next;
184: }
185: #print "record=$record<br>";
186: push( @{ $classlist{'allids'} }, $student);
187: }
188: return (%classlist);
189: }
190:
191: sub getpartlist {
192: my ($url) = @_;
193: my @parts =();
194: my (@metakeys) = split(/,/,&Apache::lonnet::metadata($url,'keys'));
195: foreach my $key (@metakeys) {
196: if ( $key =~ m/stores_([0-9]+)_.*/ ) {
197: push(@parts,$key);
198: }
199: }
200: return @parts;
201: }
202:
203: sub viewstudentgrade {
204: my ($url,$symb,$courseid,$student,@parts) = @_;
205: my $result ='';
206: my $cellclr = '"#ffffdd"';
207: my ($stuname,$domain) = split(/:/,$student);
208:
209: my %record=&Apache::lonnet::restore($symb,$courseid,$domain,$stuname);
210:
211: $result.="<tr><td bgcolor=$cellclr>$stuname</td><td bgcolor=$cellclr align=\"middle\">$domain</td>\n";
212: foreach my $part (@parts) {
213: my ($temp,$part,$type)=split(/_/,$part);
214: #print "resource.$part.$type = ".$record{"resource.$part.$type"}." <br />\n";
215: if ($type eq 'awarded') {
216: my $score=$record{"resource.$part.$type"};
217: $result.="<td bgcolor=$cellclr align=\"middle\"><input type=\"text\" name=\"GRADE.$student.$part.$type\" value=\"$score\" size=\"4\" /></td>\n";
218: } elsif ($type eq 'tries') {
219: my $score=$record{"resource.$part.$type"};
220: $result.="<td bgcolor=$cellclr align=\"middle\"><input type=\"text\" name=\"GRADE.$student.$part.$type\" value=\"$score\" size=\"4\" /></td>\n"
221: } elsif ($type eq 'solved') {
222: my $score=$record{"resource.$part.$type"};
223: $result.="<td bgcolor=$cellclr align=\"middle\"><select name=\"GRADE.$student.$part.$type\">\n";
224: if ($score =~ /^correct/) {
225: $result.="<option selected=\"on\">correct</option>\n<option>incorrect</option>\n<option>excused</option>\n<option>ungraded</option>\n<option>nothing</option>\n";
226: } elsif ($score =~ /^incorrect/) {
227: $result.="<option>correct</option>\n<option selected=\"on\">incorrect</option>\n<option>excused</option>\n<option>ungraded</option>\n<option>nothing</option>\n";
228: } elsif ($score eq '') {
229: $result.="<option>correct</option>\n<option>incorrect</option>\n<option>excused</option>\n<option>ungraded</option>\n<option selected=\"on\">nothing</option>\n";
230: } elsif ($score =~ /^excused/) {
231: $result.="<option>correct</option>\n<option>incorrect</option>\n<option selected=\"on\">excused</option>\n<option>ungraded</option>\n<option>nothing</option>\n";
232: } elsif ($score =~ /^ungraded/) {
233: $result.="<option>correct</option>\n<option>incorrect</option>\n<option>excused</option>\n<option selected=\"on\">ungraded</option>\n<option>nothing</option>\n";
234: }
235: $result.="</select></td>\n";
236: }
237: }
238: $result.='</tr>';
239: return $result;
240: }
241: #FIXME need to look at the meatdata <stores> spec on what type of data to accept and provide an
242: #interface based on that, also do that to above function.
243: sub setstudentgrade {
244: my ($url,$symb,$courseid,$student,@parts) = @_;
245:
246: my $result ='';
247:
248: my ($stuname,$domain) = split(/:/,$student);
249:
250: my %record=&Apache::lonnet::restore($symb,$courseid,$domain,$stuname);
251:
252: my %newrecord;
253:
254: foreach my $part (@parts) {
255: my ($temp,$part,$type)=split(/_/,$part);
256: my $oldscore=$record{"resource.$part.$type"};
257: my $newscore=$ENV{"form.GRADE.$student.$part.$type"};
258: if ($type eq 'solved') {
259: my $update=0;
260: if ($newscore eq 'nothing' ) {
261: if ($oldscore ne '') {
262: $update=1;
263: $newscore = '';
264: }
265: } elsif ($oldscore !~ m/^$newscore/) {
266: $update=1;
267: $result.="Updating $stuname to $newscore<br />\n";
268: if ($newscore eq 'correct') { $newscore = 'correct_by_override'; }
269: if ($newscore eq 'incorrect') { $newscore = 'incorrect_by_override'; }
270: if ($newscore eq 'excused') { $newscore = 'excused'; }
271: if ($newscore eq 'ungraded') { $newscore = 'ungraded_attempted'; }
272: } else {
273: #$result.="$stuname:$part:$type:unchanged $oldscore to $newscore:<br />\n";
274: }
275: if ($update) { $newrecord{"resource.$part.$type"}=$newscore; }
276: } else {
277: if ($oldscore ne $newscore) {
278: $newrecord{"resource.$part.$type"}=$newscore;
279: $result.="Updating $student"."'s status for $part.$type to $newscore<br />\n";
280: } else {
281: #$result.="$stuname:$part:$type:unchanged $oldscore to $newscore:<br />\n";
282: }
283: }
284: }
285: if ( scalar(keys(%newrecord)) > 0 ) {
286: $newrecord{"resource.regrader"}="$ENV{'user.name'}:$ENV{'user.domain'}";
287: &Apache::lonnet::cstore(\%newrecord,$symb,$courseid,$domain,$stuname);
288:
289: $result.="Stored away ".scalar(keys(%newrecord))." elements.<br />\n";
290: }
291: return $result;
292: }
293:
294: sub submission {
295: my ($request) = @_;
296: my $url=$ENV{'form.url'};
297: $url=~s-^http://($ENV{'SERVER_NAME'}|$ENV{'HTTP_HOST'})--;
298: if ($ENV{'form.student'} eq '') { &moreinfo($request,"Need student login id"); return ''; }
299: # if ($ENV{'form.student'} eq '') { &listStudents($request); return ''; }
300: my ($uname,$udom) = &finduser($ENV{'form.student'});
301: if ($uname eq '') { &moreinfo($request,"Unable to find student"); return ''; }
302: my $symb;
303: if ($ENV{'form.symb'}) {
304: $symb=$ENV{'form.symb'};
305: } else {
306: $symb=&Apache::lonnet::symbread($url);
307: }
308: if ($symb eq '') { $request->print("Unable to handle ambiguous references:$url:."); return ''; }
309: my $answer=&Apache::loncommon::get_previous_attempt($symb,$uname,$udom,
310: $ENV{'request.course.id'});
311: my $result="<h2> Submission Record </h2> $uname:$udom for $url <br />".$answer;
312: my $rendered=&Apache::loncommon::get_student_view($symb,$uname,$udom,
313: $ENV{'request.course.id'});
314: $result.="Student's view of the problem:<br /> $rendered <br /> Correct answer:<br />";
315:
316: $answer=&Apache::loncommon::get_student_answers($symb,$uname,$udom,
317: $ENV{'request.course.id'});
318: $result.=$answer;
319: return $result;
320: }
321:
322: sub viewgrades {
323: my ($request) = @_;
324: my $result='';
325:
326: #get resource reference
327: my $url=$ENV{'form.url'};
328: $url=~s-^http://($ENV{'SERVER_NAME'}|$ENV{'HTTP_HOST'})--;
329: my $symb=$ENV{'form.symb'};
330: if (!$symb) { $symb=&Apache::lonnet::symbread($url); }
331: if ($symb eq '') { $request->print("Unable to handle ambiguous references:$url:."); return ''; }
332:
333: #get classlist
334: my ($cdom,$cnum) = split(/_/,$ENV{'request.course.id'});
335: #print "Found $cdom:$cnum<br />";
336: my (%classlist) = &getclasslist($cdom,$cnum,'0');
337: my $headerclr = '"#ccffff"';
338: my $cellclr = '"#ffffcc"';
339:
340: #get list of parts for this problem
341: my (@parts) = &getpartlist($url);
342:
343: $request->print ("<h2><font color=\"#339966\">Manual Grading</font></h2>");
344:
345: #start the form
346: $result = '<form action="/adm/grades" method="post">'."\n".
347: '<input type="hidden" name="symb" value="'.$symb.'" />'."\n".
348: '<input type="hidden" name="url" value="'.$url.'" />'."\n".
349: '<input type="hidden" name="command" value="editgrades" />'."\n".
350: '<input type="submit" name="submit" value="Submit Changes" />'."\n".
351: '<table border=0><tr><td bgcolor="#999999">'."\n".
352: '<table border=0>'."\n".
353: '<tr><td bgcolor='.$headerclr.'>UserId</td><td bgcolor='.$headerclr.'>Domain</td>'."\n";
354: foreach my $part (@parts) {
355: my $display=&Apache::lonnet::metadata($url,$part.'.display');
356: if (!$display) { $display = &Apache::lonnet::metadata($url,$part.'.name'); }
357: $result.='<td bgcolor='.$headerclr.'>'.$display.'</td>'."\n";
358: }
359: $result.="</tr>";
360: #get info for each student
361: foreach my $student ( sort(@{ $classlist{'allids'} }) ) {
362: $result.=&viewstudentgrade($url,$symb,$ENV{'request.course.id'},$student,@parts);
363: }
364: $result.='</table></td></tr></table><input type="submit" name="submit" value="Submit Changes" /></form>';
365:
366: return $result;
367: }
368:
369: sub editgrades {
370: my ($request) = @_;
371: my $result='';
372:
373: my $symb=$ENV{'form.symb'};
374: if ($symb eq '') { $request->print("Unable to handle ambiguous references:$symb:$ENV{'form.url'}"); return ''; }
375: my $url=$ENV{'form.url'};
376: #get classlist
377: my ($cdom,$cnum) = split(/_/,$ENV{'request.course.id'});
378: #print "Found $cdom:$cnum<br />";
379: my (%classlist) = &getclasslist($cdom,$cnum,'0');
380:
381: #get list of parts for this problem
382: my (@parts) = &getpartlist($url);
383:
384: $result.='<form action="/adm/grades" method="post">'."\n".
385: '<input type="hidden" name="symb" value="'.$symb.'" />'."\n".
386: '<input type="hidden" name="url" value="'.$url.'" />'."\n".
387: '<input type="hidden" name="command" value="viewgrades" />'."\n".
388: '<input type="submit" name="submit" value="See Grades" /> <br />'."\n";
389:
390: foreach my $student ( sort(@{ $classlist{'allids'} }) ) {
391: $result.=&setstudentgrade($url,$symb,$ENV{'request.course.id'},$student,@parts);
392: }
393:
394: $result.='<input type="submit" name="submit" value="See Grades" /></table></form>';
395: return $result;
396: }
397:
398: sub send_header {
399: my ($request)= @_;
400: $request->print(&Apache::lontexconvert::header());
401: # $request->print("
402: #<script>
403: #remotewindow=open('','homeworkremote');
404: #remotewindow.close();
405: #</script>");
406: $request->print('<body bgcolor="#FFFFFF">');
407: }
408:
409: sub send_footer {
410: my ($request)= @_;
411: $request->print('</body>');
412: $request->print(&Apache::lontexconvert::footer());
413: }
414:
415: sub handler {
416: my $request=$_[0];
417:
418: if ( $ENV{'user.name'} eq 'albertel' ) {$Apache::lonxml::debug=1;} else {$Apache::lonxml::debug=0;}
419:
420: if ($ENV{'browser.mathml'}) {
421: $request->content_type('text/xml');
422: } else {
423: $request->content_type('text/html');
424: }
425: $request->send_http_header;
426: return OK if $request->header_only;
427: &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'});
428: my $url=$ENV{'form.url'};
429: my $symb=$ENV{'form.symb'};
430: my $command=$ENV{'form.command'};
431: if (!$url) {
432: my ($temp1,$temp2);
433: ($temp1,$temp2,$ENV{'form.url'})=split(/___/,$symb);
434: $url = $ENV{'form.url'};
435: }
436: &send_header($request);
437: if ($url eq '' && $symb eq '') {
438: if ($ENV{'user.adv'}) {
439: if (($ENV{'form.codeone'}) && ($ENV{'form.codetwo'}) &&
440: ($ENV{'form.codethree'})) {
441: my $token=$ENV{'form.codeone'}.'*'.$ENV{'form.codetwo'}.'*'.
442: $ENV{'form.codethree'};
443: my ($tsymb,$tuname,$tudom,$tcrsid)=
444: &Apache::lonnet::checkin($token);
445: if ($tsymb) {
446: my ($map,$id,$url)=split(/\_\_\_/,$tsymb);
447: if (&Apache::lonnet::allowed('mgr',$tcrsid)) {
448: $request->print(
449: &Apache::lonnet::ssi('/res/'.$url,
450: ('grade_username' => $tuname,
451: 'grade_domain' => $tudom,
452: 'grade_courseid' => $tcrsid,
453: 'grade_symb' => $tsymb)));
454: } else {
455: $request->print('<h1>Not authorized: '.$token.'</h1>');
456: }
457: } else {
458: $request->print('<h1>Not a valid DocID: '.$token.'</h1>');
459: }
460: } else {
461: $request->print(&Apache::lonxml::tokeninputfield());
462: }
463: }
464: } else {
465: $Apache::grades::viewgrades=&Apache::lonnet::allowed('vgr',$ENV{'request.course.id'});
466: if ($command eq 'submission') {
467: &listStudents($request) if ($ENV{'form.student'} eq '');
468: $request->print(&submission($request)) if ($ENV{'form.student'} ne '');
469: } elsif ($command eq 'viewgrades') {
470: $request->print(&viewgrades($request));
471: } elsif ($command eq 'editgrades') {
472: $request->print(&editgrades($request));
473: } elsif ($command eq 'verify') {
474: $request->print(&verifyreceipt($request));
475: } else {
476: $request->print("Unknown action: $command:");
477: }
478: }
479: &send_footer($request);
480: return OK;
481: }
482:
483: 1;
484:
485: __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