--- loncom/interface/lonnavmaps.pm	2001/01/17 17:27:04	1.8
+++ loncom/interface/lonnavmaps.pm	2001/02/08 21:47:44	1.14
@@ -9,7 +9,7 @@
 # 08/30,08/31,09/06,09/14,09/15,09/16,09/19,09/20,09/21,09/23,
 # 10/02,10/10,10/14,10/16,10/18,10/19,10/31,11/6,11/14,11/16 Gerd Kortemeyer)
 #
-# 3/1/1,6/1,17/1 Gerd Kortemeyer
+# 3/1/1,6/1,17/1,29/1,30/1,2/8 Gerd Kortemeyer
 
 package Apache::lonnavmaps;
 
@@ -23,6 +23,23 @@ use GDBM_File;
 my %hash;
 my @rows;
 
+#
+# These cache hashes need to be independent of user, resource and course
+# (user and course can/should be in the keys)
+#
+
+my %courserdatas;
+my %userrdatas;
+
+#
+# These global hashes are dependent on user, course and resource, 
+# and need to be initialized every time when a sheet is calculated
+#
+my %courseopt;
+my %useropt;
+my %parmhash;
+
+
 # ------------------------------------------------------------------ Euclid gcd
 
 sub euclid {
@@ -36,6 +53,181 @@ sub euclid {
     return $b;
 }
 
+# --------------------------------------------------------------------- Parmval
+
+# -------------------------------------------- Figure out a cascading parameter
+#
+# For this function to work
+#
+# * parmhash needs to be tied
+# * courseopt and useropt need to be initialized for this user and course
+#
+
+sub parmval {
+    my ($what,$symb)=@_;
+    my $cid=$ENV{'request.course.id'};
+    my $csec=$ENV{'request.course.sec'};
+    my $uname=$ENV{'user.name'};
+    my $udom=$ENV{'user.domain'};
+
+    unless ($symb) { return ''; }
+    my $result='';
+
+    my ($mapname,$id,$fn)=split(/\_\_\_/,$symb);
+
+# ----------------------------------------------------- Cascading lookup scheme
+       my $rwhat=$what;
+       $what=~s/^parameter\_//;
+       $what=~s/\_/\./;
+
+       my $symbparm=$symb.'.'.$what;
+       my $mapparm=$mapname.'___(all).'.$what;
+       my $usercourseprefix=$uname.'_'.$udom.'_'.$cid;
+
+       my $seclevel=
+            $usercourseprefix.'.['.
+		$csec.'].'.$what;
+       my $seclevelr=
+            $usercourseprefix.'.['.
+		$csec.'].'.$symbparm;
+       my $seclevelm=
+            $usercourseprefix.'.['.
+		$csec.'].'.$mapparm;
+
+       my $courselevel=
+            $usercourseprefix.'.'.$what;
+       my $courselevelr=
+            $usercourseprefix.'.'.$symbparm;
+       my $courselevelm=
+            $usercourseprefix.'.'.$mapparm;
+
+# ---------------------------------------------------------- fourth, check user
+      
+      if ($uname) { 
+
+       if ($useropt{$courselevelr}) { return $useropt{$courselevelr}; }
+
+       if ($useropt{$courselevelm}) { return $useropt{$courselevelm}; }
+
+       if ($useropt{$courselevel}) { return $useropt{$courselevel}; }
+
+      }
+
+# --------------------------------------------------------- third, check course
+     
+       if ($csec) {
+ 
+        if ($courseopt{$seclevelr}) { return $courseopt{$seclevelr}; }
+
+        if ($courseopt{$seclevelm}) { return $courseopt{$seclevelm}; }  
+
+        if ($courseopt{$seclevel}) { return $courseopt{$seclevel}; }
+  
+      }
+
+       if ($courseopt{$courselevelr}) { return $courseopt{$courselevelr}; }
+
+       if ($courseopt{$courselevelm}) { return $courseopt{$courselevelm}; }
+
+       if ($courseopt{$courselevel}) { return $courseopt{$courselevel}; }
+
+# ----------------------------------------------------- second, check map parms
+
+       my $thisparm=$parmhash{$symbparm};
+       if ($thisparm) { return $thisparm; }
+
+# -------------------------------------------------------- first, check default
+
+       return &Apache::lonnet::metadata($fn,$rwhat.'.default');
+        
+}
+
+
+
+# ------------------------------------------------------------- Find out status
+
+sub astatus {
+    my $rid=shift;
+    my $code=1;
+    my $ctext='';
+    $rid=~/(\d+)\.(\d+)/;
+    my $symb=&Apache::lonnet::declutter($hash{'map_id_'.$1}).'___'.$2.'___'.
+	     &Apache::lonnet::declutter($hash{'src_'.$rid});
+    my $duedate=&parmval('0.duedate',$symb);
+    my $opendate=&parmval('0.opendate',$symb);
+    my $answerdate=&parmval('0.answerdate',$symb);
+    my $now=time;
+    my $tcode=0;
+   if ($opendate) {
+    if ($now<$duedate) {
+        $tcode=2; 
+        $ctext='Due: '.localtime($duedate);
+        if ($now<$opendate) { 
+          $tcode=1; 
+          $ctext='Open: '.localtime($opendate);
+        }
+        if ($duedate-$now<86400) {
+	   $tcode=4;
+           $ctext='Due: '.localtime($duedate);
+        }
+     } else {
+       $tcode=3;
+       if ($now<$answerdate) {  
+          $ctext='Answer: '.localtime($duedate);
+       }
+    }
+   } else {
+    $tcode=1;
+   }
+    my $answer=&Apache::lonnet::reply(
+              "restore:$ENV{'user.domain'}:$ENV{'user.name'}:".
+              $ENV{'request.course.id'}.':'.
+              &Apache::lonnet::escape($symb),
+              "$ENV{'user.home'}");
+    my %returnhash=();
+    map {
+	my ($name,$value)=split(/\=/,$_);
+        $returnhash{&Apache::lonnet::unescape($name)}=
+                    &Apache::lonnet::unescape($value);
+    } split(/\&/,$answer);
+    if ($returnhash{'version'}) {
+       my $version;
+       for ($version=1;$version<=$returnhash{'version'};$version++) {
+          map {
+             $returnhash{$_}=$returnhash{$version.':'.$_};
+          } split(/\:/,$returnhash{$version.':keys'});
+       }
+       map {
+           if (($_=~/\.(\w+)\.solved$/) && ($_!~/^\d+\:/)) {
+               my $part=$1;
+               if ($ctext) { $ctext.=', '; }
+               if ($part) {
+		   $ctext.='Part '.$part.': ';
+               }
+	       if ($returnhash{$_} eq 'correct_by_student') {
+                   unless ($code==2) { $code=3; }
+                   $ctext.='solved';
+               } elsif ($returnhash{$_} eq 'correct_by_override') {
+                   unless ($code==2) { $code=3; }
+                   $ctext.='override';
+               } elsif ($returnhash{$_} eq 'incorrect_attempted') {
+                   $code=2;
+                   $ctext.=
+                     $returnhash{'resource.'.$part.'.tries'}.'/'.
+                     &parmval($part.'.maxtries',$symb).' tries';
+               } elsif ($returnhash{$_} eq 'incorrect_by_override') {
+                   $code=2;
+                   $ctext.='override';
+               } elsif ($returnhash{$_} eq 'excused') {
+                   unless ($code==2) { $code=3; }
+                   $ctext.='excused';
+               }
+           }
+       } keys %returnhash;
+    }
+    return 'p'.$code.$tcode.'"'.$ctext.'"';
+}
+
 # ------------------------------------------------------------ Build page table
 
 sub tracetable {
@@ -68,8 +260,10 @@ sub tracetable {
                my $brepriv=&Apache::lonnet::allowed('bre',$hash{'src_'.$frid});
                if (($brepriv eq '2') || ($brepriv eq 'F')) {
 		 my $pprefix='';
-                 if ($hash{'src_'.$frid}=~/\.problem$/) {
-		     $pprefix='p1';
+                 if ($hash{'src_'.$frid}=~
+                                 /\.(problem|exam|quiz|assess|survey|form)$/) {
+		     $pprefix=&astatus($frid);
+
                  }
                  if (defined($rows[$sofar])) {
                    $rows[$sofar].='&'.$pprefix.$frid;
@@ -85,8 +279,9 @@ sub tracetable {
            my $brepriv=&Apache::lonnet::allowed('bre',$hash{'src_'.$rid});
            if (($brepriv eq '2') || ($brepriv eq 'F')) {
 	     my $pprefix='';
-             if ($hash{'src_'.$rid}=~/\.problem$/) {
-	         $pprefix='p1';
+             if ($hash{'src_'.$rid}=~
+                                 /\.(problem|exam|quiz|assess|survey|form)$/) {
+	         $pprefix=&astatus($rid);
              }
              if (defined($rows[$sofar])) {
                 $rows[$sofar].='&'.$pprefix.$rid;
@@ -148,12 +343,62 @@ sub handler {
   if ($ENV{'request.course.fn'}) {
       my $fn=$ENV{'request.course.fn'};
       if (-e "$fn.db") {
-          if (tie(%hash,'GDBM_File',"$fn.db",&GDBM_READER,0640)) {
+          if ((tie(%hash,'GDBM_File',"$fn.db",&GDBM_READER,0640)) &&
+             (tie(%parmhash,'GDBM_File',
+           $ENV{'request.course.fn'}.'_parms.db',&GDBM_READER,0640))) {
 # ------------------------------------------------------------------- Hash tied
               my $firstres=$hash{'map_start_/res/'.$ENV{'request.course.uri'}};
               my $lastres=$hash{'map_finish_/res/'.$ENV{'request.course.uri'}};
               if (($firstres) && ($lastres)) {
 # ----------------------------------------------------------------- Render page
+# -------------------------------------------------------------- Set parameters
+
+
+# ---------------------------- initialize coursedata and userdata for this user
+    undef %courseopt;
+    undef %useropt;
+
+    my $uname=$ENV{'user.name'};
+    my $udom=$ENV{'user.domain'};
+    my $uhome=$ENV{'user.home'};
+    my $cid=$ENV{'request.course.id'};
+    my $chome=$ENV{'course.'.$cid.'.home'};
+    my ($cdom,$cnum)=split(/\_/,$cid);
+
+    my $userprefix=$uname.'_'.$udom.'_';
+
+    unless ($uhome eq 'no_host') { 
+# -------------------------------------------------------------- Get coursedata
+      unless
+        ((time-$courserdatas{$cid.'.last_cache'})<240) {
+         my $reply=&Apache::lonnet::reply('dump:'.$cdom.':'.$cnum.
+              ':resourcedata',$chome);
+         if ($reply!~/^error\:/) {
+            $courserdatas{$cid}=$reply;
+            $courserdatas{$cid.'.last_cache'}=time;
+         }
+      }
+      map {
+         my ($name,$value)=split(/\=/,$_);
+         $courseopt{$userprefix.&Apache::lonnet::unescape($name)}=
+                    &Apache::lonnet::unescape($value);
+      } split(/\&/,$courserdatas{$cid});
+# --------------------------------------------------- Get userdata (if present)
+      unless
+        ((time-$userrdatas{$uname.'___'.$udom.'.last_cache'})<240) {
+         my $reply=
+       &Apache::lonnet::reply('dump:'.$udom.':'.$uname.':resourcedata',$uhome);
+         if ($reply!~/^error\:/) {
+	     $userrdatas{$uname.'___'.$udom}=$reply;
+	     $userrdatas{$uname.'___'.$udom.'.last_cache'}=time;
+         }
+      }
+      map {
+         my ($name,$value)=split(/\=/,$_);
+         $useropt{$userprefix.&Apache::lonnet::unescape($name)}=
+	          &Apache::lonnet::unescape($value);
+      } split(/\&/,$userrdatas{$uname.'___'.$udom});
+    }
 
                   @rows=();
 
@@ -189,8 +434,13 @@ sub handler {
                       $r->send_http_header;
                       $r->print('<html><body>Empty Map.</body></html>');
                   } else {
+
 # ------------------------------------------------------------------ Build page
 
+		      my $currenturl=$ENV{'form.postdata'};
+                      $currenturl=~s/^http\:\/\///;
+                      $currenturl=~s/^[^\/]+//;
+
 # ---------------------------------------------------------------- Send headers
 
                           $r->content_type('text/html');
@@ -198,13 +448,37 @@ sub handler {
                           $r->print(
                    '<html><head><title>Navigate LON-CAPA Maps</title></head>');
 
-			  $r->print('<body bgcolor="#FFFFFF">'.
-                                    '<script>window.focus();</script>'.
+			  $r->print('<body bgcolor="#FFFFFF"');
+                          if (($currenturl=~/^\/res/) &&
+                              ($currenturl!~/^\/res\/adm/)) {
+                             $r->print(' onLoad="window.location.hash='.
+				       "'curloc'".'"');
+			  }
+                          $r->print('><script>window.focus();</script>'.
                            '<img align=right src=/adm/lonIcons/lonlogos.gif>'.
                                     '<h1>Navigate Course Map</h1>');
-                          $r->rflush();
+		      $r->rflush();
+                      if (($currenturl=~/^\/res/) &&
+                          ($currenturl!~/^\/res\/adm/)) {
+		       $r->print('<a href="#curloc">Current Location</a><p>');
+                      }
+# ----------------------------------------------------- The little content list
+                      for ($i=0;$i<=$#rows;$i++) {
+			if ($rows[$i]) {
+                          my @colcont=split(/\&/,$rows[$i]);
+                          my $avespan=$lcm/($#colcont+1);
+                          for ($j=0;$j<=$#colcont;$j++) {
+                              my $rid=$colcont[$j];
+                              if ($rid=~/^h(.+)/) {
+				  $rid=$1;
+                                  $r->print(
+     '&nbsp;&nbsp;&nbsp;<a href="#'.$rid.'">'.$hash{'title_'.$rid}.'</a><br>');
+                              }
+                          }
+		        }
+                      }
 # ----------------------------------------------------------------- Start table
-                      $r->print('<table cols="'.$lcm.'" border="0">');
+                      $r->print('<hr><table cols="'.$lcm.'" border="0">');
                       for ($i=0;$i<=$#rows;$i++) {
 			if ($rows[$i]) {
                           $r->print("\n<tr>");
@@ -218,23 +492,50 @@ sub handler {
                               my $hwke='</font>';
                               if ($rid=~/^h(.+)/) {
 				  $rid=$1;
-                                  $add='<th bgcolor="#AAFF55">';
+                                  $add=
+                                   '<th bgcolor="#AAFF55"><a name="'.$rid.'">';
                                   $adde='</th>';
                               }
-                              if ($rid=~/^p(\d)(.+)/) {
+                            if ($rid=~/^p(\d)(\d)\"([\w\: \(\)\/\,]*)\"(.+)/) {
                                   my $code=$1;
-                                  $rid=$2;
-                                  $hwk='<font color="#999911">';
+                                  my $tcode=$2;
+                                  my $ctext=$3;
+                                  $rid=$4;
+                                  if ($tcode eq '1') {
+                                     $add='<td bgcolor="#AAAAAA">';
+                                  }
+                                  if ($code eq '3') {
+                                     $add='<td bgcolor="#AAFFAA">';
+				  } else {
+                                      $add='<td bgcolor="#FFAAAA">';
+				      if ($tcode eq '2') {
+                                         $add='<td bgcolor="#FFFFAA">';
+                                      }
+                                      if ($tcode eq '4') {
+                                         $add='<td bgcolor="#FFFF33"><blink>';
+                                         $adde='</blink></td>';
+                                      }
+                                  }
+                                  $hwk='<font color="#888811"><b>';
+                                  $hwke='</b></font>';
+                                  if ($code eq '1') {
+                                     $hwke='</b> ('.$ctext.')</font>';
+                                  }
                                   if ($code eq '2') {
-                                     $hwk='<font color="#999911"><b>';
-                                     $hwke='</b></font>';
+                                     $hwk='<font color="#992222"><b>';
+                                     $hwke='</b> ('.$ctext.')</font>';
                                   }
                                   if ($code eq '3') {
-                                     $hwk='<font color="#229922">';
-                                  } elsif ($code eq '4') {
-                                     $hwk='<font color="#992222">';
+                                     $hwk='<font color="#229922"><b>';
+                                     $hwke='</b> ('.$ctext.')</font>';
                                   }
                               }
+			      if ($hash{'src_'.$rid} eq $currenturl) {
+                                  $add=$add.'<a name="curloc"></a>'.
+				      '<font color=red><b>-&gt; </b></font>';
+                                  $adde=
+                                '<font color=red><b> &lt;-</b></font>'.$adde;
+                              }
                               $r->print($add.'<a href="'.$hash{'src_'.$rid}.
                                 '">'.$hwk.
                                 $hash{'title_'.$rid}.$hwke.'</a>'.$adde);
@@ -243,7 +544,6 @@ sub handler {
 		        }
                       }
                       $r->print("\n</table>");
-
                       $r->print('</body></html>');
 # -------------------------------------------------------------------- End page
                   }                  
@@ -258,6 +558,10 @@ sub handler {
                    &Apache::lonnet::logthis("<font color=blue>WARNING: ".
                        "Could not untie coursemap $fn (browse).</font>"); 
               }
+              unless (untie(%parmhash)) {
+                   &Apache::lonnet::logthis("<font color=blue>WARNING: ".
+                       "Could not untie parmhash (browse).</font>"); 
+              }
 # -------------------------------------------------------------------- All done
 	      return OK;
 # ----------------------------------------------- Errors, hash could no be tied