version 1.243, 2002/06/24 19:41:41
|
version 1.249, 2002/06/27 21:11:44
|
Line 80 use vars
|
Line 80 use vars
|
qw(%perlvar %hostname %homecache %badServerCache %hostip %spareid %hostdom |
qw(%perlvar %hostname %homecache %badServerCache %hostip %spareid %hostdom |
%libserv %pr %prp %metacache %packagetab |
%libserv %pr %prp %metacache %packagetab |
%courselogs %accesshash $processmarker $dumpcount |
%courselogs %accesshash $processmarker $dumpcount |
%coursedombuf %coursehombuf %courseresdatacache); |
%coursedombuf %coursehombuf %courseresdatacache %domaindescription); |
use IO::Socket; |
use IO::Socket; |
use GDBM_File; |
use GDBM_File; |
use Apache::Constants qw(:common :http); |
use Apache::Constants qw(:common :http); |
Line 1737 sub allowed {
|
Line 1737 sub allowed {
|
} |
} |
} |
} |
|
|
# Restricted by state? |
# Restricted by state or randomout? |
|
|
if ($thisallowed=~/X/) { |
if ($thisallowed=~/X/) { |
|
if ($ENV{'acc.randomout'}) { |
|
my $symb=&symbread($uri,1); |
|
if (($symb) && ($ENV{'acc.randomout'}=~/\&$symb\&/)) { |
|
return ''; |
|
} |
|
} |
if (&condval($statecond)) { |
if (&condval($statecond)) { |
return '2'; |
return '2'; |
} else { |
} else { |
Line 1812 sub definerole {
|
Line 1818 sub definerole {
|
# ---------------- Make a metadata query against the network of library servers |
# ---------------- Make a metadata query against the network of library servers |
|
|
sub metadata_query { |
sub metadata_query { |
my ($query,$custom,$customshow)=@_; |
my ($query,$custom,$customshow,$server_array)=@_; |
my %rhash; |
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) { |
unless ($custom or $customshow) { |
my $reply=&reply("querysend:".&escape($query),$server); |
my $reply=&reply("querysend:".&escape($query),$server); |
$rhash{$server}=$reply; |
$rhash{$server}=$reply; |
Line 2693 sub symbclean {
|
Line 2701 sub symbclean {
|
# ------------------------------------------------------ Return symb list entry |
# ------------------------------------------------------ Return symb list entry |
|
|
sub symbread { |
sub symbread { |
my $thisfn=shift; |
my ($thisfn,$donotrecurse)=@_; |
# no filename provided? try from environment |
# no filename provided? try from environment |
unless ($thisfn) { |
unless ($thisfn) { |
if ($ENV{'request.symb'}) { return &symbclean($ENV{'request.symb'}); } |
if ($ENV{'request.symb'}) { return &symbclean($ENV{'request.symb'}); } |
Line 2742 sub symbread {
|
Line 2750 sub symbread {
|
# ----------------------------------------------- There is only one possibility |
# ----------------------------------------------- There is only one possibility |
my ($mapid,$resid)=split(/\./,$ids); |
my ($mapid,$resid)=split(/\./,$ids); |
$syval=declutter($bighash{'map_id_'.$mapid}).'___'.$resid; |
$syval=declutter($bighash{'map_id_'.$mapid}).'___'.$resid; |
} else { |
} elsif (!$donotrecurse) { |
# ------------------------------------------ There is more than one possibility |
# ------------------------------------------ There is more than one possibility |
my $realpossible=0; |
my $realpossible=0; |
foreach (@possibilities) { |
foreach (@possibilities) { |
Line 2757 sub symbread {
|
Line 2765 sub symbread {
|
} |
} |
} |
} |
if ($realpossible!=1) { $syval=''; } |
if ($realpossible!=1) { $syval=''; } |
|
} else { |
|
$syval=''; |
} |
} |
} |
} |
untie(%bighash) |
untie(%bighash) |
Line 2941 BEGIN {
|
Line 2951 BEGIN {
|
|
|
while (my $configline=<$config>) { |
while (my $configline=<$config>) { |
chomp($configline); |
chomp($configline); |
my ($id,$domain,$role,$name,$ip)=split(/:/,$configline); |
my ($id,$domain,$role,$name,$ip,$domdescr)=split(/:/,$configline); |
$hostname{$id}=$name; |
$hostname{$id}=$name; |
$hostdom{$id}=$domain; |
$hostdom{$id}=$domain; |
$hostip{$id}=$ip; |
$hostip{$id}=$ip; |
|
if ($domdescr) { |
|
$domaindescription{$domain}=$domdescr; |
|
} |
if ($role eq 'library') { $libserv{$id}=$name; } |
if ($role eq 'library') { $libserv{$id}=$name; } |
} |
} |
} |
} |