--- loncom/lonnet/perl/lonnet.pm 2015/08/05 18:47:25 1.1290
+++ loncom/lonnet/perl/lonnet.pm 2015/10/23 16:01:41 1.1294
@@ -1,7 +1,7 @@
# The LearningOnline Network
# TCP networking package
#
-# $Id: lonnet.pm,v 1.1290 2015/08/05 18:47:25 raeburn Exp $
+# $Id: lonnet.pm,v 1.1294 2015/10/23 16:01:41 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -1974,11 +1974,10 @@ sub get_multiple_instusers {
$uname = $key;
}
my ($resp,%info) = &get_instuser($udom,$uname,$id);
+ $outcome = $resp;
if ($resp eq 'ok') {
%{$results} = (%{$results}, %info);
- $outcome = 'ok';
} else {
- $outcome = $resp;
last;
}
}
@@ -1986,7 +1985,7 @@ sub get_multiple_instusers {
if (($response eq 'unavailable') || ($response eq 'invalid') || ($response eq 'timeout')) {
$outcome = $response;
} else {
- ($outcome,my $userdata) = split(/:/,$response,2);
+ ($outcome,my $userdata) = split(/=/,$response,2);
if ($outcome eq 'ok') {
$results = &thaw_unescape($userdata);
}
@@ -7387,7 +7386,8 @@ sub get_commblock_resources {
}
}
}
- if ($interval[0] =~ /^\d+$/) {
+ if ($interval[0] =~ /^\d+/) {
+ my ($timelimit) = split(/_/,$interval[0]);
my $first_access;
if ($type eq 'resource') {
$first_access=&get_first_access($interval[1],$item);
@@ -7397,7 +7397,7 @@ sub get_commblock_resources {
$first_access=&get_first_access($interval[1]);
}
if ($first_access) {
- my $timesup = $first_access+$interval[0];
+ my $timesup = $first_access+$timelimit;
if ($timesup > $now) {
my $activeblock;
foreach my $res (@to_test) {
@@ -10174,10 +10174,12 @@ sub get_userresdata {
}
#error 2 occurs when the .db doesn't exist
if ($tmp!~/error: 2 /) {
- &logthis("WARNING:".
- " Trying to get resource data for ".
- $uname." at ".$udom.": ".
- $tmp."");
+ if ((!defined($cached)) || ($tmp ne 'con_lost')) {
+ &logthis("WARNING:".
+ " Trying to get resource data for ".
+ $uname." at ".$udom.": ".
+ $tmp."");
+ }
} elsif ($tmp=~/error: 2 /) {
#&EXT_cache_set($udom,$uname);
&do_cache_new('userres',$hashid,undef,600);
@@ -12395,8 +12397,8 @@ sub fetch_dns_checksums {
}
sub load_domain_tab {
- my ($ignore_cache) = @_;
- &get_dns('/adm/dns/domain',\&parse_domain_tab,$ignore_cache);
+ my ($ignore_cache,$nocache) = @_;
+ &get_dns('/adm/dns/domain',\&parse_domain_tab,$ignore_cache,$nocache);
my $fh;
if (open($fh,"<".$perlvar{'lonTabDir'}.'/domain.tab')) {
my @lines = <$fh>;
@@ -12482,8 +12484,8 @@ sub fetch_dns_checksums {
}
sub load_hosts_tab {
- my ($ignore_cache) = @_;
- &get_dns('/adm/dns/hosts',\&parse_hosts_tab,$ignore_cache);
+ my ($ignore_cache,$nocache) = @_;
+ &get_dns('/adm/dns/hosts',\&parse_hosts_tab,$ignore_cache,$nocache);
open(my $config,"<$perlvar{'lonTabDir'}/hosts.tab");
my @config = <$config>;
&parse_hosts_tab(\@config);
@@ -12505,7 +12507,8 @@ sub fetch_dns_checksums {
}
sub all_names {
- &load_hosts_tab() if (!$loaded);
+ my ($ignore_cache,$nocache) = @_;
+ &load_hosts_tab($ignore_cache,$nocache) if (!$loaded);
return %name_to_host;
}
@@ -12627,7 +12630,7 @@ sub fetch_dns_checksums {
}
sub get_iphost {
- my ($ignore_cache) = @_;
+ my ($ignore_cache,$nocache) = @_;
if (!$ignore_cache) {
if (%iphost) {
@@ -12651,7 +12654,7 @@ sub fetch_dns_checksums {
%old_name_to_ip = %{$ip_info->[1]};
}
- my %name_to_host = &all_names();
+ my %name_to_host = &all_names($ignore_cache,$nocache);
foreach my $name (keys(%name_to_host)) {
my $ip;
if (!exists($name_to_ip{$name})) {
@@ -12676,9 +12679,11 @@ sub fetch_dns_checksums {
}
push(@{$iphost{$ip}},@{$name_to_host{$name}});
}
- &do_cache_new('iphost','iphost',
- [\%iphost,\%name_to_ip,\%lonid_to_ip],
- 48*60*60);
+ unless ($nocache) {
+ &do_cache_new('iphost','iphost',
+ [\%iphost,\%name_to_ip,\%lonid_to_ip],
+ 48*60*60);
+ }
return %iphost;
}