--- loncom/lonnet/perl/lonnet.pm 2002/06/24 19:41:41 1.243 +++ loncom/lonnet/perl/lonnet.pm 2002/07/17 18:01:33 1.252 @@ -1,7 +1,7 @@ # The LearningOnline Network # TCP networking package # -# $Id: lonnet.pm,v 1.243 2002/06/24 19:41:41 albertel Exp $ +# $Id: lonnet.pm,v 1.252 2002/07/17 18:01:33 albertel Exp $ # # Copyright Michigan State University Board of Trustees # @@ -80,7 +80,7 @@ use vars qw(%perlvar %hostname %homecache %badServerCache %hostip %spareid %hostdom %libserv %pr %prp %metacache %packagetab %courselogs %accesshash $processmarker $dumpcount - %coursedombuf %coursehombuf %courseresdatacache); + %coursedombuf %coursehombuf %courseresdatacache %domaindescription); use IO::Socket; use GDBM_File; use Apache::Constants qw(:common :http); @@ -1737,9 +1737,15 @@ sub allowed { } } -# Restricted by state? +# Restricted by state or randomout? if ($thisallowed=~/X/) { + if ($ENV{'acc.randomout'}) { + my $symb=&symbread($uri,1); + if (($symb) && ($ENV{'acc.randomout'}=~/\&$symb\&/)) { + return ''; + } + } if (&condval($statecond)) { return '2'; } else { @@ -1812,9 +1818,11 @@ sub definerole { # ---------------- Make a metadata query against the network of library servers sub metadata_query { - my ($query,$custom,$customshow)=@_; + my ($query,$custom,$customshow,$server_array)=@_; my %rhash; - for my $server (keys %libserv) { + my @server_list = (defined($server_array) ? @$server_array + : keys(%libserv) ); + for my $server (@server_list) { unless ($custom or $customshow) { my $reply=&reply("querysend:".&escape($query),$server); $rhash{$server}=$reply; @@ -2263,30 +2271,26 @@ sub courseresdata { my ($coursenum,$coursedomain,@which)=@_; my $coursehom=&homeserver($coursenum,$coursedomain); my $hashid=$coursenum.':'.$coursedomain; - unless (defined($courseresdatacache{$hashid.'.time'})) { - unless (time-$courseresdatacache{$hashid.'.time'}<300) { - my $coursehom=&homeserver($coursenum,$coursedomain); - if ($coursehom) { - my $dumpreply=&reply('dump:'.$coursedomain.':'.$coursenum. - ':resourcedata:.',$coursehom); - unless ($dumpreply=~/^error\:/) { - $courseresdatacache{$hashid.'.time'}=time; - $courseresdatacache{$hashid}=$dumpreply; - } - } - } + my $dodump=0; + if (!defined($courseresdatacache{$hashid.'.time'})) { + $dodump=1; + } else { + if (time-$courseresdatacache{$hashid.'.time'}>300) { $dodump=1; } } - my @pairs=split(/\&/,$courseresdatacache{$hashid}); - my %returnhash=(); - foreach (@pairs) { - my ($key,$value)=split(/=/,$_); - $returnhash{unescape($key)}=unescape($value); - } - my $item; - foreach $item (@which) { - if ($returnhash{$item}) { return $returnhash{$item}; } - } - return ''; + if ($dodump) { + my %dumpreply=&dump('resourcedata',$coursedomain,$coursenum); + my ($tmp) = keys(%dumpreply); + if ($tmp !~ /^(con_lost|error|no_such_host)/i) { + $courseresdatacache{$hashid.'.time'}=time; + $courseresdatacache{$hashid}=\%dumpreply; + } + } + foreach my $item (@which) { + if ($courseresdatacache{$hashid}->{$item}) { + return $courseresdatacache{$hashid}->{$item}; + } + } + return ''; } # --------------------------------------------------------- Value of a Variable @@ -2693,7 +2697,7 @@ sub symbclean { # ------------------------------------------------------ Return symb list entry sub symbread { - my $thisfn=shift; + my ($thisfn,$donotrecurse)=@_; # no filename provided? try from environment unless ($thisfn) { if ($ENV{'request.symb'}) { return &symbclean($ENV{'request.symb'}); } @@ -2742,7 +2746,7 @@ sub symbread { # ----------------------------------------------- There is only one possibility my ($mapid,$resid)=split(/\./,$ids); $syval=declutter($bighash{'map_id_'.$mapid}).'___'.$resid; - } else { + } elsif (!$donotrecurse) { # ------------------------------------------ There is more than one possibility my $realpossible=0; foreach (@possibilities) { @@ -2757,6 +2761,8 @@ sub symbread { } } if ($realpossible!=1) { $syval=''; } + } else { + $syval=''; } } untie(%bighash) @@ -2941,11 +2947,18 @@ BEGIN { while (my $configline=<$config>) { chomp($configline); - my ($id,$domain,$role,$name,$ip)=split(/:/,$configline); - $hostname{$id}=$name; - $hostdom{$id}=$domain; - $hostip{$id}=$ip; - if ($role eq 'library') { $libserv{$id}=$name; } + my ($id,$domain,$role,$name,$ip,$domdescr)=split(/:/,$configline); + if ($id && $domain && $role && $name && $ip) { + $hostname{$id}=$name; + $hostdom{$id}=$domain; + $hostip{$id}=$ip; + if ($domdescr) { $domaindescription{$domain}=$domdescr; } + if ($role eq 'library') { $libserv{$id}=$name; } + } else { + if ($configline) { + &logthis("Skipping hosts.tab line -$configline-"); + } + } } }