--- loncom/lonnet/perl/lonnet.pm	2000/10/31 22:32:32	1.57
+++ loncom/lonnet/perl/lonnet.pm	2000/11/22 12:14:56	1.68
@@ -42,8 +42,7 @@
 # directcondval(index) : reading condition value of single condition from 
 #                        state string
 # condval(index)     : value of condition index based on state
-# varval(name)       : value of a variable
-# refreshstate()     : refresh the state information string
+# EXT(name)          : value of a variable
 # symblist(map,hash) : Updates symbolic storage links
 # symbread([filename]) : returns the data handle (filename optional)
 # rndseed()          : returns a random seed  
@@ -68,7 +67,7 @@
 # 10/04 Gerd Kortemeyer
 # 10/04 Guy Albertelli
 # 10/06,10/09,10/10,10/11,10/14,10/20,10/23,10/25,10/26,10/27,10/28,10/29, 
-# 10/30,10/31 Gerd Kortemeyer
+# 10/30,10/31,11/2,11/14,11/15,11/16,11/20,11/21,11/22 Gerd Kortemeyer
 
 package Apache::lonnet;
 
@@ -123,8 +122,7 @@ sub reply {
     my ($cmd,$server)=@_;
     my $answer=subreply($cmd,$server);
     if ($answer eq 'con_lost') { $answer=subreply($cmd,$server); }
-    if (($answer=~/^error:/) || ($answer=~/^refused/) || 
-        ($answer=~/^rejected/)) {
+    if (($answer=~/^refused/) || ($answer=~/^rejected/)) {
        &logthis("<font color=blue>WARNING:".
                 " $cmd to $server returned $answer</font>");
     }
@@ -370,6 +368,9 @@ sub subscribe {
         return 'not_found'; 
     }
     my $answer=reply("sub:$fname",$home);
+    if (($answer eq 'con_lost') || ($answer eq 'rejected')) {
+	$answer.=' by '.$home;
+    }
     return $answer;
 }
     
@@ -381,14 +382,14 @@ sub repcopy {
     my $transname="$filename.in.transfer";
     if ((-e $filename) || (-e $transname)) { return OK; }
     my $remoteurl=subscribe($filename);
-    if ($remoteurl eq 'con_lost') {
-	   &logthis("Subscribe returned con_lost: $filename");
+    if ($remoteurl =~ /^con_lost by/) {
+	   &logthis("Subscribe returned $remoteurl: $filename");
            return HTTP_SERVICE_UNAVAILABLE;
     } elsif ($remoteurl eq 'not_found') {
 	   &logthis("Subscribe returned not_found: $filename");
 	   return HTTP_NOT_FOUND;
-    } elsif ($remoteurl eq 'rejected') {
-	   &logthis("Subscribe returned rejected: $filename");
+    } elsif ($remoteurl =~ /^rejected by/) {
+	   &logthis("Subscribe returned $remoteurl: $filename");
            return FORBIDDEN;
     } elsif ($remoteurl eq 'directory') {
            return OK;
@@ -546,6 +547,9 @@ sub coursedescription {
            $returnhash{'fn'}=$perlvar{'lonDaemons'}.'/tmp/'.
 	       $ENV{'user.name'}.'_'.$cdomain.'_'.$cnum;
            $envhash{'course.'.$normalid.'.last_cache'}=time;
+           $envhash{'course.'.$normalid.'.home'}=$chome;
+           $envhash{'course.'.$normalid.'.domain'}=$cdomain;
+           $envhash{'course.'.$normalid.'.num'}=$cnum;
            &appenv(%envhash);
            return %returnhash;
        }
@@ -772,8 +776,9 @@ sub allowed {
     }
 
 # Course: uri itself is a course
-
-    if ($ENV{'user.priv.'.$ENV{'request.role'}.'./'.$uri}
+    my $courseuri=$uri;
+    $courseuri=~s/\_(\d)/\/$1/;
+    if ($ENV{'user.priv.'.$ENV{'request.role'}.'./'.$courseuri}
        =~/$priv\&([^\:]*)/) {
        $thisallowed.=$1;
     }
@@ -968,11 +973,6 @@ sub allowed {
    return 'F';
 }
 
-# ---------------------------------------------------------- Refresh State Info
-
-sub refreshstate {
-}
-
 # ----------------------------------------------------------------- Define Role
 
 sub definerole {
@@ -1192,8 +1192,9 @@ sub condval {
 
 # --------------------------------------------------------- Value of a Variable
 
-sub varval {
+sub EXT {
     my $varname=shift;
+    unless ($varname) { return ''; }
     my ($realm,$space,$qualifier,@therest)=split(/\./,$varname);
     my $rest;
     if ($therest[0]) {
@@ -1256,9 +1257,59 @@ sub varval {
         return $ENV{'course.'.$ENV{'request.course.id'}.$section.'.'.
                               $spacequalifierrest};
     } elsif ($realm eq 'resource') {
-# ----------------------------------------------------------- resource metadata
+      if ($ENV{'request.course.id'}) {
+# ----------------------------------------------------- Cascading lookup scheme
+       my $symbparm=&symbread().'.'.$spacequalifierrest;
+       my $reslevel=
+	    $ENV{'request.course.id'}.'.'.$symbparm;
+       my $seclevel=
+            $ENV{'request.course.id'}.'.'.
+		$ENV{'request.course.sec'}.'.'.$spacequalifierrest;
+       my $courselevel=
+            $ENV{'request.course.id'}.'.'.$spacequalifierrest;
+
+# ----------------------------------------------------------- first, check user
+      my %resourcedata=get('resourcedata',($reslevel,$seclevel,$courselevel));
+      if ($resourcedata{$reslevel}!~/^error\:/) {
+       if ($resourcedata{$reslevel}) { return $resourcedata{$reslevel}; }
+       if ($resourcedata{$seclevel}) { return $resourcedata{$seclevel}; }
+       if ($resourcedata{$courselevel}) { return $resourcedata{$courselevel}; }
+      }
+# -------------------------------------------------------- second, check course
+        my $section='';
+        if ($ENV{'request.course.sec'}) {
+	    $section='_'.$ENV{'request.course.sec'};
+        }
+        my $reply=&reply('get:'.
+              $ENV{'course.'.$ENV{'request.course.id'}.$section.'.domain'}.':'.
+              $ENV{'course.'.$ENV{'request.course.id'}.$section.'.num'}.
+              ':resourcedata:'.
+              escape($reslevel).':'.escape($seclevel).':'.escape($courselevel),
+		   $ENV{'course.'.$ENV{'request.course.id'}.$section.'.home'});
+      if ($reply!~/^error\:/) {
+        map {
+           my ($name,$value)=split(/\=/,$_);
+           $resourcedata{unescape($name)}=unescape($value);  
+        } split(/\&/,$reply);
+       if ($resourcedata{$reslevel}) { return $resourcedata{$reslevel}; }
+       if ($resourcedata{$seclevel}) { return $resourcedata{$seclevel}; }  
+       if ($resourcedata{$courselevel}) { return $resourcedata{$courselevel}; }
+      }
+
+# ------------------------------------------------------ third, check map parms
+       my %parmhash=();
+       my $thisparm='';       
+       if (tie(%parmhash,'GDBM_File',
+          $ENV{'request.course.fn'}.'_parms.db',&GDBM_READER,0640)) {
+           $thisparm=$parmhash{$symbparm};
+	   untie(%parmhash);
+       }
+       if ($thisparm) { return $thisparm; }
+     }
+     
+# --------------------------------------------- last, look in resource metadata
 	my $uri=&declutter($ENV{'request.filename'});
-        my $filename=$perlvar{'lonDocRoot'}.'/res/'.$ENV.'.meta';
+        my $filename=$perlvar{'lonDocRoot'}.'/res/'.$uri.'.meta';
         if (-e $filename) {
             my @content;
             {
@@ -1268,13 +1319,8 @@ sub varval {
             if (join('',@content)=~
                  /\<$space[^\>]*\>([^\<]*)\<\/$space\>/) {
 	        return $1;
-            } else {
-                return '';
-            }
-         }
-    } elsif ($realm eq 'userdata') {
-        my $uhome=&homeserver($qualifier,$space);
-# ----------------------------------------------- userdata.domain.name.resource
+ 	    }
+        }
 # ---------------------------------------------------- Any other user namespace
     } elsif ($realm eq 'environment') {
 # ----------------------------------------------------------------- environment
@@ -1340,6 +1386,9 @@ sub symbread {
                             &GDBM_READER,0640)) {
 # ---------------------------------------------- Get ID(s) for current resource
               my $ids=$bighash{'ids_/res/'.$thisfn};
+              unless ($ids) { 
+                 $ids=$bighash{'ids_/'.$thisfn};
+              }
               if ($ids) {
 # ------------------------------------------------------------------- Has ID(s)
                  my @possibilities=split(/\,/,$ids);
@@ -1367,7 +1416,9 @@ sub symbread {
               untie(%bighash)
            } 
         }
-        if ($syval) { return $syval.'___'.$thisfn; }
+        if ($syval) {
+           return $syval.'___'.$thisfn; 
+        }
     }
     &appenv('request.ambiguous' => $thisfn);
     return '';
@@ -1418,12 +1469,17 @@ sub filelocation {
   my ($dir,$file) = @_;
   my $location;
   $file=~ s/^\s*(\S+)\s*$/$1/; ## strip off leading and trailing spaces
-  $file=~s/^$perlvar{'lonDocRoot'}//;
-  $file=~s:^/*res::;
-  if ( !( $file =~ m:^/:) ) {
-    $location = $dir. '/'.$file;
+  if ($file=~m:^/~:) { # is a contruction space reference
+    $location = $file;
+    $location =~ s:/~(.*?)/(.*):/home/$1/public_html/$2:;
   } else {
-    $location = '/home/httpd/html/res'.$file;
+    $file=~s/^$perlvar{'lonDocRoot'}//;
+    $file=~s:^/*res::;
+    if ( !( $file =~ m:^/:) ) {
+      $location = $dir. '/'.$file;
+    } else {
+      $location = '/home/httpd/html/res'.$file;
+    }
   }
   $location=~s://+:/:g; # remove duplicate /
   while ($location=~m:/\.\./:) {$location=~ s:/[^/]+/\.\./:/:g;} #remove dir/..