--- loncom/lonnet/perl/lonnet.pm 2012/08/01 04:56:54 1.1172.2.8 +++ loncom/lonnet/perl/lonnet.pm 2012/05/28 12:23:03 1.1173 @@ -1,7 +1,7 @@ # The LearningOnline Network # TCP networking package # -# $Id: lonnet.pm,v 1.1172.2.8 2012/08/01 04:56:54 raeburn Exp $ +# $Id: lonnet.pm,v 1.1173 2012/05/28 12:23:03 foxr Exp $ # # Copyright Michigan State University Board of Trustees # @@ -75,6 +75,8 @@ use LWP::UserAgent(); use HTTP::Date; use Image::Magick; +use Encode; + use vars qw(%perlvar %spareid %pr %prp $memcache %packagetab $tmpdir $_64bit %env %protocol %loncaparevs %serverhomeIDs %needsrelease %managerstab); @@ -97,6 +99,7 @@ use File::MMagic; use LONCAPA qw(:DEFAULT :match); use LONCAPA::Configuration; use LONCAPA::lonmetadata; +use LONCAPA::Lond; use File::Copy; @@ -1236,7 +1239,6 @@ sub check_loadbalancing { my ($is_balancer,$dom_in_use,$homeintdom,$rule_in_effect, $offloadto,$otherserver); my $lonhost = $perlvar{'lonHostID'}; - my @hosts = ¤t_machine_ids(); my $uprimary_id = &Apache::lonnet::domain($udom,'primary'); my $uintdom = &Apache::lonnet::internet_dom($uprimary_id); my $intdom = &Apache::lonnet::internet_dom($lonhost); @@ -1263,6 +1265,7 @@ sub check_loadbalancing { my $currtargets = $result->{'targets'}; my $currrules = $result->{'rules'}; if ($currbalancer ne '') { + my @hosts = ¤t_machine_ids(); if (grep(/^\Q$currbalancer\E$/,@hosts)) { $is_balancer = 1; } @@ -1350,43 +1353,31 @@ sub check_loadbalancing { $offloadto = &this_host_spares($dom_in_use); } } - if ($is_balancer) { - my $lowest_load = 30000; - if (ref($offloadto) eq 'HASH') { - if (ref($offloadto->{'primary'}) eq 'ARRAY') { - foreach my $try_server (@{$offloadto->{'primary'}}) { - ($otherserver,$lowest_load) = - &compare_server_load($try_server,$otherserver,$lowest_load); - } + my $lowest_load = 30000; + if (ref($offloadto) eq 'HASH') { + if (ref($offloadto->{'primary'}) eq 'ARRAY') { + foreach my $try_server (@{$offloadto->{'primary'}}) { + ($otherserver,$lowest_load) = + &compare_server_load($try_server,$otherserver,$lowest_load); } - my $found_server = ($otherserver ne '' && $lowest_load < 100); + } + my $found_server = ($otherserver ne '' && $lowest_load < 100); - if (!$found_server) { - if (ref($offloadto->{'default'}) eq 'ARRAY') { - foreach my $try_server (@{$offloadto->{'default'}}) { - ($otherserver,$lowest_load) = - &compare_server_load($try_server,$otherserver,$lowest_load); - } - } - } - } elsif (ref($offloadto) eq 'ARRAY') { - if (@{$offloadto} == 1) { - $otherserver = $offloadto->[0]; - } elsif (@{$offloadto} > 1) { - foreach my $try_server (@{$offloadto}) { + if (!$found_server) { + if (ref($offloadto->{'default'}) eq 'ARRAY') { + foreach my $try_server (@{$offloadto->{'default'}}) { ($otherserver,$lowest_load) = &compare_server_load($try_server,$otherserver,$lowest_load); } } } - if (($otherserver ne '') && (grep(/^\Q$otherserver\E$/,@hosts))) { - $is_balancer = 0; - if ($uname ne '' && $udom ne '') { - if (($env{'user.name'} eq $uname) && ($env{'user.domain'} eq $udom)) { - - &appenv({'user.loadbalexempt' => $lonhost, - 'user.loadbalcheck.time' => time}); - } + } elsif (ref($offloadto) eq 'ARRAY') { + if (@{$offloadto} == 1) { + $otherserver = $offloadto->[0]; + } elsif (@{$offloadto} > 1) { + foreach my $try_server (@{$offloadto}) { + ($otherserver,$lowest_load) = + &compare_server_load($try_server,$otherserver,$lowest_load); } } } @@ -1396,9 +1387,7 @@ sub check_loadbalancing { sub get_loadbalancer_targets { my ($rule_in_effect,$currtargets,$uname,$udom) = @_; my $offloadto; - if ($rule_in_effect eq 'none') { - return [$perlvar{'lonHostID'}]; - } elsif ($rule_in_effect eq '') { + if ($rule_in_effect eq '') { $offloadto = $currtargets; } else { if ($rule_in_effect eq 'homeserver') { @@ -1416,7 +1405,7 @@ sub get_loadbalancer_targets { } } } else { - my %servers = &internet_dom_servers($udom); + my %servers = &dom_servers($udom); my ($remotebalancer,$remotetargets) = &get_lonbalancer_config(\%servers); if (&hostname($remotebalancer) ne '') { $offloadto = [$remotebalancer]; @@ -1954,7 +1943,7 @@ sub get_domain_defaults { } else { $domdefaults{'defaultquota'} = $domconfig{'quotas'}; } - my @usertools = ('aboutme','blog','webdav','portfolio'); + my @usertools = ('aboutme','blog','portfolio'); foreach my $item (@usertools) { if (ref($domconfig{'quotas'}{$item}) eq 'HASH') { $domdefaults{$item} = $domconfig{'quotas'}{$item}; @@ -2582,10 +2571,11 @@ sub ssi { $request->header(Cookie => $ENV{'HTTP_COOKIE'}); my $response= $ua->request($request); + my $content = Encode::decode_utf8($response->content); if (wantarray) { - return ($response->content, $response); + return ($content, $response); } else { - return $response->content; + return $content; } } @@ -3971,7 +3961,7 @@ my $cachedtime=(); sub load_all_first_access { my ($uname,$udom)=@_; if (($cachedkey eq $uname.':'.$udom) && - (abs($cachedtime-time)<5) && (!$env{'form.markaccess'})) { + (abs($cachedtime-time)<5)) { return; } $cachedtime=time; @@ -5643,7 +5633,6 @@ sub usertools_access { %tools = ( aboutme => 1, blog => 1, - webdav => 1, portfolio => 1, ); } @@ -5742,7 +5731,7 @@ sub usertools_access { } } } else { - if (($context eq 'tools') && ($tool ne 'webdav')) { + if ($context eq 'tools') { $access = 1; } else { $access = 0; @@ -9812,41 +9801,6 @@ sub devalidate_slots_cache { &devalidate_cache_new('allslots',$hashid); } -sub get_coursechange { - my ($cdom,$cnum) = @_; - if ($cdom eq '' || $cnum eq '') { - return unless ($env{'request.course.id'}); - $cnum = $env{'course.'.$env{'request.course.id'}.'.num'}; - $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'}; - } - my $hashid=$cdom.'_'.$cnum; - my ($change,$cached)=&is_cached_new('crschange',$hashid); - if ((defined($cached)) && ($change ne '')) { - return $change; - } else { - my %crshash; - %crshash = &get('environment',['internal.contentchange'],$cdom,$cnum); - if ($crshash{'internal.contentchange'} eq '') { - $change = $env{'course.'.$cdom.'_'.$cnum.'.internal.created'}; - if ($change eq '') { - %crshash = &get('environment',['internal.created'],$cdom,$cnum); - $change = $crshash{'internal.created'}; - } - } else { - $change = $crshash{'internal.contentchange'}; - } - my $cachetime = 600; - &do_cache_new('crschange',$hashid,$change,$cachetime); - } - return $change; -} - -sub devalidate_coursechange_cache { - my ($cnum,$cdom)=@_; - my $hashid=$cnum.':'.$cdom; - &devalidate_cache_new('crschange',$hashid); -} - # ------------------------------------------------- Update symbolic store links sub symblist { @@ -9991,11 +9945,7 @@ sub deversion { sub symbread { my ($thisfn,$donotrecurse)=@_; my $cache_str='request.symbread.cached.'.$thisfn; - if (defined($env{$cache_str})) { - if (($thisfn) || ($env{$cache_str} ne '')) { - return $env{$cache_str}; - } - } + if (defined($env{$cache_str})) { return $env{$cache_str}; } # no filename provided? try from environment unless ($thisfn) { if ($env{'request.symb'}) {