Annotation of loncom/interface/lonnavmaps.pm, revision 1.10
1.2 www 1: # The LearningOnline Network with CAPA
2: # Navigate Maps Handler
1.1 www 3: #
1.2 www 4: # (Page Handler
1.1 www 5: #
1.2 www 6: # (TeX Content Handler
1.1 www 7: #
1.2 www 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)
1.1 www 11: #
1.10 ! www 12: # 3/1/1,6/1,17/1,29/1,30/1 Gerd Kortemeyer
1.2 www 13:
1.1 www 14: package Apache::lonnavmaps;
15:
16: use strict;
1.2 www 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:
1.10 ! www 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:
1.2 www 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:
1.10 ! www 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:
1.9 www 147: # ------------------------------------------------------------- Find out status
148:
149: sub astatus {
150: my $rid=shift;
151: my $code=1;
152: my $ctext='';
153: $rid=~/(\d+)\.(\d+)/;
1.10 ! www 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: }
1.9 www 160: my $answer=&Apache::lonnet::reply(
161: "restore:$ENV{'user.domain'}:$ENV{'user.name'}:".
1.10 ! www 162: $ENV{'request.course.id'}.':'.
! 163: &Apache::lonnet::escape($symb),
1.9 www 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;
1.10 ! www 181: if ($ctext) { $ctext.=', '; }
! 182: if ($part) {
! 183: $ctext.='Part '.$part.': ';
! 184: }
1.9 www 185: if ($returnhash{$_} eq 'correct_by_student') {
186: unless ($code==2) { $code=3; }
1.10 ! www 187: $ctext.='solved';
1.9 www 188: } elsif ($returnhash{$_} eq 'correct_by_override') {
189: unless ($code==2) { $code=3; }
1.10 ! www 190: $ctext.='override';
1.9 www 191: } elsif ($returnhash{$_} eq 'incorrect_attempted') {
192: $code=2;
1.10 ! www 193: $ctext.=
1.9 www 194: $returnhash{'resource.'.$part.'.tries'}.' attempt(s)';
195: } elsif ($returnhash{$_} eq 'incorrect_by_override') {
196: $code=2;
1.10 ! www 197: $ctext.='override';
1.9 www 198: } elsif ($returnhash{$_} eq 'excused') {
199: unless ($code==2) { $code=3; }
1.10 ! www 200: $ctext.='excused';
1.9 www 201: }
202: }
203: } keys %returnhash;
204: }
205: return 'p'.$code.'"'.$ctext.'"';
206: }
207:
1.2 www 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})) {
1.7 www 217: $sofar++;
218: my $tprefix='';
219: if ($hash{'map_type_'.$hash{'map_pc_'.$hash{'src_'.$rid}}}
220: eq 'sequence') {
221: $tprefix='h';
222: }
1.6 www 223: if (defined($rows[$sofar])) {
1.7 www 224: $rows[$sofar].='&'.$tprefix.$rid;
1.6 www 225: } else {
1.7 www 226: $rows[$sofar]=$tprefix.$rid;
1.6 www 227: }
1.2 www 228: if ((defined($hash{'map_start_'.$hash{'src_'.$rid}})) &&
1.7 www 229: (defined($hash{'map_finish_'.$hash{'src_'.$rid}})) &&
230: ($tprefix eq 'h')) {
1.2 www 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')) {
1.7 www 239: my $pprefix='';
1.9 www 240: if ($hash{'src_'.$frid}=~
241: /\.(problem|exam|quiz|assess|survey|form)$/) {
242: $pprefix=&astatus($frid);
243:
1.7 www 244: }
1.2 www 245: if (defined($rows[$sofar])) {
1.7 www 246: $rows[$sofar].='&'.$pprefix.$frid;
1.2 www 247: } else {
1.7 www 248: $rows[$sofar]=$pprefix.$frid;
1.2 www 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')) {
1.7 www 258: my $pprefix='';
1.9 www 259: if ($hash{'src_'.$rid}=~
260: /\.(problem|exam|quiz|assess|survey|form)$/) {
261: $pprefix=&astatus($rid);
1.7 www 262: }
1.2 www 263: if (defined($rows[$sofar])) {
1.7 www 264: $rows[$sofar].='&'.$pprefix.$rid;
1.2 www 265: } else {
1.7 www 266: $rows[$sofar]=$pprefix.$rid;
1.2 www 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
1.1 www 301:
302: sub handler {
1.2 www 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") {
1.10 ! www 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))) {
1.2 www 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
1.10 ! www 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: }
1.2 www 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;
1.5 www 394: my $i;
1.2 www 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: }
1.5 www 407:
1.2 www 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 {
1.10 ! www 414:
1.2 www 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">'.
1.8 www 425: '<script>window.focus();</script>'.
1.6 www 426: '<img align=right src=/adm/lonIcons/lonlogos.gif>'.
1.2 www 427: '<h1>Navigate Course Map</h1>');
1.3 www 428: $r->rflush();
1.2 www 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];
1.6 www 438: my $add='<td> ';
1.7 www 439: my $adde='</td>';
440: my $hwk='<font color="#223322">';
441: my $hwke='</font>';
1.6 www 442: if ($rid=~/^h(.+)/) {
443: $rid=$1;
444: $add='<th bgcolor="#AAFF55">';
1.7 www 445: $adde='</th>';
446: }
1.10 ! www 447: if ($rid=~/^p(\d)\"([\w\: \(\)\,]*)\"(.+)/) {
1.7 www 448: my $code=$1;
1.9 www 449: my $ctext=$2;
450: $rid=$3;
451: $hwk='<font color="#888811"><b>';
452: $hwke='</b></font>';
1.10 ! www 453: if ($code eq '1') {
! 454: $hwke='</b> ('.$ctext.')</font>';
! 455: }
1.7 www 456: if ($code eq '2') {
1.9 www 457: $hwk='<font color="#992222"><b>';
458: $hwke='</b> ('.$ctext.')</font>';
1.7 www 459: }
460: if ($code eq '3') {
1.9 www 461: $hwk='<font color="#229922"><b>';
462: $hwke='</b> ('.$ctext.')</font>';
1.7 www 463: }
1.6 www 464: }
1.7 www 465: $r->print($add.'<a href="'.$hash{'src_'.$rid}.
466: '">'.$hwk.
467: $hash{'title_'.$rid}.$hwke.'</a>'.$adde);
1.2 www 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>");
1.10 ! www 487: }
! 488: unless (untie(%parmhash)) {
! 489: &Apache::lonnet::logthis("<font color=blue>WARNING: ".
! 490: "Could not untie parmhash (browse).</font>");
1.2 www 491: }
492: # -------------------------------------------------------------------- All done
493: return OK;
494: # ----------------------------------------------- Errors, hash could no be tied
495: }
496: }
497: }
1.3 www 498:
1.2 www 499: $ENV{'user.error.msg'}="$requrl:bre:0:0:Course not initialized";
500: return HTTP_NOT_ACCEPTABLE;
501: }
1.1 www 502:
503: 1;
504: __END__
1.2 www 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