Diff for /loncom/lonnet/perl/lonnet.pm between versions 1.957 and 1.958

version 1.957, 2008/04/30 22:42:59 version 1.958, 2008/05/12 20:59:15
Line 39  use vars qw(%perlvar %spareid %pr %prp $ Line 39  use vars qw(%perlvar %spareid %pr %prp $
 my (%badServerCache, $memcache, %courselogs, %accesshash, %domainrolehash,  my (%badServerCache, $memcache, %courselogs, %accesshash, %domainrolehash,
     %userrolehash, $processmarker, $dumpcount, %coursedombuf,      %userrolehash, $processmarker, $dumpcount, %coursedombuf,
     %coursenumbuf, %coursehombuf, %coursedescrbuf, %courseinstcodebuf,      %coursenumbuf, %coursehombuf, %coursedescrbuf, %courseinstcodebuf,
     %courseownerbuf, %coursetypebuf);      %courseownerbuf, %coursetypebuf,$locknum);
   
 use IO::Socket;  use IO::Socket;
 use GDBM_File;  use GDBM_File;
Line 526  sub get_env_multiple { Line 526  sub get_env_multiple {
     return(@values);      return(@values);
 }  }
   
   # ------------------------------------------------------------------- Locking
   
   sub set_lock {
       my ($text)=@_;
       $locknum++;
       my $id=$$.'-'.$locknum;
       &appenv({'session.locks' => $env{'session.locks'}.','.$id,
                'session.lock.'.$id => $text});
       return $id;
   }
   
   sub get_locks {
       my $num=0;
       my %texts=();
       foreach my $lock (split(/\,/,$env{'session.locks'})) {
          if ($lock=~/\w/) {
             $num++;
             $texts{$lock}=$env{'session.lock.'.$lock};
          }
      }
      return ($num,%texts);
   }
   
   sub remove_lock {
       my ($id)=@_;
       my $newlocks='';
       foreach my $lock (split(/\,/,$env{'session.locks'})) {
          if (($lock=~/\w/) && ($lock ne $id)) {
             $newlocks.=','.$lock;
          }
       }
       &appenv({'session.locks' => $newlocks});
       &delenv('session.lock.'.$id);
   }
   
   sub remove_all_locks {
       my $activelocks=$env{'session.locks'};
       foreach my $lock (split(/\,/,$env{'session.locks'})) {
          if ($lock=~/\w/) {
             &remove_lock($lock);
          }
       }
   }
   
   
 # ------------------------------------------ Find out current server userload  # ------------------------------------------ Find out current server userload
 sub userload {  sub userload {
     my $numusers=0;      my $numusers=0;
Line 8763  $memcache=new Cache::Memcached({'servers Line 8808  $memcache=new Cache::Memcached({'servers
   
 $processmarker='_'.time.'_'.$perlvar{'lonHostID'};  $processmarker='_'.time.'_'.$perlvar{'lonHostID'};
 $dumpcount=0;  $dumpcount=0;
   $locknum=0;
   
 &logtouch();  &logtouch();
 &logthis('<font color="yellow">INFO: Read configuration</font>');  &logthis('<font color="yellow">INFO: Read configuration</font>');

Removed from v.1.957  
changed lines
  Added in v.1.958


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