1: # The LearningOnline Network with CAPA
2: # Navigate Maps Handler
3: #
4: # $Id: lonnavmaps.pm,v 1.20 2001/12/19 17:17:46 albertel Exp $
5: #
6: # Copyright Michigan State University Board of Trustees
7: #
8: # This file is part of the LearningOnline Network with CAPA (LON-CAPA).
9: #
10: # LON-CAPA is free software; you can redistribute it and/or modify
11: # it under the terms of the GNU General Public License as published by
12: # the Free Software Foundation; either version 2 of the License, or
13: # (at your option) any later version.
14: #
15: # LON-CAPA is distributed in the hope that it will be useful,
16: # but WITHOUT ANY WARRANTY; without even the implied warranty of
17: # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18: # GNU General Public License for more details.
19: #
20: # You should have received a copy of the GNU General Public License
21: # along with LON-CAPA; if not, write to the Free Software
22: # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
23: #
24: # /home/httpd/html/adm/gpl.txt
25: #
26: # http://www.lon-capa.org/
27: #
28: # (Page Handler
29: #
30: # (TeX Content Handler
31: #
32: # 05/29/00,05/30 Gerd Kortemeyer)
33: # 08/30,08/31,09/06,09/14,09/15,09/16,09/19,09/20,09/21,09/23,
34: # 10/02,10/10,10/14,10/16,10/18,10/19,10/31,11/6,11/14,11/16 Gerd Kortemeyer)
35: #
36: # 3/1/1,6/1,17/1,29/1,30/1,2/8,9/21,9/24,9/25 Gerd Kortemeyer
37:
38: package Apache::lonnavmaps;
39:
40: use strict;
41: use Apache::Constants qw(:common :http);
42: use Apache::lonnet();
43: use Apache::loncommon();
44: use HTML::TokeParser;
45: use GDBM_File;
46:
47: # -------------------------------------------------------------- Module Globals
48: my %hash;
49: my @rows;
50:
51: #
52: # These cache hashes need to be independent of user, resource and course
53: # (user and course can/should be in the keys)
54: #
55:
56: my %courserdatas;
57: my %userrdatas;
58:
59: #
60: # These global hashes are dependent on user, course and resource,
61: # and need to be initialized every time when a sheet is calculated
62: #
63: my %courseopt;
64: my %useropt;
65: my %parmhash;
66:
67:
68: # ------------------------------------------------------------------ Euclid gcd
69:
70: sub euclid {
71: my ($e,$f)=@_;
72: my $a; my $b; my $r;
73: if ($e>$f) { $b=$e; $r=$f; } else { $r=$e; $b=$f; }
74: while ($r!=0) {
75: $a=$b; $b=$r;
76: $r=$a%$b;
77: }
78: return $b;
79: }
80:
81: # --------------------------------------------------------------------- Parmval
82:
83: # -------------------------------------------- Figure out a cascading parameter
84: #
85: # For this function to work
86: #
87: # * parmhash needs to be tied
88: # * courseopt and useropt need to be initialized for this user and course
89: #
90:
91: sub parmval {
92: my ($what,$symb)=@_;
93: my $cid=$ENV{'request.course.id'};
94: my $csec=$ENV{'request.course.sec'};
95: my $uname=$ENV{'user.name'};
96: my $udom=$ENV{'user.domain'};
97:
98: unless ($symb) { return ''; }
99: my $result='';
100:
101: my ($mapname,$id,$fn)=split(/\_\_\_/,$symb);
102:
103: # ----------------------------------------------------- Cascading lookup scheme
104: my $rwhat=$what;
105: $what=~s/^parameter\_//;
106: $what=~s/\_/\./;
107:
108: my $symbparm=$symb.'.'.$what;
109: my $mapparm=$mapname.'___(all).'.$what;
110: my $usercourseprefix=$uname.'_'.$udom.'_'.$cid;
111:
112: my $seclevel=
113: $usercourseprefix.'.['.
114: $csec.'].'.$what;
115: my $seclevelr=
116: $usercourseprefix.'.['.
117: $csec.'].'.$symbparm;
118: my $seclevelm=
119: $usercourseprefix.'.['.
120: $csec.'].'.$mapparm;
121:
122: my $courselevel=
123: $usercourseprefix.'.'.$what;
124: my $courselevelr=
125: $usercourseprefix.'.'.$symbparm;
126: my $courselevelm=
127: $usercourseprefix.'.'.$mapparm;
128:
129: # ---------------------------------------------------------- fourth, check user
130:
131: if ($uname) {
132:
133: if ($useropt{$courselevelr}) { return $useropt{$courselevelr}; }
134:
135: if ($useropt{$courselevelm}) { return $useropt{$courselevelm}; }
136:
137: if ($useropt{$courselevel}) { return $useropt{$courselevel}; }
138:
139: }
140:
141: # --------------------------------------------------------- third, check course
142:
143: if ($csec) {
144:
145: if ($courseopt{$seclevelr}) { return $courseopt{$seclevelr}; }
146:
147: if ($courseopt{$seclevelm}) { return $courseopt{$seclevelm}; }
148:
149: if ($courseopt{$seclevel}) { return $courseopt{$seclevel}; }
150:
151: }
152:
153: if ($courseopt{$courselevelr}) { return $courseopt{$courselevelr}; }
154:
155: if ($courseopt{$courselevelm}) { return $courseopt{$courselevelm}; }
156:
157: if ($courseopt{$courselevel}) { return $courseopt{$courselevel}; }
158:
159: # ----------------------------------------------------- second, check map parms
160:
161: my $thisparm=$parmhash{$symbparm};
162: if ($thisparm) { return $thisparm; }
163:
164: # -------------------------------------------------------- first, check default
165:
166: return &Apache::lonnet::metadata($fn,$rwhat.'.default');
167:
168: }
169:
170:
171:
172: # ------------------------------------------------------------- Find out status
173:
174: sub astatus {
175: my $rid=shift;
176: my $code=1;
177: my $ctext='';
178: $rid=~/(\d+)\.(\d+)/;
179: my $symb=&Apache::lonnet::declutter($hash{'map_id_'.$1}).'___'.$2.'___'.
180: &Apache::lonnet::declutter($hash{'src_'.$rid});
181:
182: my %duedate=();
183: my %opendate=();
184: my %answerdate=();
185: map {
186: if ($_=~/^parameter\_(.*)\_opendate$/) {
187: my $part=$1;
188: $duedate{$part}=&parmval($part.'.duedate',$symb);
189: $opendate{$part}=&parmval($part.'.opendate',$symb);
190: $answerdate{$part}=&parmval($part.'.answerdate',$symb);
191: }
192: } sort split(/\,/,&Apache::lonnet::metadata($hash{'src_'.$rid},'keys'));
193:
194: my $now=time;
195: my $tcode=0;
196:
197: my %returnhash=&Apache::lonnet::restore($symb);
198:
199: map {
200:
201: my $duedate=$duedate{$_};
202: my $opendate=$opendate{$_};
203: my $answerdate=$answerdate{$_};
204: my $preface='';
205: unless ($_ eq '0') { $preface=' Part: '.$_.' '; }
206: if ($opendate) {
207: if ($now<$duedate) {
208: unless ($tcode==4) { $tcode=2; }
209: $ctext.=$preface.'Due: '.localtime($duedate);
210: if ($now<$opendate) {
211: unless ($tcode) { $tcode=1; }
212: $ctext.=$preface.'Open: '.localtime($opendate);
213: }
214: if ($duedate-$now<86400) {
215: $tcode=4;
216: $ctext.=$preface.'Due: '.localtime($duedate);
217: }
218: } else {
219: unless (($tcode==4) || ($tcode eq 2)) { $tcode=3; }
220: if ($now<$answerdate) {
221: $ctext.='Answer: '.localtime($duedate);
222: }
223: }
224: } else {
225: unless (($tcode==2) || ($tcode==4)) { $tcode=1; }
226: }
227:
228: my $status=$returnhash{'resource.'.$_.'.solved'};
229:
230: if ($status eq 'correct_by_student') {
231: unless ($code==2) { $code=3; }
232: $ctext.=' solved';
233: } elsif ($status eq 'correct_by_override') {
234: unless ($code==2) { $code=3; }
235: $ctext.=' override';
236: } elsif ($status eq 'incorrect_attempted') {
237: $code=2;
238: $ctext.=' ('.
239: ($returnhash{'resource.'.$_.'.tries'}?
240: $returnhash{'resource.'.$_.'.tries'}:'0').'/'.
241: &parmval($_.'.maxtries',$symb).' tries)';
242: } elsif ($status eq 'incorrect_by_override') {
243: $code=2;
244: $ctext.=' override';
245: } elsif ($status eq 'excused') {
246: unless ($code==2) { $code=3; }
247: $ctext.=' excused';
248: }
249:
250: } sort keys %opendate;
251:
252: return 'p'.$code.$tcode.'"'.$ctext.'"';
253: }
254:
255: # ------------------------------------------------------------ Build page table
256:
257: sub tracetable {
258: my ($sofar,$rid,$beenhere)=@_;
259: my $further=$sofar;
260: unless ($beenhere=~/\&$rid\&/) {
261: $beenhere.=$rid.'&';
262:
263: if (defined($hash{'is_map_'.$rid})) {
264: $sofar++;
265: my $tprefix='';
266: if ($hash{'map_type_'.$hash{'map_pc_'.$hash{'src_'.$rid}}}
267: eq 'sequence') {
268: $tprefix='h';
269: }
270: if (defined($rows[$sofar])) {
271: $rows[$sofar].='&'.$tprefix.$rid;
272: } else {
273: $rows[$sofar]=$tprefix.$rid;
274: }
275: if ((defined($hash{'map_start_'.$hash{'src_'.$rid}})) &&
276: (defined($hash{'map_finish_'.$hash{'src_'.$rid}})) &&
277: ($tprefix eq 'h')) {
278: my $frid=$hash{'map_finish_'.$hash{'src_'.$rid}};
279: $sofar=
280: &tracetable($sofar,$hash{'map_start_'.$hash{'src_'.$rid}},
281: '&'.$frid.'&');
282: $sofar++;
283: if ($hash{'src_'.$frid}) {
284: my $brepriv=&Apache::lonnet::allowed('bre',$hash{'src_'.$frid});
285: if (($brepriv eq '2') || ($brepriv eq 'F')) {
286: my $pprefix='';
287: if ($hash{'src_'.$frid}=~
288: /\.(problem|exam|quiz|assess|survey|form)$/) {
289: $pprefix=&astatus($frid);
290:
291: }
292: if (defined($rows[$sofar])) {
293: $rows[$sofar].='&'.$pprefix.$frid;
294: } else {
295: $rows[$sofar]=$pprefix.$frid;
296: }
297: }
298: }
299: }
300: } else {
301: $sofar++;
302: if ($hash{'src_'.$rid}) {
303: my $brepriv=&Apache::lonnet::allowed('bre',$hash{'src_'.$rid});
304: if (($brepriv eq '2') || ($brepriv eq 'F')) {
305: my $pprefix='';
306: if ($hash{'src_'.$rid}=~
307: /\.(problem|exam|quiz|assess|survey|form)$/) {
308: $pprefix=&astatus($rid);
309: }
310: if (defined($rows[$sofar])) {
311: $rows[$sofar].='&'.$pprefix.$rid;
312: } else {
313: $rows[$sofar]=$pprefix.$rid;
314: }
315: }
316: }
317: }
318:
319: if (defined($hash{'to_'.$rid})) {
320: my $mincond=1;
321: my $next='';
322: map {
323: my $thiscond=
324: &Apache::lonnet::directcondval($hash{'condid_'.$hash{'undercond_'.$_}});
325: if ($thiscond>=$mincond) {
326: if ($next) {
327: $next.=','.$_.':'.$thiscond;
328: } else {
329: $next=$_.':'.$thiscond;
330: }
331: if ($thiscond>$mincond) { $mincond=$thiscond; }
332: }
333: } split(/\,/,$hash{'to_'.$rid});
334: map {
335: my ($linkid,$condval)=split(/\:/,$_);
336: if ($condval>=$mincond) {
337: my $now=&tracetable($sofar,$hash{'goesto_'.$linkid},$beenhere);
338: if ($now>$further) { $further=$now; }
339: }
340: } split(/\,/,$next);
341:
342: }
343: }
344: return $further;
345: }
346:
347: # ================================================================ Main Handler
348:
349: sub handler {
350: my $r=shift;
351:
352:
353: # ------------------------------------------- Set document type for header only
354:
355: if ($r->header_only) {
356: if ($ENV{'browser.mathml'}) {
357: $r->content_type('text/xml');
358: } else {
359: $r->content_type('text/html');
360: }
361: $r->send_http_header;
362: return OK;
363: }
364:
365: my $requrl=$r->uri;
366: # ----------------------------------------------------------------- Tie db file
367: if ($ENV{'request.course.fn'}) {
368: my $fn=$ENV{'request.course.fn'};
369: if (-e "$fn.db") {
370: if ((tie(%hash,'GDBM_File',"$fn.db",&GDBM_READER,0640)) &&
371: (tie(%parmhash,'GDBM_File',
372: $ENV{'request.course.fn'}.'_parms.db',&GDBM_READER,0640))) {
373: # ------------------------------------------------------------------- Hash tied
374: my $firstres=$hash{'map_start_/res/'.$ENV{'request.course.uri'}};
375: my $lastres=$hash{'map_finish_/res/'.$ENV{'request.course.uri'}};
376: if (($firstres) && ($lastres)) {
377: # ----------------------------------------------------------------- Render page
378: # -------------------------------------------------------------- Set parameters
379:
380:
381: # ---------------------------- initialize coursedata and userdata for this user
382: undef %courseopt;
383: undef %useropt;
384:
385: my $uname=$ENV{'user.name'};
386: my $udom=$ENV{'user.domain'};
387: my $uhome=$ENV{'user.home'};
388: my $cid=$ENV{'request.course.id'};
389: my $chome=$ENV{'course.'.$cid.'.home'};
390: my ($cdom,$cnum)=split(/\_/,$cid);
391:
392: my $userprefix=$uname.'_'.$udom.'_';
393:
394: unless ($uhome eq 'no_host') {
395: # -------------------------------------------------------------- Get coursedata
396: unless
397: ((time-$courserdatas{$cid.'.last_cache'})<240) {
398: my $reply=&Apache::lonnet::reply('dump:'.$cdom.':'.$cnum.
399: ':resourcedata',$chome);
400: if ($reply!~/^error\:/) {
401: $courserdatas{$cid}=$reply;
402: $courserdatas{$cid.'.last_cache'}=time;
403: }
404: }
405: map {
406: my ($name,$value)=split(/\=/,$_);
407: $courseopt{$userprefix.&Apache::lonnet::unescape($name)}=
408: &Apache::lonnet::unescape($value);
409: } split(/\&/,$courserdatas{$cid});
410: # --------------------------------------------------- Get userdata (if present)
411: unless
412: ((time-$userrdatas{$uname.'___'.$udom.'.last_cache'})<240) {
413: my $reply=
414: &Apache::lonnet::reply('dump:'.$udom.':'.$uname.':resourcedata',$uhome);
415: if ($reply!~/^error\:/) {
416: $userrdatas{$uname.'___'.$udom}=$reply;
417: $userrdatas{$uname.'___'.$udom.'.last_cache'}=time;
418: }
419: }
420: map {
421: my ($name,$value)=split(/\=/,$_);
422: $useropt{$userprefix.&Apache::lonnet::unescape($name)}=
423: &Apache::lonnet::unescape($value);
424: } split(/\&/,$userrdatas{$uname.'___'.$udom});
425: }
426:
427: @rows=();
428:
429: &tracetable(0,$firstres,'&'.$lastres.'&');
430: if ($hash{'src_'.$lastres}) {
431: my $brepriv=
432: &Apache::lonnet::allowed('bre',$hash{'src_'.$lastres});
433: if (($brepriv eq '2') || ($brepriv eq 'F')) {
434: $rows[$#rows+1]=''.$lastres;
435: }
436: }
437:
438: # ------------------------------------------------------------------ Page parms
439:
440: my $j;
441: my $i;
442: my $lcm=1;
443: my $contents=0;
444:
445: # ---------------------------------------------- Go through table to get layout
446:
447: for ($i=0;$i<=$#rows;$i++) {
448: if ($rows[$i]) {
449: $contents++;
450: my @colcont=split(/\&/,$rows[$i]);
451: $lcm*=($#colcont+1)/euclid($lcm,($#colcont+1));
452: }
453: }
454:
455:
456: unless ($contents) {
457: $r->content_type('text/html');
458: $r->send_http_header;
459: $r->print('<html><body>Empty Map.</body></html>');
460: } else {
461:
462: # ------------------------------------------------------------------ Build page
463:
464: my $currenturl=$ENV{'form.postdata'};
465: $currenturl=~s/^http\:\/\///;
466: $currenturl=~s/^[^\/]+//;
467:
468: # ---------------------------------------------------------------- Send headers
469:
470: $r->content_type('text/html');
471: &Apache::loncommon::no_cache($r);
472: $r->send_http_header;
473: my $date=localtime;
474: $r->print(
475: '<html><head><title>Navigate LON-CAPA Maps</title></head>');
476: $r->print('<body bgcolor="#FFFFFF"');
477: if (($currenturl=~/^\/res/) &&
478: ($currenturl!~/^\/res\/adm/)) {
479: $r->print(' onLoad="window.location.hash='.
480: "'curloc'".'"');
481: }
482: $r->print('><script>window.focus();</script>'.
483: '<img align=right src=/adm/lonIcons/lonlogos.gif>'.
484: '<h1>Navigate Course Map</h1>');
485: $r->rflush();
486: if (($currenturl=~/^\/res/) &&
487: ($currenturl!~/^\/res\/adm/)) {
488: $r->print('<a href="#curloc">Current Location</a><p>');
489: }
490: # ----------------------------------------------------- The little content list
491: for ($i=0;$i<=$#rows;$i++) {
492: if ($rows[$i]) {
493: my @colcont=split(/\&/,$rows[$i]);
494: my $avespan=$lcm/($#colcont+1);
495: for ($j=0;$j<=$#colcont;$j++) {
496: my $rid=$colcont[$j];
497: if ($rid=~/^h(.+)/) {
498: $rid=$1;
499: $r->print(
500: ' <a href="#'.$rid.'">'.$hash{'title_'.$rid}.'</a><br>');
501: }
502: }
503: }
504: }
505: # ----------------------------------------------------------------- Start table
506: $r->print('<hr><table cols="'.$lcm.'" border="0">');
507: for ($i=0;$i<=$#rows;$i++) {
508: if ($rows[$i]) {
509: $r->print("\n<tr>");
510: my @colcont=split(/\&/,$rows[$i]);
511: my $avespan=$lcm/($#colcont+1);
512: for ($j=0;$j<=$#colcont;$j++) {
513: my $rid=$colcont[$j];
514: my $add='<td> ';
515: my $adde='</td>';
516: my $hwk='<font color="#223322">';
517: my $hwke='</font>';
518: if ($rid=~/^h(.+)/) {
519: $rid=$1;
520: $add=
521: '<th bgcolor="#AAFF55"><a name="'.$rid.'">';
522: $adde='</th>';
523: }
524: if ($rid=~/^p(\d)(\d)\"([\w\: \(\)\/\,]*)\"(.+)/) {
525: my $code=$1;
526: my $tcode=$2;
527: my $ctext=$3;
528: $rid=$4;
529: if ($tcode eq '1') {
530: $add='<td bgcolor="#AAAAAA">';
531: }
532: if ($code eq '3') {
533: $add='<td bgcolor="#AAFFAA">';
534: } else {
535: $add='<td bgcolor="#FFAAAA">';
536: if ($tcode eq '2') {
537: $add='<td bgcolor="#FFFFAA">';
538: }
539: if ($tcode eq '4') {
540: $add='<td bgcolor="#FFFF33"><blink>';
541: $adde='</blink></td>';
542: }
543: }
544: $hwk='<font color="#888811"><b>';
545: $hwke='</b></font>';
546: if ($code eq '1') {
547: $hwke='</b> ('.$ctext.')</font>';
548: }
549: if ($code eq '2') {
550: $hwk='<font color="#992222"><b>';
551: $hwke='</b> ('.$ctext.')</font>';
552: }
553: if ($code eq '3') {
554: $hwk='<font color="#229922"><b>';
555: $hwke='</b> ('.$ctext.')</font>';
556: }
557: }
558: if ($hash{'src_'.$rid} eq $currenturl) {
559: $add=$add.'<a name="curloc"></a>'.
560: '<font color=red><b>-> </b></font>';
561: $adde=
562: '<font color=red><b> <-</b></font>'.$adde;
563: }
564: $r->print($add.'<a href="'.$hash{'src_'.$rid}.
565: '">'.$hwk.
566: $hash{'title_'.$rid}.$hwke.'</a>'.$adde);
567: }
568: $r->print('</tr>');
569: }
570: }
571: $r->print("\n</table>");
572: $r->print('</body></html>');
573: # -------------------------------------------------------------------- End page
574: }
575: # ------------------------------------------------------------- End render page
576: } else {
577: $r->content_type('text/html');
578: $r->send_http_header;
579: $r->print('<html><body>Coursemap undefined.</body></html>');
580: }
581: # ------------------------------------------------------------------ Untie hash
582: unless (untie(%hash)) {
583: &Apache::lonnet::logthis("<font color=blue>WARNING: ".
584: "Could not untie coursemap $fn (browse).</font>");
585: }
586: unless (untie(%parmhash)) {
587: &Apache::lonnet::logthis("<font color=blue>WARNING: ".
588: "Could not untie parmhash (browse).</font>");
589: }
590: # -------------------------------------------------------------------- All done
591: return OK;
592: # ----------------------------------------------- Errors, hash could no be tied
593: }
594: }
595: }
596:
597: $ENV{'user.error.msg'}="$requrl:bre:0:0:Course not initialized";
598: return HTTP_NOT_ACCEPTABLE;
599: }
600:
601: 1;
602: __END__
603:
604:
605:
606:
607:
608:
609:
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