--- loncom/lonnet/perl/lonnet.pm 2016/08/16 22:28:58 1.1172.2.79 +++ loncom/lonnet/perl/lonnet.pm 2016/09/18 14:37:57 1.1172.2.81 @@ -1,7 +1,7 @@ # The LearningOnline Network # TCP networking package # -# $Id: lonnet.pm,v 1.1172.2.79 2016/08/16 22:28:58 raeburn Exp $ +# $Id: lonnet.pm,v 1.1172.2.81 2016/09/18 14:37:57 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # @@ -2468,21 +2468,25 @@ sub make_key { sub devalidate_cache_new { my ($name,$id,$debug) = @_; if ($debug) { &Apache::lonnet::logthis("deleting $name:$id"); } + my $remembered_id=$name.':'.$id; $id=&make_key($name,$id); $memcache->delete($id); - delete($remembered{$id}); - delete($accessed{$id}); + delete($remembered{$remembered_id}); + delete($accessed{$remembered_id}); } sub is_cached_new { my ($name,$id,$debug) = @_; - $id=&make_key($name,$id); - if (exists($remembered{$id})) { - if ($debug) { &Apache::lonnet::logthis("Early return $id of $remembered{$id} "); } - $accessed{$id}=[&gettimeofday()]; + my $remembered_id=$name.':'.$id; # this is to avoid make_key (which is slow) for + # keys in %remembered hash, which persists for + # duration of request (no restriction on key length). + if (exists($remembered{$remembered_id})) { + if ($debug) { &Apache::lonnet::logthis("Early return $remembered_id of $remembered{$remembered_id} "); } + $accessed{$remembered_id}=[&gettimeofday()]; $hits++; - return ($remembered{$id},1); + return ($remembered{$remembered_id},1); } + $id=&make_key($name,$id); my $value = $memcache->get($id); if (!(defined($value))) { if ($debug) { &Apache::lonnet::logthis("getting $id is not defined"); } @@ -2492,13 +2496,14 @@ sub is_cached_new { if ($debug) { &Apache::lonnet::logthis("getting $id is __undef__"); } $value=undef; } - &make_room($id,$value,$debug); + &make_room($remembered_id,$value,$debug); if ($debug) { &Apache::lonnet::logthis("getting $id is $value"); } return ($value,1); } sub do_cache_new { my ($name,$id,$value,$time,$debug) = @_; + my $remembered_id=$name.':'.$id; $id=&make_key($name,$id); my $setvalue=$value; if (!defined($setvalue)) { @@ -2514,17 +2519,17 @@ sub do_cache_new { $memcache->disconnect_all(); } # need to make a copy of $value - &make_room($id,$value,$debug); + &make_room($remembered_id,$value,$debug); return $value; } sub make_room { - my ($id,$value,$debug)=@_; + my ($remembered_id,$value,$debug)=@_; - $remembered{$id}= (ref($value)) ? &Storable::dclone($value) + $remembered{$remembered_id}= (ref($value)) ? &Storable::dclone($value) : $value; if ($to_remember<0) { return; } - $accessed{$id}=[&gettimeofday()]; + $accessed{$remembered_id}=[&gettimeofday()]; if (scalar(keys(%remembered)) <= $to_remember) { return; } my $to_kick; my $max_time=0; @@ -9913,7 +9918,23 @@ sub dirlist { foreach my $user (sort(keys(%allusers))) { push(@alluserslist,$user.'&user'); } - return (\@alluserslist); + if (!%listerror) { + # no errors + return (\@alluserslist); + } elsif (scalar(keys(%servers)) == 1) { + # one library server, one error + my ($key) = keys(%listerror); + return (\@alluserslist, $listerror{$key}); + } elsif ( grep { $_ eq 'con_lost' } values(%listerror) ) { + # con_lost indicates that we might miss data from at least one + # library server + return (\@alluserslist, 'con_lost'); + } else { + # multiple library servers and no con_lost -> data should be + # complete. + return (\@alluserslist); + } + } else { return ([],'missing username'); }