Вы можете найти рассылки сходной тематики в Каталоге рассылок.
Perl - Обсуждение
Проблема одновременного доступа.
При написании программ, интенсивно использующих совместный доступ к ресурсу,
часто возникает задача, как правильнее решить проблему
одновременного доступа различных процессов к одному файлу.
Решение данной проблемы заключается в том, что файл, к которому
идет обращение, помечается процессом для монопольного доступа
специальным образом, а после использования этого файла
пометка снимается.
У языка 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(0.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;
}
...
---------------------------
Теперь, к вопросу о "бумажных" книгах (прислал Andrew Zavjalov)
привожу в оригинале с небольшими
коментариями.
1. Perl Cookbook
Есть 2 перевода, пишу по
издательству Питер:
Т. Кристиансен, Н. Торкингтон "Perl.
Библиотека программиста". 734 страницы.
Фотку можно найти на www.piter-press.ru,
afair. Черная такая книга, совсем не
похожа на английский оригинал.
второй перевод (bhv) я не покупал,
но он по оформлению похож на
оригинал. На обложке какой-то
баран/джейран/что-то рогатое. Я не зоолог
ж-)
// Рекомендую для людей, уже освоивших
синтаксис Перла. По сути, это сборник
// готовых рецептов для решения кучи проблем.
Очень интересная книга.
2. Perl Core Language. Little Black Book. издательство Питер опять.
Стивен Холзнер, "Perl. Специальный справочник", 500 страниц. Синенькая такая,
разыгрывалась на www.simplex.ru/news, там же есть фотка. Кстати, там же
разыгрывался черный вариант Cookbook
// Книжка подойдет как начинающим (особенно
рекомендую), так и для опытных //программистов на Перле. Очень
хорошо изложен синтаксис языка. Куча
примеров.
3. Lama book.
"Изучаем Perl". Рэндал Шварц, Том Кристиансен, 320 страниц, BHV Найти
еe: не
успел, но она по формату примерно как black book, а оформление почти оригинальное,
с ламой на обложке.
4. Программирование CGI на Perl. В оригинале это что-то типа "Perl/CGI Cookbook".
Здоровая красная книга. Совершенно бестолковая.
// Подробно описываются несколько готовых скриптов
// Для освоивших основы Перла, и ленящихся
самим разбираться в готовых скриптах
//или писать свои
Camel book я найти на русском не сумел. Скорее всего и нету... Очень
жаль.
-----------------------------------------
Персональное спасибо за помощь:
Belyakovcev Evgeniy M. (aka eastwood)
Andrew Petrenko
Скворцову Михаилу
Dennis A. Rybakov
Andrew Skripnikov
Andrew Zavjalov
Igor V. Slyusarev
А также спасибо всем тем, кто откликнулся на тему данного
обсуждения или прислал письма с пожеланиями и замечаниями.
Всегда рад Вашим письмам. perl@savkin.com
http://subscribe.ru/
E-mail: ask@subscribe.ru |
В избранное | ||