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