--- loncom/lonnet/perl/lonnet.pm 2011/06/06 17:17:44 1.1110 +++ loncom/lonnet/perl/lonnet.pm 2011/06/12 13:48:28 1.1114 @@ -1,7 +1,7 @@ # The LearningOnline Network # TCP networking package # -# $Id: lonnet.pm,v 1.1110 2011/06/06 17:17:44 www Exp $ +# $Id: lonnet.pm,v 1.1114 2011/06/12 13:48:28 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # @@ -816,7 +816,7 @@ sub compare_server_load { my $userloadans = &reply('userload',$try_server); if ($loadans !~ /\d/ && $userloadans !~ /\d/) { - return; #didn't get a number from the server + return ($spare_server, $lowest_load); #didn't get a number from the server } my $load; @@ -1999,20 +1999,29 @@ sub getversion { sub currentversion { my $fname=shift; - my ($result,$cached)=&is_cached_new('resversion',$fname); - if (defined($cached)) { return $result; } my $author=$fname; $author=~s/\/home\/httpd\/html\/res\/([^\/]*)\/([^\/]*).*/$1\/$2/; my ($udom,$uname)=split(/\//,$author); - my $home=homeserver($uname,$udom); + my $home=&homeserver($uname,$udom); if ($home eq 'no_host') { return -1; } - my $answer=reply("currentversion:$fname",$home); + my $answer=&reply("currentversion:$fname",$home); if (($answer eq 'con_lost') || ($answer eq 'rejected')) { return -1; } - return &do_cache_new('resversion',$fname,$answer,600); + return $answer; +} + +# +# Return special version number of resource if set by override, empty otherwise +# +sub usedversion { + my $fname=shift; + unless ($fname) { $fname=$env{'request.uri'}; } + my ($urlversion)=($fname=~/\.(\d+)\.\w+$/); + if ($urlversion) { return $urlversion; } + return ''; } # ----------------------------- Subscribe to a resource, return URL if possible @@ -4803,7 +4812,7 @@ sub tmpget { return %returnhash; } -# ------------------------------------------------------------ tmpget interface +# ------------------------------------------------------------ tmpdel interface sub tmpdel { my ($token,$server)=@_; if (!defined($server)) { $server = $perlvar{'lonHostID'}; }