   ################################################################
   #######
   # lock() Version 2.1
   # Written by Craig Patchett craig@patchett.com
   # Created 16/09/1996 Last Modified 12/05/2000
   #
   # Function: Creates an exclusive lock for a file. The lock will
   # only work if other programs accessing the file are also
   # using this subroutine.
   #
   # Функция возвращает:
   #     0 Если блокировка установлена
   #     1 При ошибке создания $LOCK_DIR/$filename.tmp
   #     2 Если $filename используется
   #     3 Если lock-файл не возможно открыть или создать
   #
   # Глобальные переменные $error_message - информация о возникшей ошибке
   # $NAME_LEN - максимальная длина файла
   # Во время работы создаются:
   # $LOCK_DIR/$filename.tmp
   # $LOCK_DIR/$filename.lok (существует только пока файл заблокирован)
   ################################################################
   #######
   sub lock {
   local($filename) = @_; #, $LOCK_DIR, $MAX_WAIT
   local($wait, $lock_pid);
   local($temp_file) = "$LOCK_DIR$$.tmp";
   local($lock_file) = $filename;
   $lock_file =~ tr/\/\\:.//d; # Remove file separators/periods
   if ($NAME_LEN && ($NAME_LEN < length($lock_file))) {
   $lock_file = substr($lock_file, -$NAME_LEN);
   }
   $lock_file = "$LOCK_DIR$lock_file.lok";
   $error_message = '';
   # Создание файла с PID
   if (!open(TEMP, ">$temp_file")) {
   $error_message = "Невозможно создать $temp_file ($!).";
   return(1);
   }
   print TEMP $$;
   close(TEMP);
   # Проверка lock-файла
   if (-e $lock_file) {
   #Ожидание, пока файл разблокируют (если lock-файл существует)

   for ($wait = $MAX_WAIT; $wait; --$wait) {
   sleep(1);
   last unless -e $lock_file;
   }
   }
   # Check to see if there's still a valid lock
   if ((-e $lock_file) && (-M $lock_file < 0)) {
   # The file is still locked but has been modified since we started
   unlink($temp_file);
   $error_message = "Файл \"$filename\" в данный момент используется. Попытайтесь еще раз позднее.";
   return(2);
   }
   else {
   # There is either no lock or the lock has expired
   if (!rename($temp_file, $lock_file)) {
   # Невозможно создать lock-файл
   unlink($temp_file);
   $error_message = "Невозможно блокировать файл \"$filename\" ($!).";
   return(3);
   }
   # Проверка блокировки
   if (!open(LOCK, "<$lock_file")) {
   $error_message = "Невозможно проверить блокировку файла \"$filename\"
   ($!).";
   return(3);
   }
   $lock_pid = <LOCK>;
   close(LOCK);
   if ($lock_pid ne $$) {
   $error_message = "Файл \"$filename\" в данный момент используется. Попытайтесь еще раз позднее.";
   return(2);
   }
   else { return(0) }
   }
   }