1: # The LON-CAPA Grading handler
2: # 2/9,2/13 Guy Albertelli
3:
4: package Apache::grades;
5: use strict;
6: use Apache::style;
7: use Apache::lonxml;
8: use Apache::lonnet;
9: use Apache::loncommon;
10: use Apache::lonhomework;
11: use Apache::Constants qw(:common);
12:
13: sub moreinfo {
14: my ($request,$reason) = @_;
15: $request->print("Unable to process request: $reason");
16: if ( $Apache::grades::viewgrades eq 'F' ) {
17: $request->print('<form action="/adm/grades" method="post">'."\n");
18: $request->print('<input type="hidden" name="url" value="'.$ENV{'form.url'}.'"></input>'."\n");
19: $request->print('<input type="hidden" name="command" value="'.$ENV{'form.command'}.'"></input>'."\n");
20: $request->print("Student:".'<input type="text" name="student" value="'.$ENV{'form.student'}.'"></input>'."<br />\n");
21: $request->print("Domain:".'<input type="text" name="domain" value="'.$ENV{'user.domain'}.'"></input>'."<br />\n");
22: $request->print('<input type="submit" name="submit" value="ReSubmit"></input>'."<br />\n");
23: $request->print('</form>');
24: }
25: return '';
26: }
27:
28:
29: #FIXME - needs to be much smarter
30: sub finduser {
31: my ($name) = @_;
32:
33: if ( $Apache::grades::viewgrades eq 'F' ) {
34: return ($name,$ENV{'user.domain'});
35: } else {
36: return ($ENV{'user.name'},$ENV{'user.domain'});
37: }
38: }
39:
40: sub getclasslist {
41: my ($coursedomain,$coursenum,$coursehome,$hideexpired) = @_;
42: my $classlist=&Apache::lonnet::reply("dump:$coursedomain:$coursenum:classlist",$coursehome);
43: my %classlist=();
44: my $now = time;
45: foreach my $record (split /&/, $classlist) {
46: my ($name,$value)=split(/=/,&Apache::lonnet::unescape($record));
47: my ($end,$start)=split(/:/,$value);
48: # still a student?
49: if (($hideexpired) && ($end) && ($end < $now)) {
50: print "Skipping:$name:$end:$now<br />\n";
51: next;
52: }
53: push( @{ $classlist{'allids'} }, $name);
54: }
55: return (%classlist);
56: }
57:
58: sub getpartlist {
59: my ($url) = @_;
60: my @parts =();
61: my (@metakeys) = split(/,/,&Apache::lonnet::metadata($url,'keys'));
62: foreach my $key (@metakeys) {
63: if ( $key =~ m/stores_([0-9]+)_.*/ ) {
64: push(@parts,$key);
65: }
66: }
67: return @parts;
68: }
69:
70: sub viewstudentgrade {
71: my ($url,$symb,$courseid,$student,@parts) = @_;
72: my $result ='';
73:
74: my ($stuname,$domain) = split(/:/,$student);
75:
76: my %record=&Apache::lonnet::restore($symb,$courseid,$domain,$stuname,
77: &Apache::lonnet::homeserver($stuname,$domain));
78:
79: $result.="<tr><td>$stuname</td><td>$domain</td>\n";
80: foreach my $part (@parts) {
81: my ($temp,$part,$type)=split(/_/,$part);
82: #print "resource.$part.$type = ".$record{"resource.$part.$type"}." <br />\n";
83: if ($type eq 'awarded') {
84: my $score=$record{"resource.$part.$type"};
85: $result.="<td><input type=\"text\" name=\"GRADE.$student.$part.$type\" value=\"$score\" size=\"4\" /></td>\n";
86: } elsif ($type eq 'tries') {
87: my $score=$record{"resource.$part.$type"};
88: $result.="<td><input type=\"text\" name=\"GRADE.$student.$part.$type\" value=\"$score\" size=\"4\" /></td>\n"
89: } elsif ($type eq 'solved') {
90: my $score=$record{"resource.$part.$type"};
91: $result.="<td><select name=\"GRADE.$student.$part.$type\">\n";
92: if ($score =~ /^correct/) {
93: $result.="<option selected=\"on\">correct</option>\n<option>incorrect</option>\n<option>excused</option>\n<option>ungraded</option>\n<option>nothing</option>\n";
94: } elsif ($score =~ /^incorrect/) {
95: $result.="<option>correct</option>\n<option selected=\"on\">incorrect</option>\n<option>excused</option>\n<option>ungraded</option>\n<option>nothing</option>\n";
96: } elsif ($score eq '') {
97: $result.="<option>correct</option>\n<option>incorrect</option>\n<option>excused</option>\n<option>ungraded</option>\n<option selected=\"on\">nothing</option>\n";
98: } elsif ($score =~ /^excused/) {
99: $result.="<option>correct</option>\n<option>incorrect</option>\n<option selected=\"on\">excused</option>\n<option>ungraded</option>\n<option>nothing</option>\n";
100: } elsif ($score =~ /^ungraded/) {
101: $result.="<option>correct</option>\n<option>incorrect</option>\n<option>excused</option>\n<option selected=\"on\">ungraded</option>\n<option>nothing</option>\n";
102: }
103: $result.="</select></td>\n";
104: }
105: }
106: $result.='</tr>';
107: return $result;
108: }
109: #FIXME need to look at the meatdata <stores> spec on what type of data to accept and provide an
110: #interface based on that, also do that to above function.
111: sub setstudentgrade {
112: my ($url,$symb,$courseid,$student,@parts) = @_;
113:
114: my $result ='';
115:
116: my ($stuname,$domain) = split(/:/,$student);
117:
118: my %record=&Apache::lonnet::restore($symb,$courseid,$domain,$stuname,
119: &Apache::lonnet::homeserver($stuname,$domain));
120: my %newrecord;
121:
122: foreach my $part (@parts) {
123: my ($temp,$part,$type)=split(/_/,$part);
124: my $oldscore=$record{"resource.$part.$type"};
125: my $newscore=$ENV{"form.GRADE.$student.$part.$type"};
126: if ($type eq 'solved') {
127: my $update=0;
128: if ($newscore eq 'nothing' ) {
129: if ($oldscore ne '') {
130: $update=1;
131: $newscore = '';
132: }
133: } elsif ($oldscore !~ m/^$newscore/) {
134: $update=1;
135: $result.="Updating $stuname to $newscore<br />\n";
136: if ($newscore eq 'correct') { $newscore = 'correct_by_override'; }
137: if ($newscore eq 'incorrect') { $newscore = 'incorrect_by_override'; }
138: if ($newscore eq 'excused') { $newscore = 'excused'; }
139: if ($newscore eq 'ungraded') { $newscore = 'ungraded_attempted'; }
140: } else {
141: #$result.="$stuname:$part:$type:unchanged $oldscore to $newscore:<br />\n";
142: }
143: if ($update) { $newrecord{"resource.$part.$type"}=$newscore; }
144: } else {
145: if ($oldscore ne $newscore) {
146: $newrecord{"resource.$part.$type"}=$newscore;
147: $result.="Updating $student"."'s status for $part.$type to $newscore<br />\n";
148: } else {
149: #$result.="$stuname:$part:$type:unchanged $oldscore to $newscore:<br />\n";
150: }
151: }
152: }
153: if ( scalar(keys(%newrecord)) > 0 ) {
154: $newrecord{"resource.regrader"}="$ENV{'user.name'}:$ENV{'user.domain'}";
155: &Apache::lonnet::cstore(\%newrecord,$symb,$courseid,$domain,$stuname,
156: &Apache::lonnet::homeserver($stuname,$domain));
157: $result.="Stored away ".scalar(keys(%newrecord))." elements.<br />\n";
158: }
159: return $result;
160: }
161:
162: sub submission {
163: my ($request) = @_;
164: my $url=$ENV{'form.url'};
165: $url=~s-^http://($ENV{'SERVER_NAME'}|$ENV{'HTTP_HOST'})--;
166: if ($ENV{'form.student'} eq '') { &moreinfo($request,"Need student login id"); return ''; }
167: my ($uname,$udom) = &finduser($ENV{'form.student'});
168: if ($uname eq '') { &moreinfo($request,"Unable to find student"); return ''; }
169: my $symb=&Apache::lonnet::symbread($url);
170: if ($symb eq '') { $request->print("Unable to handle ambiguous references:$url:."); return ''; }
171: my $home=&Apache::lonnet::homeserver($uname,$udom);
172: my $answer=&Apache::loncommon::get_previous_attempt($symb,$uname,$udom,$home,
173: $ENV{'request.course.id'});
174: my $result="<h2> Submission Record </h2> $uname:$udom for $url".$answer;
175: return $result;
176: }
177:
178: sub viewgrades {
179: my ($request) = @_;
180: my $result='';
181:
182: #get resource reference
183: my $url=$ENV{'form.url'};
184: $url=~s-^http://($ENV{'SERVER_NAME'}|$ENV{'HTTP_HOST'})--;
185: my $symb=$ENV{'form.symb'};
186: if (!$symb) { $symb=&Apache::lonnet::symbread($url); }
187: if ($symb eq '') { $request->print("Unable to handle ambiguous references:$url:."); return ''; }
188:
189: #get classlist
190: my ($cdom,$cnum) = split(/_/,$ENV{'request.course.id'});
191: my $chome=$ENV{"course.$ENV{'request.course.id'}.home"};
192: #print "Found $cdom:$cnum:$chome<br />";
193: my (%classlist) = &getclasslist($cdom,$cnum,$chome,'0');
194:
195:
196: #get list of parts for this problem
197: my (@parts) = &getpartlist($url);
198:
199: #start the form
200: $result = '<form action="/adm/grades" method="post">'."\n".
201: '<input type="hidden" name="symb" value="'.$symb.'"/>'."\n".
202: '<input type="hidden" name="url" value="'.$url.'"/>'."\n".
203: '<input type="hidden" name="command" value="editgrades" />'."\n".
204: '<input type="submit" name="submit" value="Submit Changes" />'."\n".
205: '<table>'."\n".
206: '<tr><td>UserId</td><td>Domain</td>'."\n";
207: foreach my $part (@parts) {
208: my $display=&Apache::lonnet::metadata($url,$part.'.display');
209: if (!$display) { $display = &Apache::lonnet::metadata($url,$part.'.name'); }
210: $result.="<td>$display</td>\n";
211: }
212: $result.="</tr>";
213: #get info for each student
214: foreach my $student ( sort(@{ $classlist{'allids'} }) ) {
215: $result.=&viewstudentgrade($url,$symb,$ENV{'request.course.id'},$student,@parts);
216: }
217: $result.='</table><input type="submit" name="submit" value="Submit Changes" /></form>';
218:
219: return $result;
220: }
221:
222: sub editgrades {
223: my ($request) = @_;
224: my $result='';
225:
226: my $symb=$ENV{'form.symb'};
227: if ($symb eq '') { $request->print("Unable to handle ambiguous references:$symb:$ENV{'form.url'}"); return ''; }
228: my $url=$ENV{'form.url'};
229: #get classlist
230: my ($cdom,$cnum) = split(/_/,$ENV{'request.course.id'});
231: my $chome=$ENV{"course.$ENV{'request.course.id'}.home"};
232: #print "Found $cdom:$cnum:$chome<br />";
233: my (%classlist) = &getclasslist($cdom,$cnum,$chome,'0');
234:
235: #get list of parts for this problem
236: my (@parts) = &getpartlist($url);
237:
238: $result.='<form action="/adm/grades" method="post">'."\n".
239: '<input type="hidden" name="symb" value="'.$symb.'" />'."\n".
240: '<input type="hidden" name="url" value="'.$url.'" />'."\n".
241: '<input type="hidden" name="command" value="viewgrades" />'."\n".
242: '<input type="submit" name="submit" value="See Grades" /> <br />'."\n";
243:
244: foreach my $student ( sort(@{ $classlist{'allids'} }) ) {
245: $result.=&setstudentgrade($url,$symb,$ENV{'request.course.id'},$student,@parts);
246: }
247:
248: $result.='<input type="submit" name="submit" value="See Grades" /></table></form>';
249: return $result;
250: }
251:
252: sub send_header {
253: my ($request)= @_;
254: $request->print(&Apache::lontexconvert::header());
255: # $request->print("
256: #<script>
257: #remotewindow=open('','homeworkremote');
258: #remotewindow.close();
259: #</script>");
260: $request->print('<body bgcolor="#FFFFFF">');
261: }
262:
263: sub send_footer {
264: my ($request)= @_;
265: $request->print('</body>');
266: $request->print(&Apache::lontexconvert::footer());
267: }
268:
269: sub handler {
270: my $request=$_[0];
271:
272: if ( $ENV{'user.name'} eq 'albertel' ) {$Apache::lonxml::debug=1;} else {$Apache::lonxml::debug=0;}
273:
274: if ($ENV{'browser.mathml'}) {
275: $request->content_type('text/xml');
276: } else {
277: $request->content_type('text/html');
278: }
279: $request->send_http_header;
280: return OK if $request->header_only;
281: my $url=$ENV{'form.url'};
282: my $symb=$ENV{'form.symb'};
283: my $command=$ENV{'form.command'};
284:
285: &send_header($request);
286: if ($url eq '' && $symb eq '') {
287: $request->print("Non-Contextual Access Unsupported:$command:$url:");
288: } else {
289: $Apache::grades::viewgrades=&Apache::lonnet::allowed('vgr',$ENV{'request.course.id'});
290: if ($command eq 'submission') {
291: $request->print(&submission($request));
292: } elsif ($command eq 'viewgrades') {
293: $request->print(&viewgrades($request));
294: } elsif ($command eq 'editgrades') {
295: $request->print(&editgrades($request));
296: } else {
297: $request->print("Unknown action:$command:");
298: }
299: }
300: &send_footer($request);
301: return OK;
302: }
303:
304: 1;
305:
306: __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