--- loncom/lonnet/perl/lonnet.pm	2005/02/14 02:22:25	1.587.2.3.2.6
+++ loncom/lonnet/perl/lonnet.pm	2005/01/31 11:27:14	1.592
@@ -1,7 +1,7 @@
 # The LearningOnline Network
 # TCP networking package
 #
-# $Id: lonnet.pm,v 1.587.2.3.2.6 2005/02/14 02:22:25 albertel Exp $
+# $Id: lonnet.pm,v 1.592 2005/01/31 11:27:14 www Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -36,7 +36,7 @@ use HTTP::Date;
 # use Date::Parse;
 use vars 
 qw(%perlvar %hostname %homecache %badServerCache %hostip %iphost %spareid %hostdom 
-   %libserv %pr %prp $memcache %packagetab 
+   %libserv %pr %prp %metacache %packagetab %titlecache %courseresversioncache %resversioncache
    %courselogs %accesshash %userrolehash $processmarker $dumpcount 
    %coursedombuf %coursenumbuf %coursehombuf %coursedescrbuf %courseinstcodebuf %courseownerbuf %courseresdatacache 
    %userresdatacache %getsectioncache %domaindescription %domain_auth_def %domain_auth_arg_def 
@@ -50,7 +50,6 @@ use Fcntl qw(:flock);
 use Apache::lonlocal;
 use Storable qw(lock_store lock_nstore lock_retrieve freeze thaw nfreeze);
 use Time::HiRes qw( gettimeofday tv_interval );
-use Cache::Memcached;
 my $readit;
 my $max_connection_retries = 10;     # Or some such value.
 
@@ -924,7 +923,6 @@ sub save_cache_item {
 }
 
 sub save_cache {
-    &purge_remembered();
     if ($disk_caching_disabled) { return; }
     my ($cache,$name,$id);
     foreach $name (keys(%do_save)) {
@@ -1022,84 +1020,6 @@ EVALBLOCK
 #    &logthis("load_cache_item $name took ".(&Time::HiRes::time()-$starttime));
 }
 
-my $to_remember=10;
-my %remembered;
-my %accessed;
-my $kicks=0;
-my $hits=0;
-sub devalidate_cache_new {
-    my ($name,$id) = @_;
-    if (0) { &Apache::lonnet::logthis("deleting $name:$id"); }
-    $id=&escape($name.':'.$id);
-    $memcache->delete($id);
-    delete($remembered{$id});
-    delete($accessed{$id});
-}
-
-sub is_cached_new {
-    my ($name,$id,$debug) = @_;
-    $debug=0;
-    $id=&escape($name.':'.$id);
-    if (exists($remembered{$id})) {
-	if ($debug) { &Apache::lonnet::logthis("Earyl return $id of $remembered{$id} "); }
-	$accessed{$id}=[&gettimeofday()];
-	$hits++;
-	return ($remembered{$id},1);
-    }
-    my $value = $memcache->get($id);
-    if (!(defined($value))) {
-	if ($debug) { &Apache::lonnet::logthis("getting $id is not defined"); }
-	return (undef,undef);
-    }
-    &make_room($id,$value);
-    if ($value eq '__undef__') {
-	if ($debug) { &Apache::lonnet::logthis("getting $id is __undef__"); }
-	return (undef,1);
-    }
-    if ($debug) { &Apache::lonnet::logthis("getting $id is $value"); }
-    return ($value,1);
-}
-
-sub do_cache_new {
-    my ($name,$id,$value,$time,$debug) = @_;
-    $debug=0;
-    $id=&escape($name.':'.$id);
-    my $setvalue=$value;
-    if (!defined($setvalue)) {
-	$setvalue='__undef__';
-    }
-    if ($debug) { &Apache::lonnet::logthis("Setting $id to $value"); }
-    $memcache->set($id,$setvalue,300);
-    &make_room($id,$value);
-    return $value;
-}
-
-sub make_room {
-    my ($id,$value)=@_;
-    my $debug=0;
-    $remembered{$id}=$value;
-    $accessed{$id}=[&gettimeofday()];
-    if (scalar(keys(%remembered)) <= $to_remember) { return; }
-    my $to_kick;
-    my $max_time=0;
-    foreach my $other (keys(%accessed)) {
-	if (&tv_interval($accessed{$other}) > $max_time) {
-	    $to_kick=$other;
-	    $max_time=&tv_interval($accessed{$other});
-	}
-    }
-    delete($remembered{$to_kick});
-    delete($accessed{$to_kick});
-    $kicks++;
-    if ($debug) { &logthis("kicking $max_time $kicks\n"); }
-    return;
-}
-
-sub purge_remembered {
-    &logthis("Tossing ".scalar(keys(%remembered)));
-    undef(%remembered);
-    undef(%accessed);
-}
 # ------------------------------------- Read an entry from a user's environment
 
 sub userenvironment {
@@ -1137,7 +1057,7 @@ sub getversion {
 
 sub currentversion {
     my $fname=shift;
-    my ($result,$cached)=&is_cached_new('resversion',$fname);
+    my ($result,$cached)=&is_cached(\%resversioncache,$fname,'resversion',600);
     if (defined($cached)) { return $result; }
     my $author=$fname;
     $author=~s/\/home\/httpd\/html\/res\/([^\/]*)\/([^\/]*).*/$1\/$2/;
@@ -1150,7 +1070,7 @@ sub currentversion {
     if (($answer eq 'con_lost') || ($answer eq 'rejected')) {
 	return -1;
     }
-    return &do_cache_new('resversion',$fname,$answer,600);
+    return &do_cache(\%resversioncache,$fname,$answer,'resversion');
 }
 
 # ----------------------------- Subscribe to a resource, return URL if possible
@@ -1819,19 +1739,27 @@ sub get_first_access {
     my ($symb,$courseid,$udom,$uname)=&Apache::lonxml::whichuser();
     if ($argsymb) { $symb=$argsymb; }
     my ($map,$id,$res)=&decode_symb($symb);
-    if ($type eq 'map') { $res=$map; }
-    my %times=&get('firstaccesstimes',[$res],$udom,$uname);
-    return $times{$res};
+    if ($type eq 'map') {
+	$res=&symbread($map);
+    } else {
+	$res=$symb;
+    }
+    my %times=&get('firstaccesstimes',["$courseid\0$res"],$udom,$uname);
+    return $times{"$courseid\0$res"};
 }
 
 sub set_first_access {
     my ($type)=@_;
     my ($symb,$courseid,$udom,$uname)=&Apache::lonxml::whichuser();
     my ($map,$id,$res)=&decode_symb($symb);
-    if ($type eq 'map') { $res=$map; }
-    my $firstaccess=&get_first_access($type);
+    if ($type eq 'map') {
+	$res=&symbread($map);
+    } else {
+	$res=$symb;
+    }
+    my $firstaccess=&get_first_access($type,$symb);
     if (!$firstaccess) {
-	return &put('firstaccesstimes',{$res=>time},$udom,$uname);
+	return &put('firstaccesstimes',{"$courseid\0$res"=>time},$udom,$uname);
     }
     return 'already_set';
 }
@@ -2172,9 +2100,11 @@ sub tmpreset {
   $namespace=~s/\//\_/g;
   $namespace=~s/\W//g;
 
-  #FIXME needs to do something for /pub resources
   if (!$domain) { $domain=$ENV{'user.domain'}; }
   if (!$stuname) { $stuname=$ENV{'user.name'}; }
+  if ($domain eq 'public' && $stuname eq 'public') {
+      $stuname=$ENV{'REMOTE_ADDR'};
+  }
   my $path=$perlvar{'lonDaemons'}.'/tmp';
   my %hash;
   if (tie(%hash,'GDBM_File',
@@ -2207,9 +2137,11 @@ sub tmpstore {
   }
   $namespace=~s/\//\_/g;
   $namespace=~s/\W//g;
-#FIXME needs to do something for /pub resources
   if (!$domain) { $domain=$ENV{'user.domain'}; }
   if (!$stuname) { $stuname=$ENV{'user.name'}; }
+  if ($domain eq 'public' && $stuname eq 'public') {
+      $stuname=$ENV{'REMOTE_ADDR'};
+  }
   my $now=time;
   my %hash;
   my $path=$perlvar{'lonDaemons'}.'/tmp';
@@ -2221,7 +2153,7 @@ sub tmpstore {
     my $allkeys=''; 
     foreach my $key (keys(%$storehash)) {
       $allkeys.=$key.':';
-      $hash{"$version:$symb:$key"}=$$storehash{$key};
+      $hash{"$version:$symb:$key"}=&freeze_escape($$storehash{$key});
     }
     $hash{"$version:$symb:timestamp"}=$now;
     $allkeys.='timestamp';
@@ -2248,10 +2180,12 @@ sub tmprestore {
   $symb=escape($symb);
 
   if (!$namespace) { $namespace=$ENV{'request.state'}; }
-  #FIXME needs to do something for /pub resources
+
   if (!$domain) { $domain=$ENV{'user.domain'}; }
   if (!$stuname) { $stuname=$ENV{'user.name'}; }
-
+  if ($domain eq 'public' && $stuname eq 'public') {
+      $stuname=$ENV{'REMOTE_ADDR'};
+  }
   my %returnhash;
   $namespace=~s/\//\_/g;
   $namespace=~s/\W//g;
@@ -2269,8 +2203,8 @@ sub tmprestore {
       my $key;
       $returnhash{"$scope:keys"}=$vkeys;
       foreach $key (@keys) {
-	$returnhash{"$scope:$key"}=$hash{"$scope:$symb:$key"};
-	$returnhash{"$key"}=$hash{"$scope:$symb:$key"};
+	$returnhash{"$scope:$key"}=&thaw_unescape($hash{"$scope:$symb:$key"});
+	$returnhash{"$key"}=&thaw_unescape($hash{"$scope:$symb:$key"});
       }
     }
     if (!(untie(%hash))) {
@@ -2311,7 +2245,7 @@ sub store {
 
     my $namevalue='';
     foreach (keys %$storehash) {
-        $namevalue.=escape($_).'='.escape($$storehash{$_}).'&';
+        $namevalue.=&escape($_).'='.&freeze_escape($$storehash{$_}).'&';
     }
     $namevalue=~s/\&$//;
     &courselog($symb.':'.$stuname.':'.$domain.':STORE:'.$namevalue);
@@ -2347,7 +2281,7 @@ sub cstore {
 
     my $namevalue='';
     foreach (keys %$storehash) {
-        $namevalue.=escape($_).'='.escape($$storehash{$_}).'&';
+        $namevalue.=&escape($_).'='.&freeze_escape($$storehash{$_}).'&';
     }
     $namevalue=~s/\&$//;
     &courselog($symb.':'.$stuname.':'.$domain.':CSTORE:'.$namevalue);
@@ -2381,7 +2315,7 @@ sub restore {
     my %returnhash=();
     foreach (split(/\&/,$answer)) {
 	my ($name,$value)=split(/\=/,$_);
-        $returnhash{&unescape($name)}=&unescape($value);
+        $returnhash{&unescape($name)}=&thaw_unescape($value);
     }
     my $version;
     for ($version=1;$version<=$returnhash{'version'};$version++) {
@@ -2772,7 +2706,7 @@ sub putstore {
            my $key = $1.':keys:'.$2;
            $allitems{$key} .= $3.':';
        }
-       $items.=$_.'='.&escape($$storehash{$_}).'&';
+       $items.=$_.'='.&freeze_escape($$storehash{$_}).'&';
    }
    foreach (keys %allitems) {
        $allitems{$_} =~ s/\:$//;
@@ -3642,9 +3576,12 @@ sub modifyuser {
     if (defined($middle)) { $names{'middlename'} = $middle; }
     if ($last)   { $names{'lastname'}   = $last; }
     if (defined($gene))   { $names{'generation'} = $gene; }
-    if ($email)  { $names{'notification'} = $email;
-                   $names{'critnotification'} = $email; }
-
+    if ($email) {
+       $email=~s/[^\w\@\.\-\,]//gs;
+       if ($email=~/\@/) { $names{'notification'} = $email;
+			   $names{'critnotification'} = $email;
+			   $names{'permanentemail'} = $email; }
+    }
     my $reply = &put('environment', \%names, $udom,$uname);
     if ($reply ne 'ok') { return 'error: '.$reply; }
     &logthis('Success modifying user '.$udom.', '.$uname.', '.$uid.', '.
@@ -4544,7 +4481,6 @@ sub add_prefix_and_part {
 
 # ---------------------------------------------------------------- Get metadata
 
-my %metaentry;
 sub metadata {
     my ($uri,$what,$liburi,$prefix,$depthcount)=@_;
     $uri=&declutter($uri);
@@ -4564,29 +4500,28 @@ sub metadata {
 # Everything is cached by the main uri, libraries are never directly cached
 #
     if (!defined($liburi)) {
-	my ($result,$cached)=&is_cached_new('meta',$uri);
+	my ($result,$cached)=&is_cached(\%metacache,$uri,'meta');
 	if (defined($cached)) { return $result->{':'.$what}; }
     }
     {
 #
 # Is this a recursive call for a library?
 #
-#	if (! exists($metacache{$uri})) {
-#	    $metacache{$uri}={};
-#	}
+	if (! exists($metacache{$uri})) {
+	    $metacache{$uri}={};
+	}
         if ($liburi) {
 	    $liburi=&declutter($liburi);
             $filename=$liburi;
         } else {
-	    &devalidate_cache_new('meta',$uri);
-	    undef(%metaentry);
+	    &devalidate_cache(\%metacache,$uri,'meta');
 	}
         my %metathesekeys=();
         unless ($filename=~/\.meta$/) { $filename.='.meta'; }
 	my $metastring;
 	if ($uri !~ m|^uploaded/|) {
 	    my $file=&filelocation('',&clutter($filename));
-	    #push(@{$metaentry{$uri.'.file'}},$file);
+	    push(@{$metacache{$uri.'.file'}},$file);
 	    $metastring=&getfile($file);
 	}
         my $parser=HTML::LCParser->new(\$metastring);
@@ -4603,10 +4538,10 @@ sub metadata {
 		    if (defined($token->[2]->{'id'})) { 
 			$keyroot.='_'.$token->[2]->{'id'}; 
 		    }
-		    if ($metaentry{':packages'}) {
-			$metaentry{':packages'}.=','.$package.$keyroot;
+		    if ($metacache{$uri}->{':packages'}) {
+			$metacache{$uri}->{':packages'}.=','.$package.$keyroot;
 		    } else {
-			$metaentry{':packages'}=$package.$keyroot;
+			$metacache{$uri}->{':packages'}=$package.$keyroot;
 		    }
 		    foreach (keys %packagetab) {
 			my $part=$keyroot;
@@ -4628,14 +4563,14 @@ sub metadata {
 			    if ($subp eq 'display') {
 				$value.=' [Part: '.$part.']';
 			    }
-			    $metaentry{':'.$unikey.'.part'}=$part;
+			    $metacache{$uri}->{':'.$unikey.'.part'}=$part;
 			    $metathesekeys{$unikey}=1;
-			    unless (defined($metaentry{':'.$unikey.'.'.$subp})) {
-				$metaentry{':'.$unikey.'.'.$subp}=$value;
+			    unless (defined($metacache{$uri}->{':'.$unikey.'.'.$subp})) {
+				$metacache{$uri}->{':'.$unikey.'.'.$subp}=$value;
 			    }
-			    if (defined($metaentry{':'.$unikey.'.default'})) {
-				$metaentry{':'.$unikey}=
-				    $metaentry{':'.$unikey.'.default'};
+			    if (defined($metacache{$uri}->{':'.$unikey.'.default'})) {
+				$metacache{$uri}->{':'.$unikey}=
+				    $metacache{$uri}->{':'.$unikey.'.default'};
 			    }
 			}
 		    }
@@ -4668,7 +4603,7 @@ sub metadata {
 			    foreach (sort(split(/\,/,&metadata($uri,'keys',
 							       $location,$unikey,
 							       $depthcount+1)))) {
-				$metaentry{':'.$_}=$metaentry{':'.$_};
+				$metacache{$uri}->{':'.$_}=$metacache{$uri}->{':'.$_};
 				$metathesekeys{$_}=1;
 			    }
 			}
@@ -4679,18 +4614,18 @@ sub metadata {
 			}
 			$metathesekeys{$unikey}=1;
 			foreach (@{$token->[3]}) {
-			    $metaentry{':'.$unikey.'.'.$_}=$token->[2]->{$_};
+			    $metacache{$uri}->{':'.$unikey.'.'.$_}=$token->[2]->{$_};
 			}
 			my $internaltext=&HTML::Entities::decode($parser->get_text('/'.$entry));
-			my $default=$metaentry{':'.$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
-			    $metaentry{':'.$unikey}=$default;
+			    $metacache{$uri}->{':'.$unikey}=$default;
 			} else {
 		  # either something interesting inside the tag or default
                   # uninteresting
-			    $metaentry{':'.$unikey}=$internaltext;
+			    $metacache{$uri}->{':'.$unikey}=$internaltext;
 			}
 # end of not-a-package not-a-library import
 		    }
@@ -4707,7 +4642,7 @@ sub metadata {
 	    &metadata_create_package_def($uri,$key,'extension_'.$extension,
 					 \%metathesekeys);
 	}
-	if (!exists($metaentry{':packages'})) {
+	if (!exists($metacache{$uri}->{':packages'})) {
 	    foreach my $key (sort(keys(%packagetab))) {
 		#no specific packages well let's get default then
 		if ($key!~/^default&/) { next; }
@@ -4716,31 +4651,31 @@ sub metadata {
 	    }
 	}
 # are there custom rights to evaluate
-	if ($metaentry{':copyright'} eq 'custom') {
+	if ($metacache{$uri}->{':copyright'} eq 'custom') {
 
     #
     # Importing a rights file here
     #
 	    unless ($depthcount) {
-		my $location=$metaentry{':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)))) {
-		    #$metaentry{':'.$_}=$metacache{$uri}->{':'.$_};
+		    $metacache{$uri}->{':'.$_}=$metacache{$uri}->{':'.$_};
 		    $metathesekeys{$_}=1;
 		}
 	    }
 	}
-	$metaentry{':keys'}=join(',',keys %metathesekeys);
-	&metadata_generate_part0(\%metathesekeys,\%metaentry,$uri);
-	$metaentry{':allpossiblekeys'}=join(',',keys %metathesekeys);
-	&do_cache_new('meta',$uri,\%metaentry);
+	$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 $metaentry{':'.$what};
+    return $metacache{$uri}->{':'.$what};
 }
 
 sub metadata_create_package_def {
@@ -4748,22 +4683,22 @@ sub metadata_create_package_def {
     my ($pack,$name,$subp)=split(/\&/,$key);
     if ($subp eq 'default') { next; }
     
-    if (defined($metaentry{':packages'})) {
-	$metaentry{':packages'}.=','.$package;
+    if (defined($metacache{$uri}->{':packages'})) {
+	$metacache{$uri}->{':packages'}.=','.$package;
     } else {
-	$metaentry{':packages'}=$package;
+	$metacache{$uri}->{':packages'}=$package;
     }
     my $value=$packagetab{$key};
     my $unikey;
     $unikey='parameter_0_'.$name;
-    $metaentry{':'.$unikey.'.part'}=0;
+    $metacache{$uri}->{':'.$unikey.'.part'}=0;
     $$metathesekeys{$unikey}=1;
-    unless (defined($metaentry{':'.$unikey.'.'.$subp})) {
-	$metaentry{':'.$unikey.'.'.$subp}=$value;
+    unless (defined($metacache{$uri}->{':'.$unikey.'.'.$subp})) {
+	$metacache{$uri}->{':'.$unikey.'.'.$subp}=$value;
     }
-    if (defined($metaentry{':'.$unikey.'.default'})) {
-	$metaentry{':'.$unikey}=
-	    $metaentry{':'.$unikey.'.default'};
+    if (defined($metacache{$uri}->{':'.$unikey.'.default'})) {
+	$metacache{$uri}->{':'.$unikey}=
+	    $metacache{$uri}->{':'.$unikey.'.default'};
     }
 }
 
@@ -4801,8 +4736,7 @@ sub gettitle {
     my $urlsymb=shift;
     my $symb=&symbread($urlsymb);
     if ($symb) {
-	my $key=$ENV{'request.course.id'}."\0".$symb;
-	my ($result,$cached)=&is_cached_new('title',$key);
+	my ($result,$cached)=&is_cached(\%titlecache,$symb,'title',600);
 	if (defined($cached)) { 
 	    return $result;
 	}
@@ -4817,7 +4751,7 @@ sub gettitle {
 	}
 	$title=~s/\&colon\;/\:/gs;
 	if ($title) {
-	    return &do_cache_new('title',$key,$title,600);
+	    return &do_cache(\%titlecache,$symb,$title,'title');
 	}
 	$urlsymb=$url;
     }
@@ -4931,7 +4865,8 @@ sub fixversion {
     my $uri=&clutter($fn);
     my $key=$ENV{'request.course.id'}.'_'.$uri;
 # is this cached?
-    my ($result,$cached)=&is_cached_new('courseresversion',$key);
+    my ($result,$cached)=&is_cached(\%courseresversioncache,$key,
+				    'courseresversion',600);
     if (defined($cached)) { return $result; }
 # unfortunately not cached, or expired
     if (tie(%bighash,'GDBM_File',$ENV{'request.course.fn'}.'.db',
@@ -4945,7 +4880,8 @@ sub fixversion {
  	}
  	untie %bighash;
     }
-    return &do_cache_new('courseresversion',$key,&declutter($uri),600);
+    return &do_cache
+	(\%courseresversioncache,$key,&declutter($uri),'courseresversion');
 }
 
 sub deversion {
@@ -5506,39 +5442,42 @@ sub readfile {
 }
 
 sub filelocation {
-  my ($dir,$file) = @_;
-  my $location;
-  $file=~ s/^\s*(\S+)\s*$/$1/; ## strip off leading and trailing spaces
-  if ($file=~m:^/~:) { # is a contruction space reference
-    $location = $file;
-    $location =~ s:/~(.*?)/(.*):/home/$1/public_html/$2:;
-  } elsif ($file=~/^\/*uploaded/) { # is an uploaded file
-      my ($udom,$uname,$filename)=
-	  ($file=~m|^/+uploaded/+([^/]+)/+([^/]+)/+(.*)$|);
-      my $home=&homeserver($uname,$udom);
-      my $is_me=0;
-      my @ids=&current_machine_ids();
-      foreach my $id (@ids) { if ($id eq $home) { $is_me=1; } }
-      if ($is_me) {
-	  $location=&Apache::loncommon::propath($udom,$uname).
-	      '/userfiles/'.$filename;
-      } else {
-	  $location=$Apache::lonnet::perlvar{'lonDocRoot'}.'/userfiles/'.
-	      $udom.'/'.$uname.'/'.$filename;
-      }
-  } else {
-    $file=~s/^\Q$perlvar{'lonDocRoot'}\E//;
-    $file=~s:^/res/:/:;
-    if ( !( $file =~ m:^/:) ) {
-      $location = $dir. '/'.$file;
-    } else {
-      $location = '/home/httpd/html/res'.$file;
+    my ($dir,$file) = @_;
+    my $location;
+    $file=~ s/^\s*(\S+)\s*$/$1/; ## strip off leading and trailing spaces
+    if ($file=~m:^/~:) { # is a contruction space reference
+        $location = $file;
+        $location =~ s:/~(.*?)/(.*):/home/$1/public_html/$2:;
+    } elsif ($file=~/^\/*uploaded/) { # is an uploaded file
+        my ($udom,$uname,$filename)=
+  	    ($file=~m|^/+uploaded/+([^/]+)/+([^/]+)/+(.*)$|);
+        my $home=&homeserver($uname,$udom);
+        my $is_me=0;
+        my @ids=&current_machine_ids();
+        foreach my $id (@ids) { if ($id eq $home) { $is_me=1; } }
+        if ($is_me) {
+  	    $location=&Apache::loncommon::propath($udom,$uname).
+  	      '/userfiles/'.$filename;
+        } else {
+  	  $location=$Apache::lonnet::perlvar{'lonDocRoot'}.'/userfiles/'.
+  	      $udom.'/'.$uname.'/'.$filename;
+        }
+    } elsif ($file =~ /^\/adm\/portfolio\//) {
+        $file =~ s:^/adm/portfolio/::;
+        $location = $location=&Apache::loncommon::propath($ENV{'user.domain'},$ENV{'user.name'}).'/userfiles/portfolio/'.$file;
+    } else {
+        $file=~s/^\Q$perlvar{'lonDocRoot'}\E//;
+        $file=~s:^/res/:/:;
+        if ( !( $file =~ m:^/:) ) {
+            $location = $dir. '/'.$file;
+        } else {
+            $location = '/home/httpd/html/res'.$file;
+        }
     }
-  }
-  $location=~s://+:/:g; # remove duplicate /
-  while ($location=~m:/\.\./:) {$location=~ s:/[^/]+/\.\./:/:g;} #remove dir/..
-  while ($location=~m:/\./:) {$location=~ s:/\./:/:g;} #remove /./
-  return $location;
+    $location=~s://+:/:g; # remove duplicate /
+    while ($location=~m:/\.\./:) {$location=~ s:/[^/]+/\.\./:/:g;} #remove dir/..
+    while ($location=~m:/\./:) {$location=~ s:/\./:/:g;} #remove /./
+    return $location;
 }
 
 sub hreflocation {
@@ -5654,20 +5593,17 @@ sub correct_line_ends {
 sub goodbye {
    &logthis("Starting Shut down");
 #not converted to using infrastruture and probably shouldn't be
-   &logthis(sprintf("%-20s is %s",'%badServerCache',length(&freeze(\%badServerCache))));
+   &logthis(sprintf("%-20s is %s",'%badServerCache',scalar(%badServerCache)));
 #converted
-#   &logthis(sprintf("%-20s is %s",'%metacache',scalar(%metacache)));
-   &logthis(sprintf("%-20s is %s",'%homecache',length(&freeze(\%homecache))));
-#   &logthis(sprintf("%-20s is %s",'%titlecache',length(&freeze(\%titlecache))));
-   &logthis(sprintf("%-20s is %s",'%courseresdatacache',length(&freeze(\%courseresdatacache))));
+   &logthis(sprintf("%-20s is %s",'%metacache',scalar(%metacache)));
+   &logthis(sprintf("%-20s is %s",'%homecache',scalar(%homecache)));
+   &logthis(sprintf("%-20s is %s",'%titlecache',scalar(%titlecache)));
+   &logthis(sprintf("%-20s is %s",'%courseresdatacache',scalar(%courseresdatacache)));
 #1.1 only
-   &logthis(sprintf("%-20s is %s",'%userresdatacache',length(&freeze(\%userresdatacache))));
-   &logthis(sprintf("%-20s is %s",'%getsectioncache',length(&freeze(\%getsectioncache))));
-#   &logthis(sprintf("%-20s is %s",'%courseresversioncache',length(&freeze(\%courseresversioncache))));
-#   &logthis(sprintf("%-20s is %s",'%resversioncache',length(&freeze(\%resversioncache))));
-   &logthis(sprintf("%-20s is %s",'%remembered',length(&freeze(\%remembered))));
-   &logthis(sprintf("%-20s is %s",'kicks',$kicks));
-   &logthis(sprintf("%-20s is %s",'hits',$hits));
+   &logthis(sprintf("%-20s is %s",'%userresdatacache',scalar(%userresdatacache)));
+   &logthis(sprintf("%-20s is %s",'%getsectioncache',scalar(%getsectioncache)));
+   &logthis(sprintf("%-20s is %s",'%courseresversioncache',scalar(%courseresversioncache)));
+   &logthis(sprintf("%-20s is %s",'%resversioncache',scalar(%resversioncache)));
    &flushcourselogs();
    &logthis("Shutting down");
    return DONE;
@@ -5813,7 +5749,7 @@ BEGIN {
 
 }
 
-$memcache=new Cache::Memcached({'servers'=>['127.0.0.1:11211']});
+%metacache=();
 
 $processmarker='_'.time.'_'.$perlvar{'lonHostID'};
 $dumpcount=0;