Как заблокировать файл в Perl?

Если вы в конечном итоге используете flock, вот некоторый код для этого:

use Fcntl ':flock'; # Import LOCK_* constants

# We will use this file path in error messages and function calls.
# Don't type it out more than once in your code.  Use a variable.
my $file = '/path/to/some/file';

# Open the file for appending.  Note the file path is quoted
# in the error message.  This helps debug situations where you
# have a stray space at the start or end of the path.
open(my $fh, '>>', $file) or die "Could not open '$file' - $!";

# Get exclusive lock (will block until it does)
flock($fh, LOCK_EX) or die "Could not lock '$file' - $!";

# Do something with the file here...

# Do NOT use flock() to unlock the file if you wrote to the
# file in the "do something" section above.  This could create
# a race condition.  The close() call below will unlock the
# file for you, but only after writing any buffered data.

# In a world of buffered i/o, some or all of your data may not 
# be written until close() completes.  Always, always, ALWAYS 
# check the return value of close() if you wrote to the file!
close($fh) or die "Could not write '$file' - $!";

Несколько полезных ссылок:

• руководство по блокировке файлов PerlMonks (несколько старое)
• flock() документация

В ответ на ваш добавленный вопрос я бы сказал, либо поместите блокировку в файл, либо создайте файл, который вы называете «блокировкой» всякий раз, когда файл заблокирован, и удалите его, когда он больше не заблокирован (а затем убедитесь, что ваши программы подчиняются эта семантика).

Другие ответы довольно хорошо охватывают блокировку Perl flock, но во многих системах Unix/Linux на самом деле есть две независимые системы блокировки: блокировки BSD flock() и POSIX fcntl().

Если вы не предоставите специальные параметры для настройки при сборке Perl, его flock будет использовать flock(), если он доступен. Как правило, это нормально и, вероятно, то, что вам нужно, если вам просто нужна блокировка в вашем приложении (работающем в одной системе). Однако иногда вам нужно взаимодействовать с другим приложением, которое использует блокировки fcntl() (например, Sendmail во многих системах), или, возможно, вам нужно выполнить блокировку файлов в файловых системах, смонтированных через NFS.

В таких случаях вы можете посмотреть File::FcntlLock или Файл::lockf. Также возможно реализовать блокировку на основе fcntl() в чистом Perl (с некоторыми неудобными и непереносимыми битами pack()).

Краткий обзор различий между flock/fcntl/lockf:

lockf почти всегда реализуется поверх fcntl, имеет блокировку только на уровне файлов. При реализации с использованием fcntl приведенные ниже ограничения также применяются к lockf.

fcntl обеспечивает блокировку на уровне диапазона (внутри файла) и сетевую блокировку через NFS, но блокировки не наследуются дочерними процессами после fork(). Во многих системах дескриптор файла должен быть открыт только для чтения, чтобы запросить общую блокировку, и для чтения и записи, чтобы запросить эксклюзивную блокировку.

flock имеет блокировку только на уровне файла, блокировка только в пределах одной машины (вы можете заблокировать файл, смонтированный через NFS, но только локальные процессы увидят блокировку). Блокировки наследуются потомками (при условии, что файловый дескриптор не закрыт).

Иногда (системы SYSV) flock эмулируется с помощью lockf или fcntl; в некоторых системах BSD lockf эмулируется с помощью flock. Как правило, эти виды эмуляции работают плохо, и вам рекомендуется избегать их.

CPAN вам в помощь: IO::LockedFile.

Райан П написал:

В этом случае файл фактически разблокируется на короткий период времени, пока файл повторно открывается.

Так что не делайте этого. Вместо этого open файл для чтения/записи:

open my $fh, '+<', 'test.dat'
    or die "Couldn’t open test.dat: $!\n";

Когда вы будете готовы записать счетчик, просто seek вернитесь к началу файла. Обратите внимание, что если вы это сделаете, вы должны truncate непосредственно перед close, чтобы файл не оставался с конечным мусором, если его новое содержимое короче, чем его предыдущее. (Обычно текущая позиция в файле находится в его конце, поэтому вы можете просто написать truncate $fh, tell $fh.)

Также обратите внимание, что я использовал open с тремя аргументами и лексический дескриптор файла, а также проверил успешность операции. Пожалуйста, избегайте глобальных файловых дескрипторов (глобальные переменные — это плохо, ладно?) и магических двухаргументных open (которые были источником многих ошибок в коде Perl), и всегда проверяйте, успешны ли ваши open.

Я думаю, было бы намного лучше показать это с помощью лексических переменных в качестве обработчиков файлов и обработки ошибок. Также лучше использовать константы из модуля Fcntl, чем жестко запрограммировать магическое число 2, которое может быть неправильным числом во всех операционных системах.

    use Fcntl ':flock'; # import LOCK_* constants

    # open the file for appending
    open (my $fh, '>>', 'test.dat') or die $!;

    # try to lock the file exclusively, will wait till you get the lock
    flock($fh, LOCK_EX);

    # do something with the file here (print to it in our case)

    # actually you should not unlock the file
    # close the file will unlock it
    close($fh) or warn "Could not close file $!";

Ознакомьтесь с полной документацией по flock и Руководство по блокировке файлов на PerlMonks, несмотря на то, что там также используется старый стиль использования файловых дескрипторов.

На самом деле я обычно пропускаю обработку ошибок в close(), так как я мало что могу сделать, если она все равно не работает.

Что касается блокировки, если вы работаете с одним файлом, заблокируйте этот файл. Если вам нужно заблокировать несколько файлов одновременно, то, чтобы избежать мертвых блокировок, лучше выбрать один файл, который вы блокируете. На самом деле не имеет значения, является ли это одним из нескольких файлов, которые вам действительно нужно заблокировать, или отдельным файлом, который вы создаете только для целей блокировки.

Рассматривали ли вы возможность использования модуля LockFile::Simple? Он уже делает большую часть работы за вас.

По моему прошлому опыту, я нашел его очень простым в использовании и прочным.

Моя цель в этом вопросе состояла в том, чтобы заблокировать файл, используемый в качестве хранилища данных для нескольких сценариев. В конце концов я использовал код, аналогичный следующему (от Криса):

open (FILE, '>>', test.dat') ; # open the file 
flock FILE, 2; # try to lock the file 
# do something with the file here 
close(FILE); # close the file

В его примере я удалил стадо FILE, 8, так как close(FILE) также выполняет это действие. Настоящая проблема заключалась в том, что когда скрипт запускается, он должен удерживать текущий счетчик, а когда он заканчивается, он должен обновлять счетчик. Вот где у Perl есть проблема, чтобы прочитать файл, который вы:

 open (FILE, '<', test.dat');
 flock FILE, 2;

Теперь я хочу записать результаты, и, поскольку я хочу перезаписать файл, мне нужно снова открыть и обрезать, что приводит к следующему:

 open (FILE, '>', test.dat'); #single arrow truncates double appends
 flock FILE, 2;

В этом случае файл фактически разблокируется на короткий период времени, пока файл повторно открывается. Это демонстрирует случай с файлом внешней блокировки. Если вы собираетесь изменять контекст файла, используйте файл блокировки. Модифицированный код:

open (LOCK_FILE, '<', test.dat.lock') or die "Could not obtain lock";
flock LOCK_FILE, 2;
open (FILE, '<', test.dat') or die "Could not open file";
# read file
# ...
open (FILE, '>', test.dat') or die "Could not reopen file";
#write file
close (FILE);
close (LOCK_FILE);

Разработано на основе http://metacpan.org/pod/File%3a%3aFcntlLock

use Fcntl qw(:DEFAULT :flock :seek :Fcompat);
use File::FcntlLock;
sub acquire_lock {
  my $fn = shift;
  my $justPrint = shift || 0;
  confess "Too many args" if defined shift;
  confess "Not enough args" if !defined $justPrint;

  my $rv = TRUE;
  my $fh;
  sysopen($fh, $fn, O_RDWR | O_CREAT) or LOGDIE "failed to open: $fn: $!";
  $fh->autoflush(1);
  ALWAYS "acquiring lock: $fn";
  my $fs = new File::FcntlLock;
  $fs->l_type( F_WRLCK );
  $fs->l_whence( SEEK_SET );
  $fs->l_start( 0 );
  $fs->lock( $fh, F_SETLKW ) or LOGDIE  "failed to get write lock: $fn:" . $fs->error;
  my $num = <$fh> || 0;
  return ($fh, $num);
}

sub release_lock {
  my $fn = shift;
  my $fh = shift;
  my $num = shift;
  my $justPrint = shift || 0;

  seek($fh, 0, SEEK_SET) or LOGDIE "seek failed: $fn: $!";
  print $fh "$num\n" or LOGDIE "write failed: $fn: $!";
  truncate($fh, tell($fh)) or LOGDIE "truncate failed: $fn: $!";
  my $fs = new File::FcntlLock;
  $fs->l_type(F_UNLCK);
  ALWAYS "releasing lock: $fn";
  $fs->lock( $fh, F_SETLK ) or LOGDIE "unlock failed: $fn: " . $fs->error;
  close($fh) or LOGDIE "close failed: $fn: $!";
}

Одной из альтернатив блокировке файла является использование блокировки сокета. См. Lock::Socket на CPAN для такой реализации. Использование так же просто, как следующее:

use Lock::Socket qw/lock_socket/;
my $lock = lock_socket(5197); # raises exception if lock already taken

Есть несколько преимуществ использования сокета:

• гарантируется (через операционную систему), что никакие два приложения не будут удерживать одну и ту же блокировку: условия гонки отсутствуют.
• гарантируется (опять же через операционную систему) аккуратная очистка при завершении вашего процесса, поэтому не нужно иметь дело с устаревшими блокировками.
• полагается на функциональность, которая хорошо поддерживается всем, на чем работает Perl: например, нет проблем с поддержкой flock(2) в Win32.

Очевидным недостатком является то, что пространство имен блокировки является глобальным. Возможен своего рода отказ в обслуживании, если другой процесс решит заблокировать нужный вам порт.

[раскрытие информации: я являюсь автором вышеупомянутого модуля]

Используйте стаю Люка.

Изменить: Это хорошее объяснение.

flock создает блокировки файлов в стиле Unix и доступен в большинстве операционных систем, на которых работает Perl. Однако замки стада носят только рекомендательный характер.

edit: подчеркнуто, что стадо переносимо

Вот мое решение для чтения и записи в одном замке...

open (TST,"+< readwrite_test.txt") or die "Cannot open file\n$!";
flock(TST, LOCK_EX);
# Read the file:
@LINES=<TST>;
# Wipe the file:
seek(TST, 0, 0); truncate(TST, 0);
# Do something with the contents here:
push @LINES,"grappig, he!\n";
$LINES[3]="Gekke henkie!\n";
# Write the file:
foreach $l (@LINES)
{
   print TST $l;
}
close(TST) or die "Cannot close file\n$!";

Flock, вероятно, лучший, но требует, чтобы вы написали вокруг него весь вспомогательный код - тайм-ауты, устаревшие блокировки, несуществующие файлы и т. д. Я проверил LockFile::Simple, но обнаружил, что он начал устанавливать umask по умолчанию только для чтения и не очищает это. В результате проблем со случайными разрешениями в многопроцессорном/многопоточном приложении на modperl я решил обернуть NFSLock некоторой обработкой пустых файлов.