[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.139 and 1.140

version 1.139, 2001/08/04 20:13:17 version 1.140, 2001/08/07 09:47:53
Line 122 Line 122
 # 5/30 H. K. Ng  # 5/30 H. K. Ng
 # 6/1 Gerd Kortemeyer  # 6/1 Gerd Kortemeyer
 # July Guy Albertelli  # July Guy Albertelli
 # 8/4 Gerd Kortemeyer  # 8/4,8/7 Gerd Kortemeyer
   
 package Apache::lonnet;  package Apache::lonnet;
   
Line 1846  sub metadata { Line 1846  sub metadata {
     my $filename=$uri;      my $filename=$uri;
     $uri=~s/\.meta$//;      $uri=~s/\.meta$//;
     unless ($metacache{$uri.':keys'}) {      unless ($metacache{$uri.':keys'}) {
           my %metathesekeys=();
         unless ($filename=~/\.meta$/) { $filename.='.meta'; }          unless ($filename=~/\.meta$/) { $filename.='.meta'; }
  my $metastring=&getfile($perlvar{'lonDocRoot'}.'/res/'.$filename);   my $metastring=&getfile($perlvar{'lonDocRoot'}.'/res/'.$filename);
         my $parser=HTML::TokeParser->new(\$metastring);          my $parser=HTML::TokeParser->new(\$metastring);
         my $token;          my $token;
           undef %metathesekeys;
         while ($token=$parser->get_token) {          while ($token=$parser->get_token) {
            if ($token->[0] eq 'S') {             if ($token->[0] eq 'S') {
      if (defined($token->[2]->{'package'})) {       if (defined($token->[2]->{'package'})) {
       my $package=$token->[2]->{'package'};        my $package=$token->[2]->{'package'};
               my %thispackagekeys=();  
       my $keyroot='';        my $keyroot='';
               if (defined($token->[2]->{'part'})) {                 if (defined($token->[2]->{'part'})) { 
                  $keyroot.='_'.$token->[2]->{'part'};                    $keyroot.='_'.$token->[2]->{'part'}; 
Line 1867  sub metadata { Line 1868  sub metadata {
               } else {                } else {
                  $metacache{$uri.':packages'}=$package.$keyroot;                   $metacache{$uri.':packages'}=$package.$keyroot;
       }        }
               undef %thispackagekeys;  
               map {                map {
   if ($_=~/^$package\&/) {    if ($_=~/^$package\&/) {
       my ($pack,$name,$subp)=split(/\&/,$_);        my ($pack,$name,$subp)=split(/\&/,$_);
Line 1878  sub metadata { Line 1878  sub metadata {
   $value.=' [Part: '.$part.']';    $value.=' [Part: '.$part.']';
                       }                        }
                       my $unikey='parameter'.$keyroot.'_'.$name;                        my $unikey='parameter'.$keyroot.'_'.$name;
                       $thispackagekeys{$unikey}=1;                        $metathesekeys{$unikey}=1;
                       $metacache{$uri.':'.$unikey.'.'.$subp}=$value;                        $metacache{$uri.':'.$unikey.'.'.$subp}=$value;
                   }                    }
               } keys %packagetab;                } keys %packagetab;
               my $addpackagekeys=join(',',keys %thispackagekeys);  
               if ($metacache{$uri.':keys'}) {  
                  $metacache{$uri.':keys'}.=','.$addpackagekeys;  
               } else {  
                  $metacache{$uri.':keys'}=$addpackagekeys;  
       }  
              } else {               } else {
       my $entry=$token->[1];        my $entry=$token->[1];
               my $unikey=$entry;                my $unikey=$entry;
Line 1900  sub metadata { Line 1894  sub metadata {
               if (defined($token->[2]->{'name'})) {                 if (defined($token->[2]->{'name'})) { 
                  $unikey.='_'.$token->[2]->{'name'};                    $unikey.='_'.$token->[2]->{'name'}; 
       }        }
               if ($metacache{$uri.':keys'}) {                $metathesekeys{$unikey}=1;
                  $metacache{$uri.':keys'}.=','.$unikey;  
               } else {  
                  $metacache{$uri.':keys'}=$unikey;  
       }  
               map {                map {
   $metacache{$uri.':'.$unikey.'.'.$_}=$token->[2]->{$_};    $metacache{$uri.':'.$unikey.'.'.$_}=$token->[2]->{$_};
               } @{$token->[3]};                } @{$token->[3]};
Line 1914  sub metadata { Line 1904  sub metadata {
       $metacache{$uri.':'.$unikey.'.default'};        $metacache{$uri.':'.$unikey.'.default'};
       }        }
     }      }
   }   }
        }         }
          $metacache{$uri.':keys'}=join(',',keys %metathesekeys);
     }      }
     return $metacache{$uri.':'.$what};      return $metacache{$uri.':'.$what};
 }  }
Removed from v.1.139  
changed lines
  Added in v.1.140

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