--- loncom/lonnet/perl/lonnet.pm	2000/10/31 19:28:11	1.56
+++ loncom/lonnet/perl/lonnet.pm	2000/11/14 02:39:30	1.60
@@ -42,7 +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
+# EXT(name)          : value of a variable
 # refreshstate()     : refresh the state information string
 # symblist(map,hash) : Updates symbolic storage links
 # symbread([filename]) : returns the data handle (filename optional)
@@ -68,7 +68,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 Gerd Kortemeyer
 
 package Apache::lonnet;
 
@@ -546,6 +546,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;
        }
@@ -885,7 +888,9 @@ sub allowed {
                if (($ENV{$prefix.'res.'.$uri.'.lock.sections'}=~/\,$csec\,/)
                 || ($ENV{$prefix.'res.'.$uri.'.lock.sections'} eq 'all')) {
 		   if ($ENV{$prefix.'res.'.$uri.'.lock.expire'}>time) {
-                       &log('Locked by res: '.$priv.' for '.$uri.' due to '.
+                       &log($ENV{'user.domain'},$ENV{'user.name'},
+                            $ENV{'user.host'},
+                            'Locked by res: '.$priv.' for '.$uri.' due to '.
                             $cdom.'/'.$cnum.'/'.$csec.' expire '.
                             $ENV{$prefix.'priv.'.$priv.'.lock.expire'});
 		       return '';
@@ -894,7 +899,9 @@ sub allowed {
                if (($ENV{$prefix.'priv.'.$priv.'.lock.sections'}=~/\,$csec\,/)
                 || ($ENV{$prefix.'priv.'.$priv.'.lock.sections'} eq 'all')) {
 		   if ($ENV{'priv.'.$priv.'.lock.expire'}>time) {
-                       &log('Locked by priv: '.$priv.' for '.$uri.' due to '.
+                       &log($ENV{'user.domain'},$ENV{'user.name'},
+                            $ENV{'user.host'},
+                            'Locked by priv: '.$priv.' for '.$uri.' due to '.
                             $cdom.'/'.$cnum.'/'.$csec.' expire '.
                             $ENV{$prefix.'priv.'.$priv.'.lock.expire'});
 		       return '';
@@ -923,7 +930,8 @@ sub allowed {
        my $rolecode=(split(/\./,$ENV{'request.role'}))[0];
        if ($ENV{'course.'.$ENV{'request.course.id'}.'.'.$priv.'.roles.denied'}
 	   =~/\,$rolecode\,/) {
-           &log('Denied by role: '.$priv.' for '.$uri.' as '.$rolecode.' in '.
+           &log($ENV{'user.domain'},$ENV{'user.name'},$ENV{'user.host'},
+                'Denied by role: '.$priv.' for '.$uri.' as '.$rolecode.' in '.
                 $ENV{'request.course.id'});
            return '';
        }
@@ -942,7 +950,8 @@ sub allowed {
 	   }
            if (join('',@content)=~
                     /\<roledeny[^\>]*\>[^\<]*$rolecode[^\<]*\<\/roledeny\>/) {
-	       &log('Denied by role: '.$priv.' for '.$uri.' as '.$rolecode);
+	       &log($ENV{'user.domain'},$ENV{'user.name'},$ENV{'user.host'},
+                    'Denied by role: '.$priv.' for '.$uri.' as '.$rolecode);
            return '';
 
            }
@@ -1186,7 +1195,7 @@ sub condval {
 
 # --------------------------------------------------------- Value of a Variable
 
-sub varval {
+sub EXT {
     my $varname=shift;
     my ($realm,$space,$qualifier,@therest)=split(/\./,$varname);
     my $rest;
@@ -1195,15 +1204,21 @@ sub varval {
     } else {
        $rest='';
     }
+    my $qualifierrest=$qualifier;
+    if ($rest) { $qualifierrest.='.'.$rest; }
+    my $spacequalifierrest=$space;
+    if ($qualifierrest) { $spacequalifierrest.='.'.$qualifierrest; }
     if ($realm eq 'user') {
 # --------------------------------------------------------------- user.resource
 	if ($space eq 'resource') {
+	    my %restored=&restore;
+            return $restored{$qualifierrest};
 # ----------------------------------------------------------------- user.access
         } elsif ($space eq 'access') {
             return &allowed($qualifier,$rest);
 # ------------------------------------------ user.preferences, user.environment
         } elsif (($space eq 'preferences') || ($space eq 'environment')) {
-            return $ENV{join('.',('environment',$qualifier,$rest))};
+            return $ENV{join('.',('environment',$qualifierrest))};
 # ----------------------------------------------------------------- user.course
         } elsif ($space eq 'course') {
             return $ENV{join('.',('request.course',$qualifier))};
@@ -1231,33 +1246,79 @@ sub varval {
 # ------------------------------------------------------------- request.browser
         if ($space eq 'browser') {
 	    return $ENV{'browser.'.$qualifier};
-        } elsif ($space eq 'filename') {
-            return $ENV{'request.filename'};
+# ------------------------------------------------------------ request.filename
+        } else {
+            return $ENV{'request.'.$spacequalifierrest};
         }
     } elsif ($realm eq 'course') {
 # ---------------------------------------------------------- course.description
-        if ($space eq 'description') {
-            my %reply=&coursedescription($ENV{'request.course.id'});
-            return $reply{'description'};
-# ------------------------------------------------------------------- course.id
-        } elsif ($space eq 'id') {
-            return $ENV{'request.course.id'};
-# -------------------------------------------------- Any other course namespace
-        } else {
-	    my ($cdom,$cnam)=split(/\_/,$ENV{'request.course.id'});
-	    my $chome=&homeserver($cnam,$cdom);
-            my $item=join('.',($qualifier,$rest));
-            return &unescape
-                   (&reply('get:'.$cdom.':'.$cnam.':'.&escape($space).':'.
-			   &escape($item),$chome));
+        my $section='';
+        if ($ENV{'request.course.sec'}) {
+	    $section='_'.$ENV{'request.course.sec'};
+        }
+        return $ENV{'course.'.$ENV{'request.course.id'}.$section.'.'.
+                              $spacequalifierrest};
+    } elsif ($realm eq 'resource') {
+      if ($ENV{'request.course.id'}) {
+# ----------------------------------------------------- Cascading lookup scheme
+       my $reslevel=
+	    $ENV{'request.course.id'}.'.'.&symbread().'.'.$spacequalifierrest;
+       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}) { 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'});
+        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
+       
+       if ($ENV{'resource.parms.'.$reslevel}) {
+	   return $ENV{'resource.parms.'.$reslevel};
+       }
+     }
+     
+# --------------------------------------------- last, look in resource metadata
+	my $uri=&declutter($ENV{'request.filename'});
+        my $filename=$perlvar{'lonDocRoot'}.'/res/'.$ENV.'.meta';
+        if (-e $filename) {
+            my @content;
+            {
+             my $fh=Apache::File->new($filename);
+             @content=<$fh>;
+            }
+            if (join('',@content)=~
+                 /\<$space[^\>]*\>([^\<]*)\<\/$space\>/) {
+	        return $1;
+ 	    }
         }
-    } elsif ($realm eq 'userdata') {
-        my $uhome=&homeserver($qualifier,$space);
-# ----------------------------------------------- userdata.domain.name.resource
 # ---------------------------------------------------- Any other user namespace
     } elsif ($realm eq 'environment') {
 # ----------------------------------------------------------------- environment
-        return $ENV{join('.',($space,$qualifier,$rest))};
+        return $ENV{$spacequalifierrest};
     } elsif ($realm eq 'system') {
 # ----------------------------------------------------------------- system.time
 	if ($space eq 'time') {
@@ -1397,12 +1458,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/..