Diff for /loncom/lonnet/perl/lonnet.pm between versions 1.70 and 1.73

version 1.70, 2000/11/25 19:56:04 version 1.73, 2000/11/28 02:48:25
Line 61 Line 61
 #                      an array of IDs  #                      an array of IDs
 # idrget(domain,array): returns hash with IDs for usernames (name=>id,...) for  # idrget(domain,array): returns hash with IDs for usernames (name=>id,...) for
 #                       an array of names  #                       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,  # 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,  # 7/1,7/2,7/9,7/10,7/12,7/14,7/15,7/19,
Line 76 Line 78
 # 10/04 Gerd Kortemeyer  # 10/04 Gerd Kortemeyer
 # 10/04 Guy Albertelli  # 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/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,11/25 Gerd Kortemeyer  # 10/30,10/31,
   # 11/2,11/14,11/15,11/16,11/20,11/21,11/22,11/25,11/27 Gerd Kortemeyer
   
 package Apache::lonnet;  package Apache::lonnet;
   
Line 85  use Apache::File; Line 88  use Apache::File;
 use LWP::UserAgent();  use LWP::UserAgent();
 use HTTP::Headers;  use HTTP::Headers;
 use vars   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 IO::Socket;
 use GDBM_File;  use GDBM_File;
 use Apache::Constants qw(:common :http);  use Apache::Constants qw(:common :http);
   use HTML::TokeParser;
   
 # --------------------------------------------------------------------- Logging  # --------------------------------------------------------------------- Logging
   
Line 1451  sub EXT { Line 1455  sub EXT {
      }       }
             
 # --------------------------------------------- last, look in resource metadata  # --------------------------------------------- last, look in resource metadata
  my $uri=&declutter($ENV{'request.filename'});  
         my $filename=$perlvar{'lonDocRoot'}.'/res/'.$uri.'.meta';        my $metadata=&metadata($ENV{'request.filename'},$spacequalifierrest);
         if (-e $filename) {        if ($metadata) { return $metadata; }
             my @content;  
             {  
              my $fh=Apache::File->new($filename);  
              @content=<$fh>;  
             }  
             if (join('',@content)=~  
                  /\<$space[^\>]*\>([^\<]*)\<\/$space\>/) {  
         return $1;  
      }  
         }  
 # ---------------------------------------------------- Any other user namespace  # ---------------------------------------------------- Any other user namespace
     } elsif ($realm eq 'environment') {      } elsif ($realm eq 'environment') {
 # ----------------------------------------------------------------- environment  # ----------------------------------------------------------------- environment
Line 1477  sub EXT { Line 1472  sub EXT {
     return '';      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  # ------------------------------------------------- Update symbolic store links
   
 sub symblist {  sub symblist {
Line 1742  if ($readit ne 'done') { Line 1774  if ($readit ne 'done') {
     }      }
 }  }
   
   %metacache=();
   
 $readit='done';  $readit='done';
 &logthis('<font color=yellow>INFO: Read configuration</font>');  &logthis('<font color=yellow>INFO: Read configuration</font>');

Removed from v.1.70  
changed lines
  Added in v.1.73


FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>