Приглашаем посетить
7.14. Асинхронный ввод/вывод
Проблема
Требуется прочитать или записать данные через файловый манипулятор так. чтобы система не приостанавливала процесс до наступления готовности программы, файла, сокета или устройства на другом конце. Такая задача чаще возни кает для специальных, нежели для обычных файлов.
Решение
Откройте файл функцией sysopen с параметром 0_NOCBLOCK:
use Fcnti;
sysopen(MODEM, "/dev/cuaO", 0_NONBLOCK|0_RDWR) or die "Can't open modem: $!\n";
Если у вас уже есть файловый манипулятор, измените флаги с помощью функции fcnti:
use Fcnti;
$flags = o o;
fcntl(HANDLE, F_GETFL, $flags)
or die "Couldn't get flags for HANDLE : $!\n";
$flags |= 0_NONBLOCK;
fcntl(HANDLE, F_SETFL, $flags)
or die "Couldn't set flags for HANDLE: $!\n";
После того как файловый манипулятор будет открыт для асинхронного ввода/вывода, измените флаги с помощью функции fcnti:
use POSIX qw(:errno_h);
$rv = syswrite(HANDLE, $buffer, length $buffer);
if (!defined($rv) && $! == EAGAIN) {
# Ожидание
} elsif ($rv != length $buffer) {
# Незавершенная запись
} else {
# Успешная запись
}
$rv = sysread(HANDLE, $buffer, SBUFSIZ);
or die "sysread: $!";
if (!defined($rv) && $! == EAGAIN) {
# Ожидание
} else {
# Успешно прочитано $rv байт из HANDLE
}
Комментарий
Константа 0_NONBLOCK входит в стандарт POSIX и потому поддерживается большинством компьютеров. Мы используем модуль POSIX для получения числового значения ошибки EAGAIN.
Смотри также: Описание функций sysopen и fcnti в perlfunc{1); документация по стандартному модулю POSIX; страницы руководства ореп{2) fcntl(2) рецепты 7.13 и 7.15.
Проблема
Требуется узнать, сколько байтов может быть прочитано через файловый манипулятор функцией read или sysread.
Решение
Воспользуйтесь функцией iocti в режиме FIONREAD:
$size = pack("l", 0);
ioctl(FH, $FIONREAD, $size) or die "Couldn't call iocti: $!\n";
$size = unpack("l", $size);
# Могут быть прочитаны $size байт
Комментарий
Функция Perl iocti предоставляет прямой интерфейс к системной функции ioctl(2). Если ваш компьютер не поддерживает запросы FIONREAD при вызове iocti (2), вам не удастся использовать этот рецепт. FIONREAD и другие запросы iocti (2) соответствуют числовым значениям, которые обычно хранятся в заголовочных файлах С.
Вам может понадобиться утилита Perl h2ph, преобразующая заголовочные файлы С в код Perl. FIONREAD в конечном счете определяется как функция в файле sys/ioctl.ph:
require 'sys/ioctl.ph';
$size = pack("l", 0);
ioctl(FH, FIONREADO, $size) or die "Couldn't call iocti: $!\n";
$size = unpack("l", $size);
Если утилита h2ph не установлена или не подходит вам, найдите нужное место в заголовочном файле с помощью дгер:
%grер FIONREAD /usr/include/*/*
/usr/include/asm/ioctls.h:#define FIONREAD Ox541B
Также можно написать небольшую программу на С в "редакторе настоящего программиста":
% cat > fionread.c
#include
main() {
printf("%#08x\n", FIONREAD);
}
^D
% cc -o fionread fionread
% ./fionread
Ox4004667f
Затем жестко закодируйте полученное значение в программе. С переносимостью пускай возится ваш преемник:
$FIONREAD = ox4004667f; # xxx: зависит от операционной системы
$size = pack("l", 0);
ioctl(FH, $FIONREAD, $size) or die "Couldn't call iocti: $!\n";
$size = unpack("l", $size);
FIONREAD требует, чтобы файловый манипулятор был подключен к потоку. Следовательно, сокеты, каналы и терминальные устройства будут работать, а файлы - нет.
Если вам это покажется чем-то вроде системного программирования, взгляните на проблему под другим углом. Выполните асинхронное чтение данных из манипулятора (см. рецепт 7.14). Если вам удастся что-нибудь прочитать, вы узнаете, столько байтов ожидало чтения, а если не удастся - значит, и читать нечего.
Смотри также: Рецепт 7.14; страница руководства ioctl(1) вашей системы; описание функции iocti в perlfunc(1).
Проблема
Вы собираетесь использовать файловый манипулятор как обычную переменную, чтобы его можно было передать или вернуть из функции, сохранить в структуре данных и т. д.
Решение
Если у вас уже имеется символьный файловый манипулятор (например, STDIN или LOGFILE), воспользуйтесь записью тип-глоба, *FH. Такой подход является самым эффективным.
$vaciable = *filehandle; # Сохранить в переменной
subroutine(*FILEHANDLE); # или передать функции
sub subroutine {
my $fh = shift;
print $fh "Hello, filehandle!\n";
}
Если вы хотите работать с анонимным файловым манипулятором, воспользуйтесь функцией return_fh (см. ниже) или новыми методами модулей IO::File или IO::Handle, сохраните его в скалярной переменной и используйте так, словно это обычный файловый манипулятор:
use FileHandle; # Анонимные манипуляторы $fh = filehandle->new();
use IO::File; # 5.004 и выше $fh = IO::file->new();
Комментарий
Существует немало способов передать файловый манипулятор функции или сохранить его в структуре данных. Самое простое и быстрое решение заключается в применении тип-глоба, *FH. Рассматривайте запись *FH как обозначение типа файлового манипулятора, подобно тому, как представляли молекулы на уроках химии в виде цветных шариков - не совсем точно, зато удобно
Когда вы начнете понимать недостатки этой модели, она вам уже не понадобится.
Конечно, в простых ситуациях этого вполне достаточно, но что если вам потребовался массив файловых манипуляторов с неизвестными именами? Как показано в главе 11 "Ссылки и записи", построение анонимных массивов, хэшей и даже функций во время выполнения программы оказывается исключительно удобным приемом. Нам хотелось бы иметь аналогичную возможность и для файловых манипуляторов, На помощь приходят модули 10.
Метод new модуля IO::Handle или IO::File генерирует анонимный фйловый манипулятор. Его можно передать функции, сохранить в массиве и вообще применять везде, где используются именованные тип-глобы файловых манипуляторов - и не только. Эти модули также могут использоваться в иерархии наследования, поскольку конструктор new возвращает полноценные объекты, для которых могут вызываться методы.
Объекты могут косвенно использоваться в качестве файловых манипуляторов, что избавляет вас от необходимости придумывать для них имена.
Чтобы получить тип-глоб из именованного файлового манипулятора, снабдите его префиксом *:
$fh_a = file->new("< /etc/motd") or die "open /etc/motd: $!";
$fh_b = *stdin;
some_sub($fh_a, $fh_b);
Существуют и другие способы, но этот проще и удобнее всех остальных. Един ственное ограничение - в том, что его нельзя превратить в объект вызовом bless. Bless вызывается для ссылки на тип-глоб - именно это и происходит в IO::Handle. Ссылки на тип-глоб, как и сами тип-глобы, можно косвенно использовать в качестве файловых манипуляторов, с приведением посредством bless или без него.
Создание и возврат нового файлового манипулятора из функции происходит следующим образом:
sub return_fh { # Создание анонимных файловых манипуляторов
local *FH; # Должны быть local, не my Я now open it if you want to,
#then...
return *FH:
}
$handle = return_fh();
Функция, получающая файловый манипулятор в качестве аргумента, может либо сохранить его в переменной (желательно лексической) и затем косвенно использовать его:
sub accept_fh {
my $fh = shift;
print $fh "Sending to indirect filehandle\n";
}
in6o локализовать тип-глоб и использовать файловый манипулятор напрямую:
sub accept_fh {
local *FH = shift;
print FH "Sending to localized filehandle\n";
}
Оба варианта работают как с объектами IO::Handle, так и с тип-глобами и настоящими файловыми манипуляторами:
accept_fh(*STDOUT);
accept_fh($handle);
Perl позволяет использовать строки, тип-глобы и ссылки на тип-глобы в качестве косвенных файловых манипуляторов, но без передачи тип-глобов или объектов IO::Handle можно нарваться на неприятности. Применение строк ("LOGFILE" вместо * LOGFILE) между пакетами потребует специальных усилий, а функции не могут возвращать ссылки на тип-глобы.
В предыдущих примерах файловый манипулятор перед использованием присваивался скалярной переменной. Дело в том, что во встроенных функциях (print или printf) или в операторе о могут использоваться только простые скалярные переменные, но не выражения или элементы хэшей и массивов. Следующие строки даже не пройдут компиляцию:
Ofd = (.stdin, *stdout, *stderr);
print $fd[1] "Type it: "; # НЕВЕРНО
$got = <$fd[0]> # НЕВЕРНО
print $fd[2] "What was that: $got"; # НЕВЕРНО
В print и printf это ограничение удается обойти - воспользуйтесь блоком ii выражением, в котором находится файловый манипулятор:
print { $fd[1] } "funny stuff\n";
printf { $fd[1] } "Pity the poor %x.\n", 3_735_928_559;
Pity the poor deadbeef.
Внутри блока может находиться и более сложный код. Следующий фрагмент отправляет сообщение в один из двух адресов:
$ok = -x "/bin/cat";
print { $ok ? $fd[1] : $fd[2] } "cat stat $ok\n";
print { $fd[ 1 + ($ok || 0) ] } "cat stat $ok\n";
Подход, при котором print и printf интерпретируются как вызовы методов объекта, не работает для оператора о, поскольку это настоящий оператор, а не вызов функции с аргументом без запятых. Если тип-глобы сохранены в структуре, как это было сделано выше, то для чтения записей можно воспользоваться встроенной функцией read line, работающей аналогично о:
$got = readline($fd[0]);
Смотри также: Рецепт 7.1; документация по стандартному модулю FileHandle; описание функции open в perlfunc(1).
Проблема
Требуется одновременно открыть больше файлов, чем позволяет ваша система.
Решение
Воспользуйтесь стандартным модулем FileCache:
use FileCache;
cacheout ($path); # При каждом применении манипулятора
print $path "output";
Комментарий
Функция cacheout модуля FileCache позволяет одновременно открывать больше файлов, чем позволяет операционная система. Если воспользоваться ей для открытия существующего файла, который FileCache видит впервые, этот файл без лишних вопросов усекается до нулевой длины. Однако во время фонового открытия и закрытия файлов cacheout следит за открывавшимися ранее файлами и не стирает их, а присоединяет к ним данные. Она не умеет создавать каталоги, поэтому, если попытаться открыть файл /usr/local/dates/merino. ewe в несуществующем каталоге
/usr/local/dates, из cacheout будет вызвана die.
Функция cacheout() проверяет значение константы NO FILE уровня С из стандартного заголовочного файла sys/params.h, чтобы определить, сколько файлов разрешается открывать одновременно. В некоторых системах это значение может быть неверным или вовсе отсутствовать (например, там, где максимальное количество дескрипторов является лимитом ресурса процесса и устанавливается командой limit или ulimit). Если cacheout() не может получить значение NOFILE, достаточно присвоить $FileCache: :maxopen значение, на 4 меньше правильного, или подобрать разумное число методом проб и, ошибок.
В примере 7.8 файл xferlog, создаваемый популярным ЕТР-сервером wuftpd, разбивается на файлы, имена которых соответствуют именам пользователей. Поля файла xferlog разделяются пробелами; имя пользователя хранится в четвертом поле с конца.
Пример 7.8. splitwulog
#!/usr/bin/perl
# splitwulog - разделение журнала wuftpd по именам пользователей
use FileCache;
$outdir = '/var/log/ftp/by-user';
while (<>) {
unless (defined ($user = (split)[-4])) { warn "invalid line: $.\n";
next;
}
$path = "$outdir/$user";
cacheout $path;
print $path $_;
}
Смотри также: Документация по стандартному модулю FileCache; описание функции open в perlfunc(1).
Проблема
Одни и те же данные требуется вывести через несколько разных файловых манипуляторов.
Решение
Если вы предпочитаете обходиться без создания новых процессов, напишите цикл f о reach для перебора файловых манипуляторов:
foreach $filehandle (OFILEHANDLES) { print $filehandle $stuff_to_print;
}
Если новые процессы вас не пугают, откройте файловый манипулятор, связав его с программой tee:
open(MANY, "| tee file"! file2 file3 > /dev/null") or die $!;
print MANY "data\n" or die $!;
close(MANY) or die $!;
Комментарий
Файловый манипулятор передает выходные данные лишь одному файлу или программе. Чтобы дублировать вывод, следует многократно вызвать print или связать манипулятор с программой распределения выходных данных (например, tee). В первом варианте проще всего занести файловые манипуляторы в список или массив и организовать их перебор:
# 'use strict' пожалуется на эту команду:
for $fh ('FH1', 'FH2', 'FH3') { print $fh "whatever\n" }
# но не возразит против этой:
for $fh (*FH1, *FH2, *FH3) { print $fh "whatever\n" }
Но если ваша система включает программу tee или вы установили Perl-версию tee из рецепта 8.19, можно открыть канал к tee и поручить ей всю работу по копированию файла в несколько приемников. Не забывайте, что tee обычно ко-
пирует выходные данные в STDOUT; если лишняя копия данных вам не нужна, перенаправьте стандартный вывод tee в /(lev/null:
open (FH, "| tee file-l file2 file3 >/dev/null");
print FH "whatever\n";
Вы даже можете перенаправить процессу tee свой собственный STDOUT и использовать при выводе обычную функцию print:
# Продублировать STDOUT в трех файлах с сохранением исходного STDOUT
open (STDOUT, "| tee file1 file2 file3") or die "Teeing off: $!\n";
print "whatever\n" or die "Writing: $!\n";
close(STDOUT) or die "Closing: $!\n";
Смотри также: Описание функции print в perlfunc(1). Аналогичная методика используется в рецептах 8.19 и 13.15.
Проблема
Вам известны файловые дескрипторы, через которые должен выполняться ввод/вывод, но Perl вместо числовых дескрипторов требует манипуляторы.
Решение
Для открытия файлового дескриптора воспользуйтесь режимами "<&=" и "<&" или методом fdopen модуля IO::Handle:
open(FH, "<&=$fdnum"); # fh открывается для дескриптора
open(FH, "<&$FDNUM"); # FH открывается для копии дескриптора
use Handle;
$fh->fdopen($FDNUM, "r"); # Открыть дескриптор 3 для чтения
Чтобы закрыть дескриптор, воспользуйтесь функцией POSIX: : close или открой-г его описанным выше способом.
Комментарий
Иногда вам известен файловой дескриптор, а не манипулятор. В системе ввода/ вывода Perl вместо дескрипторов используются манипуляторы, поэтому для уже открытого файлового дескриптора придется создать новый манипулятор. Режимы open "<&", ">&" и "+<&" решают эту задачу соответственно для чтения, записи и обновления. Режимы со знаком равенства ("<&=", ">&=" и "+<&=") работают с дескрипторами более экономно, при этом почти всегда делается именно то,
что нужно. Дело в том, что они используют лишь функцию fdopen уровня С без системной функции dup2.
Если у вас установлена версия perl 5.004 и выше, воспользуйтесь методом объекта io::handle:
use Handle;
$fh = handle->new();
$fh->fdopen(3, "г"); # Открыть fd 3 для чтения
Закрытие числовых файловых дескрипторов встречается еще реже. Задача напрямую решается функцией POSIX: : close. Если в вашей системе нет библиотеки POSIX, но зато имеется работающая функция syscall (и ваш системный администратор установил файл sys/syscall.ph, созданный транслятором h2ph), можно воспользоваться функцией syscall, хотя переносимость в этом случае оставляет желать лучшего. Вам придется добавлять 0 к числам и присоединять "" к строкам, чтобы обеспечить правильность типов С; кроме того, код ошибки равен -1, а не false, как в других функциях Perl. He стоит и говорить, что syscall применяется лишь в крайнем случае.
Ниже показано, как открыть файловые дескрипторы, которые почтовая система МН передает своим дочерним процессам. Дескрипторы идентифицируются по переменной окружения MHCONTEXTFD:
$fd = $env{mhcontextfd};
open(MHCONTEXT, "<&=$fd") or die "couldn't fdopen $fd: $!";
# after processing close(MHCONTEXT)
or die "couldn't close context file: $!";
Чтобы закрыть дескриптор по числовому значению, достаточно сначала вызвать для него open.
Смотри также: Документация но стандартным модулям POSIX и IO::Handle; страница руководства fdopen(3) вашей системы; описание функции open в perlfunc{1).
Проблема
Требуется создать копию файлового манипулятора.
Решение
Синоним файлового манипулятора создается следующей командой:
"СИНОНИМ = *ОРИГИНАЛ;
Чтобы создать независимую копию файлового дескриптора для существующего манипулятора, воспользуйтесь функцией open в режиме &:
open(OUTCOPY, ">&STDOUT") or die "Couldn't dup S.TDOUT: $!";
open(INCOPY, "<&STDIN" ) or die "Couldn't dup STDIN : $!";
Чтобы создать синоним файлового дескриптора для существующего манипулятора, воспользуйтесь функцией open в режиме &=:
open(OUTALIAS, ">&=stdout") or die "couldn't alias stdout: $!";
open(INALIAS, "<&=stdin") or die "couldn't alias stdin : $!oo;
open(BYNUMBER, ">&=5") or die "couldn't alias file descriptor 5: $!";
Комментарий
Если синоним манипулятора создан с помощью тип-глоба, программа по-прежнему работает лишь с одним объектом ввода/вывода Perl. При закрытии манипулятора-синонима закрывается и объект ввода/вывода. Все последующие попытки использования копий этого манипулятора лишь приводят к выдаче сообщений типа "print on closed filehandle". Чередование записи через разные синонимы не вызывает проблем, поскольку при этом не создаются дублирующиеся структуры данных, способные вызвать десинхронизацию.
При копировании дескриптора командой ореп(КОПИЯ, ">&МАНИПУЛЯТОР") вызывается системная функция dup(2). Вы получаете два независимых дескриптора с общей текущей позицией, блокировкой и флагами, но разными буферами ввода/вывода. Закрытие одного дескриптора не отражается на его копии. Одновременная работа с файлом через оба дескриптора - верный путь к катастрофе. Обычно этот прием используется для сохранения и восстановления STDOUT и STDERR:
# Получить копии дескрипторов
open(OLDOUT, ">&STDOUT");
open(OLDERR, ">&STDERR");
# Перенаправить stdout и stderr
open(STDOUT, "> /Imp/program.out") or die "Can't redirect stdout: $!";
open(STDERR, ">&STDOUT") or die "Can't dup stdout: $!";
# Запустить программу system($joe_random_program):
# Закрыть измененные манипуляторы
close(STDOUT) or die "Can't close STDOUT: $!";
close(STDERR) or die "Can't close STDERR: $!";
# Восстановить stdout и stderr
open(STDERR, ">&OLDERR") or die "Can't restore stderr: $!";
open(STDOUT, ">&OLDOUT") or die "Can't restore stdout: $!";
# Для надежности закрыть независимые копии
close(OLDOUT) or die "Can't close OLDOUT: $!";
close(OLDERR) or die "Can't close OLDERR: $!":
Если синоним дескриптора создается командой ореп(СИНОНИМ, ">&=МАНИПУЛЯ-ОР"), в действительности вызывается системная функция ввода/вывода fdopen(3v
Вы получаете один файловый дескриптор с двумя буферами, доступ к которым осу ществляется через два манипулятора. Закрытие одного манипулятора закрыва ет дескрипторы синонимов, но не манипуляторы - если вы попытаетесь вызва'1 [ print для манипулятора с закрытым синонимом, perl не выдаст предупреждения "print on closed filehandle", даже если вызов print закончится неудачей. Короче говоря, попытки работать с файлом через оба манипулятора тоже наверняка приведут к катастрофе. Такая методика используется только для открытия файлового дескриптора по известному числовому значению (см. рецепт 7.19).
Смотри также: Страница руководства dup(T) вашей системы; описание функции open в perlfunc(1).
При блокировке файлов мы рекомендуем по возможности использовать функ цию flock. К сожалению, в некоторых системах блокировка через flock ненадеж на. Допустим, функция flock может быть настроена на вариант блокировки поддержки сети или вы работаете в одной из редких систем, в которой вообще не существует эмуляции flock.
Приведенная ниже программа и модуль содержат базовую реализацию механизма блокировки файлов. В отличие от обычной функции flock, данный модуль блокирует файлы по именам, а не по дескрипторам.
Следовательно, он может применяться для блокировки каталогов, сокетов и других нестандартных файлов. Более того, вы даже сможете блокировать несуществующие файлы. При этом используется каталог, созданный в иерархии на одном уровне с блокируемым файлом, поэтому вы должны иметь право записи в каталог, содержащий его. Файл в каталоге блокировки содержит сведения о владельце блокировки. Это пригодится в рецепте 7.8, поскольку блокировка сохраняется, несмотря на изменение файла, которому принадлежит данное имя.
Функция n flock вызывается с одним или двумя аргументами. Первый определяет имя блокируемого файла; второй, необязательный - промежуток времени, в течение которого происходит ожидание. Функция возвращает true при успешном предоставлении блокировки и false при истечении времени ожидания. При возникновении различных маловероятных событий (например, при невозможности записи в каталог) инициируется исключение.
Присвойте true переменной $File: : LockDir: : Debug, чтобы модуль выдавал сообщения при неудачном ожидании. Если вы забудете снять блокировку, при выходе из программы модуль снимет ее за вас. Этого не произойдет, если ваша программа получит неперехваченный сигнал.
Вспомогательная программа из примера 7.9 демонстрирует применение модуля File::LockDir.
Пример 7.9. drivelock
#!/usr/bin/perl -w
# drivelock - демонстрация модуля File::LockDir
use strict;
use File::LockDir;
$SIG{INT} = sub { die "outta here\n" };
$File::LockDir::Debug = 1;
my $path = shift or die "usage: $0 \n";
unless (nflock($path, 2)) {
die "couldn't lock $path in 2 seconds\n";
}
sleep 100;
nunflock($path);
Исходный текст модуля приведен в примере 7.10. За дополнительными сведениями о построении модулей обращайтесь к главе 12 "Пакеты, библиотеки и модули".
Пример 7.10. File: :LockDir
package File::LockDir;
# Модуль, обеспечивающий простейшую блокировку
# на уровне имен файлов без применения хитрых системных функций.
# Теоретически информация о каталогах синхронизируется в NFS.
# Стрессовое тестирование не проводилось.
use strict;
use Exporter;
use vars qw((o)ISA OEXPORT);
@ISA = qw(exporter);
@EXPORT = qw(nflock nunflock);
use vars qw($Debug $Check);
$Debug |= 0; # Может определяться заранее
$Check ||= 5; # Может определяться заранее
use Cwd;
use Fcnti;
use Sys::Hostname;
use File::Basename;
use File::stat;
use Carp;
my %Locked_Files = ();
# Применение:
nflock(OAI?lJ1; ТАЙМАУТ)
sub nflock($;$) {
my $pathname = shift;
my $naptime = shift || 0;
my $lockname = name21ock($pathname);
my $whosegot = "$lockname/owner";
my $start = time();
my $missed = 0;
local *OWNER;
# Если блокировка уже установлена, вернуться
if ($Locked_Files{$pathname}) {
carp "$pathname already locked";
return 1
}
if (!-w dirname($pathname)) {
croak "can't write to directory of $pathname'
}
while (1) {
last if mkdir($lockname, 0777);
confess "can't get $lockname: $!" if $missed++ > 10 && !-d $lockname;
if ($Debug) {{
open(OWNER, "< $whosegot") || last; # exit "if"! my $lockee = ;
chomp($lockee):
printf STDERR "%s $0\[$$]; lock on %s held by %s\n", scalar(localtime), $pathname,
$lockee;
close OWNER;
}} sleep $Check;
return if $naptime && time > $start+$naptime;
} sysopen(OWNER, $whosegot, 0_WRONLY|0_CREAT|O.EXCL)
or croak "can't create $whosegot:
$! printf OWNER "$0\[$$] on
%s since %s\n", hostname(), scalar(localtime);
close(OWNER)
or croak "close $whosegot: $!";
$Locked_Files{$pathname}++;
return 1;
}
# Освободить заблокированный файл
sub nunflock($) {
my $pathname = shift;
my $lockname = name21ock($pathname);
my $whosegot = "$lockname/owner";
unlink($whosegot);
carp "releasing lock on $lockname" if $Debug;
delete $Locked_Files{$pathname};
return rmdir($lockname);
}
# Вспомогательная функция
sub name21ock($) {
my $pathname = shift;
my $dir = dirname($pathname);
my $file = basename($pathname);
$dir = getcwd() if $dir eq '.';
my $lockname = "$dir/$file.lockdir' return $lockname;
}
}
# Ничего не забыли?
END {
for my $pathname (keys %Locked_Files)
{ my $lockname = name21ock($pathname);
my $whosegot = "$lockname/owner";
carp "releasing forgotten $lockname";
unlink($whosegot);
return rmdir($lockname);
}
}
1
Функция Perl flock блокирует только целые файлы, но не отдельные их области. Хотя fcnti поддерживает частичную блокировку файлов, из Perl с ней работать трудно - в основном из-за отсутствия модуля XS, который бы обеспечивал переносимую упаковку необходимой структуры данных.
Программа из примера 7.11 реализует fcnti, но лишь для трех конкретных архитектур: SunOS, BSD и Linux. Если вы работаете в другой системе, придется узнать формат структуры flock. Для этого мы просмотрели заголовочный файл С sys/ fcntl.h и запустили программу c2ph, чтобы получить информацию о выравнивании и типах. Эта программа, распространяемая с Perl, работает только в системах с сильным влиянием Беркли (как те, что перечислены выше). Вы не обязаны использовать c2ph, но эта программа несомненно облегчит ваше существование.
Функция struct_flock в программе lockarea выполняет упаковку и распаковку структуры, руководствуясь переменной $"0 с именем операционной системы. Объявления функции struct_flock не существует, мы просто создаем синоним для версии, относящейся к конкретной архитектуре. Синонимы функций рассматриваются в рецепте 10.14.
Программа lockarea открывает временный файл, уничтожая его текущее содержимое, и записывает в него полный экран (80х23) пробелов. Все строки имеют одинаковую длину.
Затем программа создает производные процессы и предоставляет им возможность одновременного обновления файла. Первый аргумент, N, определяет количество порождаемых процессов (2**М). Следовательно, lockarea 1 порождает два процесса, lockarea 2 - четыре, lockarea 3 - восемь, lockarea 4 - шестнадцать
и т. д. С увеличением числа потомков возрастает конкуренция за блокировку участков файла.
Каждый процесс выбирает из файла случайную строку, блокирует и обновляет ее. Он записывает в строку свой идентификатор процесса с префиксом - количеством обновлений данной строки:
4: 18584 was just here
Если в момент запроса блокировки строка уже была заблокирована, то после предоставления блокировки в сообщение включается идентификатор предыдущего процесса:
29: 24652 ZAPPED 24656
Попробуйте запустить программу lockarea в фоновом режиме и отображайте изменения файла с помощью программы rep из главы 15. Получается видеоигра для системных программистов.
%lockarea 5 & % rep -1 'cat /tmp/lkscreen'
Если работа основной программы прерывается клавишами Ctrl+C или сигналом SIGINT из командной строки, она уничтожает всех своих потомков, посылая сигнал всей группе процессов.
Пример 7.11. lockarea
#!/usr/bin/perl -w
# lockarea - частичная блокировка с использованием fcnti
use strict;
my $FORKS = shift || 1;
my $SLEEP = shift | | 1;
use Fcnti;
use POSIX qw(:unistd_h ;errno_h):
my $COLS = 80;
my $ROWS = 23;
# Когда вы в последний раз видели *этот* режим правильно работающим?
open(FH, "+> /tmp/lkscreen") or die $!;
select(FH);
$| = 1;
select STDOUT;
# Очистить экран
for (1 .. $ROWS) {
print FH " " x $COLS, "\n";
}
my $progenitor = $$;
fork while $FORKS-- > 0;
print "hello from $$\n";
if ($progenitor == $$) {
$SIG{INT} = \&genocide;
} else {
$SIG{INT} = sub { die "goodbye from $$" }:
}
while (1) {
my $line_num = int rand($rows), my $line;
my $n;
# Перейти к строке
seek(FH, $n = $line_num * ($cols+1), seek_set) or next;
# Получить блокировку
my $place = tell(fh);
my $him;
next unless defined($him = lock(*fh, $place, $cols));
# Прочитать строку
read(FH, $line, $COLS) == $cols or next;
my $count = ($line =~ /(\d+)/) ? $1 : 0;
$count++;
# Обновить строку
seek(FH, $place, 0) or die $!
my $update = sprintf($him
? "%6d: %d ZAPPED %d" : "%6d: %d was just here", $count, $$, $him);
my $start = int(rand($cols - length($update)));
die "XXX" if $start + length($update) > $COLS;
printf FH "%*.*s\n", -$COLS, $COLS, " " x $start . $update;
# Снять блокировку и сделать паузу
unlock(*FH, $place, $COLS);
sleep $SLEEP if $SLEEP;
} die "NOT REACHED"; # На всякий случай
lock($handle, $offset, $timeout) - get an fcnti lock sub lock {
my ($fh, $start, Still) = @_;
##print "$$: Locking $start, $till\n";
my $lock = struct_flock(f_wrlck, seek_set, $start, $till, 0);
my $blocker = 0;
unless (fcntl($fh, F_SETLK, $lock)) {
die "F_SETLK $$ @_: $!oo unless $! == eagain || $! == edeadlk;
fcntl($fh, F_GETLK, $lock)
or die "F_GETLK $$ @_: $! $blocker = (struct_flock($lock))[-1];
##print "lock $$ @_: waiting for $blocker\n";
$lock = struct_flock(f_wrlck, seek_set, $start, $till, 0);
unless (fcntl($fh, F_SETLKW, $lock)) { warn "F_SETLKW $$ @>_: $!\n";
return; # undef
}
}
return Sblocker;
}
# unlock($handle, $offset, $timeout) - снять блокировку fcnti
sub unlock {
my ($fh, $start, $till) = @_;
##print "$$: Unlocking $start, $till\n";
my $lock - struct_flock(F_UNLCK, SEEK_SET, $start, $till, O):
fcntl($fh, F_SETLK, $lock) or die "F_UNLCK $$ @_: $!";
}
# Структуры flock для разных ОС
# Структура flock для Linux
# short 1_type;
# short 1_whence;
# off_t 1_start;
# off_t 1_len;
# pid_t 1_pid;
BEGIN {
# По данным c2ph:
typedef='s2 12 i', sizeof=16
my $FLOCK_STRUCT = os s 1 1 i';
sub linux_flock { if (wantarray) {
my ($type, $whence, Sstart, $len, $pid) = unpack($flock_struct, $_[0]);
return ($type, $whence, $start, $len, $pid);
} else {
my ($type, $whence, $start, $len, $pid) = @_;
return pack($FLOCK_STRUCT,
$type, $whence, $start, $len, $pid);
}
}
}
# Структура flock для SunOS
# short 1_type; /* F_RDLCK, F_WRLCK или F_UNLCK */
# short 1_whence; /* Флаг выбора начального смещения */
# long 1_start; /* Относительное смещение в байтах */
# long 1_len; /* Длина в байтах;
О - блокировка до EOF */
# short 1_pid; /* Возвращается F_GETLK "/
# short 1_xxx; /* Зарезервировано на будущее */
BEGIN {
# По данным c2ph: typedef='s2 12 s2', sizeof=16
my $FLOCK_STRUCT = os s 1 1 s s':
sub sunos_flock { If (wantarray) {
my ($type, $whence, $start, $len, $pid, $xxx) = unpack($flock_struct, $_[0]);
return ($type, $whence, $start, $len, $pid);
} else {
my ($type, $whence, $start, $len, $pid) = @>_;
return pack($FLOCK_STRUCT,
$type, $whence, $start, $len, $pid, 0);
}
}
}
# Структура flock для (Free)BSD:
# off_t 1_start; /* Начальное смещение "/
# off_t 1_len; /* len = 0 означает блокировку до конца файла */
# pid_t 1_pid; /* Владелец блокировки */
# short 1_type; /* Тип блокировки: чтение/запись и т. д. */
# short 1_whence; /* Тип 1_start */
BEGIN {
# По данным c2ph: typedef="q2 i s2", size=24
my $FLOCK_STRUCT = oii 11 i s s-;
sub bsd_flock {
if (wantarray) {
my ($xxstart, $start, $xxlen, $len, $pid, $type, $whence) = unpack($flock_struct,
$_[0]);
return ($type, $whence, $start, $len, $pid);
} else {
my ($type, $whence, $start, $len, $pid) = @>_;
my ($xxstart, $xxlen) = (0,0);
return pack($FLOCK_STRUCT,
$xxstart, $start, $xxlen, $len, $pid, $type, $whence);
}
}
}
# Синоним структуры fcnti на стадии компиляции
BEGIN {
for ($-0) {
*struct_flock = do { /bsd/ && \&bsd_flpck
/linux/ && \&linux_flock /
sunos/ && \&sunos_flock die "unknown operating system $"0, bailing out";
};
}
}
# Установить обработчик сигнала для потомков
BEGIN {
my $called = 0;
sub genocide {
exit if $called++;
print "$$: Time to die, kiddies.\n" if $$ == $progenitor;
my $job = getpgrpo;
$SIG{INT} = 'ignore';
kill -2, $]ob if $job; # killpg(SIGINT, job) 1 while wait > 0;
print "$$: My turn\n" if $$ == $progenitor;
exit:
}
}
END { &genocide }
