[LON-CAPA-cvs] cvs: loncom /lonnet/perl lonnet.pm

[albertel]

albertel		Thu Dec  4 16:00:23 2003 EDT

  Modified files:              
    /loncom/lonnet/perl	lonnet.pm 
  Log:
  - BUG#2421, recursive metadata calss where throwing away the data (but not the keys) from the recursive call, modified it so that it looks more like the metadata call before the caching was modified,
  - now restores the assumption that the lower metadata calls store their data into the same hash location as the calling metadata function, rather than a local hast that is then save into the cache.
  
  
  
Index: loncom/lonnet/perl/lonnet.pm
diff -u loncom/lonnet/perl/lonnet.pm:1.452 loncom/lonnet/perl/lonnet.pm:1.453
--- loncom/lonnet/perl/lonnet.pm:1.452	Thu Dec  4 15:09:35 2003
+++ loncom/lonnet/perl/lonnet.pm	Thu Dec  4 16:00:23 2003
@@ -1,7 +1,7 @@
 # The LearningOnline Network
 # TCP networking package
 #
-# $Id: lonnet.pm,v 1.452 2003/12/04 20:09:35 albertel Exp $
+# $Id: lonnet.pm,v 1.453 2003/12/04 21:00:23 albertel Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -3846,7 +3846,9 @@
 #
 # Is this a recursive call for a library?
 #
-	my %lcmetacache;
+	if (! exists($metacache{$uri})) {
+	    $metacache{$uri}={};
+	}
         if ($liburi) {
 	    $liburi=&declutter($liburi);
             $filename=$liburi;
@@ -3870,10 +3872,10 @@
 		    if (defined($token->[2]->{'id'})) { 
 			$keyroot.='_'.$token->[2]->{'id'}; 
 		    }
-		    if ($lcmetacache{':packages'}) {
-			$lcmetacache{':packages'}.=','.$package.$keyroot;
+		    if ($metacache{$uri}->{':packages'}) {
+			$metacache{$uri}->{':packages'}.=','.$package.$keyroot;
 		    } else {
-			$lcmetacache{':packages'}=$package.$keyroot;
+			$metacache{$uri}->{':packages'}=$package.$keyroot;
 		    }
 		    foreach (keys %packagetab) {
 			my $part=$keyroot;
@@ -3895,14 +3897,14 @@
 			    if ($subp eq 'display') {
 				$value.=' [Part: '.$part.']';
 			    }
-			    $lcmetacache{':'.$unikey.'.part'}=$part;
+			    $metacache{$uri}->{':'.$unikey.'.part'}=$part;
 			    $metathesekeys{$unikey}=1;
-			    unless (defined($lcmetacache{':'.$unikey.'.'.$subp})) {
-				$lcmetacache{':'.$unikey.'.'.$subp}=$value;
+			    unless (defined($metacache{$uri}->{':'.$unikey.'.'.$subp})) {
+				$metacache{$uri}->{':'.$unikey.'.'.$subp}=$value;
 			    }
-			    if (defined($lcmetacache{':'.$unikey.'.default'})) {
-				$lcmetacache{':'.$unikey}=
-				    $lcmetacache{':'.$unikey.'.default'};
+			    if (defined($metacache{$uri}->{':'.$unikey.'.default'})) {
+				$metacache{$uri}->{':'.$unikey}=
+				    $metacache{$uri}->{':'.$unikey.'.default'};
 			    }
 			}
 		    }
@@ -3935,6 +3937,7 @@
 			    foreach (sort(split(/\,/,&metadata($uri,'keys',
 							       $location,$unikey,
 							       $depthcount+1)))) {
+				$metacache{$uri}->{':'.$_}=$metacache{$uri}->{':'.$_};
 				$metathesekeys{$_}=1;
 			    }
 			}
@@ -3945,18 +3948,18 @@
 			}
 			$metathesekeys{$unikey}=1;
 			foreach (@{$token->[3]}) {
-			    $lcmetacache{':'.$unikey.'.'.$_}=$token->[2]->{$_};
+			    $metacache{$uri}->{':'.$unikey.'.'.$_}=$token->[2]->{$_};
 			}
 			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*$/) {
 		 # only ws inside the tag, and not in default, so use default
 		 # as value
-			    $lcmetacache{':'.$unikey}=$default;
+			    $metacache{$uri}->{':'.$unikey}=$default;
 			} else {
 		  # either something interesting inside the tag or default
                   # uninteresting
-			    $lcmetacache{':'.$unikey}=$internaltext;
+			    $metacache{$uri}->{':'.$unikey}=$internaltext;
 			}
 # end of not-a-package not-a-library import
 		    }
@@ -3966,27 +3969,28 @@
 	    }
 	}
 # are there custom rights to evaluate
-	if ($lcmetacache{':copyright'} eq 'custom') {
+	if ($metacache{$uri}->{':copyright'} eq 'custom') {
 
     #
     # Importing a rights file here
     #
 	    unless ($depthcount) {
-		my $location=$lcmetacache{':customdistributionfile'};
+		my $location=$metacache{$uri}->{':customdistributionfile'};
 		my $dir=$filename;
 		$dir=~s|[^/]*$||;
 		$location=&filelocation($dir,$location);
 		foreach (sort(split(/\,/,&metadata($uri,'keys',
 						   $location,'_rights',
 						   $depthcount+1)))) {
+		    $metacache{$uri}->{':'.$_}=$metacache{$uri}->{':'.$_};
 		    $metathesekeys{$_}=1;
 		}
 	    }
 	}
-	$lcmetacache{':keys'}=join(',',keys %metathesekeys);
-	&metadata_generate_part0(\%metathesekeys,\%lcmetacache,$uri);
-	$lcmetacache{':allpossiblekeys'}=join(',',keys %metathesekeys);
-	&do_cache(\%metacache,$uri,\%lcmetacache,'meta');
+	$metacache{$uri}->{':keys'}=join(',',keys %metathesekeys);
+	&metadata_generate_part0(\%metathesekeys,$metacache{$uri},$uri);
+	$metacache{$uri}->{':allpossiblekeys'}=join(',',keys %metathesekeys);
+	&do_cache(\%metacache,$uri,$metacache{$uri},'meta');
 # this is the end of "was not already recently cached
     }
     return $metacache{$uri}->{':'.$what};