--- loncom/lonnet/perl/lonnet.pm	2001/08/07 22:56:06	1.143
+++ loncom/lonnet/perl/lonnet.pm	2001/08/16 11:25:03	1.149
@@ -122,7 +122,7 @@
 # 5/30 H. K. Ng
 # 6/1 Gerd Kortemeyer
 # July Guy Albertelli
-# 8/4,8/7 Gerd Kortemeyer
+# 8/4,8/7,8/8,8/9,8/11,8/16 Gerd Kortemeyer
 
 package Apache::lonnet;
 
@@ -659,6 +659,45 @@ sub log {
     return critical("log:$dom:$nam:$what",$hom);
 }
 
+# ----------------------------------------------------------- Check out an item
+
+
+sub checkout {
+    my ($symb,$tuname,$tudom,$tcrsid)=@_;
+    my $now=time;
+    my $lonhost=$perlvar{'lonHostID'};
+    my $infostr=&escape(
+                 $tuname.'&'.
+                 $tudom.'&'.
+                 $tcrsid.'&'.
+                 $symb.'&'.
+		 $now.'&'.$ENV{'REMOTE_ADDR'});
+    my $token=&reply('tmpput:'.$infostr,$lonhost);
+    if ($token=~/^error\:/) { return ''; }
+    $token=~s/^(\d+)\_.*\_(\d+)$/$1\*$2\*$lonhost/;
+    $token=~tr/a-z/A-Z/;
+
+    my %infohash=('token' => $token,
+                  'checktime' => $now,
+                  'remote' => $ENV{'REMOTE_ADDR'});
+
+    unless (&cstore(\%infohash,$symb,$tcrsid,$tudom,$tuname) eq 'ok') {
+       return '';
+    }    
+
+    if (&log($tudom,$tuname,&homeserver($tuname,$tudom),
+                         &escape('Checkout '.$infostr.' - '.
+                                                 $token)) ne 'ok') {
+	return '';
+    }
+}
+
+# ------------------------------------------------------------ Check in an item
+
+sub checkin {
+    my $token=shift;
+}
+
 # --------------------------------------------- Set Expire Date for Spreadsheet
 
 sub expirespread {
@@ -896,7 +935,7 @@ sub rolesinit {
         my $author=0;
         map {
             %thesepriv=();
-            if (($_!~/^st/) && ($_!~/^ta/)) { $adv=1; }
+            if (($_!~/^st/) && ($_!~/^ta/) && ($_!~/^cm/)) { $adv=1; }
             if (($_=~/^au/) || ($_=~/^ca/)) { $author=1; }
             map {
                 if ($_ ne '') {
@@ -1108,10 +1147,22 @@ sub allowed {
            }
        }
        
-       if (($ENV{'HTTP_REFERER'}) && ($checkreferer)) {
-	  my $refuri=$ENV{'HTTP_REFERER'};
-          $refuri=~s/^http\:\/\/$ENV{'request.host'}//i;
-          $refuri=&declutter($refuri);
+       if ($checkreferer) {
+	  my $refuri=$ENV{'httpref.'.$uri};
+
+            unless ($refuri) {
+                map {
+		    if ($_=~/^httpref\..*\*/) {
+			my $pattern=$_;
+                        $pattern=~s/\*/\[\^\/\]\+/g;
+                        $pattern=~s/\//\\\//g;
+                        if ($uri=~/$pattern/) {
+			    $refuri=$ENV{$_};
+                        }
+                    }
+                } keys %ENV;
+            }
+         if ($refuri) { 
           my @uriparts=split(/\//,$refuri);
           my $filename=$uriparts[$#uriparts];
           my $pathname=$refuri;
@@ -1129,6 +1180,7 @@ sub allowed {
               }
             }
           }
+        }
        }
    }
 
@@ -1674,7 +1726,7 @@ sub condval {
 # --------------------------------------------------------- Value of a Variable
 
 sub EXT {
-    my $varname=shift;
+    my ($varname,$symbparm)=@_;
     unless ($varname) { return ''; }
     my ($realm,$space,$qualifier,@therest)=split(/\./,$varname);
     my $rest;
@@ -1735,8 +1787,17 @@ sub EXT {
                               $spacequalifierrest};
     } elsif ($realm eq 'resource') {
        if ($ENV{'request.course.id'}) {
+
+#	   print '<br>'.$space.' - '.$qualifier.' - '.$spacequalifierrest;
+
+
 # ----------------------------------------------------- Cascading lookup scheme
-         my $symbp=&symbread();
+         my $symbp;
+         if ($symbparm) {
+            $symbp=$symbparm;
+	 } else {
+            $symbp=&symbread();
+         }            
          my $mapp=(split(/\_\_\_/,$symbp))[0];
 
          my $symbparm=$symbp.'.'.$spacequalifierrest;
@@ -1823,12 +1884,21 @@ sub EXT {
       $metadata=&metadata($ENV{'request.filename'},
                                          'parameter_'.$spacequalifierrest);
       if ($metadata) { return $metadata; }
-      
-      $spacequalifierrest=~/[^\_]+$/;
-      
-      $metadata=&metadata($ENV{'request.filename'},'parameter_0'.$1);
 
-      if ($metadata) { return $metadata; }
+# ------------------------------------------------------------------ Cascade up
+
+      unless ($space eq '0') {
+          my ($part,$id)=split(/\_/,$space);
+          if ($id) {
+	      my $partgeneral=&EXT('resource.'.$part.'.'.$qualifierrest,
+                                   $symbparm);
+              if ($partgeneral) { return $partgeneral; }
+          } else {
+              my $resourcegeneral=&EXT('resource.0.'.$qualifierrest,
+                                       $symbparm);
+              if ($resourcegeneral) { return $resourcegeneral; }
+          }
+      }
 
 # ---------------------------------------------------- Any other user namespace
     } elsif ($realm eq 'environment') {
@@ -1878,13 +1948,14 @@ sub metadata {
 		  if ($_=~/^$package\&/) {
 		      my ($pack,$name,$subp)=split(/\&/,$_);
                       my $value=$packagetab{$_};
+		      my $part=$keyroot;
+                      $part=~s/^\_//;
                       if ($subp eq 'display') {
-			  my $part=$keyroot;
-                          $part=~s/^\_//;
 			  $value.=' [Part: '.$part.']';
                       }
                       my $unikey='parameter'.$keyroot.'_'.$name;
                       $metathesekeys{$unikey}=1;
+                      $metacache{$uri.':'.$unikey.'.part'}=$part;
                       unless 
                        (defined($metacache{$uri.':'.$unikey.'.'.$subp})) {
                          $metacache{$uri.':'.$unikey.'.'.$subp}=$value;