--- loncom/lonnet/perl/lonnet.pm 2007/01/25 21:10:51 1.824.2.1 +++ loncom/lonnet/perl/lonnet.pm 2007/03/17 04:13:06 1.824.2.3 @@ -1,7 +1,7 @@ # The LearningOnline Network # TCP networking package # -# $Id: lonnet.pm,v 1.824.2.1 2007/01/25 21:10:51 albertel Exp $ +# $Id: lonnet.pm,v 1.824.2.3 2007/03/17 04:13:06 albertel Exp $ # # Copyright Michigan State University Board of Trustees # @@ -990,10 +990,16 @@ my %remembered; my %accessed; my $kicks=0; my $hits=0; +sub make_key { + my ($name,$id) = @_; + if (length($id) > 200) { $id=length($id).':'.&Digest::MD5::md5_hex($id); } + return &escape($name.':'.$id); +} + sub devalidate_cache_new { my ($name,$id,$debug) = @_; if ($debug) { &Apache::lonnet::logthis("deleting $name:$id"); } - $id=&escape($name.':'.$id); + $id=&make_key($name,$id); $memcache->delete($id); delete($remembered{$id}); delete($accessed{$id}); @@ -1001,7 +1007,7 @@ sub devalidate_cache_new { sub is_cached_new { my ($name,$id,$debug) = @_; - $id=&escape($name.':'.$id); + $id=&make_key($name,$id); if (exists($remembered{$id})) { if ($debug) { &Apache::lonnet::logthis("Earyl return $id of $remembered{$id} "); } $accessed{$id}=[&gettimeofday()]; @@ -1024,7 +1030,7 @@ sub is_cached_new { sub do_cache_new { my ($name,$id,$value,$time,$debug) = @_; - $id=&escape($name.':'.$id); + $id=&make_key($name,$id); my $setvalue=$value; if (!defined($setvalue)) { $setvalue='__undef__'; @@ -7167,14 +7173,7 @@ sub repcopy_userfile { } else { my $lwpresp = &getuploaded('GET',$uri,$cdom,$cnum,\$info,\$rtncode); if ($lwpresp ne 'ok') { - my $ua=new LWP::UserAgent; - my $request=new HTTP::Request('GET',&tokenwrapper($uri)); - my $response=$ua->request($request); - if ($response->is_success()) { - $info=$response->content; - } else { - return -1; - } + return -1; } my @parts = ($cdom,$cnum); if ($filename =~ m|^(.+)/[^/]+$|) {