Требуется извлечь из входных данных поля переменной длины.
Решение
Воспользуйтесь функцией split с шаблоном, совпадающим с разделителями полей:
# Имеется $ЗАПИСЬ с полями, разделенными шаблоном ШАБЛОН.
# Из записи извлекаются @ПОЛЯ.
@П0ЛЯ = split(/ШАБЛОН/, $ЗАПИСЬ);
Комментарий
Функция split вызывается с тремя аргументами: шаблон, выражение и лимит (максимальное количество извлекаемых полей). Если количество полей во входных данных превышает лимит, лишние поля возвращаются неразделенными в последнем элементе списка. Если лимит н
Если разделитель входных полей не является фиксированной строкой, можно вызвать split так, чтобы функция возвращала разделители полей вместе с данными, - для этого в шаблон включаются круглые скобки. Например:
split(/([+-])/, "3+5-2"); возвращает список:
(3, '+', 5, '-', 2)
Поля, разделенные двоеточиями (в стиле файла /etc/passwd), извлекаются следующим образом:
@fields = split(/:/, $record):
Классическое применение функции split - извлечение данных, разделенных пропусками:
@fields = split(/\s+/, $record);
Если $ЗАПИСЬ начинается с пропуска, в последнем варианте первому элементу списка будет присвоена пустая строка, поскольку split сочтет, что запись имеет начальное пустое поле. Если это не подходит, используйте особую форму split:
#fields = split(" ", $ЗАПИСЬ); В этом случае split ведет себя так же, как и с шаблоном /\s+/, но игнорирует начальный пропуск.
Если разделитель может присутствовать внутри самих полей, возникает проблема. Стандартное решение - снабжать экземпляры разделителя в полях префиксом \. См. рецепт 1.13.
> Смотри также -------------------------------
Описание функции split в perlfunc(1).
Читайте файл по одной строке и запоминайте байтовое смещение последней прочитанной строки. Когда файл будет исчерпан, обрежьте файл по последнему сохраненному смещению:
open (FH, "+< $file") or die "can't update $file: $!";
while ( ) {
$addr = tell(FH) unless eof(FH);
} truncate(FH, $addr) or die "can't truncate $file: $!";
Комментарий
Такое решение намного эффективнее загрузки всего файла, поскольку в любом момент времени в памяти хранится всего одна строка. Хотя вам все равно приходится читать весь файл, программу можно использовать и для больших файлов, размер которых превышает объем
> Смотри также -------------------------------
Описание функций open и binmode в perlfunc(1); man-страницы ореn(2) и fореn(2) вашей системы.
Операционная система отличает текстовые файлы от двоичных. Как это сделать в программе?
Решение
Вызовите функцию binmode для файлового манипулятора:
binmode(МАНИПУЛЯТОР);
Комментарий
Не существует единого мнения по поводу того, что является строкой текстового файла; текстовые символы одного компьютера могут превратиться в двоичную белиберду на другом. Но даже если все станут пользоваться кодировкой ASCII вместо EBCDIC, Rad50 или Unico
Как говорилось во введении, конкретного символа перевода строки не существует. Это чисто абстрактное понятие, которое поддерживается операционной системой, стандартными библиотеками, драйверами устройств и Perl.
В Unix или Р1ап9 "\п" представляет физическую последовательность "\cJ" (служебная последовательность Perl, соответствующая Ctrl+J). Однако на терминале, не работающем в "чистом" (raw) режиме, нажатие на клавишу Enter генерирует код "\сМ" (возврат курсора)
На Мае код "\п" обычно представляется "\сМ"; чтобы жизнь была интереснее (а также из-за стандартов, требующих различий между "\п" и "\г"), "\г" соответствует "\cJ". Такая интерпретация в точности противоположна стандартам UNIX, Plan9, VMS, CP/M... словом,
В VMS, DOS и их производных "\п" также представляет "\cJ", по аналогии с Unix и Plan9. С терминальной точки зрения UNIX и DOS ведут себя одинаково:
при нажатии пользователем клавиши Enter генерируется "\сМ", однако в программу поступает уже "\п", то есть "\cJ". Код "\п", переданный терминалу, превращается в "\cM\cJ".
Эти странные преобразования выполняются и с файлами Windows. В текстовых файлах DOS каждая строка завершается двумя символами, "\cM\cJ". Последний блок файла содержит код "\cZ", определяющий окончание текста. В таких системах при записи строки "bad news\n
Но при чтении строк в таких системах происходят еще более странные вещи. Файл содержит "bad news\cM\cJ" - строку, состоящую из 10 байт. При чтении ваша программа не получит ничего, кроме "bad news\n", где "\n" - виртуальный символ перевода строки, то есть
Такое наследие старой файловой системы СР/М, в которой хранились лишь сведения о количестве блоков, но не о размере файлов, бесит программистов уже несколько десятилетий, и конца-края этому не видно. Ведь DOS была совместима с файловым форматом СР/М, Wind
Впрочем, проблему одиночного "\п" можно обойти - достаточно сообщить Perl (и операционной системе), что вы работаете с двоичными данными. Функция binmode означает, что прочитанные или записанные через конкретный манипулятор данные не должны преобразовыват
$gifname = "picture.gif";
open(GIF, $gifname) or die "can't open $gifname: $!";
binmode(GIF); # Теперь DOS не преобразует двоичные
# входные данные GIF binmode(STDOUT);
# Теперь DOS не преобразует двоичные
# выходные данные STDOUT
while (read(GIF, $buff, 8 * 2**10)) { print STDOUT $buff;
} Вызов binmode в системах, где отличия между текстовыми и двоичными файлами несущественны (в том числе UNIX, Mac и Plan9), не принесет никакого вреда. Однако несвоевременный вызов функции в других системах (включая MVS, VMS и всех разновидностей DOS) м
Если функция binmode не используется, в данных, прочитанных с помощью о, строковый терминатор системы заменяется на "\n", даже если $/ было присвоено другое значение. Аналогично, любой "\n", выводимый через манипулятор функцией print, превращается в строк
Если вы хотите, чтобы прочитанные данные совпадали с содержимым файла байт в байт, и при этом работаете в одной из перечисленных странных систем, -вызовите binmode. Конечно, если вы захотите использовать их с о, вам придется присвоить $/ настоящий раздели
> Смотри также --------------------------------
Описание функций open и binmode в per!func(1); страницы руководства орen( 2) и fopen(3) вашей системы.
Нужно прочитать двоичную запись из середины большого файла, но вам не хочется добираться до нее, последовательно читая все предыдущие записи.
Решение
Определите размер записи и умножьте его на номер записи, чтобы получить смещение в байтах. Затем вызовите seek для полученного смещения и прочитайте запись:
$АДРЕС = $РАЗМЕР * $НОМБР;
seek(FH, $АДРЕС, 0) or die "seek:$!";
read(FH, $БУФЕР, $РАЗМЕР);
Комментарий
В решении предполагается, что $НОМЕР первой записи равен нулю. Если нумерация начинается с единицы, измените первую строку фрагмента:
$АДРЕС = $РАЗМЕР * ($НОМЕР-1); Для текстовых файлов это решение не работает - только строки не имеют одинаковую длину. Но такие ситуации встречаются очень редко.
> Смотри также -------------------------------
Описание функции seek в perlfunc(1); рецепт 8.13.
Для вывода записей в Perl не потребуется ничего, кроме функции print. Помните, что антиподом read является print, а не write, хотя, как ни странно, антиподом sysread все же является syswrite.
В примере 8.4 приведен исходный текст программы weekearly, которой передается один аргумент - имя пользователя. Программа смещает дату регистрации этого пользователя на неделю в прошлое. Конечно, на практике с системными срайлами экспериментировать не сле
Пример 8.4. weekearly
#!/usr/bin/perl
# weekearly - смещение даты регистрации на неделю назад
use User::pwent;
use 10::Seekable;
$typedef = 'L A12 A16'; # Формат linux : в sunos - "L A8 A16"
$sizeof = length(pack($typedef, ()));
$user = shift(@ARGV) || $ENV{USER} [| $ENV{LOGNAME};
$address = getpwnam($user)->uid * $sizeof;
open (LASTLOG, "+or die "can't update /usr/adm/lastlog: $!";
seek(LASTLOG, $address, SEEK_SET)
or die "seek failed: $!";
read(LASTLOG, $buffer, $sizeof) == $sizeof
or die "read failed: $!";
($time, $line, $host) = unpack($typedef, $buffer);
$time -= 24 * 7 * 60 * 60; # На неделю назад
$buffer = pack($typedef, $time, $line, $time);
seek(LASTLOG, -$sizeof, SEEK_CUR) # Вернуться на одну запись
or die "seek failed: $!";
print LASTLOG $record;
close(LASTLOG)
or die "close failed: $!";
> Смотри также --------------------------------
Описание функций open, seek, read, pack и unpack в perlfunc(i); рецепты 8.12; 8.14.
Требуется прочитать из файла строку, завершенную нуль-символом, начиная с определенного адреса.
Решение
Присвойте $/ нуль-символ ASCII и прочитайте строку с помощью :
$old_rs = $/; # Сохранить старое значение $/
$/ = "\0"; # Нуль-символ
seek(FH, $addr, SEEK_SET) or die "Seek error: $!\n":
$string = ; # Прочитать строку
chomp Ss.tring; # Удалить нуль-символ
$/ = $old_rs: # Восстановить старое значение $/ При желании сохранение и восстановление $/ можно реализовать с помощью local:
{
local $/ ^ "\0";
# ...
} # $/ восстанавливается автоматически
Комментарий
Программа bgets из примера 8.5 получает в качестве аргументов имя файла и одно или несколько байтовых смещений. Допускается десятичная, восьмеричная или шестнадцатеричная запись смещений. Для каждого смещения программа читает и выводит строку, которая нач
Пример 8.5. bgets
#!/usr/bin/perl
# bgets - вывод строк по смещениям в двоичном файле
use 10::Seekable;
($file, @addrs) = @ARGV or die "usage: $0 addr ...";
open(FH, $file) or die "cannot open $file: $!";
$/ = "\000";
foreach $addr (@addrs) {
$addr = oct $addr if $addr =~ /"0/;
seek(FH, $addr, SEEK_SET)
or die "can't seek to $addr in $file: $!";
printf qq{%ftx %fto %d "%s"\n}, $addr, $addr, $addr, scalar <>;
} Приведем простейшую реализацию программы UNIX strings:
Пример 8.6. strings
#!/usr/bin/perl
# strings - извлечение строк из двоичного файла
$/ = "\0";
while (<>) {
while (/([\040-\176\s]{4,})/g) { print $1, "\n";
}
}
[> Смотри также ------------------------
Описание функций seek, getc и ord в perlfunc(1); описание qq// в разделе "Quote and Quote-like Operators" man-страницы perlop(i).
Требуется прочитать файл с записями фиксированной длины.
Решение
Воспользуйтесь функциями pack и unpack:
# $RECORDSIZE - длина записи в байтах.
# $TEMPLATE - шаблон распаковки для записи
# FILE - файл, из которого читаются данные
# @FIELDS - массив для хранения полей
until ( eof(FILE) ) {
read(FILE, $record, $RECORDSIZE) == $RECORDSIZE or die "short read\n";
@FIELDS = unpack($TEMPLATE, $record);
}
Комментарий
Поскольку мы работаем не с текстовым, а с двоичным файлом, для чтения записей нельзя воспользоваться оператором <. . .> или методом getline модулей 10: :. Вместо этого приходится считывать конкретное количество байт в буфер
функцией read. После этого буфер содержит данные одной записи, которые декодируются функцией unpack с правильным форматом.
При работе с двоичными данными трудности часто начинаются как раз с правильного выбора формата. Если данные были записаны программой на С, приходится просматривать заголовочные файлы С или страницы руководства с описанием структур, для чего необходимо зна
Программа tailwtmp в конце этой главы использует формат, описанный в utmp(5) системы Linux, и работает с файлами /var/log/wtmp и /var/run/utmp. Но стоит нам привыкнуть к работе с двоичными данными, как возникает другая напасть - особенности конкретных ком
#define UT_LINESIZE
12 #define UT.NAMESIZE
8 #define UT_HOSTSIZE
16
struct utmp { /* Коды для шаблона распаковки */
short ut_type; /* s - short, должно быть дополнено */
pid_t ut_pid; /* i для integer */
char ut_line[UT_LINESIZE]; /* A12 - 12-символьная строка */
char ut_id[2]; /* A2, но для выравнивания
необходимо х2 */ time_t ut_time; /*
1 - long */ char ut_user[UT_NAMESIZE]; /*
AS - 8-символьная строка */ char ut_host[UT_HOSTSIZE]; /*
A16 - 16-символьная строка */ long ut_addr; /*
1 - long */
};
Вычисленная двоичная структура (в нашем примере - "s х2 i A12 A2 х2 1 A16 I") передается pack с пустым списком полей для определения размера записи. Не забудьте проверить код возврата read при чтении записи, чтобы убедиться в том, что вы получили запрошен
Если записи представляют собой текстовые строки, используйте шаблон рас-. паковки "а" или "А".
. Записи фиксированной длины хороши тем, что п-я запись начинается в фай-|е со смещения SIZE*(n-1), где SIZE - размер одной записи. Пример приведен в зограмме с построением индекса из рецепта 8.8.
> Смотри также ------------------------------
Описание функций unpack, pack и read в perlfunc{1) рецепт 1.1.
Вы хотите, чтобы пользователи вашей программы могли изменить ее поведение с помощью конфигурационного файла.
Решение
Организуйте обработку файла в тривиальном формате ПЕРЕМЕННАЯ=ЗНАЧЕНИЕ, создавая для каждого параметра элемент хэша "ключ/значение":
while () {
chomp; и Убрать перевод строки
s/й.*//; # Убрать комментарии
s/~\s+//; # Убрать начальные пропуски
s/\s+$//: # Убрать конечные пропуски
next unless length; # Что-нибудь осталось?
my ($var, $value) = split(/\s*=\s*/, $_, 2);
$User_Preferences{$var} = $value;
} Существует другой более изящный вариант - интерпретировать конфигурационный файл как полноценный код Perl:
do "$ENV{HOME}/.progrc";
Комментарий
В первом решении конфигурационный файл интерпретируется в тривиальном формате следующего вида (допускаются комментарии и пустые строки):
# Сеть класса С NETMASK = 255.255.255.0 MTU = 296
DEVICE = cua1 RATE = 115200 MODE = adaptive
После этого можно легко получить значение нужных параметров - например, $User_Preferences{"RATE"} дает значение 115200. Если вы хотите, чтобы конфигурационный файл непосредственно устанавливал значения переменных в программе вместо заполнения хэша, включи
no strict 'rets';
$$var = $value;
и переменная $RATE будет содержать значение 115200.
Во втором решении do организует непосредственное выполнение кода Perl, Если вместо блока используется выражение, do интерпретирует его как имя фай" ла. Это практически идентично применению require, но без риска фатальных
исключений. В формате второго решения конфигурационный файл принимает следующий вид:
# Сеть класса С $NETMASK = -255.255.255.О':
$MTU = 0х128;
$DEVICE = ocua1';
$RATE = 115_200;
$MODE = 'adaptive'; Если вам непонятно, зачем включать в файл лишние знаки препинания, задумайтесь - в вашем распоряжении оказывается весь синтаксис Perl. Теперь простые присваивания можно дополнить логикой и проверкой условий:
if ($DEVICE =~ /1$/) {
$RATE = 28_800;
} else {
$RATE = 115_200;
}
Во многих программах предусмотрены системные и личные конфигурационные файлы. Если вы хотите, чтобы предпочтения пользователя отменяли действия системных параметров, загрузите личный файл после системного:
SAPPDFLT = "/usr/local/share/myprog";
do "$APPDFLT/sysconfig.pl";
do "$ENV{HOME}/.myprogrc";
Если при существующем личном файле системный файл должен игнорироваться, проверьте возвращаемое значение do:
do "$APPDFLT/sysconfig.pl"
or do "$ENV{HOME}/.myprogrc"; Возможно, вас интересует, в каком контексте должны выполняться эти файлы. Они будут принадлежать пакету, в котором была откомпилирована команда do. Обычно пользователи устанавливают значения конкретных переменных, которые представляют собой неуточненн
{ package Settings; do "$ENV{HOME}/.myprogcc" } Файл, прочитанный с помощью do (а также require и use), представляет собой отдельную, самостоятельную область действия. Это означает как то, что конфигурационный файл не может обратиться к лексическим (mу) переменным вызывающей стороны, так и то, что
Если столь четкое разграничение видимости переменных нежелательно, вы можете заставить код конфигурационного файла выполняться в вашей лексической области действия. Имея под рукой программу cat или ее эквивалент, можно написать доморощенный аналог do:
eval 'cat $ENV{HOME}/.myprogrc'; Мы еще не видели, чтобы кто-нибудь (кроме Ларри) использовал такой подход в рабочем коде.
Во-первых, do проще вводится. Кроме того, do учитывает @INC, который обычно просматривается при отсутствии полностью указанного пути, но в отличие oт require в do не выполняется неявная проверка ошибок. Следовательно, вам не придется заворачивать do в eva
При желании можно организовать собственную проверку ошибок:
$file = "someprog.pi";
unless ($return = do $file) {
warn "couldn't parse $file: $@" if $@;
warn "couldn't do $file: $!" unless defined $return;
warn "couldn't run $file" unless $return;
} Программисту намного проще отследить это в исходном тексте, чем изобретать новый, сложный синтаксис. Проще будет и пользователю, которому не придется изучать правила синтаксиса очередного конфигурационного файла. Приятно и то, что пользователь получае
Однако не следует забывать о безопасности. Как убедиться в том, что файл не модифицировался никем, кроме пользователя? Традиционный подход - не делать ничего, полагаясь исключительно на права доступа каталогов и файлов. В девяти случаях из десяти такое ре
> Смотри также -------------------------------
Описание функций eval и require в perlfunc(1); рецепты 8.17; 10.12.
Требуется прочитать файл (например, содержащий данные о конфигурации). BL хотите использовать файл лишь в том случае, если правом записи в него (а возможно, даже правом чтения) не обладает никто, кроме его владельца.
Решение
Получите данные о владельце и правах доступа с помощью функции stat. Можи воспользоваться встроенной версией, которая возвращает список:
( $dev, $ino. $mode, $nlink, $uid, $gid, $rdev, $size, $atime, $mtime, $ctime, $blksize, $blocks )
= stat($filename) or die "no $filenanie: $!";
$mode &= 07777; # Отбросить информацию о типе файла Или воспользуйтесь # интерфейсом с именованными полями:
$info = stat($filename) or die "no $filename: $!":
if ($info->uid == 0) {
print "Superuser owns $filename\n";
} if ($info->atime > $info->mtime) {
print "$filename has been read since it was written.\n";
}
Комментарий
Обычно мы доверяем пользователям и позволяем им устанавливать права доступа по своему усмотрению. Если они захотят, чтобы другие могли читать или даже записывать данные в их личные файлы - это их дело. Однако многие приложения (редакторы, почтовые програм
Если файл может быть записан кем-то, кроме владельца, или принадлежит кому-то, отличному от текущего или привилегированного пользователя, он не признается достоверным. Информация о владельце и правах доступа может быть получена с помощью функции star. Сле
use File::stat;
sub is_safe {
my $path = shift;
my $info = stat($path);
return unless $info;
# Проверить владельца (привилегированный или текущий пользователь)
# Настоящий идентификатор пользователя хранится в переменной $<.
if (($info->uid != 0) && ($info->uid != $<)) { return 0;
}
# Проверить, может ли группа или остальные пользователи
# записывать в файл.
# Для проверки чтения/записи используйте константу 066
# ($info->mode & 022) { # Если другие имеют право записи
return 0 unless -d _; # He-каталоги недостоверны
# но каталоги с битом запрета (01000) - достоверны
return 0 unless $info->mode & 01000;
}
return 1;
}
Каталог считается достоверным даже в том случае, если другие имеют право записи в него - при условии, что для пего установлен бит 01000 (разрешающим удаление только владельцу каталога).
Осторожный программист также проследит, чтобы запись была запрещена и для всех каталогов верхнего уровня. Это связано с известной "проблемой chown", при которой любой пользователь может передать принадлежащий ему файл и сделать его владельцем кого-то друг
use Cwd;
use POSIX qw(sysconf _PC_CHOWN_RESTRICTED);
sub is_verysafe { my $path = shift;
return is_safe($path) if sysconf(_PC_CHOWN_RESTRICTED);
$path = getcwd() . o/o . $path if $path !~ m{^/};
do {
return unless is_safe($path);
$path =~ s#(["/]+|/)$##; # Имя каталога
$path =~ s#/$## if length($path) > 1; # Последний символ /
} while length $path:
return 1;
} В программе эта функция используется примерно так:
$file = ".$ENV{HOME}/.my.progrc";
readconfig($file) if is_safe($file); При этом возникает потенциальная опасность перехвата, поскольку предполагается, что файл открывается гипотетической функцией readconfig. Между получением сведений о файле (is_safe) и его открытием функцией readconfic теоретически может случиться что-н
$file = "$ENV{HOME}/.myprogrc";
if (open(FILE, oo< $file")) {
readconfig(*FILE) if is_safe(*FILE);
} Впрочем, вам также придется позаботиться о том, чтобы функция readconfig принимала файловый манипулятор вместо имени.
В начале и конце рабочего сеанса пользователя в системе UNIX в файл wtmp добавляется новая запись. Вам не удастся получить ее с помощью обычной программы tail, поскольку файл хранится в двоичном формате. Программа tailwtmp из примера 8.7 умеет работать с
Пример 8.7. tailwtmp
#!/usr/bin/perl
# tailwtmp - отслеживание начала/конца сеанса
# Использует структуру linux utmp, см. utmp(5)
$typedef = 's x2 i A12 A4 1 A8 A16 l;
$sizeof = length pack($typedef, () ):
use 10::File;
open(WTMP, '/var/log/wtmp') or die "can't open /var/log/wtmp: $!";
seek(WTMP, 0, SEEK_END);
for (;;) {'
while (read(WTMP, $buffer, $sizeof) == $sizeof) { ($type, $pid, $line, $id, $time, $user, $host, $addr) = unpack($typedef, $buffer);
next unless $user && ord($user) && $time;
printf "%1d %-8s %-12s %2s %-24s %-16s %5d %08x\n", $type,$user,$line,$id,scalar(localtime($time)), $host,$pid,$addr;
}
for ($size = -s WTMP; $size == -s WTMP; sleep 1) {}
WTMP->clearerr();
}
Во многих системах существует классическая программа tee для направления выходных данных в несколько приемников. Например, следующая команда передает выходные данные someprog в/tmp/output и через конвейер - в почтовую систему:
% someprog | tee /Imp/output | Mail -s 'check this' userohost.org
Программа tctee пригодится не только тем пользователям, которые работают вне UNIX и не имеют tee. Она обладает некоторыми возможностями, отсутствующими в стандартной версии tee.
При запуске программа может получать четыре флага:
-i -игнорировать прерывания,
-а - дописывать данные в конец выходных файлов,
-u - выполнять небуферизованный вывод,
-n - отменить копирование выходных данных в стандартный вывод.
Поскольку в программе используется "волшебная" функция open, вместо файлов можно передавать каналы:
% someprog ] tctee f1 "|cat -n" f2 ""f3"
В примере 8.8 приведена программа-ветеран, написанная на Perl почти 10 лет назад и работающая до сих пор. Если бы нам пришлось писать ее заново, вероятно, мы бы использовали strict, предупреждения и модули с десятками тысяч строк. Но как известно, "лучшее
Пример 8.8. tctee
#!/usr/bin/perl
# tctee - клон tee
# Программа совместима с perl версии 3 и выше.
while ($ARGV[0] =~ /"-(.+)/ && (shirt, ($_ = $1), 1)) { next if /"$/;
s/i// && (++$ignore_ints, redo);
s/a// && (++$append, redo);
s/u/7- && (++$unbuffer, redo):
s/n// && (++$nostdout, redo);
die "usage tee [-aiun] [filenames] ...\n";
}
if ($ignore_ints) {
for $sig CINT', 'TERM', 'HUP', 'QUIT') { $SIG{$sig} = 'IGNORE'; }
}
$SIG{'PIPE'} = 'PLUMBER';
$rnode = $append ? '>>' : '>';
$fh = 'FHOOO';
unless ($nostdout) {
%fh = ('STDOUT', 'standard output'); # Направить в STOOUT
}
$| = 1 if $unbuffer;
for (@ARGV) {
if (!open($fh, (/"[">]]/ && $mode) . $_)) {
warn "$0: cannot open $_: $!\n"; # Как в sun; я предпочитаю die
$status++;
next;
}
select((select($fh), $| =1)[0]) if $unbuffer;
$fh{$fh++} = $_;
}
while () {
for $fh (keys %fh) {
print $fh $_;
}
}
for $fh (keys %fh) {
next if close($fh) || !defined $fh{$fh};
warn "$0: couldnt close $fh{$fh}: $!\n";
$status++;
}
exit $status;
sub PLUMBER {
warn "$0: pipe to \"$fh{$fh}\" broke!\n' $status++;
delete $fh{$fh};
}
Во время регистрации в системе UNIX на экран выводятся сведения о времени последней регистрации. Эта информация хранится в двоичном файле с именем lastlog. Каждый пользователь имеет собственную запись в этом файле; данные пользователя с UID 8 хранятся в з
% laston gnat gnat UID 314 at Mon May 25 08:32:52 1998 on ttypO from below.perl.com
Программа из примера 8.9 была написана гораздо позже программы tctee из примера 8.8, однако она менее переносима, поскольку в ней используется двоичная структура файла lastlog системы UNIX. Для других систем ее необходимо изменить.
Пример 8.9. laston
#!/usr/bin/perl
# laston - определение времени последней регистрации пользователя
use User::pwent;
use IO::Seekable qw(SEEK_SET);
open (LASTLOG, "/var/log/lastlog") or die "can't open /usr/adm/lastlog: $!";
$typedef = 'L A12 A16'; # Формат linux; для SunOS - "L A8 A16' $sizeof = length(pack($typedef, ()));
for $user (@ARGV) {
$U = ($user =~ /"\d+$/) ? getpwuid($user) : getpwnam($user);
unless ($U) { warn "no such uid $user\n"; next; }
seek(LASTLOG, $U->uid * $sizeof, SEEK_SET) or die "seek failed: $!
read(LASTLOG, Sbuffer, $sizeof) == $sizeof or next;
($time, $line, $host) = unpack($typedef, $buffer);
printf "%-8s UID %5d %s%s%s\n", $U->name, $U->uid,
$time ? ("at " . localtime($time)) : "never logged in",
$line && " on $line",
$host && " from $host";
}
