[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.338 and 1.339

version 1.338, 2003/03/14 02:26:12 version 1.339, 2003/03/14 15:08:20
Line 3089  sub metadata { Line 3089  sub metadata {
         my $token;          my $token;
         undef %metathesekeys;          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'})) {
 #  #
 # This is a package - get package info  # This is a package - get package info
 #  #
       my $package=$token->[2]->{'package'};      my $package=$token->[2]->{'package'};
       my $keyroot=&add_prefix_and_part($prefix,$token->[2]->{'part'});      my $keyroot=&add_prefix_and_part($prefix,$token->[2]->{'part'});
               if (defined($token->[2]->{'id'})) {       if (defined($token->[2]->{'id'})) { 
                  $keyroot.='_'.$token->[2]->{'id'};    $keyroot.='_'.$token->[2]->{'id'}; 
       }      }
               if ($metacache{$uri.':packages'}) {      if ($metacache{$uri.':packages'}) {
                  $metacache{$uri.':packages'}.=','.$package.$keyroot;   $metacache{$uri.':packages'}.=','.$package.$keyroot;
               } else {      } else {
                  $metacache{$uri.':packages'}=$package.$keyroot;   $metacache{$uri.':packages'}=$package.$keyroot;
       }      }
               foreach (keys %packagetab) {      foreach (keys %packagetab) {
   if ($_=~/^$package\&/) {   if ($_=~/^$package\&/) {
       my ($pack,$name,$subp)=split(/\&/,$_);      my ($pack,$name,$subp)=split(/\&/,$_);
                       my $value=$packagetab{$_};      my $value=$packagetab{$_};
       my $part=$keyroot;      my $part=$keyroot;
                       $part=~s/^\_//;      $part=~s/^\_//;
                       if ($subp eq 'display') {      if ($subp eq 'display') {
   $value.=' [Part: '.$part.']';   $value.=' [Part: '.$part.']';
                       }      }
                       my $unikey='parameter'.$keyroot.'_'.$name;      my $unikey='parameter'.$keyroot.'_'.$name;
                       $metathesekeys{$unikey}=1;      $metathesekeys{$unikey}=1;
                       $metacache{$uri.':'.$unikey.'.part'}=$part;      $metacache{$uri.':'.$unikey.'.part'}=$part;
                       unless (defined($metacache{$uri.':'.$unikey.'.'.$subp})) {      unless (defined($metacache{$uri.':'.$unikey.'.'.$subp})) {
   $metacache{$uri.':'.$unikey.'.'.$subp}=$value;   $metacache{$uri.':'.$unikey.'.'.$subp}=$value;
       }      }
       if (defined($metacache{$uri.':'.$unikey.'.default'})) {      if (defined($metacache{$uri.':'.$unikey.'.default'})) {
   $metacache{$uri.':'.$unikey}=   $metacache{$uri.':'.$unikey}=
      $metacache{$uri.':'.$unikey.'.default'}      $metacache{$uri.':'.$unikey.'.default'}
       }   }
                   }   }
               }      }
              } else {   } else {
 #  #
 # This is not a package - some other kind of start tag  # This is not a package - some other kind of start tag
 #   #
               my $entry=$token->[1];      my $entry=$token->[1];
               my $unikey;      my $unikey;
               if ($entry eq 'import') {      if ($entry eq 'import') {
                  $unikey='';   $unikey='';
               } else {      } else {
                  $unikey=$entry;   $unikey=$entry;
       }      }
       $unikey.=&add_prefix_and_part($prefix,$token->[2]->{'part'});      $unikey.=&add_prefix_and_part($prefix,$token->[2]->{'part'});
   
               if (defined($token->[2]->{'id'})) {       if (defined($token->[2]->{'id'})) { 
                  $unikey.='_'.$token->[2]->{'id'};    $unikey.='_'.$token->[2]->{'id'}; 
       }      }
   
              if ($entry eq 'import') {      if ($entry eq 'import') {
 #  #
 # Importing a library here  # Importing a library here
 #                  #
                  if ($depthcount<20) {   if ($depthcount<20) {
      my $location=$parser->get_text('/import');      my $location=$parser->get_text('/import');
      my $dir=$filename;      my $dir=$filename;
      $dir=~s|[^/]*$||;      $dir=~s|[^/]*$||;
      $location=&filelocation($dir,$location);      $location=&filelocation($dir,$location);
      foreach (sort(split(/\,/,&metadata($uri,'keys',      foreach (sort(split(/\,/,&metadata($uri,'keys',
  $location,$unikey,         $location,$unikey,
  $depthcount+1)))) {         $depthcount+1)))) {
                          $metathesekeys{$_}=1;   $metathesekeys{$_}=1;
      }      }
  }   }
              } else {       } else { 
   
               if (defined($token->[2]->{'name'})) {    if (defined($token->[2]->{'name'})) { 
                  $unikey.='_'.$token->[2]->{'name'};       $unikey.='_'.$token->[2]->{'name'}; 
       }   }
               $metathesekeys{$unikey}=1;   $metathesekeys{$unikey}=1;
               foreach (@{$token->[3]}) {   foreach (@{$token->[3]}) {
   $metacache{$uri.':'.$unikey.'.'.$_}=$token->[2]->{$_};      $metacache{$uri.':'.$unikey.'.'.$_}=$token->[2]->{$_};
               }   }
       my $internaltext=&HTML::Entities::decode($parser->get_text('/'.$entry));   my $internaltext=&HTML::Entities::decode($parser->get_text('/'.$entry));
       my $default=$metacache{$uri.':'.$unikey.'.default'};   my $default=$metacache{$uri.':'.$unikey.'.default'};
       if ( $internaltext =~ /^\s*$/ && $default !~ /^\s*$/) {   if ( $internaltext =~ /^\s*$/ && $default !~ /^\s*$/) {
   # only ws inside the tag, and not in default, so use default   # only ws inside the tag, and not in default, so use default
                   # as value   # as value
   $metacache{$uri.':'.$unikey}=$default;      $metacache{$uri.':'.$unikey}=$default;
       } else {   } else {
   # either something interesting inside the tag or default    # either something interesting inside the tag or default
                   # uninteresting                    # uninteresting
   $metacache{$uri.':'.$unikey}=$internaltext;      $metacache{$uri.':'.$unikey}=$internaltext;
       }   }
 # end of not-a-package not-a-library import  # end of not-a-package not-a-library import
    }      }
 # end of not-a-package start tag  # end of not-a-package start tag
   }   }
 # the next is the end of "start tag"  # the next is the end of "start tag"
  }      }
        }   }
 # are there custom rights to evaluate  # are there custom rights to evaluate
  if ($metacache{$uri.':copyright'} eq 'custom') {   if ($metacache{$uri.':copyright'} eq 'custom') {
           
     #      #
     # Importing a rights file here      # Importing a rights file here
     #                      #
                  unless ($depthcount) {      unless ($depthcount) {
      my $location=$metacache{$uri.':customdistributionfile'};   my $location=$metacache{$uri.':customdistributionfile'};
      my $dir=$filename;   my $dir=$filename;
      $dir=~s|[^/]*$||;   $dir=~s|[^/]*$||;
      $location=&filelocation($dir,$location);   $location=&filelocation($dir,$location);
      foreach (sort(split(/\,/,&metadata($uri,'keys',   foreach (sort(split(/\,/,&metadata($uri,'keys',
  $location,'_rights',     $location,'_rights',
  $depthcount+1)))) {     $depthcount+1)))) {
                          $metathesekeys{$_}=1;      $metathesekeys{$_}=1;
      }   }
  }      }
      }   }
    $metacache{$uri.':keys'}=join(',',keys %metathesekeys);   $metacache{$uri.':keys'}=join(',',keys %metathesekeys);
  &metadata_generate_part0(\%metathesekeys,\%metacache,$uri);   &metadata_generate_part0(\%metathesekeys,\%metacache,$uri);
        $metacache{$uri.':allpossiblekeys'}=join(',',keys %metathesekeys);   $metacache{$uri.':allpossiblekeys'}=join(',',keys %metathesekeys);
        $metacache{$uri.':cachedtimestamp'}=time;   $metacache{$uri.':cachedtimestamp'}=time;
 # this is the end of "was not already recently cached  # this is the end of "was not already recently cached
     }      }
     return $metacache{$uri.':'.$what};      return $metacache{$uri.':'.$what};
Removed from v.1.338  
changed lines
  Added in v.1.339

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