Diff for /loncom/lonnet/perl/lonnet.pm between versions 1.1118 and 1.1121

version 1.1118, 2011/07/18 10:25:55 version 1.1121, 2011/07/31 22:55:53
Line 306  sub get_server_homeID { Line 306  sub get_server_homeID {
     return &do_cache_new('serverhomeID',$hostname,$serverhomeID,$cachetime);      return &do_cache_new('serverhomeID',$hostname,$serverhomeID,$cachetime);
 }  }
   
   sub get_remote_globals {
       my ($lonhost,$whathash,$ignore_cache) = @_;
       my (%returnhash,%whatneeded);
       if (ref($whathash) eq 'ARRAY') {
           foreach my $what (sort(keys(%{$whathash}))) {
               my $type = $whathash->{$what};
               my $hashid = $lonhost.'-'.$what;
               my ($result,$cached); 
               unless ($ignore_cache) {
                   ($result,$cached)=&is_cached_new('lonnetglobal',$hashid);
                   $returnhash{$what} = $result;
               }
               if (defined($cached)) {
                   $returnhash{$what} = $result;
               } else {
                   $whatneeded{$what} = $type;
               }
           }
           if (keys(%whatneeded) > 0) {
               my $requested = &freeze_escape(\%whatneeded);
               my $rep=&reply('readlonnetglobal:'.$requested,$lonhost);
               unless (($rep=~/^refused/) || ($rep=~/^rejected/) || $rep eq 'con_lost')) {
                   my @pairs=split(/\&/,$rep);
                   if ($rep !~ /^error/) {
                       foreach my $item (@pairs) {
                           my ($key,$value)=split(/=/,$item,2);
                           my $what = &unescape($key);
                           my $hashid = $lonhost.'-'.$what;
                           $returnhash{$what}=&thaw_unescape($value);
                           &do_cache_new('lonnetglobal',$hashid,$returnhash{$what},600);
                       }
                   }
               }
           }
       }
       return %returnhash;
   }
   
 # -------------------------------------------------- Non-critical communication  # -------------------------------------------------- Non-critical communication
 sub subreply {  sub subreply {
     my ($cmd,$server)=@_;      my ($cmd,$server)=@_;
Line 1035  sub can_host_session { Line 1073  sub can_host_session {
     }      }
     if ($canhost) {      if ($canhost) {
         if (ref($hostedsessions) eq 'HASH') {          if (ref($hostedsessions) eq 'HASH') {
               my $uprimary_id = &Apache::lonnet::domain($udom,'primary');
               my $uint_dom = &Apache::lonnet::internet_dom($uprimary_id);
             if (ref($hostedsessions->{'excludedomain'}) eq 'ARRAY') {              if (ref($hostedsessions->{'excludedomain'}) eq 'ARRAY') {
                 if (grep(/^\Q$udom\E$/,@{$hostedsessions->{'excludedomain'}})) {                  if (($uint_dom ne '') && 
                       (grep(/^\Q$uint_dom\E$/,@{$hostedsessions->{'excludedomain'}}))) {
                     $canhost = 0;                      $canhost = 0;
                 } else {                  } else {
                     $canhost = 1;                      $canhost = 1;
                 }                  }
             }              }
             if (ref($hostedsessions->{'includedomain'}) eq 'ARRAY') {              if (ref($hostedsessions->{'includedomain'}) eq 'ARRAY') {
                 if (grep(/^\Q$udom\E$/,@{$hostedsessions->{'includedomain'}})) {                  if (($uint_dom ne '') && 
                       (grep(/^\Q$uint_dom\E$/,@{$hostedsessions->{'includedomain'}}))) {
                     $canhost = 1;                      $canhost = 1;
                 } else {                  } else {
                     $canhost = 0;                      $canhost = 0;
Line 11463  splitting on '&', supports elements that Line 11505  splitting on '&', supports elements that
   
 =head2 Logging Routines  =head2 Logging Routines
   
 =over 4  
   
 These routines allow one to make log messages in the lonnet.log and  These routines allow one to make log messages in the lonnet.log and
 lonnet.perm logfiles.  lonnet.perm logfiles.
   
   =over 4
   
 =item *  =item *
   
 logtouch() : make sure the logfile, lonnet.log, exists  logtouch() : make sure the logfile, lonnet.log, exists
Line 11483  logperm() : append a permanent message t Line 11526  logperm() : append a permanent message t
 file never gets deleted by any automated portion of the system, only  file never gets deleted by any automated portion of the system, only
 messages of critical importance should go in here.  messages of critical importance should go in here.
   
   
 =back  =back
   
 =head2 General File Helper Routines  =head2 General File Helper Routines

Removed from v.1.1118  
changed lines
  Added in v.1.1121


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