[an error occurred while processing this directive]

Как создать лок файл на Perl
Для защиты от одновременного запуска нескольких процессов, можно сделать так:

use Fcntl qw(:flock :DEFAULT);
my $cfg_glob_lock="/var/run/myprog/test.pid";

# Проверяем лок.
if (-f $cfg_glob_lock){
      # Лок присутствует. Проверяем не дохлый ли процесс.
      my $lock_pid = 0;
      open(LOCK,"<$cfg_glob_lock");
      # Если удалось заблокировать, значит процесс мертв.
      my $zombie_lock_flag = flock(LOCK,  LOCK_EX|LOCK_NB);
      $lock_pid = <LOCK>;
      close (LOCK);
      chomp ($lock_pid);
      if ($lock_pid > 0 && $zombie_lock_flag == 0){
          # Реакция на зависший процесс.                                        
          die "Proccess locked (pid=$lock_pid)";
      } else {
          # Лок от мертвого процесса.
          unlink("$cfg_glob_lock");
          warn("DeadLock detected ($lock_pid)");
      }
}    
# Записываем pid в новый лок файл.
sysopen(LOCK, $cfg_glob_lock, O_CREAT|O_EXCL|O_WRONLY) or die 'Race condition';

print LOCK "$$\n";
close(LOCK);
# Открываем лок.
open(GLOB_LOCK,"<$cfg_glob_lock");
flock(GLOB_LOCK,  LOCK_EX);

.... рабочий код скрипта

# Закрываем и удаляем лок
flock(GLOB_LOCK, LOCK_UN);
close(GLOB_LOCK);
unlink("$cfg_glob_lock");
 
20.01.2005
Ключи: perl, lock / Лицензия: CC-BY
Раздел:    Корень / Программисту и web-разработчику / Perl / Полезные подпрограммы на Perl / Работа с сетью и IP адресами на Perl

[an error occurred while processing this directive]

[an error occurred while processing this directive]