[BACK]Return to lonnet.pm CVS log [TXT] [DIR] Up to [LON-CAPA] / loncom / lonnet / perl

Diff for /loncom/lonnet/perl/lonnet.pm between versions 1.243 and 1.250

version 1.243, 2002/06/24 19:41:41 version 1.250, 2002/07/04 15:47:18
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 2263  sub courseresdata { Line 2271  sub courseresdata {
     my ($coursenum,$coursedomain,@which)=@_;      my ($coursenum,$coursedomain,@which)=@_;
     my $coursehom=&homeserver($coursenum,$coursedomain);      my $coursehom=&homeserver($coursenum,$coursedomain);
     my $hashid=$coursenum.':'.$coursedomain;      my $hashid=$coursenum.':'.$coursedomain;
     unless (defined($courseresdatacache{$hashid.'.time'})) {      my $dodump=0;
  unless (time-$courseresdatacache{$hashid.'.time'}<300) {      if (!defined($courseresdatacache{$hashid.'.time'})) {
            my $coursehom=&homeserver($coursenum,$coursedomain);   $dodump=1;
            if ($coursehom) {      } else {
               my $dumpreply=&reply('dump:'.$coursedomain.':'.$coursenum.   if (time-$courseresdatacache{$hashid.'.time'}>300) { $dodump=1; }
      ':resourcedata:.',$coursehom);      }
       unless ($dumpreply=~/^error\:/) {      if ($dodump) {
          $courseresdatacache{$hashid.'.time'}=time;   my $coursehom=&homeserver($coursenum,$coursedomain);
                  $courseresdatacache{$hashid}=$dumpreply;   if ($coursehom) {
      }      my $dumpreply=&reply('dump:'.$coursedomain.':'.$coursenum.
   }   ':resourcedata:.',$coursehom);
        }      if ($dumpreply!~/^error\:/) {
    $courseresdatacache{$hashid.'.time'}=time;
    $courseresdatacache{$hashid}=$dumpreply;
       }
    }
       }
       my @pairs=split(/\&/,$courseresdatacache{$hashid});
       my %returnhash=();
       foreach (@pairs) {
    my ($key,$value)=split(/=/,$_);
    $returnhash{unescape($key)}=unescape($value);
     }      }
    my @pairs=split(/\&/,$courseresdatacache{$hashid});  
    my %returnhash=();  
    foreach (@pairs) {  
       my ($key,$value)=split(/=/,$_);  
       $returnhash{unescape($key)}=unescape($value);  
    }  
     my $item;      my $item;
    foreach $item (@which) {      foreach $item (@which) {
        if ($returnhash{$item}) { return $returnhash{$item}; }   if ($returnhash{$item}) { return $returnhash{$item}; }
    }      }
    return '';      return '';
 }  }
   
 # --------------------------------------------------------- Value of a Variable  # --------------------------------------------------------- Value of a Variable
Line 2693  sub symbclean { Line 2705  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 2754  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 2769  sub symbread {
  }   }
                      }                       }
      if ($realpossible!=1) { $syval=''; }       if ($realpossible!=1) { $syval=''; }
                    } else {
                        $syval='';
                  }                   }
       }        }
               untie(%bighash)                untie(%bighash)
Line 2941  BEGIN { Line 2955  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; }
     }      }
 }  }
Removed from v.1.243  
changed lines
  Added in v.1.250

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>