[BACK]Return to lonnet.pm CVS log [TXT] [DIR] Up to [LON-CAPA] / loncom / lonnet / perl

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

version 1.70, 2000/11/25 19:56:04 version 1.71, 2000/11/27 20:44:04
Line 76 Line 76
 # 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 86  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 1453  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 1470  sub EXT {
     return '';      return '';
 }  }
   
   # ---------------------------------------------------------------- Get metadata
   
   sub metadata {
       my ($uri,$what)=@_;
       $uri=&declutter($uri);
       unless ($uri=~/\.meta$/) { $uri.='.meta'; }
       unless ($metacache{$uri.':keys'}) {
    my $metastring=&getfile($perlvar{'lonDocRoot'}.'/res/'.$uri);
           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 ($token->[2]->{'part'}) { 
                    $unikey.='_'.$token->[2]->{'part'}; 
         }
                 if ($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 1770  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.71

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