При написании программ, интенсивно использующих совместный доступ к ресурсу, часто возникает задача, как правильнее решить проблему одновременного доступа различных процессов к одному файлу.
Решение данной проблемы заключается в том, что файл, к которому идет обращение, помечается процессом для монопольного доступа специальным образом, а после использования этого файла пометка снимается.
У языка Perl есть встроенная функция flock. Она позволяет "заблокировать" доступ к файлу со стороны других процессов, пока в этот файл будут вноситься какие-либо изменения.
Синтаксис flock: flock(дескриптор_файла, код_блокировки), где код_блокировки может быть равен:
1 - для разделяемого доступа (совместная блокировка)
2 - для монопольного доступа (монопольная блокировка)
4 - асинхронная блокировка (функция flock не ожидает активизации блокировки)
8 - снятие блокировки
Функция flock в Perl'е реализует так называемую "мягкую болкировку", блокируя другие вызовы flock, а не сами процессы. Проще говоря, это не означает, что остальные программы не смогут использовать заблокированный файл, просто они не смогут получить от функции flock значение "истина". Таким образом, если какой-то процесс не использует проверку блокировки при обращении к заблокированному файлу, то можно ожидать неприятностей. Пример использования функции flock: функция lock_file возвращает 1, если файл удалось заблокировать для монопольного доступа, и 0 - в противном случае.
sub lock_file
{
my $handle=shift; # передаем дескриптор файла
my $time_waut=20; # кол-во циклов ожидания
until (flock($handle,2)) # ждем, пока файл не освободиться
для монопольной блокировки
{
sleep(1); # типа пауза
if (--$time_wait) {return (0);}
# если не удалось заблокировать файл за определенное кол-во циклов,
выходим из подпрограммы
}
return (1); # установлена монопольная блокировка
}
sub unlock_file # функция снятия блокировки
{
my $handle=shift; # передаем дескриптор файла
flock($handle,8);
}
пример использования (из какой-то подпрограммки)
open (FILE,$filename)
or die "Can't open file";
unless (&lock_file(FILE)) {return (34);} #Если не удается
заблокировать файл, выходим с кодом ошибки
#....
#действие с файлом
#....
&unlock_file; #разблокирование файла
Но часто бывает так, что flock работает не верно или не справляется со своей задачей. Причем, чем больше количество обращений в единицу времени к разделяемому ресурсу, тем больше шансов увидеть вместо корректной информации мусор. Как же быть в таком случае???
Почти во всех письмах, присланных мне, для этих целей используются подпрограммы, в которых создается специальный файл, наличие которого свидетельствует о недоступности в данный момент времени нужного нам ресурса (файла). Приведу пример подпрограмм (написанный Крэйгом Патчетом (Craig A.Patchett) и Матом Райтом (Matthew Wright) и взятым с http://www.cgi-resources.com/ ), который мне прислал Денис (Dennis A. Rybakov) Мне кажется, это самый удачный пример, кроме того, он лишний раз свидетельствует о том, что не надо изобретать велосипед. В свое время, я написал свои подпрограммы для решения обсуждаемой проблемы, потратив на это некоторое время. И вот теперь, все-таки, буду пользоваться присланными примерами.
####################################################################
#######
# 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) }
}
}
#####################################################################
#######
# #
# unlock() Version 2.1 #
# Written by Craig Patchett craig@patchett.com #
# Created 16/09/1996 Last Modified 12/05/2000 #
# #
#Разблокирует файл заблокированный функцией lock()
# Возвращает: 0 файл разблокирован
# 1 Если невозможно удалить lock-файл
# Глобальные переменные: $error_message - информация о возникшей
ошибке
#$NAME_LEN - максимальная длина файла
# Во время работы удаляется $LOCK_DIR/$filename.lok
#
#####################################################################
#######
sub unlock {
local($filename) = @_; #, $LOCK_DIR
local($lock_file) = $filename;
$lock_file =~ tr/\/\\:.//d; # Remove file separators/periods
if ($NAME_LEN < length($lock_file)) {
$lock_file = substr($lock_file, -$NAME_LEN);
}
$lock_file = "$LOCK_DIR$lock_file.lok";
$error_message = '';
# Проверка блокировки
if (!open(LOCK, "<$lock_file")) {
$error_message = "Нет доступа к заблокированному файлу \"$filename\"
($!).";
return(1);
}
$lock_pid = <LOCK>
close(LOCK);
if ($lock_pid ne $$) {
$error_message = "Файл \"$filename\" заблокирован другим процессом.";
return(2);
}
#Удаление lock-файла
if (!unlink($lock_file)) {
$error_message = "Невозможно разблокировать файл \"$filename\"
($!).";
return(3);
}
return(0);
}
#
# пример кода с использванием этих процедур
# взято на фонарь из одного из скриптов :)) (рассылка сообщений,
кстати)
#
...
if (&lock("$USERS_DIR$user_name/$MESSAGES_DIR$message_file")) {
$bad_users .= ($bad_users eq "") ? $user_name : ", ".$user_name;
next;
}
if (!open(BOX,">>$USERS_DIR$user_name/$MESSAGES_DIR$message_file")) {
&unlock("$USERS_DIR$user_name/$MESSAGES_DIR$message_file");
$bad_users .= ($bad_users eq "") ? $user_name : ", ".$user_name;
next;
}
...
Данная статья была взята из рассылки "Программирование скриптов на Perl'e".
Получить всю информацию о рассылке, а также подписаться на неё можно здесь: http://subscribe.ru/catalog/comp.prog.perlsav.
