Annotation of loncom/homework/grades.pm, revision 1.6
1.1 albertel 1: # The LON-CAPA Grading handler
1.4 albertel 2: # 2/9,2/13 Guy Albertelli
1.1 albertel 3:
4: package Apache::grades;
5: use strict;
6: use Apache::style;
7: use Apache::lonxml;
8: use Apache::lonnet;
1.3 albertel 9: use Apache::loncommon;
1.1 albertel 10: use Apache::lonhomework;
11: use Apache::Constants qw(:common);
12:
1.2 albertel 13: sub moreinfo {
14: my ($request,$reason) = @_;
15: $request->print("Unable to process request: $reason");
1.5 albertel 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 '';
1.2 albertel 26: }
27:
28:
1.3 albertel 29: #FIXME - needs to be much smarter
1.2 albertel 30: sub finduser {
31: my ($name) = @_;
1.5 albertel 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) {
1.6 ! albertel 63: if ( $key =~ m/stores_([0-9]+)_.*/ ) {
! 64: push(@parts,$key);
! 65: }
1.5 albertel 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"};
1.6 ! albertel 85: $result.="<td><input type=\"text\" name=\"GRADE.$student.$part.$type\" value=\"$score\" size=\"4\" /></td>\n";
1.5 albertel 86: } elsif ($type eq 'tries') {
87: my $score=$record{"resource.$part.$type"};
1.6 ! albertel 88: $result.="<td><input type=\"text\" name=\"GRADE.$student.$part.$type\" value=\"$score\" size=\"4\" /></td>\n"
1.5 albertel 89: } elsif ($type eq 'solved') {
90: my $score=$record{"resource.$part.$type"};
1.6 ! albertel 91: $result.="<td><select name=\"GRADE.$student.$part.$type\">\n";
1.5 albertel 92: if ($score =~ /^correct/) {
1.6 ! albertel 93: $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 94: } elsif ($score =~ /^incorrect/) {
1.6 ! albertel 95: $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 96: } elsif ($score eq '') {
1.6 ! albertel 97: $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 98: } elsif ($score =~ /^excused/) {
1.6 ! albertel 99: $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 100: } elsif ($score =~ /^ungraded/) {
1.6 ! albertel 101: $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 102: }
103: $result.="</select></td>\n";
104: }
105: }
106: $result.='</tr>';
107: return $result;
108: }
1.6 ! albertel 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.
1.5 albertel 111: sub setstudentgrade {
112: my ($url,$symb,$courseid,$student,@parts) = @_;
113:
1.6 ! albertel 114: my $result ='';
1.5 albertel 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;
1.6 ! albertel 121:
1.5 albertel 122: foreach my $part (@parts) {
123: my ($temp,$part,$type)=split(/_/,$part);
124: my $oldscore=$record{"resource.$part.$type"};
1.6 ! albertel 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; }
1.5 albertel 144: } else {
1.6 ! albertel 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: }
1.5 albertel 151: }
152: }
1.6 ! albertel 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: }
1.5 albertel 159: return $result;
1.2 albertel 160: }
161:
162: sub submission {
163: my ($request) = @_;
1.3 albertel 164: my $url=$ENV{'form.url'};
165: $url=~s-^http://($ENV{'SERVER_NAME'}|$ENV{'HTTP_HOST'})--;
1.2 albertel 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 ''; }
1.3 albertel 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;
1.2 albertel 176: }
177:
1.5 albertel 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".
1.6 ! albertel 201: '<input type="hidden" name="symb" value="'.$symb.'"/>'."\n".
! 202: '<input type="hidden" name="url" value="'.$url.'"/>'."\n".
1.5 albertel 203: '<input type="hidden" name="command" value="editgrades" />'."\n".
204: '<input type="submit" name="submit" value="Submit Changes" />'."\n".
205: '<table>'."\n".
1.6 ! albertel 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>";
1.5 albertel 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".
1.6 ! albertel 242: '<input type="submit" name="submit" value="See Grades" /> <br />'."\n";
1.5 albertel 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:
1.2 albertel 252: sub send_header {
253: my ($request)= @_;
254: $request->print(&Apache::lontexconvert::header());
1.6 ! albertel 255: # $request->print("
! 256: #<script>
! 257: #remotewindow=open('','homeworkremote');
! 258: #remotewindow.close();
! 259: #</script>");
1.2 albertel 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:
1.1 albertel 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'};
1.5 albertel 282: my $symb=$ENV{'form.symb'};
1.2 albertel 283: my $command=$ENV{'form.command'};
284:
285: &send_header($request);
1.5 albertel 286: if ($url eq '' && $symb eq '') {
1.2 albertel 287: $request->print("Non-Contextual Access Unsupported:$command:$url:");
1.1 albertel 288: } else {
1.5 albertel 289: $Apache::grades::viewgrades=&Apache::lonnet::allowed('vgr',$ENV{'request.course.id'});
1.2 albertel 290: if ($command eq 'submission') {
1.3 albertel 291: $request->print(&submission($request));
1.5 albertel 292: } elsif ($command eq 'viewgrades') {
293: $request->print(&viewgrades($request));
294: } elsif ($command eq 'editgrades') {
295: $request->print(&editgrades($request));
1.2 albertel 296: } else {
297: $request->print("Unknown action:$command:");
298: }
1.1 albertel 299: }
1.2 albertel 300: &send_footer($request);
1.1 albertel 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