--- loncom/lonnet/perl/lonnet.pm	2000/11/22 12:14:56	1.68
+++ loncom/lonnet/perl/lonnet.pm	2000/12/02 12:41:48	1.75
@@ -52,6 +52,17 @@
 #                          from the directory dir
 # hreflocation(dir,file) : same as filelocation, but for hrefs
 # log(domain,user,home,msg) : write to permanent log for user
+# usection(domain,user,courseid) : output of section name/number or '' for
+#                                  "not in course" and '-1' for "no section"
+# userenvironment(domain,user,what) : puts out any environment parameter 
+#                                     for a user
+# idput(domain,hash) : writes IDs for users from hash (name=>id,name=>id)
+# idget(domain,array): returns hash with usernames (id=>name,id=>name) for
+#                      an array of IDs
+# idrget(domain,array): returns hash with IDs for usernames (name=>id,...) for
+#                       an array of names
+# metadata(file,entry): returns the metadata entry for a file. entry='keys'
+#                       returns a comma separated list of keys
 #
 # 6/1/99,6/2,6/10,6/11,6/12,6/14,6/26,6/28,6/29,6/30,
 # 7/1,7/2,7/9,7/10,7/12,7/14,7/15,7/19,
@@ -67,7 +78,9 @@
 # 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,11/2,11/14,11/15,11/16,11/20,11/21,11/22 Gerd Kortemeyer
+# 10/30,10/31,
+# 11/2,11/14,11/15,11/16,11/20,11/21,11/22,11/25,11/27,
+# 12/02 Gerd Kortemeyer
 
 package Apache::lonnet;
 
@@ -76,10 +89,11 @@ use Apache::File;
 use LWP::UserAgent();
 use HTTP::Headers;
 use vars 
-qw(%perlvar %hostname %homecache %spareid %hostdom %libserv %pr %prp %fe %fd $readit);
+qw(%perlvar %hostname %homecache %spareid %hostdom %libserv %pr %prp %fe %fd $readit %metacache);
 use IO::Socket;
 use GDBM_File;
 use Apache::Constants qw(:common :http);
+use HTML::TokeParser;
 
 # --------------------------------------------------------------------- Logging
 
@@ -356,6 +370,111 @@ sub homeserver {
     return 'no_host';
 }
 
+# ------------------------------------- Find the usernames behind a list of IDs
+
+sub idget {
+    my ($udom,@ids)=@_;
+    my %returnhash=();
+    
+    my $tryserver;
+    foreach $tryserver (keys %libserv) {
+       if ($hostdom{$tryserver} eq $udom) {
+	  my $idlist=join('&',@ids);
+          $idlist=~tr/A-Z/a-z/; 
+	  my $reply=&reply("idget:$udom:".$idlist,$tryserver);
+          my @answer=();
+          if ($reply ne 'con_lost') {
+	      @answer=split(/\&/,$reply);
+          }                    ;
+          my $i;
+          for ($i=0;$i<=$#ids;$i++) {
+              if ($answer[$i]) {
+		  $returnhash{$ids[$i]}=$answer[$i];
+              } 
+          }
+       }
+    }    
+    return %returnhash;
+}
+
+# ------------------------------------- Find the IDs behind a list of usernames
+
+sub idrget {
+    my ($udom,@unames)=@_;
+    my %returnhash=();
+    map {
+        $returnhash{$_}=(&userenvironment($udom,$_,'id'))[1];
+    } @unames;
+    return %returnhash;
+}
+
+# ------------------------------- Store away a list of names and associated IDs
+
+sub idput {
+    my ($udom,%ids)=@_;
+    my %servers=();
+    map {
+        my $uhom=&homeserver($_,$udom);
+        if ($uhom ne 'no_host') {
+            my $id=&escape($ids{$_});
+            $id=~tr/A-Z/a-z/;
+            my $unam=&escape($_);
+	    if ($servers{$uhom}) {
+		$servers{$uhom}.='&'.$id.'='.$unam;
+            } else {
+                $servers{$uhom}=$id.'='.$unam;
+            }
+            &critical('put:'.$udom.':'.$unam.':environment:id='.$id,$uhom);
+        }
+    } keys %ids;
+    map {
+        &critical('idput:'.$udom.':'.$servers{$_},$_);
+    } keys %servers;
+}
+
+# ------------------------------------- Find the section of student in a course
+
+sub usection {
+    my ($udom,$unam,$courseid)=@_;
+    $courseid=~s/\_/\//g;
+    $courseid=~s/^(\w)/\/$1/;
+    map {
+        my ($key,$value)=split(/\=/,$_);
+        $key=&unescape($key);
+        if ($key=~/^$courseid(?:\/)*(\w+)*\_st$/) {
+            my $section=$1;
+            if ($key eq $courseid.'_st') { $section=''; }
+	    my ($dummy,$end,$start)=split(/\_/,&unescape($value));
+            my $now=time;
+            my $notactive=0;
+            if ($start) {
+		if ($now<$start) { $notactive=1; }
+            }
+            if ($end) {
+                if ($now>$end) { $notactive=1; }
+            } 
+            unless ($notactive) { return $section; }
+        }
+    } split(/\&/,&reply('dump:'.$udom.':'.$unam.':roles',
+                        &homeserver($unam,$udom)));
+    return '-1';
+}
+
+# ------------------------------------- Read an entry from a user's environment
+
+sub userenvironment {
+    my ($udom,$unam,@what)=@_;
+    my %returnhash=();
+    my @answer=split(/\&/,
+                &reply('get:'.$udom.':'.$unam.':environment:'.join('&',@what),
+                      &homeserver($unam,$udom)));
+    my $i;
+    for ($i=0;$i<=$#what;$i++) {
+	$returnhash{$what[$i]}=&unescape($answer[$i]);
+    }
+    return %returnhash;
+}
+
 # ----------------------------- Subscribe to a resource, return URL if possible
 
 sub subscribe {
@@ -513,9 +632,12 @@ sub restore {
 	my ($name,$value)=split(/\=/,$_);
         $returnhash{&unescape($name)}=&unescape($value);
     } split(/\&/,$answer);
-    map {
-        $returnhash{$_}=$returnhash{$returnhash{'version'}.':'.$_};
-    } split(/\:/,$returnhash{$returnhash{'version'}.':keys'});
+    my $version;
+    for ($version=1;$version<=$returnhash{'version'};$version++) {
+       map {
+          $returnhash{$_}=$returnhash{$version.':'.$_};
+       } split(/\:/,$returnhash{$version.':keys'});
+    }
     return %returnhash;
 }
 
@@ -1031,7 +1153,7 @@ sub fileembstyle {
 
 # ------------------------------------------------------------ Description Text
 
-sub filedecription {
+sub filedescription {
     my $ending=shift;
     return $fd{$ending};
 }
@@ -1259,21 +1381,41 @@ sub EXT {
     } elsif ($realm eq 'resource') {
       if ($ENV{'request.course.id'}) {
 # ----------------------------------------------------- Cascading lookup scheme
-       my $symbparm=&symbread().'.'.$spacequalifierrest;
-       my $reslevel=
-	    $ENV{'request.course.id'}.'.'.$symbparm;
+       my $symbp=&symbread();
+       my $mapp=(split(/\_\_\_/,$symbp))[0];
+
+       my $symbparm=$symbp.'.'.$spacequalifierrest;
+       my $mapparm=$mapp.'___(all).'.$spacequalifierrest;
+
        my $seclevel=
-            $ENV{'request.course.id'}.'.'.
-		$ENV{'request.course.sec'}.'.'.$spacequalifierrest;
+            $ENV{'request.course.id'}.'.['.
+		$ENV{'request.course.sec'}.'].'.$spacequalifierrest;
+       my $seclevelr=
+            $ENV{'request.course.id'}.'.['.
+		$ENV{'request.course.sec'}.'].'.$symbparm;
+       my $seclevelm=
+            $ENV{'request.course.id'}.'.['.
+		$ENV{'request.course.sec'}.'].'.$mapparm;
+
        my $courselevel=
             $ENV{'request.course.id'}.'.'.$spacequalifierrest;
+       my $courselevelr=
+            $ENV{'request.course.id'}.'.'.$symbparm;
+       my $courselevelm=
+            $ENV{'request.course.id'}.'.'.$mapparm;
+
 
 # ----------------------------------------------------------- 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}; }
+      my %resourcedata=get('resourcedata',
+                           ($courselevelr,$courselevelm,$courselevel));
+      if ($resourcedata{$courselevelr}!~/^error\:/) {
+
+       if ($resourcedata{$courselevelr}) { 
+          return $resourcedata{$courselevelr}; }
+       if ($resourcedata{$courselevelm}) { 
+          return $resourcedata{$courselevelm}; }
        if ($resourcedata{$courselevel}) { return $resourcedata{$courselevel}; }
+
       }
 # -------------------------------------------------------- second, check course
         my $section='';
@@ -1284,16 +1426,25 @@ sub EXT {
               $ENV{'course.'.$ENV{'request.course.id'}.$section.'.domain'}.':'.
               $ENV{'course.'.$ENV{'request.course.id'}.$section.'.num'}.
               ':resourcedata:'.
-              escape($reslevel).':'.escape($seclevel).':'.escape($courselevel),
+ escape($seclevelr).':'.escape($seclevelm).':'.escape($seclevel).':'.
+ escape($courselevelr).':'.escape($courselevelm).':'.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{$seclevelr}) { return $resourcedata{$seclevelr}; }
+       if ($resourcedata{$seclevelm}) { return $resourcedata{$seclevelm}; }  
+       if ($resourcedata{$seclevel}) { return $resourcedata{$seclevel}; }
+
+       if ($resourcedata{$courselevelr}) { 
+          return $resourcedata{$courselevelr}; }
+       if ($resourcedata{$courselevelm}) { 
+          return $resourcedata{$courselevelm}; }
        if ($resourcedata{$courselevel}) { return $resourcedata{$courselevel}; }
+
       }
 
 # ------------------------------------------------------ third, check map parms
@@ -1308,19 +1459,10 @@ sub EXT {
      }
      
 # --------------------------------------------- last, look in resource metadata
-	my $uri=&declutter($ENV{'request.filename'});
-        my $filename=$perlvar{'lonDocRoot'}.'/res/'.$uri.'.meta';
-        if (-e $filename) {
-            my @content;
-            {
-             my $fh=Apache::File->new($filename);
-             @content=<$fh>;
-            }
-            if (join('',@content)=~
-                 /\<$space[^\>]*\>([^\<]*)\<\/$space\>/) {
-	        return $1;
- 	    }
-        }
+
+      my $metadata=&metadata($ENV{'request.filename'},$spacequalifierrest);
+      if ($metadata) { return $metadata; }
+
 # ---------------------------------------------------- Any other user namespace
     } elsif ($realm eq 'environment') {
 # ----------------------------------------------------------------- environment
@@ -1334,6 +1476,43 @@ sub EXT {
     return '';
 }
 
+# ---------------------------------------------------------------- Get metadata
+
+sub metadata {
+    my ($uri,$what)=@_;
+    $uri=&declutter($uri);
+    my $filename=$uri;
+    $uri=~s/\.meta$//;
+    unless ($metacache{$uri.':keys'}) {
+        unless ($filename=~/\.meta$/) { $filename.='.meta'; }
+	my $metastring=&getfile($perlvar{'lonDocRoot'}.'/res/'.$filename);
+        my $parser=HTML::TokeParser->new(\$metastring);
+        my $token;
+        while ($token=$parser->get_token) {
+           if ($token->[0] eq 'S') {
+	      my $entry=$token->[1];
+              my $unikey=$entry;
+              if (defined($token->[2]->{'part'})) { 
+                 $unikey.='_'.$token->[2]->{'part'}; 
+	      }
+              if (defined($token->[2]->{'name'})) { 
+                 $unikey.='_'.$token->[2]->{'name'}; 
+	      }
+              if ($metacache{$uri.':keys'}) {
+                 $metacache{$uri.':keys'}.=','.$unikey;
+              } else {
+                 $metacache{$uri.':keys'}=$unikey;
+	      }
+              map {
+		  $metacache{$uri.':'.$unikey.'.'.$_}=$token->[2]->{$_};
+              } @{$token->[3]};
+              $metacache{$uri.':'.$unikey}=$parser->get_text('/'.$entry);
+          }
+       }
+    }
+    return $metacache{$uri.':'.$what};
+}
+
 # ------------------------------------------------- Update symbolic store links
 
 sub symblist {
@@ -1599,6 +1778,7 @@ if ($readit ne 'done') {
     }
 }
 
+%metacache=();
 
 $readit='done';
 &logthis('<font color=yellow>INFO: Read configuration</font>');