Глава 7 Доступ к файлам

7.14. Асинхронный ввод/вывод

Проблема

Решение

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
}

Комментарий

> Смотри также -------------------------------
Описание функций sysopen и fcnti в perlfunc{1); документация по стандартному модулю POSIX; страницы руководства ореп{2) fcntl(2) рецепты 7.13 и 7.15.

7.15. Определение количества читаемых байтов

Проблема

Решение

Комментарий

Если утилита 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).

7.16. Хранение файловых манипуляторов в переменных

Проблема

Решение

Комментарий

$fh_a = 10::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).

7.17. Кэширование открытых файловых манипуляторов

Проблема

Решение

Комментарий

> Смотри также ------
Документация по стандартному модулю FileCache; описание функции open в perlfunc(1).

7.18. Одновременный вывод через несколько файловых манипуляторов

Проблема

Решение

Комментарий

> Смотри также -------------------------------
Описание функции print в perlfunc(1). Аналогичная методика используется в рецептах 8.19 и 13.15.

7.19. Открытие и закрытие числовых файловых дескрипторов

Проблема

Решение

Комментарий

use 10::Handle;
$fh = 10::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).

7.20. Копирование файловых манипуляторов

Проблема

Решение

Комментарий

7.21. Программа: netlock

Исходный текст модуля приведен в примере 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

7.22. Программа: lockarea

© copyright 2000 Soft group