--- loncom/lonnet/perl/lonnet.pm 2011/06/06 17:17:44 1.1110 +++ loncom/lonnet/perl/lonnet.pm 2011/06/12 14:18:12 1.1115 @@ -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.1115 2011/06/12 14:18:12 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; @@ -862,13 +862,16 @@ sub has_user_session { # --------- determine least loaded server in a user's domain which allows login sub choose_server { - my ($udom) = @_; + my ($udom,$checkloginvia) = @_; my %domconfhash = &Apache::loncommon::get_domainconf($udom); my %servers = &get_servers($udom); my $lowest_load = 30000; my ($login_host,$hostname); foreach my $lonhost (keys(%servers)) { - my $loginvia = $domconfhash{$udom.'.login.loginvia_'.$lonhost}; + my $loginvia; + if ($checkloginvia) { + $loginvia = $domconfhash{$udom.'.login.loginvia_'.$lonhost}; + } if ($loginvia eq '') { ($login_host, $lowest_load) = &compare_server_load($lonhost, $login_host, $lowest_load); @@ -1999,20 +2002,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 +4815,7 @@ sub tmpget { return %returnhash; } -# ------------------------------------------------------------ tmpget interface +# ------------------------------------------------------------ tmpdel interface sub tmpdel { my ($token,$server)=@_; if (!defined($server)) { $server = $perlvar{'lonHostID'}; }