[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.452 and 1.453

version 1.452, 2003/12/04 20:09:35 version 1.453, 2003/12/04 21:00:23
Line 3846  sub metadata { Line 3846  sub metadata {
 #  #
 # Is this a recursive call for a library?  # Is this a recursive call for a library?
 #  #
  my %lcmetacache;   if (! exists($metacache{$uri})) {
       $metacache{$uri}={};
    }
         if ($liburi) {          if ($liburi) {
     $liburi=&declutter($liburi);      $liburi=&declutter($liburi);
             $filename=$liburi;              $filename=$liburi;
Line 3870  sub metadata { Line 3872  sub metadata {
     if (defined($token->[2]->{'id'})) {       if (defined($token->[2]->{'id'})) { 
  $keyroot.='_'.$token->[2]->{'id'};    $keyroot.='_'.$token->[2]->{'id'}; 
     }      }
     if ($lcmetacache{':packages'}) {      if ($metacache{$uri}->{':packages'}) {
  $lcmetacache{':packages'}.=','.$package.$keyroot;   $metacache{$uri}->{':packages'}.=','.$package.$keyroot;
     } else {      } else {
  $lcmetacache{':packages'}=$package.$keyroot;   $metacache{$uri}->{':packages'}=$package.$keyroot;
     }      }
     foreach (keys %packagetab) {      foreach (keys %packagetab) {
  my $part=$keyroot;   my $part=$keyroot;
Line 3895  sub metadata { Line 3897  sub metadata {
     if ($subp eq 'display') {      if ($subp eq 'display') {
  $value.=' [Part: '.$part.']';   $value.=' [Part: '.$part.']';
     }      }
     $lcmetacache{':'.$unikey.'.part'}=$part;      $metacache{$uri}->{':'.$unikey.'.part'}=$part;
     $metathesekeys{$unikey}=1;      $metathesekeys{$unikey}=1;
     unless (defined($lcmetacache{':'.$unikey.'.'.$subp})) {      unless (defined($metacache{$uri}->{':'.$unikey.'.'.$subp})) {
  $lcmetacache{':'.$unikey.'.'.$subp}=$value;   $metacache{$uri}->{':'.$unikey.'.'.$subp}=$value;
     }      }
     if (defined($lcmetacache{':'.$unikey.'.default'})) {      if (defined($metacache{$uri}->{':'.$unikey.'.default'})) {
  $lcmetacache{':'.$unikey}=   $metacache{$uri}->{':'.$unikey}=
     $lcmetacache{':'.$unikey.'.default'};      $metacache{$uri}->{':'.$unikey.'.default'};
     }      }
  }   }
     }      }
Line 3935  sub metadata { Line 3937  sub metadata {
     foreach (sort(split(/\,/,&metadata($uri,'keys',      foreach (sort(split(/\,/,&metadata($uri,'keys',
        $location,$unikey,         $location,$unikey,
        $depthcount+1)))) {         $depthcount+1)))) {
    $metacache{$uri}->{':'.$_}=$metacache{$uri}->{':'.$_};
  $metathesekeys{$_}=1;   $metathesekeys{$_}=1;
     }      }
  }   }
Line 3945  sub metadata { Line 3948  sub metadata {
  }   }
  $metathesekeys{$unikey}=1;   $metathesekeys{$unikey}=1;
  foreach (@{$token->[3]}) {   foreach (@{$token->[3]}) {
     $lcmetacache{':'.$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=$lcmetacache{':'.$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
     $lcmetacache{':'.$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
     $lcmetacache{':'.$unikey}=$internaltext;      $metacache{$uri}->{':'.$unikey}=$internaltext;
  }   }
 # end of not-a-package not-a-library import  # end of not-a-package not-a-library import
     }      }
Line 3966  sub metadata { Line 3969  sub metadata {
     }      }
  }   }
 # are there custom rights to evaluate  # are there custom rights to evaluate
  if ($lcmetacache{':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=$lcmetacache{':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)))) {
       $metacache{$uri}->{':'.$_}=$metacache{$uri}->{':'.$_};
     $metathesekeys{$_}=1;      $metathesekeys{$_}=1;
  }   }
     }      }
  }   }
  $lcmetacache{':keys'}=join(',',keys %metathesekeys);   $metacache{$uri}->{':keys'}=join(',',keys %metathesekeys);
  &metadata_generate_part0(\%metathesekeys,\%lcmetacache,$uri);   &metadata_generate_part0(\%metathesekeys,$metacache{$uri},$uri);
  $lcmetacache{':allpossiblekeys'}=join(',',keys %metathesekeys);   $metacache{$uri}->{':allpossiblekeys'}=join(',',keys %metathesekeys);
  &do_cache(\%metacache,$uri,\%lcmetacache,'meta');   &do_cache(\%metacache,$uri,$metacache{$uri},'meta');
 # 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.452  
changed lines
  Added in v.1.453

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