Annotation of loncom/homework/grades.pm, revision 1.9
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);
1.6 albertel 166: $result.="Stored away ".scalar(keys(%newrecord))." elements.<br />\n";
167: }
1.5 albertel 168: return $result;
1.2 albertel 169: }
170:
171: sub submission {
172: my ($request) = @_;
1.3 albertel 173: my $url=$ENV{'form.url'};
174: $url=~s-^http://($ENV{'SERVER_NAME'}|$ENV{'HTTP_HOST'})--;
1.2 albertel 175: if ($ENV{'form.student'} eq '') { &moreinfo($request,"Need student login id"); return ''; }
176: my ($uname,$udom) = &finduser($ENV{'form.student'});
177: if ($uname eq '') { &moreinfo($request,"Unable to find student"); return ''; }
1.3 albertel 178: my $symb=&Apache::lonnet::symbread($url);
179: if ($symb eq '') { $request->print("Unable to handle ambiguous references:$url:."); return ''; }
1.9 ! albertel 180: my $answer=&Apache::loncommon::get_previous_attempt($symb,$uname,$udom,
1.3 albertel 181: $ENV{'request.course.id'});
182: my $result="<h2> Submission Record </h2> $uname:$udom for $url".$answer;
183: return $result;
1.2 albertel 184: }
185:
1.5 albertel 186: sub viewgrades {
187: my ($request) = @_;
188: my $result='';
189:
190: #get resource reference
191: my $url=$ENV{'form.url'};
192: $url=~s-^http://($ENV{'SERVER_NAME'}|$ENV{'HTTP_HOST'})--;
193: my $symb=$ENV{'form.symb'};
194: if (!$symb) { $symb=&Apache::lonnet::symbread($url); }
195: if ($symb eq '') { $request->print("Unable to handle ambiguous references:$url:."); return ''; }
196:
197: #get classlist
198: my ($cdom,$cnum) = split(/_/,$ENV{'request.course.id'});
199: my $chome=$ENV{"course.$ENV{'request.course.id'}.home"};
200: #print "Found $cdom:$cnum:$chome<br />";
201: my (%classlist) = &getclasslist($cdom,$cnum,$chome,'0');
202:
203:
204: #get list of parts for this problem
205: my (@parts) = &getpartlist($url);
206:
207: #start the form
208: $result = '<form action="/adm/grades" method="post">'."\n".
1.6 albertel 209: '<input type="hidden" name="symb" value="'.$symb.'"/>'."\n".
210: '<input type="hidden" name="url" value="'.$url.'"/>'."\n".
1.5 albertel 211: '<input type="hidden" name="command" value="editgrades" />'."\n".
212: '<input type="submit" name="submit" value="Submit Changes" />'."\n".
213: '<table>'."\n".
1.6 albertel 214: '<tr><td>UserId</td><td>Domain</td>'."\n";
215: foreach my $part (@parts) {
216: my $display=&Apache::lonnet::metadata($url,$part.'.display');
217: if (!$display) { $display = &Apache::lonnet::metadata($url,$part.'.name'); }
218: $result.="<td>$display</td>\n";
219: }
220: $result.="</tr>";
1.5 albertel 221: #get info for each student
222: foreach my $student ( sort(@{ $classlist{'allids'} }) ) {
223: $result.=&viewstudentgrade($url,$symb,$ENV{'request.course.id'},$student,@parts);
224: }
225: $result.='</table><input type="submit" name="submit" value="Submit Changes" /></form>';
226:
227: return $result;
228: }
229:
230: sub editgrades {
231: my ($request) = @_;
232: my $result='';
233:
234: my $symb=$ENV{'form.symb'};
235: if ($symb eq '') { $request->print("Unable to handle ambiguous references:$symb:$ENV{'form.url'}"); return ''; }
236: my $url=$ENV{'form.url'};
237: #get classlist
238: my ($cdom,$cnum) = split(/_/,$ENV{'request.course.id'});
239: my $chome=$ENV{"course.$ENV{'request.course.id'}.home"};
240: #print "Found $cdom:$cnum:$chome<br />";
241: my (%classlist) = &getclasslist($cdom,$cnum,$chome,'0');
242:
243: #get list of parts for this problem
244: my (@parts) = &getpartlist($url);
245:
246: $result.='<form action="/adm/grades" method="post">'."\n".
247: '<input type="hidden" name="symb" value="'.$symb.'" />'."\n".
248: '<input type="hidden" name="url" value="'.$url.'" />'."\n".
249: '<input type="hidden" name="command" value="viewgrades" />'."\n".
1.6 albertel 250: '<input type="submit" name="submit" value="See Grades" /> <br />'."\n";
1.5 albertel 251:
252: foreach my $student ( sort(@{ $classlist{'allids'} }) ) {
253: $result.=&setstudentgrade($url,$symb,$ENV{'request.course.id'},$student,@parts);
254: }
255:
256: $result.='<input type="submit" name="submit" value="See Grades" /></table></form>';
257: return $result;
258: }
259:
1.2 albertel 260: sub send_header {
261: my ($request)= @_;
262: $request->print(&Apache::lontexconvert::header());
1.6 albertel 263: # $request->print("
264: #<script>
265: #remotewindow=open('','homeworkremote');
266: #remotewindow.close();
267: #</script>");
1.2 albertel 268: $request->print('<body bgcolor="#FFFFFF">');
269: }
270:
271: sub send_footer {
272: my ($request)= @_;
273: $request->print('</body>');
274: $request->print(&Apache::lontexconvert::footer());
275: }
276:
1.1 albertel 277: sub handler {
278: my $request=$_[0];
279:
280: if ( $ENV{'user.name'} eq 'albertel' ) {$Apache::lonxml::debug=1;} else {$Apache::lonxml::debug=0;}
281:
282: if ($ENV{'browser.mathml'}) {
283: $request->content_type('text/xml');
284: } else {
285: $request->content_type('text/html');
286: }
287: $request->send_http_header;
288: return OK if $request->header_only;
289: my $url=$ENV{'form.url'};
1.5 albertel 290: my $symb=$ENV{'form.symb'};
1.2 albertel 291: my $command=$ENV{'form.command'};
292:
293: &send_header($request);
1.5 albertel 294: if ($url eq '' && $symb eq '') {
1.2 albertel 295: $request->print("Non-Contextual Access Unsupported:$command:$url:");
1.1 albertel 296: } else {
1.5 albertel 297: $Apache::grades::viewgrades=&Apache::lonnet::allowed('vgr',$ENV{'request.course.id'});
1.2 albertel 298: if ($command eq 'submission') {
1.3 albertel 299: $request->print(&submission($request));
1.5 albertel 300: } elsif ($command eq 'viewgrades') {
301: $request->print(&viewgrades($request));
302: } elsif ($command eq 'editgrades') {
303: $request->print(&editgrades($request));
1.2 albertel 304: } else {
305: $request->print("Unknown action:$command:");
306: }
1.1 albertel 307: }
1.2 albertel 308: &send_footer($request);
1.1 albertel 309: return OK;
310: }
311:
312: 1;
313:
314: __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