[BACK]Return to lond CVS log [TXT] [DIR] Up to [LON-CAPA] / loncom

Diff for /loncom/lond between versions 1.324 and 1.326

version 1.324, 2006/03/29 19:56:10 version 1.326, 2006/05/13 01:31:15
Line 31 Line 31
   
 use strict;  use strict;
 use lib '/home/httpd/lib/perl/';  use lib '/home/httpd/lib/perl/';
   use LONCAPA;
 use LONCAPA::Configuration;  use LONCAPA::Configuration;
   
 use IO::Socket;  use IO::Socket;
Line 1050  sub _do_hash_untie { Line 1051  sub _do_hash_untie {
     sub _locking_hash_tie {      sub _locking_hash_tie {
  my ($file_prefix,$namespace,$how,$loghead,$what) = @_;   my ($file_prefix,$namespace,$how,$loghead,$what) = @_;
   
   # is this locked by an external program?
   
           if (-e "$file_prefix.db.lock") {
       my $failed=0;
       eval {
    local $SIG{__DIE__}='DEFAULT';
    local $SIG{ALRM}=sub { 
       $failed=1;
       die("failed lock");
    };
    alarm(2*$lond_max_wait_time);
    while (-e "$file_prefix.db.lock") {}
    alarm(0);
       };
       if ($failed) {
    $! = 100; # throwing error # 100
    return undef;
       }
    }
   
   # is this archived?
   
           if (-e "$file_prefix.db.gz") {
   # lock immediately
       open(TOUCH,">>$file_prefix.db.lock");
      close(TOUCH);
              system("gunzip $file_prefix.db.gz");
      if (-e "$file_prefix.hist.gz") {
          system("gunzip $file_prefix.hist.gz");
      }
   # all set, unlock
              unlink("$file_prefix.db.lock");
          }
   
   
  my ($lock);   my ($lock);
           
  if ($how eq &GDBM_READER()) {   if ($how eq &GDBM_READER()) {
Line 5177  sub status { Line 5213  sub status {
     $0='lond: '.$what.' '.$local;      $0='lond: '.$what.' '.$local;
 }  }
   
 # -------------------------------------------------------- Escape Special Chars  
   
 sub escape {  
     my $str=shift;  
     $str =~ s/(\W)/"%".unpack('H2',$1)/eg;  
     return $str;  
 }  
   
 # ----------------------------------------------------- Un-Escape Special Chars  
   
 sub unescape {  
     my $str=shift;  
     $str =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;  
     return $str;  
 }  
   
 # ----------------------------------------------------------- Send USR1 to lonc  # ----------------------------------------------------------- Send USR1 to lonc
   
 sub reconlonc {  sub reconlonc {
Removed from v.1.324  
changed lines
  Added in v.1.326

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