--- loncom/lonnet/perl/lonnet.pm	2005/04/07 08:15:41	1.621
+++ loncom/lonnet/perl/lonnet.pm	2005/04/18 21:19:53	1.626
@@ -1,7 +1,7 @@
 # The LearningOnline Network
 # TCP networking package
 #
-# $Id: lonnet.pm,v 1.621 2005/04/07 08:15:41 albertel Exp $
+# $Id: lonnet.pm,v 1.626 2005/04/18 21:19:53 albertel Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -875,6 +875,9 @@ sub do_cache_new {
     if (!defined($setvalue)) {
 	$setvalue='__undef__';
     }
+    if (!defined($time) ) {
+	$time=600;
+    }
     if ($debug) { &Apache::lonnet::logthis("Setting $id to $value"); }
     $memcache->set($id,$setvalue,$time);
     # need to make a copy of $value
@@ -1614,7 +1617,7 @@ sub courseidput {
 }
 
 sub courseiddump {
-    my ($domfilter,$descfilter,$sincefilter,$instcodefilter,$ownerfilter,$hostidflag,$hostidref)=@_;
+    my ($domfilter,$descfilter,$sincefilter,$instcodefilter,$ownerfilter,$coursefilter,$hostidflag,$hostidref)=@_;
     my %returnhash=();
     unless ($domfilter) { $domfilter=''; }
     foreach my $tryserver (keys %libserv) {
@@ -1623,7 +1626,7 @@ sub courseiddump {
 	        foreach (
                  split(/\&/,&reply('courseiddump:'.$hostdom{$tryserver}.':'.
 			       $sincefilter.':'.&escape($descfilter).':'.
-                               &escape($instcodefilter).':'.&escape($ownerfilter),
+                               &escape($instcodefilter).':'.&escape($ownerfilter).':'.&escape($coursefilter),
                                $tryserver))) {
 		    my ($key,$value)=split(/\=/,$_);
                     if (($key) && ($value)) {
@@ -2636,6 +2639,21 @@ sub cput {
    return &critical("put:$udomain:$uname:$namespace:$items",$uhome);
 }
 
+# ------------------------------------------------------ critical inc interface
+                                                                                
+sub cinc {
+   my ($namespace,$storehash,$udomain,$uname)=@_;
+   if (!$udomain) { $udomain=$env{'user.domain'}; }
+   if (!$uname) { $uname=$env{'user.name'}; }
+   my $uhome=&homeserver($uname,$udomain);
+   my $items='';
+   foreach (keys %$storehash) {
+       $items.=escape($_).'='.&freeze_escape($$storehash{$_}).'&';
+   }
+   $items=~s/\&$//;
+   return &critical("inc:$udomain:$uname:$namespace:$items",$uhome);
+}
+
 # -------------------------------------------------------------- eget interface
 
 sub eget {
@@ -4082,13 +4100,14 @@ sub devalidatecourseresdata {
 
 # --------------------------------------------------- Course Resourcedata Query
 
-sub courseresdata {
-    my ($coursenum,$coursedomain,@which)=@_;
+sub get_courseresdata {
+    my ($coursenum,$coursedomain)=@_;
     my $coursehom=&homeserver($coursenum,$coursedomain);
     my $hashid=$coursenum.':'.$coursedomain;
     my ($result,$cached)=&is_cached_new('courseres',$hashid);
+    my %dumpreply;
     unless (defined($cached)) {
-	my %dumpreply=&dump('resourcedata',$coursedomain,$coursenum);
+	%dumpreply=&dump('resourcedata',$coursedomain,$coursenum);
 	$result=\%dumpreply;
 	my ($tmp) = keys(%dumpreply);
 	if ($tmp !~ /^(con_lost|error|no_such_host)/i) {
@@ -4100,6 +4119,46 @@ sub courseresdata {
 	    &do_cache_new('courseres',$hashid,$result,600);
 	}
     }
+    return $result;
+}
+
+sub get_userresdata {
+    my ($uname,$udom)=@_;
+    #most student don\'t have any data set, check if there is some data
+    if (&EXT_cache_status($udom,$uname)) { return undef; }
+
+    my $hashid="$udom:$uname";
+    my ($result,$cached)=&is_cached_new('userres',$hashid);
+    if (!defined($cached)) {
+	my %resourcedata=&dump('resourcedata',$udom,$uname);
+	$result=\%resourcedata;
+	&do_cache_new('userres',$hashid,$result,600);
+    }
+    my ($tmp)=keys(%$result);
+    if (($tmp!~/^error\:/) && ($tmp!~/^con_lost/)) {
+	return $result;
+    }
+    #error 2 occurs when the .db doesn't exist
+    if ($tmp!~/error: 2 /) {
+	&logthis("<font color=blue>WARNING:".
+		 " Trying to get resource data for ".
+		 $uname." at ".$udom.": ".
+		 $tmp."</font>");
+    } elsif ($tmp=~/error: 2 /) {
+	&EXT_cache_set($udom,$uname);
+    }
+    return $tmp;
+}
+
+sub resdata {
+    my ($name,$domain,$type,@which)=@_;
+    my $result;
+    if ($type eq 'course') {
+	$result=&get_courseresdata($name,$domain);
+    } elsif ($type eq 'user') {
+	$result=&get_userresdata($name,$domain);
+    }
+    if (!ref($result)) { return $result; }    
     foreach my $item (@which) {
 	if (defined($result->{$item})) {
 	    return $result->{$item};
@@ -4285,44 +4344,20 @@ sub EXT {
 	    $courselevelm=$courseid.'.'.$mapparm;
 
 # ----------------------------------------------------------- first, check user
-	    #most student don\'t have any data set, check if there is some data
-	    if (! &EXT_cache_status($udom,$uname)) {
-		my $hashid="$udom:$uname";
-		my ($result,$cached)=&is_cached_new('userres',$hashid);
-		if (!defined($cached)) {
-		    my %resourcedata=&dump('resourcedata',$udom,$uname);
-		    $result=\%resourcedata;
-		    &do_cache_new('userres',$hashid,$result);
-		}
-		my ($tmp)=keys(%$result);
-		if (($tmp!~/^error\:/) && ($tmp!~/^con_lost/)) {
-		    if ($$result{$courselevelr}) {
-			return $$result{$courselevelr}; }
-		    if ($$result{$courselevelm}) {
-			return $$result{$courselevelm}; }
-		    if ($$result{$courselevel}) {
-			return $$result{$courselevel}; }
-		} else {
-		    #error 2 occurs when the .db doesn't exist
-		    if ($tmp!~/error: 2 /) {
-			&logthis("<font color=blue>WARNING:".
-				 " Trying to get resource data for ".
-				 $uname." at ".$udom.": ".
-				 $tmp."</font>");
-		    } elsif ($tmp=~/error: 2 /) {
-			&EXT_cache_set($udom,$uname);
-		    } elsif ($tmp =~ /^(con_lost|no_such_host)/) {
-			return $tmp;
-		    }
-		}
-	    }
+
+	    my $userreply=&resdata($uname,$udom,'user',
+				       ($courselevelr,$courselevelm,
+					$courselevel));
+
+	    if (defined($userreply)) { return $userreply; }
 
 # ------------------------------------------------ second, check some of course
 
-	    my $coursereply=&courseresdata($env{'course.'.$courseid.'.num'},
-					   $env{'course.'.$courseid.'.domain'},
-					   ($seclevelr,$seclevelm,$seclevel,
-					    $courselevelr));
+	    my $coursereply=&resdata($env{'course.'.$courseid.'.num'},
+				     $env{'course.'.$courseid.'.domain'},
+				     'course',
+				     ($seclevelr,$seclevelm,$seclevel,
+				      $courselevelr));
 	    if (defined($coursereply)) { return $coursereply; }
 
 # ------------------------------------------------------ third, check map parms
@@ -4354,9 +4389,10 @@ sub EXT {
 # ---------------------------------------------- fourth, look in rest pf course
 	if ($symbparm && defined($courseid) && 
 	    $courseid eq $env{'request.course.id'}) {
-	    my $coursereply=&courseresdata($env{'course.'.$courseid.'.num'},
-					   $env{'course.'.$courseid.'.domain'},
-					   ($courselevelm,$courselevel));
+	    my $coursereply=&resdata($env{'course.'.$courseid.'.num'},
+				     $env{'course.'.$courseid.'.domain'},
+				     'course',
+				     ($courselevelm,$courselevel));
 	    if (defined($coursereply)) { return $coursereply; }
 	}
 # ------------------------------------------------------------------ Cascade up
@@ -4620,7 +4656,7 @@ sub metadata {
 	$metaentry{':keys'}=join(',',keys %metathesekeys);
 	&metadata_generate_part0(\%metathesekeys,\%metaentry,$uri);
 	$metaentry{':allpossiblekeys'}=join(',',keys %metathesekeys);
-	&do_cache_new('meta',$uri,\%metaentry);
+	&do_cache_new('meta',$uri,\%metaentry,60*60*24);
 # this is the end of "was not already recently cached
     }
     return $metaentry{':'.$what};
@@ -4916,7 +4952,8 @@ sub symbread {
                  if ($#possibilities==0) {
 # ----------------------------------------------- There is only one possibility
 		     my ($mapid,$resid)=split(/\./,$ids);
-                     $syval=declutter($bighash{'map_id_'.$mapid}).'___'.$resid;
+		     $syval=&encode_symb($bighash{'map_id_'.$mapid},
+						    $resid,$thisfn);
                  } elsif (!$donotrecurse) {
 # ------------------------------------------ There is more than one possibility
                      my $realpossible=0;
@@ -4926,8 +4963,8 @@ sub symbread {
          		    my ($mapid,$resid)=split(/\./,$_);
                             if ($bighash{'map_type_'.$mapid} ne 'page') {
 				$realpossible++;
-                                $syval=declutter($bighash{'map_id_'.$mapid}).
-                                       '___'.$resid;
+                                $syval=&encode_symb($bighash{'map_id_'.$mapid},
+						    $resid,$thisfn);
                             }
 			 }
                      }
@@ -4941,7 +4978,6 @@ sub symbread {
         }
         if ($syval) {
 	    return $env{$cache_str}=$syval;
-	    #return $env{$cache_str}=&symbclean($syval.'___'.$thisfn);
         }
     }
     &appenv('request.ambiguous' => $thisfn);
@@ -6140,9 +6176,10 @@ coursedescription($courseid) : course de
 
 =item *
 
-courseresdata($coursenum,$coursedomain,@which) : request for current
-parameter setting for a specific course, @what should be a list of
-parameters to ask about. This routine caches answers for 5 minutes.
+resdata($name,$domain,$type,@which) : request for current parameter
+setting for a specific $type, where $type is either 'course' or 'user',
+@what should be a list of parameters to ask about. This routine caches
+answers for 5 minutes.
 
 =back