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]+)_.*/ ) { push(@parts,$key); }
64: }
65: return @parts;
66: }
67:
68: sub viewstudentgrade {
69: my ($url,$symb,$courseid,$student,@parts) = @_;
70: my $result ='';
71:
72: my ($stuname,$domain) = split(/:/,$student);
73:
74: my %record=&Apache::lonnet::restore($symb,$courseid,$domain,$stuname,
75: &Apache::lonnet::homeserver($stuname,$domain));
76:
77: $result.="<tr><td>$stuname</td><td>$domain</td>\n";
78: foreach my $part (@parts) {
79: my ($temp,$part,$type)=split(/_/,$part);
80: #print "resource.$part.$type = ".$record{"resource.$part.$type"}." <br />\n";
81: if ($type eq 'awarded') {
82: my $score=$record{"resource.$part.$type"};
83: $result.="<td><input type=\"text\" name=\"GRADE.$stuname.$part.$type\" value=\"$score\" size=\"4\" /></td>\n";
84: } elsif ($type eq 'tries') {
85: my $score=$record{"resource.$part.$type"};
86: $result.="<td><input type=\"text\" name=\"GRADE.$stuname.$part.$type\" value=\"$score\" size=\"4\" /></td>\n"
87: } elsif ($type eq 'solved') {
88: my $score=$record{"resource.$part.$type"};
89: $result.="<td><select name=\"GRADE.$stuname.$part.$type\">\n";
90: if ($score =~ /^correct/) {
91: $result.="<option selected=\"on\">Correct</option>\n<option>Incorrect</option>\n<option>Excused</option>\n<option>Attempted</option>\n<option>Nothing</option>\n";
92: } elsif ($score =~ /^incorrect/) {
93: $result.="<option>Correct</option>\n<option selected=\"on\">Incorrect</option>\n<option>Excused</option>\n<option>Attempted</option>\n<option>Nothing</option>\n";
94: } elsif ($score eq '') {
95: $result.="<option>Correct</option>\n<option>Incorrect</option>\n<option>Excused</option>\n<option>Attempted</option>\n<option selected=\"on\">Nothing</option>\n";
96: } elsif ($score =~ /^excused/) {
97: $result.="<option>Correct</option>\n<option>Incorrect</option>\n<option selected=\"on\">Excused</option>\n<option>Attempted</option>\n<option>Nothing</option>\n";
98: } elsif ($score =~ /^ungraded/) {
99: $result.="<option>Correct</option>\n<option>Incorrect</option>\n<option>Excused</option>\n<option selected=\"on\">Attempted</option>\n<option>Nothing</option>\n";
100: }
101: $result.="</select></td>\n";
102: }
103: }
104: $result.='</tr>';
105: return $result;
106: }
107:
108: sub setstudentgrade {
109: my ($url,$symb,$courseid,$student,@parts) = @_;
110:
111: my $result ='Hi!';
112:
113: my ($stuname,$domain) = split(/:/,$student);
114:
115: my %record=&Apache::lonnet::restore($symb,$courseid,$domain,$stuname,
116: &Apache::lonnet::homeserver($stuname,$domain));
117: my %newrecord;
118: foreach my $part (@parts) {
119: my ($temp,$part,$type)=split(/_/,$part);
120: my $oldscore=$record{"resource.$part.$type"};
121: my $newscore=$ENV{"GRADE.$stuname.$part.$type"};
122: if ($oldscore != $newscore) {
123: $result.="$stuname:$part:$type:changed from $oldscore to $newscore:<br />\n";
124: } else {
125: $result.="$stuname:$part:$type:changed same $oldscore to $newscore:<br />\n";
126: }
127: }
128: return $result;
129: }
130:
131: sub submission {
132: my ($request) = @_;
133: my $url=$ENV{'form.url'};
134: $url=~s-^http://($ENV{'SERVER_NAME'}|$ENV{'HTTP_HOST'})--;
135: if ($ENV{'form.student'} eq '') { &moreinfo($request,"Need student login id"); return ''; }
136: my ($uname,$udom) = &finduser($ENV{'form.student'});
137: if ($uname eq '') { &moreinfo($request,"Unable to find student"); return ''; }
138: my $symb=&Apache::lonnet::symbread($url);
139: if ($symb eq '') { $request->print("Unable to handle ambiguous references:$url:."); return ''; }
140: my $home=&Apache::lonnet::homeserver($uname,$udom);
141: my $answer=&Apache::loncommon::get_previous_attempt($symb,$uname,$udom,$home,
142: $ENV{'request.course.id'});
143: my $result="<h2> Submission Record </h2> $uname:$udom for $url".$answer;
144: return $result;
145: }
146:
147: sub viewgrades {
148: my ($request) = @_;
149: my $result='';
150:
151: #get resource reference
152: my $url=$ENV{'form.url'};
153: $url=~s-^http://($ENV{'SERVER_NAME'}|$ENV{'HTTP_HOST'})--;
154: my $symb=$ENV{'form.symb'};
155: if (!$symb) { $symb=&Apache::lonnet::symbread($url); }
156: if ($symb eq '') { $request->print("Unable to handle ambiguous references:$url:."); return ''; }
157:
158: #get classlist
159: my ($cdom,$cnum) = split(/_/,$ENV{'request.course.id'});
160: my $chome=$ENV{"course.$ENV{'request.course.id'}.home"};
161: #print "Found $cdom:$cnum:$chome<br />";
162: my (%classlist) = &getclasslist($cdom,$cnum,$chome,'0');
163:
164:
165: #get list of parts for this problem
166: my (@parts) = &getpartlist($url);
167:
168: #start the form
169: $result = '<form action="/adm/grades" method="post">'."\n".
170: '<input type="hidden" name="symb" value="'.$symb.' "/>'."\n".
171: '<input type="hidden" name="url" value="'.$url.' "/>'."\n".
172: '<input type="hidden" name="command" value="editgrades" />'."\n".
173: '<input type="submit" name="submit" value="Submit Changes" />'."\n".
174: '<table>'."\n".
175: '<tr><td>UserId</td><td>Domain</td><td>Portion Correct</td><td>Status</td><td>Tries</td></tr>'."\n";
176: #get info for each student
177: foreach my $student ( sort(@{ $classlist{'allids'} }) ) {
178: $result.=&viewstudentgrade($url,$symb,$ENV{'request.course.id'},$student,@parts);
179: }
180: $result.='</table><input type="submit" name="submit" value="Submit Changes" /></form>';
181:
182: return $result;
183: }
184:
185: sub editgrades {
186: my ($request) = @_;
187: my $result='';
188:
189: my $symb=$ENV{'form.symb'};
190: if ($symb eq '') { $request->print("Unable to handle ambiguous references:$symb:$ENV{'form.url'}"); return ''; }
191: my $url=$ENV{'form.url'};
192:
193: #get classlist
194: my ($cdom,$cnum) = split(/_/,$ENV{'request.course.id'});
195: my $chome=$ENV{"course.$ENV{'request.course.id'}.home"};
196: #print "Found $cdom:$cnum:$chome<br />";
197: my (%classlist) = &getclasslist($cdom,$cnum,$chome,'0');
198:
199: #get list of parts for this problem
200: my (@parts) = &getpartlist($url);
201:
202: $result.='<form action="/adm/grades" method="post">'."\n".
203: '<input type="hidden" name="symb" value="'.$symb.'" />'."\n".
204: '<input type="hidden" name="url" value="'.$url.'" />'."\n".
205: '<input type="hidden" name="command" value="viewgrades" />'."\n".
206: '<input type="submit" name="submit" value="See Grades" />'."\n";
207:
208: foreach my $student ( sort(@{ $classlist{'allids'} }) ) {
209: $result.=&setstudentgrade($url,$symb,$ENV{'request.course.id'},$student,@parts);
210: }
211:
212: $result.='<input type="submit" name="submit" value="See Grades" /></table></form>';
213: return $result;
214: }
215:
216: sub send_header {
217: my ($request)= @_;
218: $request->print(&Apache::lontexconvert::header());
219: $request->print("
220: <script>
221: remotewindow=open('','homeworkremote');
222: remotewindow.close();
223: </script>");
224: $request->print('<body bgcolor="#FFFFFF">');
225: }
226:
227: sub send_footer {
228: my ($request)= @_;
229: $request->print('</body>');
230: $request->print(&Apache::lontexconvert::footer());
231: }
232:
233: sub handler {
234: my $request=$_[0];
235:
236: if ( $ENV{'user.name'} eq 'albertel' ) {$Apache::lonxml::debug=1;} else {$Apache::lonxml::debug=0;}
237:
238: if ($ENV{'browser.mathml'}) {
239: $request->content_type('text/xml');
240: } else {
241: $request->content_type('text/html');
242: }
243: $request->send_http_header;
244: return OK if $request->header_only;
245: my $url=$ENV{'form.url'};
246: my $symb=$ENV{'form.symb'};
247: my $command=$ENV{'form.command'};
248:
249: &send_header($request);
250: if ($url eq '' && $symb eq '') {
251: $request->print("Non-Contextual Access Unsupported:$command:$url:");
252: } else {
253: $Apache::grades::viewgrades=&Apache::lonnet::allowed('vgr',$ENV{'request.course.id'});
254: if ($command eq 'submission') {
255: $request->print(&submission($request));
256: } elsif ($command eq 'viewgrades') {
257: $request->print(&viewgrades($request));
258: } elsif ($command eq 'editgrades') {
259: $request->print(&editgrades($request));
260: } else {
261: $request->print("Unknown action:$command:");
262: }
263: }
264: &send_footer($request);
265: return OK;
266: }
267:
268: 1;
269:
270: __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