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

[www]

www		Wed Oct 29 19:26:25 2003 EDT

  Modified files:              
    /loncom/lonnet/perl	lonnet.pm 
  Log:
  * Trying to understand all of the "Unable to tie hash" - they come from the
  meta cache
  * Correct way to get versioned URL from symb
  Still lots of problems with versioned sequences.
  
  
Index: loncom/lonnet/perl/lonnet.pm
diff -u loncom/lonnet/perl/lonnet.pm:1.434 loncom/lonnet/perl/lonnet.pm:1.435
--- loncom/lonnet/perl/lonnet.pm:1.434	Wed Oct 29 17:33:49 2003
+++ loncom/lonnet/perl/lonnet.pm	Wed Oct 29 19:26:25 2003
@@ -1,7 +1,7 @@
 # The LearningOnline Network
 # TCP networking package
 #
-# $Id: lonnet.pm,v 1.434 2003/10/29 22:33:49 www Exp $
+# $Id: lonnet.pm,v 1.435 2003/10/30 00:26:25 www Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -831,7 +831,7 @@
 	delete($hash{$id});
 	delete($hash{$id.'.time'});
     } else {
-	&logthis("Unable to tie hash");
+	&logthis("Unable to tie hash (devalidate cache): $name");
     }
     untie(%hash);
     flock(DB,LOCK_UN);
@@ -849,7 +849,7 @@
 	return (undef,undef);
     } else {
 	if (time-($$cache{$id.'.time'})>$time) {
-#	    &logthis("Devailidating $id - ".time-($$cache{$id.'.time'}));
+#	    &logthis("Devalidating $id - ".time-($$cache{$id.'.time'}));
 	    &devalidate_cache($cache,$id,$name);
 	    return (undef,undef);
 	}
@@ -929,7 +929,7 @@
 	$hash{$id.'.time'}=$$cache{$id.'.time'};
 	$hash{$id}=freeze({'item'=>$$cache{$id}});
     } else {
-	&logthis("Unable to tie hash");
+	&logthis("Unable to tie hash (save cache item): $name");
     }
     untie(%hash);
     flock(DB,LOCK_UN);
@@ -964,7 +964,7 @@
 	    $$cache{$id.'.time'}=$hash{$id.'.time'};
 	}
     } else {
-	&logthis("Unable to tie hash");
+	&logthis("Unable to tie hash (load cache item): $name");
     }
     untie(%hash);
     flock(DB,LOCK_UN);
@@ -2734,6 +2734,7 @@
 
 sub is_on_map {
     my $uri=&declutter(shift);
+    $uri=~s/\.\d+\.(\w+)$/\.$1/;
     my @uriparts=split(/\//,$uri);
     my $filename=$uriparts[$#uriparts];
     my $pathname=$uri;
@@ -4075,11 +4076,19 @@
 sub fixversion {
     my $fn=shift;
     if ($fn=~/^(adm|uploaded|public)/) { return $fn; }
-    my ($match,$cond,$versioned)=&is_on_map($fn);
-    unless ($match) {
-	$fn=$versioned;
+    my %bighash;
+    my $uri=&clutter($fn);
+    if (tie(%bighash,'GDBM_File',$ENV{'request.course.fn'}.'.db',
+       &GDBM_READER(),0640)) {
+	if ($bighash{'version_'.$uri}) {
+	    my $version=$bighash{'version_'.$uri};
+	    unless ($version eq 'mostrecent') {
+		$uri=~s/\.(\w+)$/\.$version\.$1/;
+	    }
+	}
+	untie %bighash;
     }
-    return $fn;
+    return &declutter($uri);
 }
 
 # ------------------------------------------------------ Return symb list entry