Annotation of loncom/interface/lonchart.pm, revision 1.6
1.1 www 1: # The LearningOnline Network with CAPA
2: # Homework Performance Chart
3: #
4: # (Navigate Maps Handler
5: #
6: # (Page Handler
7: #
8: # (TeX Content Handler
9: #
10: # 05/29/00,05/30 Gerd Kortemeyer)
11: # 08/30,08/31,09/06,09/14,09/15,09/16,09/19,09/20,09/21,09/23,
12: # 10/02,10/10,10/14,10/16,10/18,10/19,10/31,11/6,11/14,11/16 Gerd Kortemeyer)
13: #
14: # 3/1/1,6/1,17/1,29/1,30/1 Gerd Kortemeyer)
15: #
16: # 1/31 Gerd Kortemeyer
1.5 minaeibi 17: #
18: # 7/10/01 Behrouz Minaei
1.6 ! www 19: # 9/8 Gerd Kortemeyer
1.1 www 20:
21: package Apache::lonchart;
22:
23: use strict;
24: use Apache::Constants qw(:common :http);
25: use Apache::lonnet();
26: use HTML::TokeParser;
27: use GDBM_File;
28:
29: # -------------------------------------------------------------- Module Globals
30: my %hash;
31: my @cols;
32: my @rowlabels;
33: my @students;
34:
35: # ------------------------------------------------------------- Find out status
36:
1.5 minaeibi 37: sub ExtractStudentData {
38: my ($index,$coid)=@_;
39: my ($sname,$sdom) = split( /\:/, $students[$index] );
40: my $shome=&Apache::lonnet::homeserver( $sname,$sdom );
41: my $reply=&Apache::lonnet::reply('dump:'.$sdom.':'.$sname.':'.$coid,$shome );
42: my %result=();
43: my $ResId;
44: my $Code;
45: my $Tries;
46: my $Wrongs;
47: my $Version;
48:
49: my $Str=substr($students[$index].
50: ' ',0,14).' ! '.
51: substr($rowlabels[$index].
52: ' ',0,45).' ! ';
53:
54: unless ($reply=~/^error\:/) {
55: map {
56: my ($name,$value)=split(/\=/,&Apache::lonnet::unescape($_));
57: $result{$name}=$value;
58: } split(/\&/,$reply);
59: foreach $ResId (@cols) {
60: if ( !$ResId ) { $Str .= ' ! '; next; }
61: $ResId=~/(\d+)\.(\d+)/;
62: my $Prob = &Apache::lonnet::declutter( $hash{'map_id_'.$1} ).
63: '___'.$2.'___'.
64: &Apache::lonnet::declutter( $hash{'src_'.$ResId} );
65: $Code=' ';
66: $Tries = 0;
67: $Version = $result{"version:$Prob"};
68: if ( $Version ) {
69: my $vkeys = $result{"$Version:keys:$Prob"};
70: my @keys = split(/:/,$vkeys);
71: foreach my $Key (@keys) {
72: if (($Key=~/\.(\w+)\.solved$/) && ($Key!~/^\d+\:/)) {
73: my $Part = $1;
74: $Tries = $result{"$Version:$Prob:resource.$Part.tries"};
75: my $Val = $result{"$Version:$Prob:$Key"};
76: if ($Val eq 'correct_by_student'){$Code='*';}
77: elsif ($Val eq 'correct_by_override'){$Code = '+';}
78: elsif ($Val eq 'incorrect_attempted'){$Code = '.';}
79: elsif ($Val eq 'incorrect_by_override'){$Code = '-';}
80: elsif ($Val eq 'excused'){$Code = 'x';}
81: }
82: if (($Code eq '*')&&($Tries<10)){$Code=$Tries;}
83: }
84: }
85: $Str .= $Code;
86: }
1.1 www 87: }
1.5 minaeibi 88: return $Str;
1.1 www 89: }
90:
1.5 minaeibi 91: #sub astatus {
92: # my ($rid,$student)=@_;
93: # my ($uname,$udom)=split(/\:/,$student);
94: # my $code=' ';
95: # $rid=~/(\d+)\.(\d+)/;
96: # my $symb=&Apache::lonnet::declutter($hash{'map_id_'.$1}).'___'.$2.'___'.
97: # &Apache::lonnet::declutter($hash{'src_'.$rid});
98: # my $answer=&Apache::lonnet::reply(
99: # "restore:$udom:$uname:".
100: # $ENV{'request.course.id'}.':'.
101: # &Apache::lonnet::escape($symb),
102: # &Apache::lonnet::homeserver($uname,$udom));
103: # my %returnhash=();
104: # map {
105: # my ($name,$value)=split(/\=/,$_);
106: # $returnhash{&Apache::lonnet::unescape($name)}=
107: # &Apache::lonnet::unescape($value);
108: # } split(/\&/,$answer);
109: # if ($returnhash{'version'}) {
110: # my $version;
111: # for ($version=1;$version<=$returnhash{'version'};$version++) {
112: # map {
113: # $returnhash{$_}=$returnhash{$version.':'.$_};
114: # } split(/\:/,$returnhash{$version.':keys'});
115: # }
116: # my $totaltries=0;
117: # map {
118: # if (($_=~/\.(\w+)\.solved$/) && ($_!~/^\d+\:/)) {
119: # my $part=$1;
120: # if ($returnhash{$_} eq 'correct_by_student') {
121: # unless (($code eq '.') || ($code eq '-')) { $code='*'; }
122: # $totaltries+=$returnhash{'resource.'.$part.'.tries'};
123: # } elsif ($returnhash{$_} eq 'correct_by_override') {
124: # unless (($code eq '.') || ($code eq '-')) { $code='+'; }
125: # } elsif ($returnhash{$_} eq 'incorrect_attempted') {
126: # $code='.';
127: # } elsif ($returnhash{$_} eq 'incorrect_by_override') {
128: # $code='-';
129: # } elsif ($returnhash{$_} eq 'excused') {
130: # unless (($code eq '.') || ($code eq '-')) { $code='x'; }
131: # }
132: # }
133: # } keys %returnhash;
134: # if (($code eq '*') && ($totaltries<10)) { $code="$totaltries"; }
135: # }
136: # return $code;
137: #}
138:
1.1 www 139: # ------------------------------------------------------------ Build page table
140:
141: sub tracetable {
142: my ($rid,$beenhere)=@_;
143: unless ($beenhere=~/\&$rid\&/) {
144: $beenhere.=$rid.'&';
145: if (defined($hash{'is_map_'.$rid})) {
146: if ($hash{'map_type_'.$hash{'map_pc_'.$hash{'src_'.$rid}}}
147: eq 'sequence') {
148: $cols[$#cols+1]=0;
149: }
150: if ((defined($hash{'map_start_'.$hash{'src_'.$rid}})) &&
151: (defined($hash{'map_finish_'.$hash{'src_'.$rid}}))) {
152: my $frid=$hash{'map_finish_'.$hash{'src_'.$rid}};
153:
154: &tracetable($hash{'map_start_'.$hash{'src_'.$rid}},
155: '&'.$frid.'&');
156:
157: if ($hash{'src_'.$frid}) {
158: if ($hash{'src_'.$frid}=~
159: /\.(problem|exam|quiz|assess|survey|form)$/) {
160: $cols[$#cols+1]=$frid;
161: }
162: }
163:
164: }
165: } else {
166: if ($hash{'src_'.$rid}) {
167: if ($hash{'src_'.$rid}=~
168: /\.(problem|exam|quiz|assess|survey|form)$/) {
169: $cols[$#cols+1]=$rid;
170: }
171: }
172: }
173: if (defined($hash{'to_'.$rid})) {
174: map {
175: &tracetable($hash{'goesto_'.$_},$beenhere);
176: } split(/\,/,$hash{'to_'.$rid});
177: }
178: }
179: }
180:
181: # ================================================================ Main Handler
182:
183: sub handler {
184: my $r=shift;
185:
186: if (&Apache::lonnet::allowed('vgr',$ENV{'request.course.id'})) {
187: # ------------------------------------------- Set document type for header only
188:
189: if ($r->header_only) {
190: if ($ENV{'browser.mathml'}) {
191: $r->content_type('text/xml');
192: } else {
193: $r->content_type('text/html');
194: }
195: $r->send_http_header;
196: return OK;
197: }
198:
199: my $requrl=$r->uri;
200: # ----------------------------------------------------------------- Tie db file
201: if ($ENV{'request.course.fn'}) {
202: my $fn=$ENV{'request.course.fn'};
203: if (-e "$fn.db") {
204: if (tie(%hash,'GDBM_File',"$fn.db",&GDBM_READER,0640)) {
205: # ------------------------------------------------------------------- Hash tied
206:
207:
208: # ------------------------------------------------------------------ Build page
209:
210: # ---------------------------------------------------------------- Send headers
211:
212: $r->content_type('text/html');
213: $r->send_http_header;
214: $r->print(
215: '<html><head><title>LON-CAPA Assessment Chart</title></head>');
216:
217: $r->print('<body bgcolor="#FFFFFF">'.
218: '<script>window.focus();</script>'.
219: '<img align=right src=/adm/lonIcons/lonlogos.gif>'.
220: '<h1>Assessment Chart</h1>');
221:
222: # ---------------------------------------------------------------- Course title
223:
224: $r->print('<h1>'.
1.6 ! www 225: $ENV{'course.'.$ENV{'request.course.id'}.'.description'}.'</h1><h3>'.
! 226: localtime()."</h3><p><pre>1..9: correct by student in 1..9 tries\n".
! 227: " *: correct by student in more than 9 tries\n".
! 228: " +: correct by override\n".
! 229: " -: incorrect by override\n".
! 230: " .: incorrect attempted\n".
! 231: " : not attempted\n".
! 232: " x: excused</pre><p>");
! 233:
1.1 www 234: # ------------------------------- This is going to take a while, produce output
235:
236: $r->rflush();
237:
238: # ----------------------- Get first and last resource, see if there is anything
239:
240:
241: my $firstres=$hash{'map_start_/res/'.$ENV{'request.course.uri'}};
242: my $lastres=$hash{'map_finish_/res/'.$ENV{'request.course.uri'}};
243: if (($firstres) && ($lastres)) {
244: # ----------------------------------------------------------------- Render page
245:
246: my $cid=$ENV{'request.course.id'};
247: my $chome=$ENV{'course.'.$cid.'.home'};
248: my ($cdom,$cnum)=split(/\_/,$cid);
249:
250: # ---------------------------------------------- Read class list and row labels
251:
252: undef @rowlabels;
253: undef @students;
254:
255: my $classlst=&Apache::lonnet::reply
256: ('dump:'.$cdom.':'.$cnum.':classlist',$chome);
257: my $now=time;
258: unless ($classlst=~/^error\:/) {
259: map {
260: my ($name,$value)=split(/\=/,$_);
261: my ($end,$start)=split(/\:/,&Apache::lonnet::unescape($value));
262: my $active=1;
263: if (($end) && ($now>$end)) { $active=0; }
264: if ($active) {
265: my $thisindex=$#students+1;
266: $name=&Apache::lonnet::unescape($name);
267: $students[$thisindex]=$name;
268: my ($sname,$sdom)=split(/\:/,$name);
269: my $ssec=&Apache::lonnet::usection($sdom,$sname,$cid);
270: if ($ssec==-1) {
271: $rowlabels[$thisindex]=
272: 'Data not available: '.$name;
273: } else {
274: my %reply=&Apache::lonnet::idrget($sdom,$sname);
1.3 albertel 275: my $reply=&Apache::lonnet::reply('get:'.$sdom.':'.$sname.
276: ':environment:lastname&generation&firstname&middlename',
277: &Apache::lonnet::homeserver($sname,$sdom));
1.1 www 278: $rowlabels[$thisindex]=
1.3 albertel 279: sprintf('%3s',$ssec).' '.$reply{$sname}.' ';
280: my $i=0;
1.1 www 281: map {
1.3 albertel 282: $i++;
283: if ( $_ ne '') {
1.4 albertel 284: $rowlabels[$thisindex].=&Apache::lonnet::unescape($_).' ';
1.3 albertel 285: }
286: if ($i == 2) {
287: chop($rowlabels[$thisindex]);
288: $rowlabels[$thisindex].=', ';
289: }
1.1 www 290: } split(/\&/,$reply);
1.4 albertel 291:
292: }
1.1 www 293: }
294: } sort split(/\&/,$classlst);
295:
296: } else {
297: $r->print('<h1>Could not access course data</h1>');
298: }
299:
300: my $allstudents=$#students+1;
301: $r->print('<h3>'.$allstudents.' students</h3>');
302: $r->rflush();
303:
304: # --------------- Find all assessments and put them into some linear-like order
305:
306: &tracetable($firstres,'&'.$lastres.'&');
307:
308: # ----------------------------------------------------------------- Start table
309:
310: $r->print('<p><pre>');
311: my $index;
312: for ($index=0;$index<=$#students;$index++) {
1.5 minaeibi 313: # $r->print(
314: # substr($students[$index].
315: # ' ',0,14).' ! '.
316: # substr($rowlabels[$index].
317: # ' ',0,45).' ! ');
318: # map {
319: # if ($_) {
320: # $r->print(&astatus($_,$students[$index]));
321: # } else {
322: # $r->print(' ! ');
323: # }
324: # } @cols;
325: # $r->print("\n");
326: $r->print(&ExtractStudentData($index,$cid).'<br>');
1.1 www 327: $r->rflush();
328: }
329: $r->print('</pre>');
330:
331: } else {
332: $r->print('<h3>Undefined course sequence</h3>');
333: }
334:
335: $r->print('</body></html>');
336:
337: # ------------------------------------------------------------- End render page
338: } else {
339: $r->content_type('text/html');
340: $r->send_http_header;
341: $r->print('<html><body>Coursemap undefined.</body></html>');
342: }
343: # ------------------------------------------------------------------ Untie hash
344: unless (untie(%hash)) {
345: &Apache::lonnet::logthis("<font color=blue>WARNING: ".
346: "Could not untie coursemap $fn (browse).</font>");
347: }
348:
349: # -------------------------------------------------------------------- All done
350: return OK;
351: # ----------------------------------------------- Errors, hash could no be tied
352: }
353: } else {
354: $ENV{'user.error.msg'}="$requrl:bre:0:0:Course not initialized";
355: return HTTP_NOT_ACCEPTABLE;
356: }
357: } else {
358: $ENV{'user.error.msg'}=
359: $r->uri.":vgr:0:0:Cannot view grades for complete course";
360: return HTTP_NOT_ACCEPTABLE;
361:
362: }
363: }
364: 1;
365: __END__
366:
367:
368:
369:
370:
371:
372:
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/back.gif){kind=icon}
Return to lonchart.pm CVS log ![[TXT]](/icons/text.gif){kind=icon}
![[DIR]](/icons/dir.gif){kind=icon}
Up to [LON-CAPA] / loncom / interface