1: # The LearningOnline Network with CAPA
2: # Navigate Maps Handler
3: #
4: # (Page Handler
5: #
6: # (TeX Content Handler
7: #
8: # 05/29/00,05/30 Gerd Kortemeyer)
9: # 08/30,08/31,09/06,09/14,09/15,09/16,09/19,09/20,09/21,09/23,
10: # 10/02,10/10,10/14,10/16,10/18,10/19,10/31,11/6,11/14,11/16 Gerd Kortemeyer)
11: #
12: # 3/1/1,6/1,17/1,29/1,30/1 Gerd Kortemeyer
13:
14: package Apache::lonnavmaps;
15:
16: use strict;
17: use Apache::Constants qw(:common :http);
18: use Apache::lonnet();
19: use HTML::TokeParser;
20: use GDBM_File;
21:
22: # -------------------------------------------------------------- Module Globals
23: my %hash;
24: my @rows;
25:
26: #
27: # These cache hashes need to be independent of user, resource and course
28: # (user and course can/should be in the keys)
29: #
30:
31: my %courserdatas;
32: my %userrdatas;
33:
34: #
35: # These global hashes are dependent on user, course and resource,
36: # and need to be initialized every time when a sheet is calculated
37: #
38: my %courseopt;
39: my %useropt;
40: my %parmhash;
41:
42:
43: # ------------------------------------------------------------------ Euclid gcd
44:
45: sub euclid {
46: my ($e,$f)=@_;
47: my $a; my $b; my $r;
48: if ($e>$f) { $b=$e; $r=$f; } else { $r=$e; $b=$f; }
49: while ($r!=0) {
50: $a=$b; $b=$r;
51: $r=$a%$b;
52: }
53: return $b;
54: }
55:
56: # --------------------------------------------------------------------- Parmval
57:
58: # -------------------------------------------- Figure out a cascading parameter
59: #
60: # For this function to work
61: #
62: # * parmhash needs to be tied
63: # * courseopt and useropt need to be initialized for this user and course
64: #
65:
66: sub parmval {
67: my ($what,$symb)=@_;
68: my $cid=$ENV{'request.course.id'};
69: my $csec=$ENV{'request.course.sec'};
70: my $uname=$ENV{'user.name'};
71: my $udom=$ENV{'user.domain'};
72:
73: unless ($symb) { return ''; }
74: my $result='';
75:
76: my ($mapname,$id,$fn)=split(/\_\_\_/,$symb);
77:
78: # ----------------------------------------------------- Cascading lookup scheme
79: my $rwhat=$what;
80: $what=~s/^parameter\_//;
81: $what=~s/\_/\./;
82:
83: my $symbparm=$symb.'.'.$what;
84: my $mapparm=$mapname.'___(all).'.$what;
85: my $usercourseprefix=$uname.'_'.$udom.'_'.$cid;
86:
87: my $seclevel=
88: $usercourseprefix.'.['.
89: $csec.'].'.$what;
90: my $seclevelr=
91: $usercourseprefix.'.['.
92: $csec.'].'.$symbparm;
93: my $seclevelm=
94: $usercourseprefix.'.['.
95: $csec.'].'.$mapparm;
96:
97: my $courselevel=
98: $usercourseprefix.'.'.$what;
99: my $courselevelr=
100: $usercourseprefix.'.'.$symbparm;
101: my $courselevelm=
102: $usercourseprefix.'.'.$mapparm;
103:
104: # ---------------------------------------------------------- fourth, check user
105:
106: if ($uname) {
107:
108: if ($useropt{$courselevelr}) { return $useropt{$courselevelr}; }
109:
110: if ($useropt{$courselevelm}) { return $useropt{$courselevelm}; }
111:
112: if ($useropt{$courselevel}) { return $useropt{$courselevel}; }
113:
114: }
115:
116: # --------------------------------------------------------- third, check course
117:
118: if ($csec) {
119:
120: if ($courseopt{$seclevelr}) { return $courseopt{$seclevelr}; }
121:
122: if ($courseopt{$seclevelm}) { return $courseopt{$seclevelm}; }
123:
124: if ($courseopt{$seclevel}) { return $courseopt{$seclevel}; }
125:
126: }
127:
128: if ($courseopt{$courselevelr}) { return $courseopt{$courselevelr}; }
129:
130: if ($courseopt{$courselevelm}) { return $courseopt{$courselevelm}; }
131:
132: if ($courseopt{$courselevel}) { return $courseopt{$courselevel}; }
133:
134: # ----------------------------------------------------- second, check map parms
135:
136: my $thisparm=$parmhash{$symbparm};
137: if ($thisparm) { return $thisparm; }
138:
139: # -------------------------------------------------------- first, check default
140:
141: return &Apache::lonnet::metadata($fn,$rwhat.'.default');
142:
143: }
144:
145:
146:
147: # ------------------------------------------------------------- Find out status
148:
149: sub astatus {
150: my $rid=shift;
151: my $code=1;
152: my $ctext='';
153: $rid=~/(\d+)\.(\d+)/;
154: my $symb=&Apache::lonnet::declutter($hash{'map_id_'.$1}).'___'.$2.'___'.
155: &Apache::lonnet::declutter($hash{'src_'.$rid});
156: my $duedate=&parmval('0.duedate',$symb);
157: if ($duedate) {
158: $ctext.='Due: '.localtime($duedate);
159: }
160: my $answer=&Apache::lonnet::reply(
161: "restore:$ENV{'user.domain'}:$ENV{'user.name'}:".
162: $ENV{'request.course.id'}.':'.
163: &Apache::lonnet::escape($symb),
164: "$ENV{'user.home'}");
165: my %returnhash=();
166: map {
167: my ($name,$value)=split(/\=/,$_);
168: $returnhash{&Apache::lonnet::unescape($name)}=
169: &Apache::lonnet::unescape($value);
170: } split(/\&/,$answer);
171: if ($returnhash{'version'}) {
172: my $version;
173: for ($version=1;$version<=$returnhash{'version'};$version++) {
174: map {
175: $returnhash{$_}=$returnhash{$version.':'.$_};
176: } split(/\:/,$returnhash{$version.':keys'});
177: }
178: map {
179: if (($_=~/\.(\w+)\.solved$/) && ($_!~/^\d+\:/)) {
180: my $part=$1;
181: if ($ctext) { $ctext.=', '; }
182: if ($part) {
183: $ctext.='Part '.$part.': ';
184: }
185: if ($returnhash{$_} eq 'correct_by_student') {
186: unless ($code==2) { $code=3; }
187: $ctext.='solved';
188: } elsif ($returnhash{$_} eq 'correct_by_override') {
189: unless ($code==2) { $code=3; }
190: $ctext.='override';
191: } elsif ($returnhash{$_} eq 'incorrect_attempted') {
192: $code=2;
193: $ctext.=
194: $returnhash{'resource.'.$part.'.tries'}.' attempt(s)';
195: } elsif ($returnhash{$_} eq 'incorrect_by_override') {
196: $code=2;
197: $ctext.='override';
198: } elsif ($returnhash{$_} eq 'excused') {
199: unless ($code==2) { $code=3; }
200: $ctext.='excused';
201: }
202: }
203: } keys %returnhash;
204: }
205: return 'p'.$code.'"'.$ctext.'"';
206: }
207:
208: # ------------------------------------------------------------ Build page table
209:
210: sub tracetable {
211: my ($sofar,$rid,$beenhere)=@_;
212: my $further=$sofar;
213: unless ($beenhere=~/\&$rid\&/) {
214: $beenhere.=$rid.'&';
215:
216: if (defined($hash{'is_map_'.$rid})) {
217: $sofar++;
218: my $tprefix='';
219: if ($hash{'map_type_'.$hash{'map_pc_'.$hash{'src_'.$rid}}}
220: eq 'sequence') {
221: $tprefix='h';
222: }
223: if (defined($rows[$sofar])) {
224: $rows[$sofar].='&'.$tprefix.$rid;
225: } else {
226: $rows[$sofar]=$tprefix.$rid;
227: }
228: if ((defined($hash{'map_start_'.$hash{'src_'.$rid}})) &&
229: (defined($hash{'map_finish_'.$hash{'src_'.$rid}})) &&
230: ($tprefix eq 'h')) {
231: my $frid=$hash{'map_finish_'.$hash{'src_'.$rid}};
232: $sofar=
233: &tracetable($sofar,$hash{'map_start_'.$hash{'src_'.$rid}},
234: '&'.$frid.'&');
235: $sofar++;
236: if ($hash{'src_'.$frid}) {
237: my $brepriv=&Apache::lonnet::allowed('bre',$hash{'src_'.$frid});
238: if (($brepriv eq '2') || ($brepriv eq 'F')) {
239: my $pprefix='';
240: if ($hash{'src_'.$frid}=~
241: /\.(problem|exam|quiz|assess|survey|form)$/) {
242: $pprefix=&astatus($frid);
243:
244: }
245: if (defined($rows[$sofar])) {
246: $rows[$sofar].='&'.$pprefix.$frid;
247: } else {
248: $rows[$sofar]=$pprefix.$frid;
249: }
250: }
251: }
252: }
253: } else {
254: $sofar++;
255: if ($hash{'src_'.$rid}) {
256: my $brepriv=&Apache::lonnet::allowed('bre',$hash{'src_'.$rid});
257: if (($brepriv eq '2') || ($brepriv eq 'F')) {
258: my $pprefix='';
259: if ($hash{'src_'.$rid}=~
260: /\.(problem|exam|quiz|assess|survey|form)$/) {
261: $pprefix=&astatus($rid);
262: }
263: if (defined($rows[$sofar])) {
264: $rows[$sofar].='&'.$pprefix.$rid;
265: } else {
266: $rows[$sofar]=$pprefix.$rid;
267: }
268: }
269: }
270: }
271:
272: if (defined($hash{'to_'.$rid})) {
273: my $mincond=1;
274: my $next='';
275: map {
276: my $thiscond=
277: &Apache::lonnet::directcondval($hash{'condid_'.$hash{'undercond_'.$_}});
278: if ($thiscond>=$mincond) {
279: if ($next) {
280: $next.=','.$_.':'.$thiscond;
281: } else {
282: $next=$_.':'.$thiscond;
283: }
284: if ($thiscond>$mincond) { $mincond=$thiscond; }
285: }
286: } split(/\,/,$hash{'to_'.$rid});
287: map {
288: my ($linkid,$condval)=split(/\:/,$_);
289: if ($condval>=$mincond) {
290: my $now=&tracetable($sofar,$hash{'goesto_'.$linkid},$beenhere);
291: if ($now>$further) { $further=$now; }
292: }
293: } split(/\,/,$next);
294:
295: }
296: }
297: return $further;
298: }
299:
300: # ================================================================ Main Handler
301:
302: sub handler {
303: my $r=shift;
304:
305:
306: # ------------------------------------------- Set document type for header only
307:
308: if ($r->header_only) {
309: if ($ENV{'browser.mathml'}) {
310: $r->content_type('text/xml');
311: } else {
312: $r->content_type('text/html');
313: }
314: $r->send_http_header;
315: return OK;
316: }
317:
318: my $requrl=$r->uri;
319: # ----------------------------------------------------------------- Tie db file
320: if ($ENV{'request.course.fn'}) {
321: my $fn=$ENV{'request.course.fn'};
322: if (-e "$fn.db") {
323: if ((tie(%hash,'GDBM_File',"$fn.db",&GDBM_READER,0640)) &&
324: (tie(%parmhash,'GDBM_File',
325: $ENV{'request.course.fn'}.'_parms.db',&GDBM_READER,0640))) {
326: # ------------------------------------------------------------------- Hash tied
327: my $firstres=$hash{'map_start_/res/'.$ENV{'request.course.uri'}};
328: my $lastres=$hash{'map_finish_/res/'.$ENV{'request.course.uri'}};
329: if (($firstres) && ($lastres)) {
330: # ----------------------------------------------------------------- Render page
331: # -------------------------------------------------------------- Set parameters
332:
333:
334: # ---------------------------- initialize coursedata and userdata for this user
335: undef %courseopt;
336: undef %useropt;
337:
338: my $uname=$ENV{'user.name'};
339: my $udom=$ENV{'user.domain'};
340: my $uhome=$ENV{'user.home'};
341: my $cid=$ENV{'request.course.id'};
342: my $chome=$ENV{'course.'.$cid.'.home'};
343: my ($cdom,$cnum)=split(/\_/,$cid);
344:
345: my $userprefix=$uname.'_'.$udom.'_';
346:
347: unless ($uhome eq 'no_host') {
348: # -------------------------------------------------------------- Get coursedata
349: unless
350: ((time-$courserdatas{$cid.'.last_cache'})<240) {
351: my $reply=&Apache::lonnet::reply('dump:'.$cdom.':'.$cnum.
352: ':resourcedata',$chome);
353: if ($reply!~/^error\:/) {
354: $courserdatas{$cid}=$reply;
355: $courserdatas{$cid.'.last_cache'}=time;
356: }
357: }
358: map {
359: my ($name,$value)=split(/\=/,$_);
360: $courseopt{$userprefix.&Apache::lonnet::unescape($name)}=
361: &Apache::lonnet::unescape($value);
362: } split(/\&/,$courserdatas{$cid});
363: # --------------------------------------------------- Get userdata (if present)
364: unless
365: ((time-$userrdatas{$uname.'___'.$udom.'.last_cache'})<240) {
366: my $reply=
367: &Apache::lonnet::reply('dump:'.$udom.':'.$uname.':resourcedata',$uhome);
368: if ($reply!~/^error\:/) {
369: $userrdatas{$uname.'___'.$udom}=$reply;
370: $userrdatas{$uname.'___'.$udom.'.last_cache'}=time;
371: }
372: }
373: map {
374: my ($name,$value)=split(/\=/,$_);
375: $useropt{$userprefix.&Apache::lonnet::unescape($name)}=
376: &Apache::lonnet::unescape($value);
377: } split(/\&/,$userrdatas{$uname.'___'.$udom});
378: }
379:
380: @rows=();
381:
382: &tracetable(0,$firstres,'&'.$lastres.'&');
383: if ($hash{'src_'.$lastres}) {
384: my $brepriv=
385: &Apache::lonnet::allowed('bre',$hash{'src_'.$lastres});
386: if (($brepriv eq '2') || ($brepriv eq 'F')) {
387: $rows[$#rows+1]=''.$lastres;
388: }
389: }
390:
391: # ------------------------------------------------------------------ Page parms
392:
393: my $j;
394: my $i;
395: my $lcm=1;
396: my $contents=0;
397:
398: # ---------------------------------------------- Go through table to get layout
399:
400: for ($i=0;$i<=$#rows;$i++) {
401: if ($rows[$i]) {
402: $contents++;
403: my @colcont=split(/\&/,$rows[$i]);
404: $lcm*=($#colcont+1)/euclid($lcm,($#colcont+1));
405: }
406: }
407:
408:
409: unless ($contents) {
410: $r->content_type('text/html');
411: $r->send_http_header;
412: $r->print('<html><body>Empty Map.</body></html>');
413: } else {
414:
415: # ------------------------------------------------------------------ Build page
416:
417: # ---------------------------------------------------------------- Send headers
418:
419: $r->content_type('text/html');
420: $r->send_http_header;
421: $r->print(
422: '<html><head><title>Navigate LON-CAPA Maps</title></head>');
423:
424: $r->print('<body bgcolor="#FFFFFF">'.
425: '<script>window.focus();</script>'.
426: '<img align=right src=/adm/lonIcons/lonlogos.gif>'.
427: '<h1>Navigate Course Map</h1>');
428: $r->rflush();
429: # ----------------------------------------------------------------- Start table
430: $r->print('<table cols="'.$lcm.'" border="0">');
431: for ($i=0;$i<=$#rows;$i++) {
432: if ($rows[$i]) {
433: $r->print("\n<tr>");
434: my @colcont=split(/\&/,$rows[$i]);
435: my $avespan=$lcm/($#colcont+1);
436: for ($j=0;$j<=$#colcont;$j++) {
437: my $rid=$colcont[$j];
438: my $add='<td> ';
439: my $adde='</td>';
440: my $hwk='<font color="#223322">';
441: my $hwke='</font>';
442: if ($rid=~/^h(.+)/) {
443: $rid=$1;
444: $add='<th bgcolor="#AAFF55">';
445: $adde='</th>';
446: }
447: if ($rid=~/^p(\d)\"([\w\: \(\)\,]*)\"(.+)/) {
448: my $code=$1;
449: my $ctext=$2;
450: $rid=$3;
451: $hwk='<font color="#888811"><b>';
452: $hwke='</b></font>';
453: if ($code eq '1') {
454: $hwke='</b> ('.$ctext.')</font>';
455: }
456: if ($code eq '2') {
457: $hwk='<font color="#992222"><b>';
458: $hwke='</b> ('.$ctext.')</font>';
459: }
460: if ($code eq '3') {
461: $hwk='<font color="#229922"><b>';
462: $hwke='</b> ('.$ctext.')</font>';
463: }
464: }
465: $r->print($add.'<a href="'.$hash{'src_'.$rid}.
466: '">'.$hwk.
467: $hash{'title_'.$rid}.$hwke.'</a>'.$adde);
468: }
469: $r->print('</tr>');
470: }
471: }
472: $r->print("\n</table>");
473:
474: $r->print('</body></html>');
475: # -------------------------------------------------------------------- End page
476: }
477: # ------------------------------------------------------------- End render page
478: } else {
479: $r->content_type('text/html');
480: $r->send_http_header;
481: $r->print('<html><body>Coursemap undefined.</body></html>');
482: }
483: # ------------------------------------------------------------------ Untie hash
484: unless (untie(%hash)) {
485: &Apache::lonnet::logthis("<font color=blue>WARNING: ".
486: "Could not untie coursemap $fn (browse).</font>");
487: }
488: unless (untie(%parmhash)) {
489: &Apache::lonnet::logthis("<font color=blue>WARNING: ".
490: "Could not untie parmhash (browse).</font>");
491: }
492: # -------------------------------------------------------------------- All done
493: return OK;
494: # ----------------------------------------------- Errors, hash could no be tied
495: }
496: }
497: }
498:
499: $ENV{'user.error.msg'}="$requrl:bre:0:0:Course not initialized";
500: return HTTP_NOT_ACCEPTABLE;
501: }
502:
503: 1;
504: __END__
505:
506:
507:
508:
509:
510:
511:
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/back.gif){kind=icon}
Return to lonnavmaps.pm CVS log ![[TXT]](/icons/text.gif){kind=icon}
![[DIR]](/icons/dir.gif){kind=icon}
Up to [LON-CAPA] / loncom / interface