--- loncom/lonnet/perl/lonnet.pm 2003/10/04 02:27:02 1.425 +++ loncom/lonnet/perl/lonnet.pm 2003/10/06 20:38:25 1.427 @@ -1,7 +1,7 @@ # The LearningOnline Network # TCP networking package # -# $Id: lonnet.pm,v 1.425 2003/10/04 02:27:02 albertel Exp $ +# $Id: lonnet.pm,v 1.427 2003/10/06 20:38:25 www Exp $ # # Copyright Michigan State University Board of Trustees # @@ -586,9 +586,9 @@ sub authenticate { sub homeserver { my ($uname,$udom,$ignoreBadCache)=@_; my $index="$uname:$udom"; - if ($homecache{$index}) { - return "$homecache{$index}"; - } + + my ($result,$cached)=&is_cached(\%homecache,$index,'home',86400); + if (defined($cached)) { return $result; } my $tryserver; foreach $tryserver (keys %libserv) { next if ($ignoreBadCache ne 'true' && @@ -596,8 +596,7 @@ sub homeserver { if ($hostdom{$tryserver} eq $udom) { my $answer=reply("home:$udom:$uname",$tryserver); if ($answer eq 'found') { - $homecache{$index}=$tryserver; - return $tryserver; + return &do_cache(\%homecache,$index,$tryserver,'home'); } elsif ($answer eq 'no_host') { $badServerCache{$tryserver}=1; } @@ -2712,6 +2711,31 @@ sub is_on_map { } } +# --------------------------------------------------------- Get symb from alias + +sub get_symb_from_alias { + my $symb=shift; + my ($map,$resid,$url)=&decode_symb($symb); +# Already is a symb + if ($url) { return $symb; } +# Must be an alias + my $aliassymb=''; + my %bighash; + if (tie(%bighash,'GDBM_File',$ENV{'request.course.fn'}.'.db', + &GDBM_READER(),0640)) { + my $rid=$bighash{'mapalias_'.$symb}; + if ($rid) { + my ($mapid,$resid)=split(/\./,$rid); + $aliassymb= + &declutter($bighash{'map_id_'.$mapid}). + '___'.$resid.'___'. + &declutter($bighash{'src_'.$rid}); + } + untie %bighash; + } + return $aliassymb; +} + # ----------------------------------------------------------------- Define Role sub definerole { @@ -3430,6 +3454,9 @@ sub EXT { #get real user name/domain, courseid and symb my $courseid; my $publicuser; + if ($symbparm) { + $symbparm=&get_symb_from_alias($symbparm); + } if (!($uname && $udom)) { (my $cursymb,$courseid,$udom,$uname,$publicuser)= &Apache::lonxml::whichuser($symbparm);