Строки
..И открыл легкомысленно уста свои, и безрассудно расточает слова.
Книга Иова, 35:16
Введение
Многие языки программирования заставляют нас мыслить на неудобном низком уровне. Вам понадобилась строка, а язык хочет, чтобы вы работали с указателем или байтовым массивом. Впрочем, не отчаивайтесь — Perl не относится к языкам низкого уровня, и в нем удобно работать со строками.
Perl проектировался для обработки текста. В сущности, в Perl существует такое количество текстовых операций, что их невозможно описать в одной главе. Рецепты обработки текста встречаются и в других главах. В частности, обратитесь к главе 6 «Поиск по шаблону» и главе 8 «Содержимое файлов» — в них описаны интересные приемы, не рассмотренные в этой главе.
Фундаментальной единицей для работы с данными в Perl является скаляр (scalar), то есть отдельное значение, хранящееся в отдельной (скалярной) переменной. В скалярных переменных хранятся строки, числа и ссылки. Массивы и хэши представляют собой соответственно списки или ассоциативные массивы скаляров. Ссылки используются для косвенных обращений к другим величинам; они отчасти похожи на указатели в языках низкого уровня. Числа обычно хранятся в формате вещественных чисел с двойной точностью. Строки в Perl могут иметь произвольную длину (ограниченную только объемом виртуальной памяти вашего компьютера) и содержат произвольные данные — даже двоичные последовательности с нулевыми байтами.
Строка не является массивом байт; к отдельному символу нельзя обратиться по индексу, как к элементу массива — для этого следует воспользоваться функцией substr. Строки, как и все типы данных Perl, увеличиваются и уменьшаются в размерах по мере необходимости. Неиспользуемые строки уничтожаются системой сборки мусора Perl (обычно при выходе переменной, содержащей строку, за пределы области действия или после вычисления выражения, в которое входит стро-
ка). Иначе говоря, об управлении памятью можно не беспокоиться — об этом уже позаботились до вас.
Скалярная величина может быть определенной или неопределенной. Определенная величина может содержать строку, число или ссылку. Единственным неопределенным значением является undef, все остальные значения считаются определенными — даже 0 и пустая строка. Однако определенность не следует путать с логической истиной; чтобы проверить, определена ли некоторая величина, следует воспользоваться функций defined. Логическая истина имеет особое значение, которое проверяется логическими операторами && и | |, а также в условии блока while.
Две определенные строки считаются ложными: пустая строка ("") и строка единичной длины, содержащая цифру «ноль» (' 0"). Возможно, второе вас несколько удивит, но это связано с тем, что Perl выполняет преобразования между числами и строками по мере необходимости. Числа 0. 0.00 и 0.00000000 без кавычек считаются ложными значениями, но в строках они становятся истинными (так, строка 0 00 считается истинной, а не ложной). Все остальные определенные значения (например, ' false", 15 и \$х) истинны.
В строковом контексте значение undef интерпретируется как пустая строка ( '"). В числовом контексте undef интерпретируется как 0, а в ссылочном — как нуль-ссылка. При этом во всех случаях оно считается ложным. Использование неопределенной величины там, где Perl ожидает получить определенную, приводит к записи в STDERR предупреждения времени выполнения (если был использован флаг -w). Для простого вопроса о том, является ли нечто истинным или ложным, предупреждение не выдается. Некоторые операции не выдают предупреждений при использовании переменных, содержащих неопределенные значения. К их числу относятся операции автоматического увеличения и уменьшения, ++ и --, а также сложение и конкатенация с присваиванием, += и =.
В программах строки записываются в апострофах или кавычках, в форме q// или qq// или «встроенных документов» (here-documents). Апострофы используются в простейшей форме определения строк с минимальным количеством специальных символов: ' — завершает строку, \' — вставляет в нее апостроф, а \\ — обратную косую черту:
$string = '\п', й Два символа, \ и п
$string = 'Jon \'Maddog\ Orwant' # Внутренние апострофы
В строках, заключенных в кавычки, возможна интерполяция имен переменных (но не вызовов функций — о том, как это делается, см. рецепт 1.10). В них используется множество служебных символов: ' \п" — символ перевода строки, "\033" — символ с восьмеричным кодом 33, "\cJ" — Ctrl+J и т. д. Полный список приведен в странице руководства perlop(l).
$stnng = '\n', # Символ перевода строки
Sstring = 'Jon YMaddogV Orwant , 8 Внутренние кавычки
Операторы q// и qq// позволяют чередовать разделители строк с апострофами и кавычками. Например, строку с внутренними апострофами проще записать в следующем виде, вместо того чтобы использовать служебные символы \':
28 Глава 1 • Строки
Sstring = q/Jon 'Maddog' Orwant/; # Внутренние апострофыВ качестве разделителей могут использоваться одинаковые символы, как в этом примере, или парные (для различных типов скобок):
$stnng = q[Jon 'Maddog' Orwant]; it Внутренние апострофы
Sstring = q{Jon 'Maddog' Orwant}; # Внутренние апострофы
Sstring = q(Jon 'Maddog' Orwant); # Внутренние апострофы
Sstring = q<Jon 'Maddog' Orwant>; # Внутренние апострофы
Концепция «встроенных документов» позаимствована из командных интерпретаторов (shell) и позволяет определять строки, содержащие большое количество текста. Текст может интерпретироваться по правилам для строк, заключенных в апострофы или кавычки, и даже как перечень исполняемых команд — в зависимости от того, как задается завершающий идентификатор. Например, следующий встроенный документ будет интерпретироваться по правилам для строк, заключенных в кавычки:
$а = «"EOF";
This is a multiline here document
terminated by EOF on a line by itself
EOF
Обратите внимание: после завершающего EOF точка с запятой не ставится. Встроенные документы более подробно рассматриваются в рецепте 1.11.
Предупреждение для программистов из других стран: в настоящее время Perl не обладает прямой поддержкой многобайтовых кодировок (в версии 5.006 ожидается поддержка Unicode), поэтому в тексте книги понятия байт и символ считаются идентичными.
1.1. Работа с подстроками
Проблема
Требуется получить или модифицировать не целую строку, а лишь ее часть. Например, вы прочитали запись с фиксированной структурой и теперь хотите извлечь из нее отдельные поля.
Решение
Функция substr предназначена для чтения и записи отдельных байтов строки:
lvalue = substr($string, Soffset, 4count); Svalue = substr($stnng, Soffset);
substr($string, Soffset, Scount) = Snewstring;
substr($string, Soffset) = Snewtail;
Функция unpack ограничивается доступом только для чтения, но при извлечении нескольких подстрок работает быстрее:
# Получить 5-байтовую строку, пропустить 3,
# затем две 8-байтовые строки, затем все остальное
(Sleading, $s1, $s2, $trailing) =
unpack("A5 хЗ A8 A8 A*", $data);
# Деление на группы из пяти байт
@fivers = unpack("A5" x (length($stnng)/5), $string);
# Деление строки на отдельные символы
@chars = unpack("A1" x (length($string), $string);
Комментарий
В отличие от многих языков, в которых строки представлены в виде массива байтов (или символов), в Perl они относятся к базовым типам данных. Это означает, что для работы с отдельными символами или подстроками применяется функция unpack или substr.
Второй аргумент функции substr (смещение) определяет начало интересующей вас подстроки; положительные значения отсчитываются от начала строки, а отрицательные — с конца. Если смещение равно 0, подстрока начинается с начала. Третий аргумент определяет длину подстроки.
$stnng = "This is what you have";
U +012345678901234567890 Прямое индексирование (слева направо)
# 109876543210987654321- Обратное индексирование (слева направо)
0 соответствует 10, 20 и т. д
$first = substr($stnng, 0, 1); п "Т"
$start = substr($string, 5, 2); # "is"
$rest = substr($string. 13); n "you have"
$last = substr($string, -1); # "e"
$end = substr($string, -4); # "have"
$piece = substr($stnng, -8, 3), # "you"
Однако функция substr позволяет не только просматривать части строки, но и изменять их. Дело в том, что substr относится к экзотической категории левосторонних функций, то есть таких, которым при вызове можно присвоить значение. К тому же семейству относятся функции vec, pos и keys (начиная с версии 5.004). При некоторой фантазии функции local и ту также можно рассматривать как левосторонние.
Sstring = "This is what you have";
print Sstring;
This is what you have
substr($stnng, 5, 2) = "wasn't"; # заменить "is" на "wasn't"
This wasn't what you have
substr($string, -12) = "ondrous"; # "This wasn't wondrous"
This wasn't wondrous
substr($string, 0, 1) = ""; # Удалить первый символ
his wasn't wondrous
30 Глава 1 • Строки
substr($string, -10) = ' , # Удалить последние 10 символовhis wasn'
Применяя оператор =" в сочетании с операторами s///, m// или tr///, можно заставить их работать только с определенной частью строки:
# =~ применяется для поиска по шаблону if (substr($stnng, -10) =" /pattern/) {
print Pattern matches in last 10 characters'^ ',
# подставить "at" вместо 'is', ограничиваясь первыми пятью символами
substr($string, 0, 5) =" s/is/at/g,
Более того, подстроки даже можно поменять местами, используя с каждой стороны присваивания несколько вызовов substr:
# Поменять местами первый и последний символ строки
$а = make a hat ,
(substr($a,0,1), substr($a,-1)) = (substr($a.-1), substr($a,0,1)); print $a, take a ham
Хотя функция unpack не является левосторонней, она работает значительно быстрее substr, особенно при одновременном извлечении нескольких величин. В отличие от substr она не поддерживает непосредственные смещения. Вместо этого символ х нижнего регистра с числом пропускает заданное количество байт в прямом направлении, а символ ' X ' верхнего регистра — в обратном направлении.
# Извлечение подстроки функцией unpack
$а = ' То be or not to be ,
$b = unpack( хб А6 , $a), tt Пропустить 6 символов, прочитать 6 символов print $b; or not
($b, $c) = unpack( хб A2 X5 A2', $a), # Вперед 6, прочитать 2,
# назад 5, прочитать 2 print '$b\n$c\n"; or be
Иногда строка «режется» на части в определенных позициях. Предположим, вам захотелось установить позиции разреза перед символами 8, 14, 20, 26 и 30 — в каждом из перечисленных столбцов начинается новое поле. В принципе можно вычислить форматную строку unpack - 'А7 А6 А6 А4 А*", но программист на Perl по природе ленив и не желает попусту напрягаться. Пусть за него работает Per]. Воспользуйтесь приведенной ниже функцией cut2fmt.
sub cut2fmt {
my((s>positions) = @>_, my $template = my $lastpos = 1, foreach $place(positions) {
Stemplate = A ($place - $lastpos) ";
Slastpos = $place;
}
Stemplate = "A*';
return $template; }
$fmt = cut2fmt(8, 14, 20, 26, 30); print "$fmt\n", A7 A6 A6 A6 A4 A*
Возможности функции unpack выходят далеко за пределы обычной обработки текста. Она также обеспечивает преобразование между текстовыми и двоичными данными.
> Смотри также---------------------------------------------------------------------------------------------
Описание функций unpack и substг в perlfunc(l); подпрограмма cut2fmt из рецепта 1.18. Применение unpack для двоичных данных демонстрируется в рецепте 8.18.
1.2. Выбор значения по умолчанию
Проблема
Требуется закрепить за скалярной переменной значение по умолчанию, но лишь в том случае, если оно не было задано ранее. Довольно часто требуется, чтобы стандартное значение переменной жестко кодировалось в программе, по его можно было переопределить из командной строки или переменной окружения.
Решение
Воспользуйтесь оператором | | или | | =, работающим как со строками, так и с числами:
U Использовать $Ь, если значение $Ь истинно, и $с в противном случае $а = $Ь || $с,
и Присвоить $х значение $у, но лишь в том случае, U если $х не является истинной $х ||= $у,
Если ваша переменная может принимать значения 0 или "0", воспользуйтесь функцией defined:
# Использовать $Ь, если значение $Ь определено, и $с в противном случае $а = defmed($b) ? $b $c,
Комментарий
Главное отличие между этими двумя приемами (defined и | |) состоит, прежде всего, в том, что именно проверяется — определенность или истинность. В мире Perl три определенных значения являются ложными: 0, "0" и "". Если ваша переменная содержит одну из этих величин, но вы не хотите изменять ее, 11 не подой-
дет — приходится выполнять неуклюжие проверки с defined. Часто бывает удоб но организовать программу так, чтобы принималась в расчет истинность или ложность переменных, а не их определенность.
В отличие от других языков, где возвращаемые значения ограничиваются О и 1, оператор | | Perl обладает более интересным свойством: он возвращает первый (левый) операнд, если тот имеет истинное значение; в противном случае возвращается второй операнд. Оператор && ведет себя аналогично (для второго выражения), но этот факт используется реже. Для операторов несущественно, что представляют собой их операнды — строки, числа или ссылки; подойдет любое скалярное значение. Они просто возвращают первый операнд, из-за которого все выражение становится истинным или ложным. Возможно, это расходится с возвращаемым значением в смысле булевой алгебры, но такими операторами удобнее пользоваться.
Это позволяет установить значение по умолчанию для переменной, функции или более длинного выражения в том случае, если первый операнд не подходит. Ниже приведен пример использования 11, в котором $foo присваивается либо $bar, либо, если значение $Ьаг ложно, — строка "DEFAULT VALUE":
$foo = $bar || DEFAULT VALUE'
В другом примере переменной $di г присваивается либо первый аргумент командной строки программы, либо ' /tmp", если аргумент не указан:
$dir = shift(@ARGV) ||
To же самое можно сделать и без изменения @ARGV:
$dir = $ARGV[O] || Vtmp"
Если 0 является допустимым значением $ARGV[O], использовать 11 нельзя, потому что вполне нормальное значение будет интерпретировано как ложное. Приходится обращаться к тернарному оператору выбора:
$dir = defmed($ARGV[O]) ? shift(@ARGV) Vtmp ,
To же можно записать и иначе, со слегка измененной семантикой:
$dir = (3ARGV ? $ARGV[O] /tmp"
Мы проверяем количество элементов в @ARGV. В условии оператора выбора (9 ¦) @ARGV интерпретируется в скалярном контексте. Значение будет ложным лишь при нулевом количестве элементов, в этом случае будет использоваться "/tmp". Во всех остальных ситуациях переменной (когда пользователь вводит аргумент) будет присвоен первый аргумент командной строки.
Следующая строка увеличивает значение %count, при этом в качестве ключа используется значение $shell, а если оно ложно — строка "/bin/sh".
$count{ $shell || "/bin/sh' }++,
В одном условии можно объединить несколько альтернативных вариантов, как показывает следующий пример. Результат совпадает с первым операндом, имеющим истинное значение.
й Определить имя пользователя в системе UNIX $user = $ENV{USER}
11 getloginO
|| (getwuid($<))[0]
|| "Unknown uid number $<";
Оператор && работает аналогично; он возвращает первый операнд, если этот операнд ложен. В противном случае возвращается второй операнд. Поскольку ложные значения представляют интерес существенно реже, чем истинные, это свойство используется не так часто. Одно из возможных применений продемонстрировано в рецепте 8.13.
Оператор присваивания 11 = выглядит странно, но работает точно так же, как и остальные операторы присваивания. Практически для всех бинарных операторов Perl $VAR 0P= VALUE означает $VAR = $VAR OP VALUE; например, $а += $b —тоже, что и $а = $a + $b. Следовательно, оператор | |= может использоваться для присваивания альтернативного значения переменной. Поскольку 11 выполняет простую логическую проверку (истина или ложь), у него не бывает проблем с неопределенными значениями, даже при использовании ключа -w.
В следующем примере | |= присваивает переменной $starting_pomt значение "Greenwich", если оно не было задано ранее. Предполагается, что $starting_point не принимает значений 0 или "О", а если принимает — то такие значения должны быть заменены:
$startmg_point ||= 'Greenwich'
В операторах присваивания 11 нельзя заменять оператором о г, поскольку о г имеет слишком низкий приоритет. Выражение $а = $b or $с эквивалентно ($а = $b) or $c. В этом случае переменной $Ь всегда присваивается $а, а это совсем не то, чего вы добивались.
Не пытайтесь распространить это любопытное применение 11 и 11 = со скалярных величин на массивы и хэши. У вас ничего не выйдет, потому что левый операнд интерпретируется в скалярном контексте. Приходится делать что-нибудь подобное:
@а = @b unless @а; # Копировать, если массив пуст
@а = @Ь ? @Ь : @с; # Присвоить @Ь, если он не пуст, иначе @с
> Смотри также---------------------------------------------------------------------------------------------
Описание оператора | | врег1ор(1); описание функций defined и exists вреИ-func{\).
1.3. Перестановка значений
без использования временных переменных
Проблема
Требуется поменять значения двух скалярных переменных, но вы не хотите использовать временную переменную.
34 Глава 1 • Строки
РешениеВоспользуйтесь присваиванием по списку:
($VAR1, $VAR2) = ($VAR2, $VAR1),
Комментарий
В большинстве языков программирования перестановка значений двух переменных требует промежуточного присваивания:
$terap = $a, $а = $Ь, $b = Sterap
В Perl дело обстоит иначе Язык следит за обеими сторонами присваивания и за тем, чтобы ни одно значение не было случайно стерто. Это позволяет избавиться от временных переменных:
$а = alpha
$b = omega ,
($а $b) = ($Ь $а), # Первый становится последним - и наоборот
Подобным способом можно поменять местами сразу несколько переменных:
($alpha $beta, $production) = qw(January March August)
# beta перемещается в alpha,
# production - в beta
# alpha - в production
($alpha, $beta, $production) = ($beta, Sproduction, $alpha),
После завершения этого фрагмента значения переменных $alpha, $beta и
$production будут равны соответственно March , August и January .
> Смотри также---------------------------------------------------------------------------------------------
Раздел «List value constructors» perlop(i).
1.4. Преобразование между символами и ASCII-кодами
Проблема
Требуется вывести код, соответствующий некоторому символу в кодировке ASCII, или наоборот — символ по ASCII-коду.
Решение
Воспользуйтесь функцией о rd для преобразования символа в число или функцией ch r — для преобразования числа в символ:
$num = ord($char), $char = chr($num),
Формат %с в функциях printf и spnntf также преобразует число в символ-
$char = sprintf( %c , $num), # Медленнее чем chr($num)
printf( Number %d is character %c\n , $num, $num) Number 101 is character e
Шаблон С*, используемый в функциях pack и unpack, позволяет быстро преобразовать несколько символов:
@ASCII = unpack( С* $stnng) ©STRING = pack( C* $ascn),
Комментарий
В отличие от низкоуровневых, нетипизованных языков вроде ассемблера, Perl не считает эквивалентными символы и числа; эквивалентными считаются строки и числа. Это означает, что вы не можете произвольно присвоить вместо символа его числовое представление, или наоборот. Для преобразования между символами и их числовыми значениями в Perl существуют функции chr и ord, взятые из Pascal:
$ascu_value = ord( e ) ft Теперь 101 Icharacter = chг(101), ft Теперь е
Символ в действительности представляется строкой единичной длины, поэтому его можно просто вывести функцией print или с помощью формата %s функций printf и spnntf Формат %с заставляет printf или spnntf преобразовать число в символ, однако он не позволяет вывести символ, который уже хранится в символьном формате (то есть в виде строки).
printf( Number %d is character %c\n 101 101),
Функции pack, unpack, chr и ord работают быстрее, чем spnntf. Приведем пример практического применения pack и unpack.
@ascn_character_numbers = unpack( С* , sample ), print (eiascii_character_numbers\n , 115 97 109 112 108 101
$word = pack( C» ascn_character_nurabers),
Sword = pack( C* 115, 97, 109, 112, 108 101), # To же самое
print $word\n
sample
А вот как превратить HAL в IBM:
$hal = HAL ,
@ascn = unpack( C* , $hal),
foreach $val (@ascii) {
$val++, # Увеличивает каждый ASCII-код на 1
}
$ibm = pack( С*). @ascii), print $ibm\n # Выводит IBM
О Смотри также--------------------------------------------------------------------------------------------
Описание функций chr, ord, printf, sprintf, pack и unpack ърег1/ипс(\).
1.5. Посимвольная обработка строк
Проблема
Требуется последовательно обрабатывать строку по одному символу.
Решение
Воспользуйтесь функцией split с пустым шаблоном, чтобы разбить строку на отдельные символы, или функцией unpack, если вам нужны лишь их ASCII-коды:
@>array = split(//, $string);
@array = unpack("O", Sstring);
Или последовательно выделяйте очередной символ в цикле:
while (/(.)/g) { # . здесь не интерпретируется как новая строка
# Сделать что-то полезное с $1 }
Комментарий
Как говорилось выше, фундаментальной единицей текста в Perl является строка, а не символ. Необходимость посимвольной обработки строк возникает достаточно редко. Обычно такие задачи легче решаются с помощью высокоуровневых операций Perl (например, поиска по шаблону). Пример приведен в рецепте 7.7, где для поиска аргументов командной строки используются подстановки.
Если вызвать split с шаблоном, который совпадает с пустой строкой, функция возвращает список отдельных символов строки. При намеренном использовании эта особенность оказывается удобной, однако с ней можно столкнуться и случайно. Например, /X*/ совпадает с пустой строкой. Не исключено, что вам встретятся и другие ненамеренные совпадения.
Ниже приведен пример, который выводит символы строки "an apple a day", отсортированные в восходящем порядке ASCII-кодов:
%seen =();
$string = "an apple a day";
foreach $byte (split //, Sstring) {
$seen($1)++; }
print "unique chars are: ", sort(keys %seen), "\n"; unique chars are: adelnpy
Решения с функциями split и unpack предоставляют массив символов, с которым можно работать. Если массив не нужен, воспользуйтесь поиском по шаблону в цикле while с флагом /д, который будет извлекать по одному символу:
%seen =();
$string = "an apple a day";
while ($string =~ /(.)/g) {
$seen($1)++; }
print "unique chars are: ", sort(keys %seen), "\n"; unique chars are: adelnpy
Как правило, посимвольная обработка строк не является оптимальным решением. Вместо использования index/substr или split/unpack проще воспользоваться шаблоном. В следующем примере 32-разрядная контрольная сумма вычисляется вручную, но лучше поручить работу функции unpack — она сделает то же самое намного эффективнее.
Следующий пример вычисляет контрольную сумму символов $st ring в цикле f о reach. Приведенный алгоритм не оптимален; просто мы используем традиционную и относительно легко вычисляемую сумму. За более достойной реализацией контрольной суммы обращайтесь к модулю MD5 на CPAN.
$sum = 0;
foreach $ascval (unpack("O", $string)) {
$sum += $ascval; > print "sum is $sum\n";
# Для строки "an apple a day" выводится сумма 1248
Следующий вариант делает то же самое, но намного быстрее:
$sum = unpack("%32C", $string);
Это позволяет эмулировать программу вычисления контрольной суммы SysV:
#!/usr/bin/perl
# sum - Вычисление 16-разрядной контрольной суммы всех входных файлов
«checksum = 0;
while (о) { $checksum += unpack("%16O", $_) } Schecksum %= (2 •• 16) - 1; print "$checksum\n";
На практике пример использования выглядит так:
% perl sum /etc/termcap 1510
Если у вас установлена GNU-версия sum, для получения идентичного ответа для того же файла ее следует вызвать с параметром -sysv:
% sum -sysv /etc/termcap 1510 851 /etc/termcap
В примере 1.1 приведена еще одна крошечная программа, в которой также реализована посимвольная обработка входных данных. Идея заключается в том, что-
38 Глава 1 • Строки
бы вывод каждого символа сопровождался небольшой паузой — текст будет появляться перед аудиторией в замедленном темпе, и его будет удобнее читать.Пример 1.1. slowcat
#!/usr/bin/perl
# slowcat -замедленный вывод
# использование: slowcat [-DELAY] [files...],
« где DELAY - задержка
SDELAY = ($ARGV[O] =~ /"-([.\d]+)/) ? (shift, $1) : 1;
$| = 1; while (<>) {
for (split(//)) { print; select(undef,undef,undef, 0.005 ¦ $DELAY);
> Смотри также---------------------------------------------------------------------------------------------
Описание функций split и unpack в perlfunc(l); применение select для организации задержки объясняется в рецепте 3.10.
1.6. Обратная перестановка слов или символов
Проблема
Требуется изменить порядок символов или слов в строке на противоположный.
Решение
Для перестановки байтов воспользуйтесь функцией reverse в скалярном контексте:
Srevbytes = reverse($string);
Для перестановки слов воспользуйтесь reverse в списковом контексте с функциями split и join:
$revwords = join(" ", reverse split(" ", Sstring);
Комментарий
У функции reverse существуют два варианта применения. В скалярном контексте функция объединяет аргументы и возвращает полученную строку в обратном порядке. В списковом контексте функция возвращает аргументы в обратном порядке. При использовании reve rse для перестановки символов в неочевидной ситуации используйте функцию scalar для форсированного применения скалярного контекста.
1.6. Обратная перестановка слов или символов 39
Sgnirts = reverse($string); tt Перестановка символов $string Ssdrow = reverse(@words); tt Перестановка элементов @sdrow
Sconfused = reverse(@words); tt Перестановка букв в join("", ©words)
Приведем пример обратной перестановки слов в строке. Пробел (" ") в качестве шаблона split является особым случаем. Он заставляет split использовать в качестве разделителя смежные пропуски (whitespace) и отбрасывать начальные пустые поля (по аналогии с awk). Обычно split отбрасывает только конечные пустые поля.
П Обратная перестановка слов
$string = 'Yoda said, "can you see this?"';
@>allwords = split(" ", Sstring);
@revwords = join(" ", reverse @allwords);
print $revwords, "\n";
this?" see you "can said, Yoda
Временный массив @allwords можно убрать и сделать все в одной строке:
$revwords = ]oin(" ", reverse split(" ", $string);
Смежные пропуски в $string превращаются в один пробел в Srevwords. Что бы сохранить существующие пропуски, поступите так:
Srevwords = join("", reverse split (/(S+)/, $string));
С помощью функции reverse можно проверить, является ли слово палиндромом (то есть читается ли одинаково в обоих направлениях):
Sword = "reviver";
$is_palmdrome = (Sword eq reverse(Sword));
Программа для поиска длинных палиндромов в файле /usr/dict/words записывается в одну строку:
% perl -nle 'print if $_ eq reverse && length >5' /usr/dict/words deedeed
deified
denned
hallah
kakkak
murdrum
redder
repaper
retter
reviver
rotator
sooloos
tebbet
terret
tut-tut
Описание функций split, reverse и scalar в perlfunc(l); раздел «Switches» perlrun(l).
1.7. Расширение и сжатие символов табуляции
Проблема
Требуется преобразовать символы табуляции в строке в соответствующее количество пробелов, или наоборот. Преобразование пробелов в табуляцию сокращает объем файлов, имеющих много смежных пробелов. Преобразование символов табуляции в пробелы может понадобиться при выводе на устройства, которые не понимают символов табуляции или считают, что они находятся в других позициях.
Решение
Примените подстановку весьма странного вида:
while (Sstnng =" s/\t+/ x length($&) * 8 - length($ ) % 8)/e) { it Выполнять пустой цикл до тех пор, # пока выполняется условие подстановки
Также можно воспользоваться стандартным модулем Text::Tabs:
use Text Tabs,
@expanded_lmes = expand(@lines_with_tabs),
@>tabulated_lines = unexpand(<s>lines_without_tabs),
Комментарий
Если позиции табуляции следуют через каждые N символов (где N обычно равно 8), их несложно преобразовать в пробелы. В стандартном, «книжном» методе не используется модуль Text::Tabs, однако разобраться в нем непросто. Кроме того, в нем используется переменная $ , одно упоминание которой замедляет поиск по шаблону в программе. Причина объясняется в разделе «Специальные переменные» введения к главе 6.
while (о) {
1 while s/\t+/' ' х length($&) • 8 - length($ ) % 8)/e, print,
Вы смотрите на второй цикл while и не можете понять, почему его нельзя было включить в конструкцию s///g? Потому что вам приходится каждый раз заново пересчитывать длину от начала строки (хранящуюся в $'), а не от последнего совпадения.
Загадочная конструкция 1 while CONDITION эквивалентна while (CONDITION) {}, но более компактна. Она появилась в те дни, когда первая конструкция работала в Perl несравнимо быстрее второй. Хотя сейчас второй вариант почти не уступает по скорости, первый стал удобным и привычным.
Стандартный модуль Text::Tabs содержит функции преобразований в обоих направлениях, экспортирует переменную $tabstop, которая определяет число пробелов на символ табуляции. Кроме того, это не приводит к снижению быстродействия, потому что вместо $& и $ используются $1 и $2:
use Text Tabs,
Stabstop = 4,
while (<>) { print expand($_) }
Модуль Text::Tabs также может применяться для «сжатия» табуляции. В следующем примере используется стандартное значение $tabstop, равное 8:
use Text Tabs,
while (о) { print unexpand($_) }
> Смотри также---------------------------------------------------------------------------------------------
Страница руководства модуля Text::Tabs; описание оператора s/// Bperlre(l) и perlop(l).
1.8. Расширение переменных во входных данных
Проблема
Имеется строка, внутри которой присутствует ссылка на переменную: You owe $debt to me Требуется заменить имя переменной $debt в строке ее текущим значением.
Решение
Если все переменные являются глобальными, воспользуйтесь подстановкой с символическими ссылками:
$text =~s/\$(\w+)/${$1}/g,
Но если среди переменных могут встречаться лексические (ту) переменные, следует использовать /ее:
Stext =~ s/(\$\w+)/$1/gee,
Комментарий
Первый способ фактически сводится к следующему: мы ищем нечто похожее на имя переменной, а затем интерполируем ее значение посредством символического разыменования (dereferencing). Если $1 содержит строку somevar, то ${$1} будет равно содержимому Ssomevar. Такой вариант не будет работать при действую-
Приведем пример:
use vars qw($rows $cols);
no strict 'refs', # для приведенного ниже ${$1}
my $text;
($rows, $cols) = (24, 80);
$text = q(I am $ rows high and $cols long); # апострофы'
$text =- s/\$(\w+)/${$1}/g;
print $text,
1 am 24 high and 80 long
Возможно, вам уже приходилось видеть, как модификатор подстановки /е используется для вычисления заменяющего выражения, а не строки. Допустим, вам потребовалось удвоить каждое целое число в строке:
$text = ' I am 17 years old'; $text =- s/(\d+)/2 * $1/eg;
Перед запуском программы, встречая /е при подстановке, Perl компилирует код заменяющего выражения вместе с остальной программой, задолго до фактической подстановки. При выполнении подстановки $1 заменяется найденной строкой. В нашем примере будет вычислено следующее выражение:
2 * 17
Но если попытаться выполнить следующий фрагмент:
$text = 'I am $AGE years old'; # Обратите внимание на апострофы1
$text =~ s/(\$\w+)/$1/eg; # НЕВЕРНО
при условии, что $text содержит имя переменной $AGE, Per] послушно заменит $1 на $AGE и вычислит следующее выражение:
'$AGE
В результате мы возвращаемся к исходной строке. Чтобы получить значение переменной, необходимо снова вычислить результат. Для этого в строку добавляется еще один модификатор /е:
$text =~ s/(\$\w+)/$1/eeg; # Находит переменные глу()
Да, количество модификаторов /е может быть любым. Только первый модификатор компилируется вместе с программой и проверяется на правильность синтаксиса. В результате он работает аналогично конструкции eval {BLOCK}, хотя и не перехватывает исключений. Возможно, лучше провести аналогию с do {BLOCK}.
Остальные модификаторы /е ведут себя иначе и больше напоминают конструкцию eval "STRING". Они не компилируются до выполнения программы. Маленькое преимущество этой схемы заключается в том, что вам не придется вставлять в блок директиву no strict ' refs1. Есть и другое огромное преимущество: этот
механизм позволяет находить лексические переменные, созданные с помощью ту, — символическое разыменование на это не способно.
В следующем примере модификатор /х разрешает пропуски и комментарии в шаблоне подстановки, а модификатор /е вычисляет правостороннее выражение на программном уровне. Модификатор /е позволяет лучше управлять обработкой ошибок или других экстренных ситуаций:
# Расширить переменные в $text Если переменная не определена, й вставить сообщение об ошибке. $text =~ s{
\$ й Найти знак доллара
(\w+) и Найти "слово1 и сохранить его в $1
Н
no strict 'refs'; if (defined $$1) {
$$1; # Расширять только глобальные переменные
} else {
"[NO VARIABLE' \$$1]; й Сообщение об ошибке } }едх;
Обратите внимание на изменение синтаксиса $$1 в Perl 5.004; когда-то это выражение означало ${$}1, а теперь оно означает ${$1}. Для обеспечения обратной совместимости в строках оно сохраняет старый смысл (но выдает предупреждение с -w). Запись ${$1} используется в строках для того, чтобы предотвратить разыменование PID. Если значение $$ равно 23448, то $$1 в строке превращается в 234481, а не в значение переменной, имя которой хранится в $1.
> Смотри также---------------------------------------------------------------------------------------------
Описание оператора s/// в perlre(l) и perlop(l); описание функции eval в perlfunc(l). Аналогичное использование подстановок встречается в рецепте 20.9.
1.9. Преобразование регистра
Проблема
Строку с символами верхнего регистра необходимо преобразовать в нижний регистр, или наоборот.
Решение
Воспользуйтесь функциями 1с и ис со служебными командами \1_ и \U:
use locale; й Необходимо в 5.004 и выше
= uc($little); й "bo peep" -> "ВО PEEP" Slittle = lc($big); й "JOHN' -> "john"
Slittle = "\L$big"; # "JOHN" -> "john"
Для замены отдельного символа используйте функции lcfirst и ucfirst со служебными командами \1 и \и:
|
$big = ' |
¦\u$little"; |
# |
"bo" |
-> "Bo" |
|
$little |
= "\l$big"; |
# |
"BoPeep» |
-> "boPeep" |
Функции и служебные команды выглядят по-разному, но делают одно и то же. Допускается указание регистра как первого символа, так и целой строки. Вы даже можете форсировать применение верхнего регистра для первого символа и нижнего — для всех остальных.
Встречая директиву use locale, функции преобразования регистра Perl и механизм поиска по шаблону начинают «уважать» правила вашего национального языка. Благодаря ей становится возможным поиск символов с диакритическими элементами и т. д. Одна из распространенных ошибок — преобразование регистра с помощью t г///. Да, мы хорошо помним, что в одном из старых изданий этой книги рекомендовали использовать tr/A-Z/a-z/. В свое оправдание можем лишь сказать, что в то время другого способа не существовало. Такое решение работает не всегда, поскольку из него выпадают все символы с умляутами, седилями и прочими диакритическими элементами, встречающимися во многих языках. Команды преобразования регистра ис и \U понимают эти символы и обеспечивают их правильное преобразование (по крайней мере, если в программе присутствует директива use locale). Исключение составляет немецкий язык; символ Я в верхнем регистре выглядит как SS, но в Perl такое преобразование не поддерживается.
use locale;
$beast = "dromedary";
# Изменить регистр разных символов $beast-
Scapit = ucfirst($beast), # Dromedary
Scapit = "\u\L$beast"; # (то же)
Scapall = "uc($beast); # DROMEDARY
$capall = "\U$beast"; » (то же)
$caprest = lcfirst(uc($beast)); # dROMEOARY
$caprest = "\l\U$beast"; # (то же)
Как правило, служебные команды обеспечивают согласованное применение регистра в строке:
# Преобразовать первый символ каждого слова в верхний регистр,
# а остальные символы - в нижний
$text = "tHIS is a loNG UNE";
$text =~ s/(w+)/\u\L$1/g;
print $text;
This Is A Long Line
Ими также можно пользоваться для выполнения сравнений без учета регистра:
if (uc($a) eq uc($b)) {
print "a and b are the same\n', >
Программа randcap из примера 1.2 случайным образом преобразует в верхний регистр примерно 20 процентов вводимых символов. Пользуясь ей, можно свободно общаться с 14-летними WaREz dOODz.
Пример 1.2. randcap
ff1/usr/bin/perl -p
# randcap фильтр, который случайным образом
# преобразует к верхнему регистру 20% символов
# В версии 5.004 вызов srandQ необязателен
BEGIN {srand(time() " ($$ + ($$ « 15))) }
sub randcase { rand(100) < 20 ¦> '\u$_[0]" • M\l$_[0]" } s/(\w)/randcase($1)/ge;
% randcap < genesis | head -9 boOk 01 genesis
001:001 in the BEginning goD created the heaven and tHe earTH.
001:002 and the earth wAS without ForM, aNO void; AnO darkneSS was upon The Face of the dEEp. an the spirit of GOd movEd upOn tHe face of the Waters.
001:003 and god Said, let there be ligHt: and therE wAs LigHt.
Более изящное решение — воспользоваться предусмотренной в Perl возможностью применения поразрядных операторов для строк:
sub randcase {
rand(100) < 20 ? С\040' " $1) . $1 }
Этот фрагмент изменяет регистр примерно у 20 процентов символов. Однако для 8-разрядных кодировок он работает неверно. Аналогичная проблема существовала и в исходной программе randcase, однако она легко решалась применением директивы use locale.
Следующий пример поразрядных строковых операций быстро отсекает у всех символов строки старшие биты:
Sstring &= "\177" х length($string),
Впрочем, о человеке, ограничивающем строки 7-разрядными символами, будут говорить все окружающие — и не в самых лестных выражениях.
D> Смотри также------------------------------------------------------------------------------------------
Описание функций uc, lc, ucfirst и lcfirst в perlfunc(l); описание метасимволов \L, \U, \1 и \и в разделе «Quote and Quote-like Operators» perlop( 1).
Проблема
Требуется интерполировать вызов функции или выражение, содержащиеся в строке. По сравнению с интерполяцией простых скалярных переменных это позволит конструировать более сложные шаблоны.
Решение
Выражение можно разбить на отдельные фрагменты и произвести конкатенацию:
Sanswer = $var1 . func(). $var2; # Только для скалярных величин
Также можно воспользоваться неочевидными расширениями @{ [LIST EXPR]} mm${\(SCALAR EXPR)}:
Sanswer = "STRING @{[LIST EXPR]} MORE STRING" Sanswer = "STRING ${\(SCALAR EXPR)} MORE STRING",
Комментарий
В следующем фрагменте продемонстрированы оба варианта. В первой строке выполняется конкатенация, а во второй — фокус с расширением:
$phrase = "I have " . ($n + 1) "guanacos.", Sphrase = "I have ${\($n +1)} guanacos ",
В первом варианте строка-результат образуется посредством конкатенации более мелких строк; таким образом, мы добиваемся нужного результата без интерполяции. Функция print фактически выполняет конкатенацию для всего списка аргументов, и, если вы собираетесь вызвать print $phrase, можно было бы просто написать:
print "I have ", $n + 1 . "guanacos.\n",
Если интерполяция абсолютно неизбежна, придется воспользоваться вторым вариантом, изобилующим знаками препинания. Только символы @, $ и \ имеют особое значение в кавычках и обратных апострофах. Как и в случаях с т// и s///, синоним qx() не подчиняется правилам расширения для кавычек, если в качестве ограничителя использованы апострофы! $home = qx'echo home is $HOME'; возьмет переменную $НОМЕ из командного интерпретатора, а не из Perl! Итак, единственный способ добиться расширения произвольных выражений — расширить ${} или @{}, в чьих блоках присутствуют ссылки.
Однако вы можете сделать нечто большее, чем просто присвоить переменной значение, полученное в результате интерполяции. Так, в следующем примере мы конструируем строку с интерполированным выражением и передаем результат функции:
some_func("What you want is @{[ split /./, $rec ]} items");
Интерполяция может выполняться и во встроенных документах:
die "Couldn't send mail" unless send_mail(«"EOTEXT", Starget);
To: $naughty
From: Your bank
Cc: @{ get_manager_list($naughty) }
Date: @{[ do { my $now = 'date'; chomp $now; $now} ]} (today)
Dear Jnaughty,
Today, you bounced check number @{[ 500 + int rand(100) ]> to us. Your account is now closed.
Sincerely, the management EOTEXT
Расширение строк в обратных апострофах (' ') оказывается особенно творческой задачей, поскольку оно часто сопровождается появлением ложных символов перевода строки. Создавая блок в скобках за @ в разыменовании анонимного массива @{[]}, как это было сделано в последнем примере, вы можете создавать закрытые (private) переменные.
Все эти приемы работают, однако простое разделение задачи на несколько этапов или хранение всех данных во временных переменных почти всегда оказывается более понятным для читателя.
В версии 5.004 Perl в выражении ${\EXPR } значение EXPR ошибочно вычислялось в списковом, а не скалярном контексте. Ошибка была исправлена в версии 5.005.
> Смотри также---------------------------------------------------------------------------------------------
perlref(l).
1.11. Отступы во встроенных документах
Проблема
При использовании механизма создания длинных строк (встроенных документов) текст должен выравниваться вдоль левого поля; в программе это неудобно. Требуется снабдить отступами текст документа в программе, но исключить отступы из окончательного содержимого документа.
Решение
Воспользуйтесь оператором s/// для отсечения начальных пропусков:
# Все сразу
($var = <<HERE_TARGET) =" s/~\s+//gm; далее следует
48 Глава 1 • Строки
ваш текст HERE_TARGET# Или за два этапа $var = «HERE_TARGET;
далее следует
ваш текст HERE_TARGET $var =~ s/"\s+//gm;
Комментарий
Подстановка получается весьма прямолинейной. Она удаляет начальные пропуски из текста встроенного документа. Модификатор /гп позволяет символу " совпадать с началом каждой строки документа, а модификатор /д заставляет механизм поиска повторять подстановку с максимальной частотой (то есть для каждой строки встроенного документа).
(Sdefimtion = «'FINIS') ="s/~\s+//gm,
The five variations of caraelids
are the familiar camel, his frieds
the llama and the alpaca, and the
rather less well-known guanaco
and vicuca. FINIS
Учтите: во всех шаблонах этого рецепта используется модификатор \s, разрешающий совпадение с символами перевода строки. В результате из встроенного документа будут удалены все пустые строки. Если вы не хотите этого, замените в шаблонах \s на [~\S\n].
В подстановке используется то обстоятельство, что результат присваивания может использоваться в левой стороне =~. Появляется возможность сделать все в одной строке, но она работает лишь при присвоении переменной. При непосредственном использовании встроенный документ интерпретируется как неизменяемый объект, и вы не сможете модифицировать его. Более того, содержимое встроенного документа нельзя изменить без предварительного сохранения его в переменной.
Впрочем, для беспокойства нет причин. Существует простой обходной путь, особенно полезный при частом выполнении этой операции. Достаточно написать подпрограмму:
sub fix {
my Sstring = shift; $strmg =~ s/~\s+//gm; return Sstring;
print fix(«"END");
Наш документ END
1.11. Отступы во встроенных документах 49
# Если функция была объявлена заранее, скобки можно опустить: print fix « 'END";
Наш документ END
Как и во всех встроенных документах, маркер конца документа (END в нашем примере) должен быть выровнен по левому полю. Если вы хотите снабдить отступом и его, в документ придется добавить соответствующее количество пропусков:
(Squote = «' FINIS') ="s/"\s+//gm;
. we will have peace, when you and all you works have perished--and the works of your dark master to whom you would deliver us You are a liar, Saruman, and a corrupter of men's hearts. --Theoden in /usr/src/perl/taint.c
FINIS Squote =~ s/\s+--/\n--; # Перенести на отдельную строку
Если эта операция выполняется с документами, содержащими программный код для eval или просто выводимый текст, массовое удаление всех начальных пропусков нежелательно, поскольку оно уничтожит отступы в тексте. Конечно, это безразлично для eval, но не для читателей.
Мы подходим к следующему усовершенствованию — префиксам для строк, которые должны снабжаться отступами. Например, в следующем примере каждая строка начинается с @@@ и нужного отступа:
if ($REMEMBER_THE_MAIN) <
$perl_main_C = dequote«' MAIN_INTERPRETER_LOOP';
@@@ mt
@@@ runops() {
@@@ SAVEI32(runlevel);
@@@ runlevel++,
@@@ while ( op = (*op->op_ppaddr)() ) ;
@@@ TAINT.N0T;
@@@ return 0;
@@@ >
MAIN_INTERPRETER_LOOP # При желании добавьте дополнительный код }
При уничтожении отступов также возникают проблемы со стихами.
sub dequote;
$poem = dequote«EVER_ON_AND_ON;
Now far ahead the Road has gone, And I must follow, if I can, Pursuing it with eager feet,
Until it joins some larger way Where may paths and errands meet. And whither then9 I cannot say.
--Bilbo in /usr/src/perl/pp_ctl. с
print "Here's your poem:\n\n$poem\n ';
Результат будет выглядеть так:
Here's your poem:
Now far ahead the Road has gone,
And I must follow, if I can, Pursuing it with eager feet,
Until it joins some larger way Where may paths and errands meet.
And whither then? I cannot say.
--Bilbo in /usr/src/perl/pp_ctl.c
Приведенная ниже функция dequote справляется со всеми описанными проблемами. При вызове ей в качестве аргумента передается встроенный документ. Функция проверяет, начинается ли каждая строка с общей подстроки (префикса), и если это так — удаляет эту подстроку. В противном случае она берет начальный пропуск из первой строки и удаляет его из всех последующих строк.
sub dequote {
local $_ = shift;
my ($white, $leader); # пропуск и префикс, общие для всех строк
if (/"\s*C:(["\w\s]+)(\s*).An)('?-\s«\1\2''.An)+$/) < (Swhite, $leader) = ($2, quotemeta($1));
} else {
($white, $leader_ = (/"(\s+)/, '');
}
s/"\s*'?$leader(?:$white)V/gm,
return $_; }
Если при виде этого шаблона у вас стекленеют глаза, его всегда можно разбить на несколько строк и добавить комментарии с помощью модификатора /х:
if (m{
# начало Строки
\s * # 0 и более символов-пропусков
(?: # начало первой несохраненной группировки
( й начать сохранение $1
[~\w\s] # один байт - не пробел и не буквенный символ
+ # 1 или более
) # закончить сохранение $1
( \s* ) # занести 0 и более пропусков в буфер $2
. * \п # искать до конца первой строки
) # конец первой группировки
(?: # начало второй несохраненной группировки
\s • # 0 и более символов-пропусков
\1 # строка, предназначенная для $1
\2 ? # то, что будет в $2, но дополнительно
.* \п # искать до конца строки
) + # повторить идею с группами 1 и более раз
$ й до конца строки
}х
(Swhite, Sleader) = ($2, quotemeta($1));
} else {
($white, Sleader) = (/~(\s+)/, ");
}
s{
# начало каждой строки (из-за /m)
\s * # любое количество начальных пропусков
9 # с минимальным совпадением
$leader # сохраненный префикс
(7 # начать несохраненную группировку
$white # то же количество
) ? # если после префикса следует конец строки
}{}xgm;
Разве не стало понятнее? Пожалуй, нет. Нет смысла уснащать программу банальными комментариями, которые просто дублируют код. Возможно, перед вами один из таких случаев.
> Смотри также---------------------------------------------------------------------------------------------
Раздел «Scalar Value Constructors» perldata(l); описание оператора s/// в perlre( 1) и perlop( 1).
1.12. Переформатирование абзацев
Проблема
Длина текста не позволяет разместить его в одной строке. Требуется разделить его на несколько строк без переноса слов. Например, сценарий проверки стиля читает текстовый файл по одному абзацу и заменяет неудачные обороты хорошими. Замена оборота «применяет функциональные возможности» словом «использует» приводит к изменению количества символов, поэтому перед выводом абзаца его придется переформатировать.
Решение
Воспользуйтесь стандартным модулем Text::Wrap для расстановки разрывов строк в нужных местах:
use Text:.Wrap;
©OUTPUT = wrap($LEADTAB, $NEXTTAB, @PARA);
Комментарий
В модуле Text::Wrap присутствует функция wrap (см. пример 1.3), которая получает список строк и переформатирует их в абзац с длиной строки не более $Text. :Wrap: : columns символов. Мы присваиваем переменной $columns значение 20; это гарантирует, что ни одна строка не будет длиннее 20 символов. Перед
Пример 1.3. wrapdemo
#'/usr/bin/perl -w
# wrapdemo - демонстрация работы Text Wrap
@input = ( Folding and splicing is the work of an editor , not a mere collection of silicon , and , mobile electrons1 )
use Text Wrap qw($columns Swrap),
$columns = 20,
print 0123456789 x 2 \n ,
print wrap( , , @input) \n ,
Результат выглядит так:
01234567890123456789
Folding and splicing is the work of an editor, not a mere collection of silicon and mobile electrons'
В результате мы получаем один абзац, в которой каждая строка, кроме последней, завершается символом перевода строки:
й Объединение нескольких строк с переносом текста
use Text Wrap,
undef $/,
print wrap( , split(/\s*\n\s*/, <>),
Если на вашем компьютере установлен модуль Term::ReadKey с CPAN, вы можете воспользоваться им для определения размеров окна, чтобы длина строк соответствовала текущему размеру экрана. Если этого модуля нет, размер экрана иногда можно взять из $ENV{COLUMNS} или определить по выходным данным команды stty.
Следующая программа переформатирует и слишком короткие, и слишком длинные строки абзаца по аналогии с программой fmt. Для этого разделителем входных записей $/ назначается пустая строка (благодаря чему о читает целые абзацы), а разделителем выходных записей $\ — два перевода строки. Затем абзац преобразуется в одну длинную строку посредством замены всех символов перевода строки (вместе с окружающими пропусками) одиночными пробелами. Наконец, мы вызываем функцию wrap с пустыми отступами первой и всех последующих строк.
use Text Wrap qw(&wrap $columns),
use Term ReadKey qw(GetTerminalSize),
($columns) = GetTerminalSize(),
($/, $\) = ( , \n\n ), ft Читать по абзацам, выводить два перевода строки
while (о) { # Читать весь абзац
s/\s*\n\s*/ /g, # Заменить промежуточные переводы строк пробелами
print wrap( ', '', $_), # и отформатировать
> Смотри также---------------------------------------------------------------------------------------------
Описание функций split и join вperlfunc(l), страница руководства стандартного модуля Text::Wrap. Применение модуля Term::ReadKey с CPAN продемонстрировано в рецепте 15.6.
1.13. Служебные преобразования символов
Проблема
Некоторые символы выводимой строки (апострофы, запятые и т. д.) требуется преобразовать к специальному виду. Предположим, вы конструируете форматную строку для sprintf и хотите преобразовать символы % в %%.
Решение
Воспользуйтесь подстановкой, которая снабжает префиксом \ или удваивает каждый преобразуемый символ:
# Обратная косая черта
$var =" s/([CHARLIST])/\\$1/g,
# Удвоение
$var =" s/([CHARLIST])/$1$1/g,
Комментарий
В приведенных выше решениях $var — модифицируемая переменная, a CHARLIST — список преобразуемых символов, который может включать служебные комбинации типа \t или \п. Если преобразуется всего один символ, можно обойтись без скобок:
$stnng ="
Преобразования, выполняемые в следующем примере, позволяют подготовить строку для передачи командному интерпретатору. На практике преобразование символов и " еще не сделает произвольную строку полностью безопасной для командного интерпретатора. Правильно собрать весь список символов так сложно, а риск так велик, что для запуска программ лучше воспользоваться списковыми формами system и exec (см. рецепт 16.11) — в этом случае вы вообще избегаете взаимодействия с интерпретатором.
Две обратные косые черты в секции заменителя были использованы потому, что эта секция интерпретируется по правилам для строк в кавычках. Следовательно, чтобы получить одну обратную косую черту, приходится писать две. Приведем аналогичный пример для VMS DCL, где дублируются все апострофы и кавычки:
$stnng = q(Mom said, "Don't do that."), Istring =" s/(["'])/$1$1/g;
С командными интерпретаторами Microsoft дело обстоит еще сложнее. В DOS и Windows COMMAND. COM работает с кавычками, но не с апострофами; не имеет представления о том, как поступать с обратными апострофами, а для превращения кавычек в литерал используется обратная косая черта. Почти все бесплатные или коммерческие Unix-подобные интерпретаторы для Windows пытаются исправить эту удручающую ситуацию.
Кроме того, можно определить интервал с помощью символа -, а затем инвертировать его с помощью символа ". Следующая команда преобразует все символы, не входящие в интервал от А до Z:
Sstring =" s/([-A-Z])/\\$1/g,
Для преобразования всех неалфавитных символов следует воспользоваться метасимволами \Q и \Е или функцией quotemeta. Например, следующие команды эквивалентны:
$stnng = "this \Qis a test1 \E"; $string = "this is\\ a\\ test1"; $string = "this " . quotemeta("is a test!'),
> Смотри также---------------------------------------------------------------------------------------------
Описание оператора s/// в perlre(l) и perlop(l); описание функции quotemeta рассматривается вperlfunc(l). В рецепте 19.1 рассматривается преобразование служебных символов в HTML, а в рецепте 19.6 — о том, как обойтись без передачи интерпретатору строк со служебными символами.
1.14. Удаление пропусков в обоих концах строки
Проблема
В полученную строку могут входить начальные или конечные пропуски. Требуется удалить их.
Решение
Воспользуйтесь парой подстановок:
$stnng =~ s/"\s+//; Sstring =" s/\s+$//;
Также можно написать специальную функцию, которая возвращает нужное значение:
$stnng = trim( $stnng); @many = trim(@many);
sub trim {
my @out = @_, for (@out) {
s/-\s+//;
s/\s+$//; } return wantarray ' @out $out[0];
Комментарий
У этой проблемы имеются различные решения, однако в большинстве случаев приведенный вариант является наиболее эффективным.
Для удаления последнего символа из строки воспользуйтесь функцией chop. В версии 5 была добавлена функция chomp, которая удаляет последний символ в том и только в том случае, если он содержится в переменной $/ (по умолчанию — "\п"). Чаще всего она применяется для удаления завершающего символа перевода строки из введенного текста:
# Вывести полученный текст заключенным в >< while(<STDIN>) {
chomp;
print ">$_<\n",
> Смотри также---------------------------------------------------------------------------------------------
Описание оператора s/// врег1ге(1) иperlop(l); описание функций chop и chomp вperlfunc(i). Начальные пропуски удаляются в функции getnum из рецепта 2.1 и при разделении элементов списка в рецепте 4.1.
1.15. Анализ данных, разделенных запятыми
Проблема
Имеется файл данных, поля которого разделены запятыми. Однако в полях могут присутствовать свои запятые (находящиеся внутри строк или снабженные служебными префиксами). Многие электронные таблицы и программы для работы с
Решение
Воспользуйтесь следующей процедурой:
sub parse_csv {
my $text = shift; # Запись со значениями, разделенными запятыми
my @new = ();
push(@new, $+) while $text =~ m{
# Первая часть группирует фразу в кавычках
I , }gx;
push(@new, undef) if substr($text, -1,1) eq ','; return @new, # Список значений, которые разделялись запятыми }
Также можно воспользоваться стандартным модулем Text: Parse Words:
use Text:.ParseWords,
sub parse_csv {
return quoteword( ',' ,0, $_[0], }
Комментарий
Ввод данных, разделенных запятыми, — коварная и непростая задача. Все выглядит просто, но в действительности приходится использовать довольно сложную систему служебных символов, поскольку сами поля могут содержать внутренние запятые. В результате подстановка получается весьма сложной, а простая функция split /, / вообще исключается.
К счастью, модуль Text::ParseWords скрывает от вас все сложности. Передайте функции qoutewords два аргумента и строку разделенных данных. Первый аргумент определяет символ-разделитель (в данном случае — запятая), а второй — логический флаг, который показывает, должна ли возвращаемая строка содержать внутренние кавычки.
Если кавычки должны присутствовать внутри поля, также ограниченного кавычками, воспользуйтесь префиксом \: "like \"this\". Кавычки, апострофы и обратная косая черта — единственные символы, для которых этот префикс имеет специальное значение. Все остальные экземпляры \ остаются в итоговой строке.
Ниже показан пример использования процедуры parse_csv. q<> — всего лишь хитроумный заменитель кавычек, благодаря которому нам не придется расставлять повсюду символы \.
$line = q<XYZZY, ""/O'Reilly, Inc'/'Wall, LarryVa \"glug\" bit,", 5,
"Error, Core Dumped">, ©fields = parse_csv($line), for ($1 = 0,$i < ©fields; $i++)
print "$i . $fields[$i]\n";
XYZZY
O'Reilly, Inc
Wall, Larry
a \"glug\" bit,
5
Error, Core Dumped
> Смотри также---------------------------------------------------------------------------------------------
Описание синтаксиса регулярных выражений в perlre{\); документация по стандартному модулю Text::ParseWords.
1.16. Сравнение слов с похожим звучанием
Проблема
Имеются две английские фамилии. Требуется узнать, звучат ли они похожим образом (независимо от написания). Это позволит выполнять неформальный поиск в телефонной книге, в результатах которого наряду со Smith будут присутствовать и другие похожие имена — например, Smythe, Smite и Smote.
Решение
Воспользуйтесь стандартным модулем Text::Soundex:
use Text .Soundex;
$CODE = soundex($STRING); ©CODES = soundex(iaLIST);
Комментарий
Алгоритм soundex хэширует слова (особенно английские фамилии) в небольшом пространстве с использованием простой модели, имитирующей произношение по правилам английского языка. Грубо говоря, каждое слово сокращается до че-тырехсимвольной строки. Первый символ является буквой верхнего регистра, а прочие — цифры. Сравнивая значения для двух строк, можно определить, звучат ли они похожим образом.
Следующая программа предлагает ввести имя и ищет в файле паролей имена с похожим звучанием. Аналогичный подход может использоваться для баз данных имен, поэтому при желании можно индексировать базу данных по ключам soundex. Конечно, такой индекс не будет уникальным.
print "Lookup user: "; chomp($user = <ST0IN>); exit unless defined $user; $name_code = soundex($user);
while($uent = getpwentO) {
(Sfirstname, $lastname) = $uent->gecos =" /(w+)[~,]*\b(\w+)/;
if ($name_code eq soundex($uent->name) ||
$name_code eq soundex($$lastname) 11
$name_code eq soundex($firstname) )
{
printf "%s: %s %s\n", $uent->name, Sfirstname, $lastname;
t> Смотри также--------------------------------------------------------------------------------------------
Документация по стандартным модулям Text::Soundex и User::pwent; man-страница passwd(5) вашей системы; «Искусство программирования», том 3, глава 6.
1.17. Программа: fixstyle
Представьте себе таблицу с парами устаревших и новых слов. Старые слова Новые слова
|
bonnet |
hood |
|
rubber |
eraser |
|
lorrie |
truck |
|
trousers |
pants |
При вызове без файловых аргументов программа выполняет функции простого фильтра. Если в командной строке передаются имена файлов, то в них помещаются результаты, а прежние версии сохраняются в файлах с расширениями *.orig (см. рецепт 7.9). При наличии параметра командной строки -v сообщения обо всех изменениях записываются в STDERR.
Таблица пар «исходное слово/заменитель» хранится в основной программе, на
чиная с_ END (см. рецепт 7.6). Каждая пара преобразуется в подстановку и на
капливается в переменной $code так же, как это делается в программе popgrep2 из
рецепта 6.10.
Параметр -t выводит сообщение об ожидании ввода с клавиатуры при отсутствии других аргументов. Если пользователь забыл ввести имя файла, он сразу поймет, чего ожидает программа.
Пример 1.4. fixstyle
#!/usr/bin/perl -w
# fixstyle - замена строк секции <DATA> парными строками
# использование: $0 [-v] [файлы...]
use strict;
my Sverbose = (@ARGV && $ARGV[O] eq '-v' && shift);
if (@ARGV) {
$"I = ".orig"; # Сохранить старые файлы } else {
warn "$0: Reading from stdin\n" if -t STDIN;
my $code = "while (<>) {\n";
# Читать данные и строить код для eval
while (<OATA>) {
chomp;
my ($in, $out) = split /\s*=>\s*/;
next unless $in && $out;
$code .= "s{\\Q$in\\E}{$out}g";
$code .= "&& printf STDERR qq($in => $out at \$ARGV line \$.\\n)M
if $verbose;
$code .= ";\n";
|
$code .= "printf; |
\n}\n"; |
|
|
eval "{ code } |
1" |
II die; |
|
__END__ |
||
|
analysed |
=> |
analyzed |
|
built-in |
=> |
builtin |
|
chastized |
=> |
chastised |
|
commandline |
=> |
command-line |
|
de-allocate |
=> |
deallocate |
|
dropin |
=> |
drop-in |
|
hardcode |
=> |
hard-code |
|
meta-data |
=> |
metadata |
|
multicharacter |
=> |
multi-charac |
|
multiway |
=> |
multi-way |
|
non-empty |
=> |
nonempty |
|
non-profit |
=> |
nonprofit |
|
non-trappable |
=> |
nontrappable |
|
pre-define |
=> |
predefine |
|
preextend |
=> |
pre-extend |
|
re-compiling |
=> |
recompiling |
|
reenter |
=> |
re-enter |
|
turnkey |
=> |
turn-key |
В примере 1.5 приведена следующая версия программы. При малом количестве замен она работает медленнее, а при большом — быстрее.
Пример 1.5. fixstyle2
#'/usr/bin/perl -w
0 fixstyle2 = аналог fixstyle для большого количества замен
use strict
my Sverbose = (@ARGV && $ARGV[O] eq -v && shift),
my $change = (),
while (<DATA>) {
chomp,
my ($m, $out) = split /\s*=>\s«/,
next unless $in && $out,
$change{$in} = $out, } if (@ARGV) {
$"I = orig , } else {
warn $0- Reading from stdm\n if -t STDIN,
while (<>) { my $i =0,
s/~(\s+)// && print $1, 0 Выдать начальный пропуск for (split /(\s+)/, $_, -1) {
pnnt( ($i++ & 1) ? $_ ($change{$J || $_)),
|
_ END__ |
||
|
analysed |
=> |
analyzed |
|
built-in |
=> |
builtm |
|
chastized |
=> |
chastised |
|
commandlme |
=> |
command-line |
|
de-allocate |
=> |
deallocate |
|
dropin |
=> |
drop-in |
|
hardcode |
=> |
hard-code |
|
meta-data |
=> |
metadata |
|
multicharacter |
=> |
multi-character |
|
multiway |
=> |
multi-way |
|
non-empty |
=> |
nonempty |
1.18. Программа: psgrep 61
non-profit => nonprofit
non-trappable => nontrappable
pre-define => predefine
preextend => pre-extend
re-compilmg => recompiling
reenter => re-enter
turnkey => turn-key
В новой версии программы каждая строка разбивается на пропуски и слова (относительно медленная операция). Затем слова используются для поиска замены в хэше, что выполняется существенно быстрее подстановки. Следовательно, первая часть работает медленнее, а вторая — быстрее. Выигрыш в скорости зависит от количества совпадений.
Если бы мы не старались сохранить количество пропусков, разделяющих слова, нетрудно сделать так, чтобы вторая версия не уступала первой по скорости даже при небольшом количестве замен. Если вам хорошо известны особенности входных данных, пропуски можно заменить одиночными пробелами. Для этого применяется следующий цикл:
U Работает очень быстро, но со сжатием пропусков while (о) {
for (split) {
print $change{$_} || $_,
}
print \n ,
>
В конце каждой строки появляется лишний пробел. Если это нежелательно, воспользуйтесь методикой рецепта 16.14 и создайте входной фильтр. Вставьте следующий фрагмент перед циклом while, сжимающим пропуски:
my $pid = open(STDOUT, |= ),
die cannot fork $' unless defined $pid,
unless ($pid) {
while (<STDIN>) {
s/ $//,
print,
>
exit,
1.18. Программа: psgrep
Многие программы (в том числе ps, netstat, Is —I, find -Is и tcpdump) часто выдают большие объемы данных. Файлы журналов тоже быстро увеличиваются в размерах, что затрудняет их просмотр. Такие данные можно обработать программой-фильтром типа дгер и отобрать из них лишь часть строк, однако регулярные выражения плохо согласуются со сложной логикой — достаточно взгляну 1Ь па ухищрения, на которые приходится пускаться в рецепте 6.17.
Программа psg rep умеет делать все это и бесконечно большее, потому что в ней критерии отбора не являются регулярными выражениями; они состоят из полноценного кода Perl. Каждый критерий последовательно применяется к каждой строке вывода. В результате выводятся лишь те данные, которые удовлетворяют всем аргументам. Ниже приведены примеры критериев поиска и соответствующие лм командные строки.
• Строки со словами, заканчивающимися на sh:
% psgrep '/sh\b/'
• Процессы с именами команд, заканчивающимися на sh:
% psgrep 'command =" /sh$/'
• Процессы с идентификатором пользователя, меньшим 10:
% psgrep 'uid < 10'
• Интерпретаторы с активными консолями:
% psgrep 'command =~ '/"-/' 'tty ne ">"'
• Процессы, запущенные на псевдоконсолях:
% psgrep 'tty =' /-[p-t]'
• Отсоединенные непривилегированные процессы:
% psgrep 'uid && tty eq "?"'
• Большие непривилегированные процессы:
% psgrep 'size > 10 * 2**10' 'uid ' = 0'
Ниже показаны данные, полученные при последнем вызове psgrep на нашем компьютере. Как и следовало ожидать, в них попал только netscape и его вспомогательный процесс:
|
FLAGS |
UID |
PID |
|
0 |
101 |
9751 |
|
100000 |
101 |
9752 |
1 0 0 14932 9652 do_select S p1 0:25 netscape 9751 0 0 10636 812 do_select S p1 0:00 (dns
helper)
В примере 1.6 приведен исходный текст программы psgrep. Пример 1.6. psgrep
#' /usr/bin/perl -w
• psgrep - фильтрация выходных данных ps
8 с компиляцией пользовательских запросов в программный код #
1.18. Программа: psgrep 63
use strict;
# Все поля из заголовка PS
my ©fieldnames = qw( FLAGS UID PID PPID PRI NICE SIZE RSS WCHAN STAT TTY TIME COMMAND),
# Определение формата распаковки (в примере
# жестко закодирован формат ps для Linux)
my $fmt = cut2fmt(8, 14, 20, 26, 30, 34, 41, 47, 59, 63, 67, 72);
my %fields; # Для хранения данных
die «Thanatos unless §ARGV; usage: $0 criterion ...
Each criterion is a Perl expression involving:
©fieldnames
All criteria must be met for a line to be printed Thanatos
# Создать синонимы для uid, size, UID, SIZE и т д.
# Пустые скобки необходимы для создания прототипа без аргументов
for my $name (©fieldname) {
no strict 'refs';
•name = *{lc $name} = sub () { $fields{$name} };
my $code = "sub is_desirable { " jom(" and ", @ARGV) ' } '; unless (eval $code.1) {
die "Error in code: $@\n\t$code\n";
open (PS, "ps wwaxl |") || die "cannot fork. $! ';
print scalar <PS>, # Строка-заголовок
while (<PS> {
(5>fields{@fieldnames} = tnm(unpack($fmt, $_));
print if is_desirable(); # Строки, удовлетворяющие критериям
}
close(PS) 11 die "ps failed!";
# Преобразовать позиции разреза в формат распаковки sub cut2fmt {
my(@positions) = @_; my Stemplate = ' '; my Slastpos = 1; foreach $place(positions) {
$template .= "A" . ($place - $lastpos) . " "; Slastpos = $place; } Stemplate .= "A*";
продолжение ¦&
return $template;
sub trim {
my §out = @_; for (@out) <
s/\s+$//; } return wantarray ? @out :
Dut[0];
# Следующий шаблон использовался для определения позиций разреза.
# Далее следует пример входных данных#123456789012345678901234567890123456789012345678901234567890123456789012345
1
|
26 30 34 I I I |
Позиции:
| 14 |
| 20 |
| 41 |
| 59 63 67 72 |
| I |
| I |
|
_ END
FLAGS
100 140 100100 100140 |
STA TTY TIME COMMAND
| UID О О 101 |
| PID 1 187 428 |
| PPID PRI |
| 0 1 1 |
|
99 30217 101 593 101 30639 101 25145 0 10116 |
|
402 426 9562 9563 9564 |
| 100000 |
О 0 1552 1008 posix.lock S ? 0:00 httpd
О 0 1780 1260 copy.thread S 1 0:00 -tcsh
17 0 924 496 R p1 0:00 ps axl
| 0 |
| 100100 100100 100000 |
| О 26560 26554 101 19058 9562 |
ся в главе 16 «Управление процессами и межпроцессные взаимодействия», особенно в рецептах 16.10 и 16.13.
Настоящая сила и выразительность psgrep обусловлены тем, что в Perl строковые аргументы могут представлять собой не просто строки, а программный код Perl. Похожий прием использован в рецепте 9.9, за исключением того, что в psgrep аргументы пользователя «упакованы» в процедуру is_desirable. При этом компиляция строк в код Perl выполняется всего один раз — еще перед запуском той программы, чей вывод мы обрабатываем. Например, при запросе UID ниже 10 будет сгенерирована следующая строка:
eval "sub is_desirable { uid < 10 } " . 1;
Загадочное . 1 в конце присутствует для того, чтобы при компиляции пользовательского кода команда eval возвращала истинное значение. В этом случае нам даже не придется проверять $@ на предмет ошибок компиляции, как это делается в рецепте 10.12.
Использование произвольного кода Perl в фильтрах для отбора записей — невероятно мощная возможность, но она не является абсолютно оригинальной. Perl многим обязан языку программирования awk, который часто применялся для подобной фильтрации. Один из недостатков awk заключался в том, что он не мог легко интерпретировать входные данные в виде полей фиксированной длины (вместо полей, разделенных особыми символами). Другой недостаток — отсутствие мнемонических имен полей; в awk использовались имена $1, $2 и т. д. К тому же Perl может делать многое такое, на что не способен awk.
Пользовательские критерии даже не обязаны быть простыми выражениями. Например, следующий вызов инициализирует переменную $id номером пользователя nobody и затем использует ее в выражении:
% psgrep 'no strict "vars";
BEGIN { $id = getpwnam("nobody") } uid == $id '
Но как использовать эти слова, uid, command и size, даже не снабжая их символом $ для представления соответствующих полей входных записей? Мы напрямую манипулируем с таблицей символов, присваивая замыкания (closures) неявным тип-глобам (typeglobs), которые создают функции с соответствующими именами. Замыкания описаны в рецепте 11.4, а их присвоение тип-глобам для создания синонимов функций — в рецепте 10.14.
Однако в psgrep встречается нюанс, отсутствующий в этих рецептах, — речь идет о пустых скобках в замыкании. Благодаря скобкам функция может использоваться в выражениях везде, где допускается отдельная величина (например, строка или числовая константа). В результате создается пустой прототип, а функция обращения к полю (например, uid) вызывается без аргументов, по аналогии со встроенной функцией time. Если не создать для функций пустые прототипы, выражения "uid < 10" или "size / 2 > rss" приведут в замешательство синтаксический анализатор — он увидит в них незаконченный глоб (wildcard glob) или шаблон поиска. Прототипы рассматриваются в рецепте 10.11.
Показанная версия psgrep получает входные данные от команды ps в формате Red Hat Linux. Чтобы перенести ее в другую систему, посмотрите, в каких столб-
После небольшого изменения в функциях отбора программа даже подойдет для работы с пользовательской базой данных. Если у вас имеется массив записей (см. рецепт 11.9), пользователь может указать произвольный критерий отбора:
sub _
sub titleO { $_->{TITLE} }
sub executive { title ="/(' vice-)?president/i }
# Критерии отбора указываются при вызове grep @slowburners = grep { id < 10 && 'executive } ©employees,
По причинам, связанным с безопасностью и быстродействием, такой подход редко встречается в реальных механизмах, описанных в главе 14 «Базы данных». В частности, он не поддерживается в SQL, но имея в своем распоряжении Perl и некоторую долю изобретательности, нетрудно создать свой собственный вариант. Подобная методика использована в поисковой системе http://mox. perl.com/ cgi-bin/MxScreen, но вместо получения данных от ps записи представляют собой хэши Perl, загружаемые из базы данных
Числа
Каждый, кто занимается математическими
методами получения случайных чисел,
несомненно, впадает в грех
Джон фон Нейман (1951)
Введение
Числа составляют основные типы данных практически в любом языке программирования, однако даже с ними могут возникнуть неожиданные сложности. Случайные числа, числа с дробной частью, числовые последовательности и преобразования строк в числа — все это вызывает немалые затруднения.
Perl старается по возможности облегчить вам жизнь, и его средства для работы с числами не являются исключением из этого правила. Если скалярное значение интерпретируется в программе как число, то Perl преобразует его в числовую форму. Читаете ли вы числовые данные из файла, извлекаете отдельные цифры из строки или иным образом получаете числа из бесчисленных текстовых источников Внешнего Мира, — вам не приходится преодолевать препятствия в виде неудобных ограничений других языков на пути преобразования ASCII-строк в числа.
Если строка используется в числовом контексте (например, в математическом выражении), Perl старается интерпретировать ее как число, однако у него нет возможности сообщить о том, что строка в действительности не соответствует числу. Встречая не-числовой символ, Perl прекращает интерпретацию строки, при этом не-числовые строки считаются равными нулю, поэтому "А7" преобразуется в О, а 7 А — в 7 (хотя флаг -w предупредит вас о некорректных преобразованиях). Иногда (например, при проверке вводимых данных) требуется узнать, соответствует ли строка числу. Мы покажем как это делается в рецепте 2.1.
В рецепте 2.16 объясняется, как получить число из строк с шестнадцатерич-ными или восьмеричными представлениями чисел — например, Oxff . Perl автоматически преобразует литералы в программном коде (поэтому $а = 3 + Oxff присвоит $а значение 258), но это не относится к данным, прочитанным программой. Вы не можете прочитать Oxff в $b и затем написать $а = 3 + $Ь, чтобы присвоить $а 258.
Числа, прочитанные из файла или встретившиеся в программе в виде литералов, преобразуются из десятичного представления (например, 0.1) во внутреннее. Невозможно точно представить 0.1 в виде двоичного числа с плавающей запятой — подобно тому, как 1/3 невозможно точно представить в виде конечного десятичного числа. Следовательно, двоичное представление 0.1 в действительности отличается от 0.1. Для 20 десятичных разрядов оно равно 0.10000000000000000555.
При выполнении арифметических операций с двоичными представлениями чисел с плавающей запятой накапливаются ошибки. Значение выражения 3*0.1 не совпадает с двоичной кодировкой числа 0.3. Это означает, что числа с плавающей запятой в Perl нельзя просто сравнивать с помощью ==. Работе с ними посвящены рецепты 2.2 и 2.3.
В рецепте 2.4 показано, как преобразовать ASCII-строку с двоичным представлением числа (например, "1001") в целое (9 для приведенного примера) и обратно. Рецепт 2.5 описывает три способа выполнения некоторой операции с каждым элементом последовательного множества целых чисел. Преобразование чисел в римскую запись и обратно продемонстрировано в рецепте 2.6.
Случайным числам посвящено сразу несколько рецептов. Функция Perl rand возвращает число с плавающей запятой от 0 до 1 или от 0 до своего аргумента. Мы покажем, как получить случайное число в конкретном интервале, как сделать их «еще более случайными» и как заставить rand генерировать новый набор случайных чисел при каждом запуске программы.
Глава завершается рецептами, относящимися к тригонометрии, логарифмам, умножению матриц, комплексным числам. Заодно вы найдете ответ на часто встречающийся вопрос: «Как включить в выводимое число запятую?»
2.1. Проверка строк на соответствие числам
Проблема
Требуется проверить, соответствует ли строка допустимому числу. Эта проблема часто возникает при проверке входных данных (например, в сценариях CGI).
Решение
Сравните строку с регулярным выражением, которое совпадает со всеми интересующими вас разновидностями чисел:
2.1. Проверка строк на соответствие числам 69
if ($strmg =- /PATTERN/) { # является числом
> else {
tt не является числом
Комментарий
Все зависит от того, что именно понимать под числом. Даже простые на первый взгляд понятия — например, целое — заставят вас поломать голову над тем, какие строки следует отнести к этой категории. Например, что делать с начальным + для положительных чисел? Разрешить, сделать обязательным или запретить? А числа с плавающей запятой представляются таким огромным количеством способов, что у вас в голове перегреется процессор.
Сначала решите, какие символы допустимы, а какие — нет. Затем сконструируйте для отобранных символов регулярное выражение. Ниже приведены некоторые стандартные конструкции для самых распространенных ситуаций (что-то вроде полуфабрикатов для нашей поваренной книги).
# Содержит нецифровые символы
warn "has nondigits" if /\0/;
# He является натуральным числом
warn "not a natural number" unless /"\d+$/; # Отвергает -3
# He является целым числом
warn "not an integer" unless /"-?\d+$/; # Отвергает +3 warn "not an integer" unless /"[+-]9\d+$/;
# He является десятичным числом
warn "not a decimal number" unless /"-Ad+X^VM/; * Отвергает .2 warn "not a decimal number" unless /"-?(?:d+(?:\.\d)?|\.\d+)$/; tt He является вещественным числом С warn "not a C float"
unless /¦([+-]?)(?=\d|\.\d)\d*(V\d*)?([Ee]([+-p\d+))?$/;
В этих шаблонах не обрабатываются особые случаи Infinity и NaN в записи IEEE. Если вы не боитесь, что члены комитета IEEE придут к вашему компьютеру и начнут бить вас по голове копиями соответствующих стандартов, вероятно, об этих странных «числах» можно забыть.
Для строк с начальными или конечными пробелами эти шаблоны не подходят. Либо вставьте в них соответствующую логику, либо вызовите функцию trim из рецепта 1.14.
В POSIX-системах Perl поддерживает функцию POSIX: :strtod. Ее семантика чрезвычайно громоздка, поэтому мы приведем функцию getnum для упрощения доступа. Эта функция получает строку и возвращает либо преобразованное число, либо undef для строк, не соответствующих вещественным числам С. Интерфейсная функция is_numeric упрощает вызов getnum в ситуациях, когда вы просто хотите спросить: «Это вещественное число»?
sub getnum {
use POSIX qw(strtod);
$str =~ s/\s+$//,
$i=0
my($num, Sunparsed) = strtod($str),
if (($str eq ") || (Sunparsed '=0) || $') {
return, } else {
return $num,
}
sub is_numeric { defined scalar &getnum }
> Смотри также------------------------------------------------------------------------
Описание синтаксиса регулярных выражений в perlre(i); страница руководства strtod(3); документация по стандартному модулю POSIX.
2.2. Сравнение чисел с плавающей запятой
Проблема
Арифметика с плавающей запятой не является абсолютно точной. Сравнивая два числа, вы хотите узнать, совпадают ли они до определенного десятичного разряда. Как правило, именно так следует сравнивать числа с плавающей запятой.
Решение
Воспользуйтесь функцией sprintf и отформатируйте числа до определенного десятичного разряда, после чего сравните полученные строки:
# equal(NUM1, NUM2, ACCURACY), возвращает true если NUM1 и NUM2
# совпадают на ACCURACY десятичных разрядов
sub equal {
my ($A $B, $dp) = @_,
return sprintf( % ${dp}g , $A) eq sprintf( % ${dp}g , $A), }
Альтернативное решение — преобразовать числа в целые, умножая их на соответствующий коэффициент.
Комментарий
Процедура equal понадобилась из-за того, что в компьютерах многие числа с плавающей запятой представляются с ограниченной точностью. Дополнительная информация приведена в разделе «Введение».
При фиксированном количестве цифр в дробной части (например, в денежных суммах) проблему можно решить преобразованием в целое число. Если
сумма 3.50 будет храниться в виде 350, а не 3.5, необходимость в числах с плавающей запятой отпадает. Десятичная точка снова появляется в выводимых данных:
Swage = 536, # $5 36/час
$week = 40 • Swage, в $214 40
printf( One week's wage is \$% 2f\n Sweek/100),
One week's wage is: $214.40
Редко требуется сравнивать числа более чем до 15 разряда.
> Смотри также---------------------------------------------------------------------------------------------
Описание функции sprintf вperifunc(\); описание переменной $# в странице руководства perlvariX); документация по стандартному модулю Math::BigFloat. Функция sprintf используется в рецепте 2.3. Также обращайтесь к разделу 4.2.2 тома 2 «Искусство программирования».
2.3. Округление чисел с плавающей запятой
Проблема
Число с плавающей запятой требуется округлить до определенного разряда. Проблема связана с теми же погрешностями представления, которые затрудняют сравнение чисел (см. рецепт 2.2), а также возникает в ситуациях, когда точность ответа намеренно снижается для получения более наглядного результата.
Решение
Для получения непосредственного вывода воспользуйтесь функциями Perl sprintf
или printf:
Srounded = sprintf( %FORMATf , Sun rounded),
Комментарий
Округление серьезно отражается на работе некоторых алгоритмов, потому используемый метод должен быть точно указан. В особо важных приложениях (например, в финансовых вычислениях или системах наведения ракет) грамотный программист реализует свою собственную функцию округления, не полагаясь на встроенную логику языка (или ее отсутствие).
Однако во многих ситуациях можно просто воспользоваться функцией sprintf. Формат f позволяет указать количество разрядов, до которого округляется аргумент. Perl округляет последний разряд вверх, если следующая цифра равна 5 и более, и вниз в противном случае.
$b = spnntf("%.2f", $a);
print "Unrounded: $a\nRounded: %.2f\n", $a,
Unrounded: 0.255 Rounded: 0.26 Unrounded: 0.255 Rounded: 0.26
Существуют три функции, предназначенные для округления чисел с плавающей запятой до целых: int, ceil и floor. Встроенная функция Perl int возвращает целую часть числа с плавающей запятой (при вызове без аргумента она использует $_). Функции модуля POSIX floor и ceil округляют аргументы вверх и вниз, соответственно, до ближайшего целого.
use POSIX;
print "number\tint\floor\tceil\n",
@a = { 3.3 , 3.5 , 3.7 , -3.3}; foreach (@a) {
printf( "% ,1f\t% ,1f\t% ,1f\t% .1f\n", $_, int($_), floor($_), ceil($_) );
|
number |
int |
floor |
ceil |
|
3.3 |
3.0 |
3.0 |
4.0 |
|
3.5 |
3.0 |
3.0 |
4.0 |
|
3.7 |
3.0 |
3.0 |
4.0 |
|
-3.3 |
-3.0 |
-4.0 |
-3.0 |
|
> Смотри также---- |
2.4. Преобразования между двоичной и десятичной системами счисления
Проблема
Имеется десятичное число, которое необходимо вывести в двоичном представлении, или наоборот, двоичная последовательность, которую требуется преобразовать в десятичное число. Такие задачи часто возникают при отображении не-текстовых данных — например, полученных в процессе взаимодействия с некоторыми системными функциями и программами.
Чтобы преобразовать целое число Perl в строку, состоящую из единиц и нулей, сначала упакуйте его в сетевой формат "N" (с начальным старшим байтом), а затем снова распакуйте по одному биту (формат "В32 ").
sub dec2bm {
my $str = unpack("B32", pack("N", shift));
$str =" s/"0+('=\d)//; » В противном случае появятся начальные нули
return $str;
Чтобы преобразовать строку из единиц и нулей в целое число Perl, дополните ее необходимым количеством нулей, а затем выполните описанную выше процедуру в обратном порядке:
sub bin2dec {
return unpack("N', pack("B32\ substr('O" x 32 shift, -32)));
Комментарий
Речь идет о преобразовании чисел между строками вида "00100011" и десятичной системой счисления (35). Строка содержит двоичное представление числа. На этот раз функция spnntf не поможет: в ней не предусмотрен формат для вывода чисел в двоичной системе счисления. Следовательно, нам придется прибегнуть к функциям Perl pack и unpack для непосредственных манипуляций со строковыми данными.
Функции pack и unpack предназначены для работы со строками. Строки можно интерпретировать как последовательности битов, байты, целые, длинные целые, числа с плавающей запятой в представлении IEEE, контрольные суммы — не говоря уже о многом другом. Обе функции, pack и unpack, по аналогии со spnntf получают форматную строку, которая определяет выполняемые с аргументом операции.
Мы используем pack и unpack для интерпретации строк как последовательностей битов и двоичного представления целого числа. Чтобы понять, каким образом строка интерпретируется как последовательность битов, необходимо хорошо разобраться в поведении функции pack. Строка интерпретируется как последовательность байтов, состоящих из восьми бит. Байты всегда нумеруются слева направо (первые восемь бит образуют первый байт, следующие восемь бит — второй и т. д.), однако внутри каждого байта биты могут нумероваться как слева направо, так и справа налево.
Функция pack с шаблоном "В" работает с битами каждого байта, пронумерованными слева направо. Именно в этом порядке они должны находиться для применения формата "N", которым мы воспользуемся для интерпретации последовательности битов как 32-разрядного целого.
' $num = bin2dec('0110110') # $num = 54
$binstr = dec2bin(54); # $binstr = 110110
Проблема
Требуется выполнить некоторую операцию со всеми целыми между X и Y. Подобная задача возникает при работе с непрерывной частью массива или в любой ситуации, когда необходимо обработать все числа1 из заданного интервала.
Решение
Воспользуйтесь циклом for или .. в сочетании с циклом f о reach:
foreach ($X . $Y) {
# $_ принимает все целые значения от X до Y включительно
foreach $i ($X .. $Y) {
# $i принимает все целые значения от X до Y включительно
foreach ($1 = $Х; $i <= $Y; $i++) {
# $i принимает все целые значения от X до Y включительно
foreach ($i = $X; $1 <= $Y; $i+=7) {
# $i принимает целые значения от X до Y включительно с шагом 7
Комментарий
В первых двух методах используется конструкция $Х. . $Y, которая создает список всех целых чисел между $Х и $Y. Если $Х и $Y расположены далеко друг от друга, это приводит к большим расходам памяти (исправлено в версии 5.005). При организации перебора последовательных целых чисел цикл for из третьего способа расходует память более эффективно.
В следующем фрагменте продемонстрированы все три способа. В данном случае мы ограничиваемся выводом сгенерированных чисел:
print "Infancy is:"; foreach (0 .. 2) { print "$_ ";
}
print "\n";
print "Toddling is: "; foreach $i (3 .. 4) {
print "$i "; } print "\n";
print "Childhood is: ";
for ($1 = 5; $i <= 12; $i++) <
print "$i "; > print "\n";
Infancy is: 0 1 2
Toddling is: 3 4
Childhood is: 5 6 7 8 9 10 11 12
Смотри также
Описание операторов for и foreach в perlsyn(l).
2.6. Работа с числами в римской записи
Проблема
Требуется осуществить преобразование между обычными числами и числами в римской записи. Такая необходимость часто возникает при оформлении сносок и нумерации страниц в предисловиях.
Решение
Воспользуйтесь модулем Roman с CPAN:
use Roman;
$roman = roman($arabic); # Преобразование
# в римскую запись
$arabic = arabic($roman) if isroman($roman); # Преобразование
# из римской записи
Комментарий
Для преобразования арабских («обычных») чисел в римские эквиваленты в модуле Roman предусмотрены две функции, Roman и roman. Первая выводит символы в верхнем регистре, а вторая — в нижнем.
Модуль работает только с римскими числами от 1 до 3999 включительно. В римской записи нет отрицательных чисел или нуля, а для числа 5000 (с помощью которого представляется 4000) используется символ, не входящий в кодировку ASCII.
use Roman;
$roman_fifteen = roman(15); # "xv"
print "Roman for fifteen is $roman_fifteen\n";
$arabic_fifteen = arabic($roman_fifteen);
print "Converted back, $roman_fifteen is $arabic_fifteen\n";
Roman for fifteen is xv
Converted back, xv is 15
Документация по модулю Roman; рецепт 6.23.
2.7. Генератор случайных чисел
Проблема
Требуется генерировать случайные числа в заданном интервале — например, чтобы выбрать произвольный элемент массива, имитировать бросок кубика в игре или сгенерировать случайный пароль.
Решение
Воспользуйтесь функцией Perl rand. $random = int( rand( $Y-$X+1 ) ) + $X;
Комментарий
Следующий фрагмент генерирует и выводит случайное число в интервале от 25 до 75 включительно:
$random = int( rand(51)) + 25; print "$random\n";
Функция rand возвращает дробное число от 0 (включительно) до заданного аргумента (не включается). Мы вызываем ее с аргументом 51, чтобы случайное число было больше либо равно 0, но никогда не было бы равно 51 и выше. Затем от сгенерированного числа берется целая часть, что дает число от 0 до 50 включительно (функция int превращает 50,9999... в 50). К полученному числу прибавляется 25, что дает в результате число от 25 до 75 включительно.
Одно из распространенных применений этой методики — выбор случайного элемента массива:
$elt = $array[ rand ©array ];
Также она часто используется для генерации случайного пароля из заданной последовательности символов:
@chars = ( "А" .. 7", "а" .. "г", 0 .. 9, qw(% ! @ $%"&*)); Spassword = jom("", @chars[ map { rand @chars } ( 1 .. 8 ) ]);
Мы генерируем восемь случайных индексов @chars с помощью функции тар, извлекаем соответствующие символы в виде среза и объединяем их в случайный пароль. Впрочем, в действительности пароль получается не совсем случайным — безопасность вашей системы зависит от стартового значения (seed) генератора случайных чисел на момент запуска программы. В рецепте 2.8 показано, как «раскрутить» генератор случайных чисел и сделать генерируемые числа более случайными.
О Смотри также
Описание функций int, rand и join Bperlfunc(l). Случайные числа исследуются в рецептах 2.8—2.10, а используются — в рецепте 1.9.
2.8. Раскрутка генератора случайных чисел
Проблема
При каждом запуске программы вы получаете один и тот же набор «случайных» чисел. Требуется «раскрутить» генератор, чтобы Perl каждый раз генерировал разные числа. Это важно практически для любых применений случайных чисел, особенно для игр.
Решение
Воспользуйтесь функцией Perl srand: srand EXPR;
Комментарий
Генерация случайных чисел — непростое дело. Лучшее, на что способен компьютер без специального оборудования, — генерация псевдослучайных чисел, равномерно распределенных в области своих значений. Псевдослучайные числа генерируются по математическим формулам, а это означает, что при одинаковом стартовом значении генератора две программы сгенерируют одни и те же псевдослучайные числа.
Функция srand задает новое стартовое значение для генератора псевдослучайных чисел. Если она вызывается с аргументом, то указанное число будет использовано в качестве стартового. При отсутствии аргумента srand использует величину, значение которой трудно предсказать заранее (относится к Perl 5.004 и более поздним версиям; до этого использовалась функция time, значения которой совсем не были случайными). Не вызывайте srand в программе более одного раза.
Если вы не вызвали srand сами, Perl версий 5.004 и выше вызывает srand с «хорошим» стартовым значением при первом запуске rand. Предыдущие версии этого не делали, поэтому программы всегда генерировали одну и ту же последовательность чисел. Если вы предпочитаете именно такое поведение, вызывайте srand с конкретным аргументом:
srand( <STOIN> );
То, что Perl старается выбрать хорошее стартовое значение, еще не гарантирует криптографической безопасности сгенерированных чисел от усердных попыток взлома. Информацию о построении надежных генераторов случайных чисел можно найти в учебниках по криптографии.
t> Смотри также--------------------------------------------------------------------------------------------
Описание функции srand Bperlfunc(l). Примеры ее применения приведены в рецептах 2.7 и 2.9.
Проблема
Требуется генерировать случайные числа, которые были бы «более случайными», чем выдаваемые генератором Perl. Иногда возникают проблемы, связанные с ограниченным выбором стартовых значений в библиотеках С. В некоторых приложениях последовательность псевдослучайных чисел начинает повторяться слишком рано.
Решение
Воспользуйтесь другими генераторами случайных чисел — например, теми, которые присутствуют в модулях Math::Random и Math::TrulyRandom с CPAN:
use Math::TrulyRandom;
Srandom = truly_random_value();
use Math_Random;
$random = random_unifonn();
Комментарий
Для генерации случайных чисел в Perl используется стандартная библиотечная функция С rand(3) (впрочем, на стадии компоновки это можно изменить). Некоторые реализации функции rand возвращают только 16-разрядные случайные числа или используют слабые алгоритмы, не обеспечивающие достаточной степени случайности.
Модуль Math::TrulyRandom генерирует случайные числа, используя погрешности системного таймера. Процесс занимает некоторое время, поэтому им не стоит пользоваться для генерации большого количества случайных чисел.
Модуль Math::Random генерирует случайные числа с помощью библиотеки randlib. Кроме того, он содержит многочисленные вспомогательные функции.
О Смотри также--------------------------------------------------------------------------------------------
Описание функций srand и rand в perlfunc(l); рецепты 2.7—2.8; документация по модулям Math::Random и Math::TrulyRandom с CPAN.
2.10. Генерация случайных чисел
с неравномерным распределением
Проблема
Требуется генерировать случайные числа в ситуации, когда одни значения появляются с большей вероятностью, чем другие (неравномерное распределение). Допустим, вы отображаете на своей Web-странице случайный баннер и у вас имеется набор весовых коэффициентов, определяющих частоту появления того или
Решение
Если вам потребовались случайные величины, распределенные по конкретному закону (допустим, по закону Гаусса), загляните в учебник по статистике и найдите в нем нужную функцию или алгоритм. Следующая функция генерирует случайные числа с нормальным распределением, со стандартным отклонением 1 и нулевым математическим ожиданием.
sub gaussian_rand {
my ($u1, $u2); # Случайные числа с однородным распределением
my $w; # Отклонение, затем весовой коэффициент
my ($g1, $g2); # Числа с гауссовским распределением
do {
$u1 = 2 * rand() - 1;
$u2 = 2 * rand() - 1;
$w = $u1*$u1 + $u2»u2 } while ($w >= 1);
$w = sqrt( (-2 * log($w)) / $w); $g2 = $u1 * $w; $g1 = $u2 * $w;
# Возвратить оба числа или только одно return wantarray ? ($g1, $g2) : $g1; }
Если у вас есть список весовых коэффициентов и значений и вы хотите выбирать элементы списка случайным образом, выполните два последовательных шага. Сначала превратите весовые коэффициенты в вероятностное распределение с помощью приведенной ниже функции weight_to_dist, а затем воспользуйтесь функцией weighted_rand для случайного выбора чисел.
# weight_to_dist: получает хэш весовых коэффициентов
# и возвращает хэш вероятностей
sub weight_to_dist {
my %weights = @>_; my %dist =(); my $total = 0; my ($key, Sweight); local $_;
foreach (values %weights) { $total += $_;
while ( ($key, Sweight) = each %weights ) { $dist{$key} = $weight/$total;
# weighted_ran: получает хэш вероятностей 8 и возвращает случайный элемент хэша sub weighted_rand {
my %dist = @_;
my ($key, $weight);
while (1) { # Чтобы избежать погрешностей вычислений
# с плавающей запятой (см. ниже), ray $rand = rand,
while ( ($кеу, $weight) = each %dist ) { return $key if ($rand -= $weight) <0;
Комментарий
Функция gaussian_rand реализует полярный метод Бокса—Мюллера для преобразования двух независимых случайных чисел с однородным распределением, лежащих в интервале от 0 до 1 в два числа с математическим ожиданием 0 и стандартным отклонением 1 (то есть распределенных по закону Гаусса). Чтобы сгенерировать числа с другим математическим ожиданием и стандартным отклонением, умножьте выходные данные gaussian_rand на нужное стандартное отклонение и прибавьте математическое ожидание:
# gaussian_rand - см. выше
$mean = 25;
$sdev = 2;
Ssalary - gaussian_rand() * $sdev + $mean;
printf("You have been hired at \$%.2f\n", Ssalary);
Функция weighted_rand получает случайное число из интервала от 0 до 1. Затем она использует вероятности, сгенерированные weight_to_dist, и определяет, какому элементу соответствует это случайное число. Из-за погрешностей представления с плавающей запятой накопленные ошибки могут привести к тому, что возвращаемый элемент не будет найден. Поэтому код размещается в цикле while, который в случае неудачи выбирает новое случайное число и делает очередную попытку.
Кроме того, модуль Math::Random с CPAN содержит функции, генерирующие случайные числа для многих распределений.
t> Смотри также--------------------------------------------------------------------------------------------
Описание функции rand в perlfunc(l); рецепт 2.7; документация по модулю Math::Random с CPAN.
2.11. Выполнение тригонометрических вычислений в градусах
Проблема
Требуется, чтобы в тригонометрических функциях использовались градусы вместо стандартных для Perl радианов.
Решение
Создайте функции для преобразований между градусами и радианами (2я радиан соответствуют 360 градусам).
BEGIN {
use constant PI => 3.14159265358979;
sub deg2rad {
my $degrees = shift;
return (Sdegrees / 180) • PI;
sub rad2deg {
my $radians = shift;
return (Sradians / PI) - 180;
Также можно воспользоваться модулем Math::Trig:
use Math::Trig;
$radians = deg2rad($degrees); Sdegrees = rad2deg($radians);
Комментарий
Если вам приходится выполнять большое количество тригонометрических вычислений, подумайте об использовании стандартных модулей Math::Trig или POSIX. В них присутствуют дополнительные тригонометрические функции, которых нет в стандартном Perl. Другой выход заключается в определении приведенных выше функций rad2deg и deg2rad. В Perl нет встроенной константы я, однако при необходимости ее можно вычислить настолько точно, насколько позволит ваше оборудование для вычислений с плавающей запятой. В приведенном выше решении п является константой, определяемой командой use constant. Синус угла, заданного в градусах, вычисляется следующим образом:
# Функции deg2rad и rad2def приведены выше или взяты из Math::Trig sub degree_sine {
my Sdegrees = shift;
return $result,
> Смотри также------------------------------------------------------------------------
Описание функций sin, cos и atan2 в perlfunc(l); стандартная документация по модулям POSIX и Math::Tng.
2.12. Тригонометрические функции
Проблема
Требуется вычислить значения различных тригонометрических функций — таких как синус, тангенс или арккосинус.
Решение
В Perl существуют лишь стандартные тригонометрические функции sin, cos и atan2. С их помощью можно вычислить тангенс (tan) и другие тригонометрические функции:
sub tan {
my $theta = shift,
return sin($theta)/cos($theta), }
В модуле POSIX представлен расширенный набор тригонометрических функций:
use POSIX,
$у = acos(3 7),
Модуль Math::Trig содержит полный набор тригонометрических функций, а также позволяет выполнять операции с комплексными аргументами (или дающие комплексный результат):
use Math Trig, $у = acos(3 7),
Комментарий
Если значение $theta равно л/2, Зп/2 и т. д., в функции tan возникает исключительная ситуация деления на ноль, поскольку для этих углов косинус равен нулю. Аналогичные ошибки возникают и во многих функциях модуля Math::Trig. Чтобы перехватить их, воспользуйтесь конструкцией eval:
eval {
$у = tan($pi/2), } or return undef,
t> Смотри также--------------------------------------------------------------------------------------------
Описание функций sin, cos и atan2 вperlfunc(l). Тригонометрия в контексте комплексных чисел рассматривается в рецепте 2.15, а использование eval для перехвата исключений — в рецепте 10.12.
2.13. Вычисление логарифмов
Проблема
Требуется вычислить логарифм по различным основаниям.
Решение
Для натуральных логарифмов (по основанию е) существует встроенная функция log:
$log_e = log(VALUE),
Чтобы вычислить логарифм по основанию 10, воспользуйтесь функцией log 10 модуля POSIX:
use POSIX qw(log10), $log_10 = Iog10(VALUE),
Для других оснований следует использовать соотношение:
1одл(х) = 1одв(х)/1оде(п)
где х — число, логарифм которого вычисляется, п — нужное основание, а е — основание натуральных логарифмов.
sub log_base {
my ($base, $value) = @_, return log($value)/log($base),
Комментарий
Функция log_base позволяет вычислять логарифмы по любому основанию. Если основание заранее известно, намного эффективнее вычислить его натуральный логарифм заранее и сохранить для последующего использования, вместо того чтобы каждый раз пересчитывать его заново.
# Определение log_base см выше
$answer = log_base(10, 10, 10_000),
print Iog10(10,100) = $answer\n ,
Iog10(10,000) = 4
use Math::Complex;
printf "Iog2(1024) = %lf\n", logn(1024, 2); S Обратите внимание
# на порядок аргументов' Iog2(1024) = 10.000000
хотя комплексные числа в вычислениях не используются. Функция не очень эффективна, однако в будущем планируется переписать Math::Complex на С для повышения быстроты.
> Смотри также------------------------------------------------------------------------
Описание функции log вperlfunc(i); документация по стандартному модулю POSIX.
2.14. Умножение матриц
Проблема
Требуется перемножить два двумерных массива. Умножение матриц часто используется в математических и инженерных вычислениях.
Решение
Воспользуйтесь модулями PDL с CPAN. Модули PDL (Perl Data Language, то есть «язык данных Perl») содержат быстрые и компактные матричные и математические функции:
use PDL;
# $а и $b - объекты pdl
$с = $а * $Ь;
Альтернативный вариант — самостоятельно реализовать алгоритм умножения матриц для двумерных массивов:
sub mmult {
my ($m1,$m2) = @_;
my ($m1rows,$m1cols) = matdim($m1);
my ($m2rows,$m2cols) = matdim($m2);
unless ($m1cols == $m2rows) { # Инициировать исключение
die "IndexError: matrices don't match; $m1cols != $m2rows";
my $result = []; my ($i, $], $k),
for $i (range($m1rows)) { for $] (range($m2cols)) { for $k (range($m1cols)) {
2.14. Умножение матриц 85
$result->[$i][$]] += $m1->[$i][$k] ¦ $m2->[$k][$j];
return $result;
sub range {0 .. ($_[0] - 1 }
sub veclen {
my $ary_ref = $_[O];
my type = ref $ary_ref;
if ($type ne "ARRAY") {die "$type is bad array ref for $ary_ref" }
return scalar(@$ary_ref);
sub raatdim {
my $matnx = $_[0];
my $rows = veclen($matnx);
my $cols = veclen($matrix->[0]);
return ($rows, $cols),
Комментарий
Если у вас установлена библиотека PDL, вы можете воспользоваться ее молниеносными числовыми операциями. Они требуют значительно меньше памяти и ресурсов процессора, чем стандартные операции с массивами Perl. При использовании объектов PDL многие числовые операторы (например, + и *) перегружаются и работают с конкретными типами операндов (например, оператор * выполняет так называемое скалярное умножение). Для умножения матриц используется перегруженный оператор х.
use PDL;
$а = pdl [
[ 3, 2, 3 ], [ 5, 9, 8 ],
$b = pdl [
[ 4, 7 ],
[ 9, 3 ],
[ 8, 1 ],
$c = $a x $b; # Перегруженный оператор x
Если библиотека PDL недоступна или вы не хотите привлекать ее для столь тривиальной задачи, матрицы всегда можно перемножить вручную:
$х = [
[ 3, 2, 3 ], [ 5, 9, 8 ],
$У = [
[ 4, 7 ],
[ 9, 3 ],
[ 8, 1 ],
$z = mult($x, $y);
> Смотри также---------------------------------------------------------------------------------------------
Документация по модулю PDL с CPAN.
2.15. Операции с комплексными числами
Проблема
Ваша программа должна работать с комплексными числами, часто используемыми в инженерных, научных и математических расчетах.
Решение
Либо самостоятельно организуйте хранение вещественной и мнимой составляющих комплексного числа, либо воспользуйтесь классом Math::Complex (из стандартной поставки Perl).
Ручное умножение комплексных чисел
# $с = $а • $Ь - моделирование операции
$c_real = ( $a_real * $b_real ) - ($a_imaginary ¦ $b_imaginary ); $c_imagmary = ( $a_real * $b_itnaginary ) - ($b_real • $a_imaginary );
Math::Complex
# Умножение комплексных чисел с помощью Math::Complex
use Math::Complex;
$c = $a * $b;
Комментарий
Ручное умножение комплексных числа 3+5i и 2-2i выполняется следующим образом:
$a_real = 3; $a_imaginary =5; # 3 + 5i;
$b_real = 2; $b_imaginary = -2; # 2 - 2i;
$c_real = ($a_real * $b_real ) - ( $a_imaginary ¦ $b_imaginary );
$c_imaginary = ($a_real • $b_imagmary ) - ( $b_real • $a_imaginary );
2.16 Преобразования восьмеричных и шестнадцатеричных чисел 87
print "с = ${c_real}+${c_imaginary}i\n";
с = 16+4i
То же с применением модуля Math::Complex:
use Math:iComplex;
$a = Math:;Complex->new(3, 5);
$b = Math::Complex->new(2,-2);
$c = $a * $t>;
print "c = $c\n";
с = 16+41
Версия 5. 004 позволяет создавать комплексные числа с помощью конструкции cplx или экспортированной константы i:
use Math::Complex;
$c = cplx(3,5) * cplx(2,-2); # Лучше воспринимается
$d = 3 + 4*i; #3+4i
printf "sqrt($d) = %s\n", sqrt($d);
sqrt(3+4i) = 2+i
В исходном варианте модуля Math::Complex, распространяемом с версией 5.003, не перегружаются многие функции и операторы версии 5.004. Кроме того, Math::Complex используется модулем Math::Trig (появившимся в версии 5.004), поскольку некоторые функции могут выходить за пределы вещественной оси в комплексную плоскость — например, арксинус 2.
Смотри также
Документация по стандартному модулю Math::Complex.
2.16. Преобразования восьмеричных и шестнадцатеричных чисел
Проблема
Требуется преобразовать строку с восьмеричным или шестнадцатеричным представлением (например, "0x55" или "0755") в правильное число.
Perl воспринимает лишь те восьмеричные и шестнадцатеричные числа, которые встречаются в программе в виде литералов. Если числа были получены при чтении из файла или переданы в качестве аргументов командной строки, автоматическое преобразование не выполняется.
Решение
Воспользуйтесь функциями Perl oct и hex:
$number = hex($hexadecimal); # Шестнадцатеричное число
$number = oct($octal); # Восьмеричное число
Функция oct преобразует восьмеричные числа как с начальными нулями, так и без них ( 0350" и "350"). Более того, она даже преобразует шестнадцатеричные числа, если у них имеется префикс "Ох". Функция hex преобразует только шестнадцатеричные числа с префиксом "Ох" или без него — например, "0x255", "ЗА", "ff" или "deadbeef" (допускаются символы верхнего и нижнего регистров).
Следующий пример получает число в десятичной, восьмеричной или шестна-дцатеричной системе счисления и выводит его во всех трех системах счисления. Для преобразования из восьмеричной системы используется функция oct. Если введенное число начинается с 0, применяется функция hex. Затем функция printf при выводе преобразует число в десятичную, восьмеричную и шестнадцатерич-ную систему:
print Gimme a number in decimal, octal, or hex , $num = <STOIN>, chomp $num,
exit unless defined $num,
$num = oct($num) is $num =~ /"0/, # Обрабатывает как восьмеричные,
# так и шестнадцатеричные числа printf %d %x %o\n , $num, $num, $num,
Следующий фрагмент преобразует режимы доступа к файлам UNIX. Режим всегда задается в восьмеричном виде, поэтому вместо hex используется функция oct:
print Enter file permission in octal ',
Spermissions = <STDIN>,
die Exiting \n unless defined $permissions,
chomp Spermissions,
Spermissions = oct($permissions), # Режим доступа всегда задается
# в восьмеричной системе print The decimal value is $permissions\n',
О Смотри также------------------------------- .------------------------------------------------------------
Раздел «Scalar Value Constructors» вperldata(l); описание функций oct и hex в perlfunc(l).
2.17. Вывод запятых в числах
Проблема
При выводе числа требуется вывести запятые после соответствующих разрядов. Длинные числа так воспринимаются намного лучше, особенно в отчетах.
Решение
Обратите строку, чтобы перебирать символы в обратном порядке, — это позволит избежать подстановок в дробной части числа. Затем воспользуйтесь регулярным
выражением, найдите позиции для запятых и вставьте их с помощью подстановки. Наконец, верните строку к исходному порядку символов.
sub commify {
my $text = reverse $_[0],
$text =" s/(\d\d\d)(?=\d)("\d.\ )/$1 /g,
return scalar reverse $text;
Комментарий
Регулярные выражения намного удобнее использовать в прямом, а не в обратном направлении. Учитывая этот факт, мы меняем порядок символов в строке на противоположный и вносим небольшие изменения в алгоритм, который многократно вставляет запятые через каждые три символа от конца. Когда все вставки будут выполнены, порядок символов снова меняется, а строка возвращается из функции. Поскольку функция reverse учитывает косвенный контекст возврата, мы принудительно переводим ее в скалярный контекст.
Функцию нетрудно модифицировать так, чтобы вместо запятых разряды разделялись точками, как принято в некоторых странах.
Пример использования функции commify выглядит так:
# Достоверный счетчик обращений -)
use Math TrulyRandom,
$hits = truly_random_value(), # Отрицательное значение1
$output = 'Your web page received $hits accesses last month \n",
print commify($output),
Your web page received -1,740,525,205 accesses last month.
> Смотри также---------------------------------------------------------------------------------------------
perllocale(l); описание функции reverse в perlfunc(l).
2.18. Правильный вывод во множественном числе
Проблема
Требуется вывести фразу типа: "It took $time hours" («Это заняло $time часов»). Однако фраза «It took I hours» («Это заняло 1 часов») не соответствует правилам грамматики. Необходимо исправить ситуацию1.
Решение
Воспользуйтесь printf и тернарным оператором X?Y: Z, чтобы изменить глагол или существительное.
printf "%d hour%s %s enough.\n", $time, $time == 1 ? "" : "s"; $time == 1 ? "is" : "are";
Кроме того, можно воспользоваться модулем Lingua::EN::Inflect с CPAN, упоминаемым в комментарии.
Комментарий
Невразумительные сообщения вроде "1 f ile(s) updated" встречаются только из-за того, что автору программы лень проверить, равен ли счетчик 1.
Если образование множественного числа не сводится к простому добавлению суффикса s, измените функцию printf соответствующим образом:
printf "It took %d centur%s", $time, $time == 1 ? "y" : "ies";
В простых ситуациях такой вариант подходит, однако вам быстро надоест писать его снова и снова. Возникает желание написать для него специальную функцию:
sub noun_plural { local $_ = shift; # Порядок проверок крайне важен!
s/ss$/sses/ 11
s/([psc]h)$/${1}es/ ||
s/z$/zes/ 11
s/ff/$/ffs/ 11
s/f$/ves/ ||
s/ey$/eys/ 11
s/y$/ies/ ч 11
s/ix$/ices/ ||
s/([sx])$/$1es/ ||
s/$/s/ I|
die "can't get here"; • return $_;
¦verb_singular = \&noun_plural; # Синоним функции
Однако со временем будут находиться новые исключения и функция будет становиться все сложнее и сложнее. Если у вас возникнет потребность в подобных морфологических изменениях, воспользуйтесь универсальным решением, которое предлагает модуль Lingua:EN::Inflect от CPAN.
use Lingua::EN::Inflect qw(PL classical);
classical(1); # Почему не сделать по умолчанию?
while (<DATA>) { # Каждая строка данных for (split) { # Каждое слово в строке print "One $_, two", PL($_), ",\n";
# И еще один вариант
$_ = 'secretary general';
print "One $_, two ", PL($_), ".\n";
__END__ fish fly ox species genus jockey index matrix mythos phenomenon formula
Результат выглядит так:
One fish, two fish.
One fly, two flies.
One ox, two oxen.
One species, two species.
One genus, two genera.
One phylum, two phyla.
One cherub, two cherubim.
One radius, two radii.
One jockey, two jockeys.
One index, two indices.
One matrix, two matrices.
One mythos, two mythoi.
One phenomenon, two phenomena.
One formula, two formulae.
One secretary general, two secretaries general.
Мы рассмотрели лишь одну из многих возможностей модуля. Кроме того, он обрабатывает склонения и спряжения для других частей речи, содержит функции сравнения без учета регистра, выбирает между использованием а и an и делает многое другое.
> Смотри также---------------------------------------------------------------------------------------------
Описание тернарного оператора выбора в perlop(l); документация по модулю Lingua::EN::Inflect с CPAN.
2.19. Программа: разложение на простые множители
Следующая программа получает один или несколько целых аргументов и раскладывает их на простые множители. В ней используется традиционное числовое представление Perl, кроме тех ситуаций, когда представление с плавающей запятой может привести к потере точности. В противном случае (или при запуске с параметром -Ь) используется стандартная библиотека Math::Blight, что позволяет работать с большими числами. Однако библиотека загружается лишь при необходимости, поэтому вместо use используются ключевые слова require и import — это позволяет выполнить динамическую загрузку библиотеки во время выполнения вместо статической загрузки на стадии компиляции.
Запустите программу со списком чисел, и она выведет простые множители для каждого числа:
$ factors 8 9 96 2178
8 2**3
9 3**2
96 2**5 3
2178 2 3**2 11**2
Программа нормально работает и с очень большими числами:
% factors 239322000000000000000000 +239322000000000000000000 2**19 3 5**18 +39887 % factors 23932200000000000000000000 +25000000000000000000000000 2**24 5**26
Исходный текст программы приведен в примере 2.1.
Пример 2.1. bigfact
#!/usr/bm/perl
# bigfact - разложение на простые множители
use strict;
use integer;
use vars qw{ $opt_b $opt_d >; use Getopt::Std;
@ARGV && getopts('bd') or die "usage: $0 [-b] number ..,"; load_biglib() if $opt_b;
ARG: foreach my $orig ( @ARGV ) { my ($n, $root, %factors, Sfactor); $n = $opt_b ? Math::BigInt->new($orig) : $orig; if ($n + 0 ne $n) { # don't use -w for this
printf STDERR "bignum: %s would become %s\n", $n, $n+0 if $opt_d;
load_biglib();
$n = Math::BigInt->new($orig); } printf "%-10s ", $n;
Я $sqi равно квадрату $i. Используется тот факт, # что ($i + 1) •* 2 == $i •* 2 + 2 * $i + 1. for (my ($i, $sqi) = (2, 4); $sqi <= $n; $sqi += 2 * $i ++ + 1) { while ($n % $i == 0) {
$n /= $i;
print STDERR "" if $opt_d;
$factors
if ($n != 1 44 $n != long) { $factors{$n}++ } if (! «factors) {
print "PRIME\n";
next ARG; >
for $factor ( sort { $a <=> $b } keys %factors ) { print "$factor";
if ($factors{$factor} > 1) {
print "*«$factors{$factor}";
>
print " "; } print "\n";
# Имитирует use, но во время выполнений sub loadjaglib {
require Math::BigInt;
Math.:8iglnt->import();
Дата и время
Не следует требовать, чтобы время в секундах с начала
эпохи точно соответствовало количеству секунд между
указанным временем и началом эпохи.
Стандарт IEEE 1003 1b-1993 (POSIX) раздел В.2.2.2
Введение
Время и дата — очень важные величины, и с ними необходимо уметь работать. «Сколько пользователей регистрировалось за последний месяц?», «Сколько секунд я должен проспать, чтобы проснуться к полудню?» и «Не истек ли срок действия пароля данного пользователя?» — вопросы кажутся тривиальными, однако ответ на них потребует на удивление нетривиальных операций.
В Perl моменты времени представлены в виде интервалов, измеряемых в секундах с некоторого момента, называемого началом эпохи. В UNIX и многих других системах начало эпохи соответствует 00 часов 00 минут 1 января 1970 года по Гринвичу (GMT1). На Macintosh дата и время измеряется в местном часовом поясе. Функция gmtime возвращает правильное время по Гринвичу, основанное на смещении местного часового пояса. Помните об этом, рассматривая рецепты этой главы. На Macintosh количество секунд с начала эпохи позволяет отсчитывать время в интервале от 00:00 1 января 1904 года до 06:28:15 6 февраля 2040 года.
Говоря о времени и датах, мы часто путаем две разные концепции: момент времени (дата, время) и интервал между двумя моментами (недели, дни, месяцы и т. д.). При отсчете секунд с начала эпохи интервалы и моменты представляются в одинаковых единицах, поэтому с ними можно выполнять простейшие математические операции.
Однако люди не привыкли измерять время в секундах с начала эпохи. Мы предпочитаем работать с конкретным годом, месяцем, днем, часом, минутой и секундой. Более того, название месяца может быть как полным, так и сокращенным. Число может указываться как перед месяцем, так и после него. Использование разных форматов затрудняет вычисления, поэтому введенная пользователем или
прочитанная из списка строка даты/времени обычно преобразуется в количество секунд с начала эпохи, с ней производятся необходимые операции, после чего секунды снова преобразуются для вывода.
Для удобства вычислений количество секунд с начала эпохи всегда измеряется по Гринвичу. В любых преобразованиях всегда необходимо учитывать, представлено ли время по Гринвичу или в местном часовом поясе. Различные функции преобразования позволяют перейти от гринвичского времени в местное, и наоборот.
Функция Perl time возвращает количество секунд, прошедших с начала эпохи... более или менее' точно. Для преобразования секунд с начала эпохи в конкретные дни, месяцы, годы, часы, минуты и секунды используются функции localtime и gmtime. В списковом контексте эти функции возвращают список, состоящий из девяти элементов.
Переменная Значение Интервал
|
$sec |
Секунды |
0-60 |
|
$Ш1П |
Минуты |
0-59 |
|
$hours |
Часы |
0-23 |
|
$mday |
День месяца |
1-31 |
|
$month |
Месяц |
0-11, 0== январь |
|
$year |
Год, начиная с 1900 |
1-138 (и более) |
|
$wday |
День недели |
0-6,0 == воскресенье |
|
$yday |
День года |
1-366 |
|
$isdst |
Оили 1 |
true, если действует летнее время |
Секунды изменяются в интервале 0-60 с учетом возможных корректировок; под влиянием стандартов в любой момент может возникнуть лишняя секунда.
В дальнейшем совокупность «день/месяц/год/час/минута/секунда» будет обозначаться выражением «полное время» — хотя бы потому, что писать каждый раз «отдельные значения дня, месяца, года, часа, минут и секунд» довольно утомительно. Сокращение не связано с конкретным порядком возвращаемых значений.
Perl не возвращает данные о годе в виде числа из двух цифр. Он возвращает разность между текущим годом и 1900, которая до 1999 года представляет собой число из двух цифр. У Perl нет своей «проблемы 2000 года», если только вы не изобретете ее сами (впрочем, у вашего компьютера и Perl может возникнуть проблема 2038 года, если к тому времени еще будет использоваться 32-разрядная адресация). Для получения полного значения года прибавьте к его представлению 1900. Не пользуйтесь конструкцией 19$уеаг", или вскоре ваши программы начнут выдавать «год 19102». Мы не можем точно зафиксировать интервал года, потому что все зависит от размера целого числа, используемого вашей системой для представления секунд с начала эпохи. Малые числа дают небольшой интервал; большие (64-разрядные) числа означают огромные интервалы.
Fri Apr 11 09:27:08 1997
Объекты стандартного модуля Time::tm позволяют обращаться к компонентам даты/времени по именам. Стандартные модули Time::localtime и Time::gmtime переопределяют функции localtime и gmtime, возвращающие списки, и заменяют их версиями, возвращающими объекты Time::tm. Сравните два следующих фрагмента:
# Массив
print 'Today is day ', (localtime()[7], of the current year \n , Today is day 117 of the current year.
# Объекты Time tm
$tm = localtime,
print Today is day ', $tm->yday, of the current year \n , Today is day 117 of the current year.\
Чтобы преобразовать список в количество секунд с начала эпохи, воспользуйтесь стандартным модулем Time::Local. В нем имеются функции timelocal и timegm, которые получают список из девяти элементов и возвращают целое число. Элементы списка и интервалы допустимых значений совпадают с теми, которые возвращаются функциями localtime и gettime.
Количество секунд с начала эпохи ограничивается размером целого числа. Беззнаковое 32-разрядное целое позволяет представить время по Гринвичу от 20:45:52 13 декабря 1901 года до 03:14:07 19 января 2038 года включительно. Предполагается, что к 2038 году в компьютерах должны использоваться целые числа большей разрядности. Во всяком случае, будем надеяться на это. Чтобы работать с временем за пределами этого интервала, вам придется воспользоваться другим представлением или выполнять операции со отдельными значениями года, месяца и числа.
Модули Date::Calc и Date::Manip с CPAN работают с этими отдельными значениями, но учтите — они не всегда вычитают из года 1900, как это делает localtime, а нумерация месяцев и недель в них не всегда начинается с 0. Как всегда, в страницах руководства можно найти достоверные сведения о том, какая информация передается модулю, а какая — возвращается им. Только представьте, как будет неприятно, если рассчитанные вами финансовые показатели уйдут на 1900 лет в прошлое!
3.1. Определение текущей даты
Проблема
Требуется определить год, месяц и число для текущей даты.
Решение
Воспользуйтесь функцией localtime. Без аргументов она возвращает текущую дату и время. Вы можете вызвать localtime и извлечь необходимую информацию из полученного списка:
($DAY, $MONTH, $YEAR) = (localtime)[3,4,5],
Модуль Timc:: localtime переопределяет localtime так, чтобы функция возвращала объект Time::tm:
use Time localtime
$tm = localtime,
($DAY, SMONTH, $YEAR) = ($tm->mday, $tm->mon, $tm->year),
Комментарий
Вывод текущей даты в формате ГГГГ-ММ-ДД с использованием стандартной функции localtime выполняется следующим образом:
($day, Smonth, $year) = (localtime)[3,4 5],
printf( The current date is %04d %02d %02\n $year+1900, $month+1, $day),
The current date is 1999 04 28
Нужные ноля из списка, возвращаемою localtime, извлекаются с помощью среза. Запись могла выглядеть иначе:
($day, Smonth, $year) = (localtime)[3 5],
А вот как текущая дата выводится в формате ГГГГ-ММ-ДД (рекомендованном стандартом ISO 8601) с использованием Time::localtime:
use Time localtime
$tm = localtime,
printf( The current date is %04d-%02d-%02\n , $tm->year+1900,
($tm->mon)+1, $tm->mday) The current date is 1999-04-28
В короткой программе обьектный интерфейс выглядит ]1еуместпо. Однако при большом объеме вычислений с отдельными компонентами даты обращения по имени заметно упрощают чтение программы.
То же самое можно сделать и хитроумным способом, не требующим создания временных переменных:
printf( The current date is %04d-%02d-%02\n ,
sub {($_[5]+1900, $_[4]+1 $_[3])}->(localtime)),
Кроме того, в модуле POSIX имеется функция strftime, упоминаемая в рецепте 3.8:
use POSIX qw(strftime),
print strftime %Y-%m-%d\n , localtime,
Функция gmtime работает аналогично localtime, но возвращает время по Гринвичу, а не для местного часового пояса.
> Смотри также---------------------------------------------------------------------------------------------
Описание функций localtime и gmtime вperlfunc(l); документация по стандартному модулю Time::locallime.
Проблема
Требуется преобразовать дату/время, выраженные отдельными значениями дня, месяца, юда и т. д. в количество секунд с начала эпохи.
Решение
Воспользуйтесь функцией timelocal пли timegm стандартного модуля Time::Local. Выбор зависит от того, относится ли дата/время к текущему часовому поясу пли Гринвичскому меридиану:
use Time Local,
$TIME = timelocal($sec, $mm, $hours Smday, Smon, $year)
$TIME = timegm($sec, $min, $hours $mday, $mon $year),
Комментарий
Встроенная функция localtime преобразует количество секунд с начала эпохи в компоненты полного времени; процедура timelocal из стандартного модуля Time::Local преобразует компоненты полного времени в секунды. Следующий пример показывает, как определяется количество секунд с начала эпохи для текущей даты. Значения дня, месяца и года получаются от localtime:
# $hours, Sminutes и Sseconds задают время для текущей даты
# и текущего часового пояса
use Time Local
$time = timelocal($seconds, Sminutes, $hours, (localtime)[3 4,5])
Если функции timelocal передаются месяц и год, они должны принадлежать тем же интервалам, что и значения, возвращаемые localtime. А именно, нумерация месяцев начинав!ся с 0, а из года вычитается 1900.
Функция timelocal предполагает, что компоненты полного времени соответствуют текущему часовому поясу. Модуль Time::Local также экспортирует процедуру timegm, для которой компоненты полного времени задаются для Гринвичского меридиана. К сожалению, удобных средств для работы с другими часовыми поясами, кроме текущего или Гринвичского, не существует. Лучшее, что можно сделать, — преобразовать время к Гринвичскому и вычесть или прибавить смещение часового пояса в секундах.
В следующем фрагменте демонстрируется как применение timegm, так и настройка интервалов года и месяца:
# $day - день месяца (1-31)
# $month - месяц (1-12)
8 $уеаг - год, состоящий из четырех цифр (например, 1999)
# $hours, Sminutes и Sseconds - компоненты времени по Гринвичу
use Time Local,
$time = timegm($seconds, Sminutes $hours, Sday, $month-1, Syear-1900)
Как было показано во введении, количество секунд с начала эпохи не может выходить за пределы интервала от 20:45:52 13 декабря 1901 года до 03:14:07 19 января 2038 года включительно. Не преобразуйте такие даты — либо воспользуйтесь модулем Date:: с CPAN, либо выполните вычисления вручную.
> Смотри также---------------------------------------------------------------------------------------------
Документация по стандартному модулю Time::Local. Обратное преобразование рассматривается в рецепте 3.3.
3.3. Преобразование секунд с начала эпохи в полное время
Проблема
Требуется преобразоват ь количество секунд с начала эпохи в отдельные значения дня, месяца, года и т. д
Решение
Воспользуйтесь функцией localtime или gmtime в зависимости от того, хотите ли вы получить дату/время для текущего часового пояса или для Гринвичского меридиана.
(Sseconds $minutes, $hours $day_of_month $year $wday, $yday $isdst) = localtime($TIME)
Стандартные модули Time-.timelocal n Time: gmtime переопределяют функции localtime и gmtime так, чтобы к компонентам можно было обращаться по именам:
use Time localtime, # или Time gmtime $tm = localtime($TIME), # или gmtime($TIME) Sseconds = $tm->sec, #
Комментарий
Функции localtime и gettime возвращают несколько странную информацию о годе и месяце; из года вычитается 1900, а нумерация месяцев начинается с 0 (январь). Не забудьте исправить полученные величины, как это делается в следующем примере:
(Sseconds, Smmutes $hours, $day_of_month, $month, Syear,
$wday, $yday, $isdst) = localtime($time), pnntf( Dateline %02d %02d %02d-%04d/%02d/%02d\n ,
Shours, $mmutes, Sseconds, $year+1900, $month+1,
$day_of_nionth),
Модуль Time::localtime позволяет избавиться от временных переменных:
use Time localtime, $tm = localtime($time)
100 Глава 3 • Дата и время
printf( Dateline %02d %02d %02d-%04d/%02d/%02d\n , $tm->hour, $tm->min, $tm->sec, $tm->year+1900, $tm->mon+1, $tm->mday),D> Смотри также------------------------------------------------------------------------------------------
Описание функции localtime в perlfunc(i); документация по стандартным модулям Timc::localtime и Time::gmtirae. Обратное преобразование рассматривается в рецепте 3.2.
3.4. Операции сложения и вычитания для дат
Проблема
Имеется значение даты/времени. Требуется определить дату/время, отделенную от них некоторым промежутком в прошлом или будущем.
Решение
Проблема решается простым сложением или вычитанием секунд с начала эпохи:
$when = $now + Sdifference, $then = Snow - Sdifference,
Если у вас имеются отдельные компоненты полного времени, воспользуйтесь модулем Date::Calc с CPAN. Если вычисления выполняются только с целыми днями, примените функцию Add_Delta_Days (смещение $offset может представлять собой как положительное, так и отрицательное целое количество дней):
use Date Calc qw(Add_Delta_Days),
($y2, $iTi2, $d2) = Add_Dclta_Days($y, $m, $d, Soffset)
Если в вычислениях используются часы, минуты и секунды (то есть не только дата, но и время), воспользуйтесь функцией Add_Delta_DHMS:
use Date DateCalc qw(Add_Delta_DHMS), ($year2, Smonth2, Sday2, $h2, $m2, $s2) =
Add_Delta_DHMS( $year, Smonth, $day, Shour Smmute, Sseconds, $days_offset, $hour_offset, $minute_offset, $seconds_offset ),
Комментарий
Вычисления с секундами от начала эпохи выполняются проще всего (если не считать усилий па преобразования даты/времени в секунды и обратно). В следующем фрагменте показано, как прибавить смещение (в данном примере — 55 диен, 2 часа, 17 минут и 5 секунд) к заданной базовой дате и времени:
Sbirthtime = 96176750, # 18 января 1973 года, 03 45 50
Sinterval = 5 + #5 секунд
17 • 60 + #17 минут
2 - 60 * 60 + #2 часа
55 ¦ 60 * 60 • 24, й и 55 дней $then = Sbirthtime + Smterval, print 'Then is ", scalar(localtime($then)), \n , Then is Wed Mar 14 06:02:55 1973
Мы также могли воспользоваться функцией Add_Delta_DHMS и обойтись без преобразований к секундам с начала эпохи и обратно:
use Date Calc qw(Add_Delta_DHMS),
($year, Smonth $day, $hh, $mm, $ss) = Add_Delta_DHMS(
1973, 1, 18, 3, 45, 50, # 18 января 1973 года, 03 45 50
55, 2, 17, 5), # 55 дней, 2 часа, 17 минут, 5 секунд print To be prcise $hh $mm $ss, $month/$day/$year\n', To be precise: 6:2:55, 3/14/1973
Как обычно, необходимо проследить, чтобы аргументы функции находились в правильных интервалах. Add_Delta_DHMS получает полное значение года (без вычитания 1900). Нумерация месяцев начинается с 1, а не с 0. Аналогичные параметры передаются и функции Add_Delta_Days модуля Date::DateCalc:
use Date DateCalc qw(Add_Delta_Days), ($year, Smonth, $day) = Add_Delta_Days( 1973, 1, 18, 55), print Nat was 55 days old on $month/$day/$year\n Nat was 55 days old on: 3/14/1973
Смотри также
Документация по модулю Date::Calc от CPAN.
3.5. Вычисление разности между датами
Проблема
Требуется определить количество дней между двумя датами или моментами времени.
Решение
Если даты представлены в виде секунд с начала эпохи и принадлежат интервалу от 20:45:52 13 декабря 1901 года до 03:14:07 19 января 2038 года включительно, достаточно вычесть одну дату из другой и преобразовать полученные секунды в дни:
Sseconds = $recent = $earlier
Если вы работаете с отдельными компонентами полного времени или беспокоитесь об ограничениях интервалов для секунд с начала эпохи, воспользуйтесь модулем Date::Calc с CPAN. Он позволяет вычислять разность дат:
use Date Calc qw(Delta_DHMS), ($days, Shours, $minutes, Sseconds) =
Delta_DHMS( Syeari, $month1, $day1, $hour1, $minute1, $seconds1, # Ранний
ft момент
$year2, $month2, $day2, $hour2, $mmute2, $seconds2, й Поздний
й момент
Одна из проблем, связанных с секундами с начала эпохи, — преобразование больших целых чисел в форму, понятную для человека. Следующий пример демонстрирует один из способов преобразования секунд с начала эпохи в привычные недели, дни, часы, минуты и секунды:
$bree = 361535725, # 04 35 25 16 июня 1981 года $nat = 96201950, # 03 45 50 18 января 1973 года
$difference = $bree - $nat,
print There were Sdifference seconds between Nat and Bree\n ,
There were 266802575 seconds between Nat and Bree
Sseconds = Sdifference % 60,
Sdifference = (Sdifference - Sseconds) / 60
Sminutes = Sdifference % 60,
Sdifference = (Sdifference - Sminutes) / 60,
Shours = Sdifference $ 24,
Sdifference = (Sdifference - Shours) / 24,
Sdays = Sdifference % 7,
$weeks = (Sdifference - Sdays) / 7,
print (Sweeks weeks, Sdays days, Shours Sminutes $seconds)\n , (441 weeks, 0 days, 23: 49: 35)
Функции модуля Date::Calc упрощают подобные вычисления. Delta_Days возвращает количество дней между двумя датами. Даты передаются ей в виде списка «год/месяц/деиь» в хронологическом порядке, то есть начиная с более ранней.
> Смотри также---------------------------------------------------------------------------------------------
Документация по стандартному модулю Date::Calc с CPAN.
3.6. Определение номера недели или дня недели/месяца/года
Проблема
Имеется дата в секундах с начала эпохи или в виде отдельных компонентов — года, месяца и т. д. Требуется узнать, на какой номер недели или день недели/месяца/года она приходится.
Решение
Если дата выражена в секундах с начала эпохи, день года, день месяца или недели возвращается функцией localtime. Номер недели легко рассчитывается по дню года.
3.6. Определение номера недели или дня недели/месяца/года 103
(SMONTHDAY, $WEEKDAY, $YEARDAY) = (localtime $DATE) [3,6,7], $WEEKNUM = mt($YEARDAY / 7) + 1,Отдельные компоненты полного времени можно преобразовать в число секунд с начала эпохи (см. рецепт 3.3) и воспользоваться приведенным выше решением. Возможен и другой вариант — применение функций Day_of_Week, Week_Number и Day_of_Year модуля Date::Calc с CPAN:
use Date Calc qw(Day_of_Week Week_Number Day_of_Year),
# Исходные величины - $year, Smonth и $day
# По определению $day является днем месяца
$wday = Oay_of_Week($year $month, $day),
$wnum = Week_Number($year, $month, $day),
$dnum = Day_of_Year($year, $month $day),
Комментарий
Функции Day_of_Week, Week_Number и Day_of_Year получают год без вычитания 1900 и месяц в нумерации, начинающейся с 1 (январь), а не с 0. Возвращаемое значение функции Day_of_Week находится в интервале 1-7 (с понедельника до воскресенья) или равняется 0 в случае ошибки (например, при неверно заданной дате).
use Date Calc qw(Day_of_Week Week_Number),
$year = 1981,
Smonth =6, # (Июнь)
$day = 16,
№ys = qw Error Monday Tuesday Wednesday Thursday Friday Saturday Sunday ,
$wday = Day_of_Week($year, $month $day), print $month/$day/$year was a $days[$wday]\n ,
$wnum = Week_Number($year, $month, $day), print in the $wnum week \n , 6/16/1981 was a Tuesday in the 25 week
В некоторых странах сущестнуют специальные стандарты, касающиеся первой недели года. Например, в Норвегии первая педеля должна содержать не менее 4 дней (и начинаться с понедельника). Если 1 января выпадает па неделю из 3 и менее дней, она считается 52 или 53 неделей предыдущего года. В Америке первая рабочая неделя обычно начинается с первого понедельника года. Возможно, при таких правилах вам придется написать собственный алгоритм или по крайней мере изучить форматы %G, %L, %W и %U функции UmxDate модуля Date::Manip.
t> Смотри также--------------------------------------------------------------------------------------------
Описание функции localtime в perlfunc(l); документация по стандартному модулю Date::Calc от CPAN.
Проблема
Спецификация даты или времени читается в произвольном формате, однако ее требуется преобразовать в отдельные компоненты (год, месяц и т. д.).
Решение
Если дата уже представлена в виде числа пли имеет жесткий, легко анализируемый формат, воспользуйтесь регулярным выражением (и, возможно, хэшем, связывающим названия месяцев с номерами) для извлечения отдельных значений дня, месяца и года. Затем преобразуйте их в секунды с начала эпохи с помощью функций timelocal и timegm стандартного модуля Timc::Local.
use Time Local,
# $date хранится в формате 1999-06-03 (ГГГГ-ММ-ДД)
($уууу, $mm $dd) = ($date =" /(\d+)-(\d+)-(\d+)/
й Вычислить секунды с начала эпохи для полночи указанного дня
# в текущем часовом поясе
$epoch_seconds = timelocal(0 0, 0 $dd, $mm $уууу)
Более гибкое решение — применение функции ParseDate из модуля Date::Manip с CPAN и последующее извлечение отдельных компонентов с помощью UnixOate.
use Date Manip qw(ParseDate UnixDate), $date = ParseDate($STRING) if O$date) {
# Неверная дата } else {
LVALUES = UmxDate($date ©FORMATS) }
Комментарий
Универсальная функция ParseDate поддерживает различные форматы дат. Она даже преобразует такие строки, как «today» («сегодня»), «2 weeks ago Friday» («в пятницу две недели назад») и «2nd Sunday in 1996» («2-е воскресенье 199G года»), а также понимает форматы даты/времени в заголовках почты и новостей. Расшифрованная дата возвращается в собственном формате — строке вида «ГГГГММДДЧЧ:ММ:СС». Сравнение двух строк позволяет узнать, совпадают ли представленные ими даты, однако арифметические операции выполняются иначе. Поэтому мы воспользовались функцией UnixDate для извлечения года, месяца и дня в нужном формате.
Функция UnixDate получает дату в виде строки, возвращаемой ParseDate, и список форматов. Она последовательно применяет каждый формат к строке и возвращает результат. Формат представляет собой строку с описанием одного или нескольких элементов даты/времени и способов оформления этих элементов. Например, формат %Y соответствует году, состоящему из четырех цифр. Приведем пример:
3.8. Вывод даты 105
use Date Mamp qw(ParseDate UnixDate)
while (<>) <
$date = ParseDate($_) if (i$date) {
warn Bad date string $_\n ,
next, } else {
($year, $month, $day) = UmxDate($date, %Y , %n , %d ),
print Date was $month/$day/$year\n
t> Смотри также--------------------------------------------------------------------------------------------
Документация для модуля Date::Manip с CPAN; пример использования приведен в рецепте 3.11.
3.8. Вывод даты
Проблема
Требуется преобразовать дату и время, выраженные в секундах с начала эпохи, в более понятную для человека форму
Решение
Вызовите localtime пли gmtime в скалярном контексте — в эюм случае функция получает количество секунд с начала эпохи и возвращает строку вида Tue May 26 05:15-20 1998:
SSTRING = localtime($EPOCH_SECONDS),
Кроме того, функция strftime из стандартного модуля POSIX позволяет лучше настроить формат вывода и работает с отдельными компонентами полного времени:
use POSIX qw(strftime),
SSTRING = strftime($FORMAT SSECONDS, SMINUTES, SHOUR,
$DAY_OF_MONTH SMONTH, $YEAR, $WEEKDAY,
SYEARDAY, $DST),
В модуле Date::Manip с CPAN есть функция UnixDate — нечто вроде специализированного варианта spnntf, предназначенного для работы с датами. Ей передается дата в формате Date::Manip. Применение Date::Manip вместо POSIX::strftime имеет дополнительное преимущество, так как для этого от системы не требуегся совместимость с POSIX.
use Date Manip qw(UmxDate) SSTRING = UmxDate($DATE, SFORMAT),
Простейшее решение — функция localtime — относится к встроенным средствам Perl. В скалярном контексте эта функция возвращает строку, отформатированную особым образом:
Sun Sep 21 15:33:36 1999
Программа получается простой, хотя формат строки сильно ограничен:
use Time Local,
$time = timelocal(50, 45, 3, 18, 0, 73)
print Scalar localtime gives scalar(localtime($time)), \n ,
Scalar localtime gives1. Thu Jan 18 03:45:50 1973
Разумеется, дата и время для localtime должны исчисляться в секундах с начала эпохи. Функция POSIX strftime получаст набор компонентов полного времени и форматную строку, аналогичную pnntf, и возвращает также строку. Поля в выходной строке задаются директивами %. Полный список директив приведен в документации по strftime для вашей системы. Функция strftime ожидает, что отдельные компоненты дагы/временп принадлежат тем же интервалам, что и значения, возвращаемые localtime:
use POSIX qw(strftime),
use Time Local
$time = timelocal(50, 45 3, 18 0, 73),
print Scalar localtime gives , scalar(localtime($time)) \n ,
Scalar localtime gives: Thu Jan 18 03:45:50 1973
Разумеется, дата и время для localtime должны исчисляться в секундах с начала эпохи. Функция POSIX strftime получает набор компонентов полного времени и форматную строку, аналогичную pnntf, и возвращает также строку. Поля в выходной строке задаются директивами %. Полный список директив приведен в документации по strftime для вашей системы. Функция strftime ожидает, что отдельные компоненты даты/времени принадлежат тем же интервалам, что и значения, возвращаемые localtime:
use POSIX qw(strftime),
use Time Local,
$time = timelocal(50, 45 3, 18, 0, 73),
print strftime gives , strftime( %A %D , localtime($time)) \n ,
strftime gives: Thursday 01/18/73
При использовании POSIX • strftime все значения выводятся в соответствии с национальными стандартами. Так, во Франции ваша программа вместо "Sunday" выведет "Dimanche". Однако учтите: интерфейс Perl к функции strftime модуля POSIX всегда преобразует дату в предположении, что она относится к текущему часовому поясу.
Если функция strftime модуля POSIX недоступна, у вас всегда остается верный модуль Date::Manip, описанный в рецепте 3.6.
use Date Manip qw(ParseDate UnixDate), $date = ParseDate( 18 Jan 1973, 3 45 50 ),
3.9. Таймеры высокого разрешения 107
$datestr = UmxOate($date, %а %Ь %е %Н %М %S %г %У ), # скалярный контекст print Date Manip gives $datestr\n , Date::Mamp gives: Thu Jan 18 03:45:50 GMT 1973
!> Смотри также--------------------------------------------------------------------------------------------
Описание функции gmtime и localtime в perlfunc(l); perllocale(l); man-страшще strftime(3) вашей системы; документация по модулям POSIX и Date::Manip cCPAN.
3.9. Таймеры высокого разрешения
Проблема
Функция time возвращает время с точностью до секунды. Требуется измерить время с более высокой точностью.
Решение
Иногда эта проблема неразрешима. Если на вашем компьютере Perl поддерживает функцию syscall, а в системе имеется функция типа gettimeofday(2), вероятно, ими можно воспользоваться для измерения времени. Особенности вызова syscall зависят от конкретного компьютера. В комментарии приведен примерный вид фрагмента, однако его переносимость не гарантирована.
На некоторых компьютерах эти функциональные возможности инкапсулируются в модуле Time::HiRes (распространяется с CPAN):
use Time HiRes qw(gettimeofday), $tO = gettimeofday, ## Ваши операции $t1 = gettimeofday, $elapsed = $t1 - $tO,
# $elapsed - значение с плавающей точкой, равное числу секунд
# между $t1 и $t2
Комментарий
В следующем фрагменте модуль Time::HiRcs используется для измерения промежутка между выдачей сообщения и нажатием клавиши RETURN:
use Time HiRes qw(gettimeofday), print "Press return when ready ", Sbefore = gettimeofday; $lme = <>;
$elapsed = gettimeofday-Sbefore, print You took $elapsed seconds \n , Press return when ready: You took 0.228149 seconds.
Сравните с эквивалентным фрагментом, использующим syscall:
Глава 3 • Дата и время
require 'sys/syscall ph ,# Инициализировать структуры, возвращаемые gettirneofday
$TIMEVAL_T = LL
$done = $start = pack($TIMEVAL_T, ()),
# Вывод приглашения
print Press return when ready
# Прочитать время в $start
syscall(&SYS_gettimeofday, Sstart 0)) '= -1
|[ die gettimeofday $' ,
# Прочитать перевод строки
$lme = <>,
# Прочитать время в $done
syscall(&SYS_gettimeofday, $done 0) '= -1
I| die gettimeofday $'
it Распаковать структуру
@start = unpack($TIMEVAL_T, Sstart),
@done = unpack($TIMEVAL_T, $done),
ft Исправить микросекунды
for ($done[1], $start[1]) { $_ /= 1_000_000 }
# Вычислить разность
$delta_time = sprintf % 4f , ($done[0] + $done[1] )
($start[0] + $start[1] )
print That took $delta_time seconds\n , Press return when ready. That took 0.3037 seconds
Программа получилась более длинной, поскольку системные функции вызываются непосредственно из Perl, а в Time::HiRes они реализованы одной функцией С. К тому же она стала сложнее — для вызова специфических функций операционной системы необходимо хорошо разбираться в структурах С, которые передаются системе и возвращаются eii. Некоторые программы, входящие в поставку Perl, пытаются автоматически определить форматы pack и unpack по заголовочному файлу С. В нашем примере sys/syscall.ph — библиотечный файл Perl, сгенерированный утилитой Ii2ph, которая преобразует заголовочный файл sys/ syscallh в sys/syscall.ph. В частности, в нем определена функция &SYS_gettimeof day, возвращающая номер системного вызова для gettimeofday.
Следующий пример показывает, как использовать Time::HiRes для измерения временных характеристик:
use Time HiRes qw(gettimeofday),
# Вычислить среднее время сортировки
$size = 500, $number_of_times = 100 $total_time = О
for ($i =0, $i < number_of_times $i++) { my (is>array, $j, $begm, $time),
# Заполнить массив
@array = (),
for ($]=0, $j<$size $]++) { push(@array, rand) }
# Выполнить сортировку
$begm = gettimeofday,
@array = sort { $a <=> $b } ©array $time = gettimeofday=$t1, $total_time += $time,
printf On average, sorting %d random numbers takes %5 f seconds\n
$size ($total_time/$number_of_times), On average, sorting 500 random numbers takes 0.02821 seconds
t> Смотри также--------------------------------------------------------------------------------------------
Документация по модулям Timc::HiRes и BenchMark с CPAN; описание функции syscall в perlfunc(l); man-страница syscall(2).
3.10. Короткие задержки
Проблема
Требуется сделать в программе паузу продолжительностью менее секунды.
Решение
Воспользуйтесь функцией select, если она поддерживается вашей системой:
select(undef undef undef, $time_to_sleep) где $time_to_sleep — длительность паузы.
Некоторые системы не поддерживают select с четырьмя аргументами. В модуле Time::HiRcs присутствует функция sleep, которая допускает длину паузы с плавающей точкой:
use Time HiRes qw(sleep), sleep($time_to_sleep),
Комментарий
Следующий фрагмент демонстрирует применение функции select. Он представляет собой упрощенную версию программы из рецепта 1.5. Можете рассматривать его как эмулятор 300-бодного терминала:
select(undef, undef undef, 0 25)
print, }
С помощью Timc::HiRes это делается так:
use Time HiRes qw(sleep) while (о) {
sleep(0 25)
print, >
> Смотри также--------------------------------------
Документация по модулям Time.:HiRcs и BenchMark с CPAN; описание функций sleep и select в perlfunc(i). Функция select использована для организации короткой задержки в программе slowcat из рецепта 1.5.
3.11. Программа: hopdelta
Вы никогда не задавались вопросом, почему какое-нибудь важное письмо так долго добиралось до вас? Обычная почта не позволит узнать, как долго ваше письмо пылилось па полках всех промежуточных почтовых отделений. Однако в электронной почте такая возможность имеется. В заголовке сообщения присутствует строка Received: с информацией о том, когда сообщение было получено каждым промежуточным транспортным агентом.
Время в заголовках воспринимается плохо. Его приходится читать в обратном направлении, снизу вверх. Оно записывается в разных форматах по прихоги каждого транспортного агента. Но хуже всего то, что каждое время регистрируется в своем часовом поясе. Взглянув на строки "Tue, 26 May 1998 23 57.38 -0400" и "Wed, 27 May 1998 05.04.03 +0100", вы вряд ли сразу поймете, что эти два момента разделяют всего 6 минут 25 секунд.
На помощь приходят функции ParseDate и DateCalc модуля Date::Manip от CPAN:
use Date Mamp qw(ParseDate DateCalc)
$d1 = ParseDate( Tue, 26 May 1998 23 57 38 -0400 ),
$d2 = ParseDate( Wed, 27 May 1998 05 04 03 +0100 ),
print DateCalc($d1, $d2),
+0:0.0:0:0:6:25
Возможно, с такими данными удобно работать программе, но пользователь все же предпочтет что-нибудь более привычное. Программа hopdelta из примера 3.1 получает заголовок сообщения и пытается проанализировать дельты (разности) между промежуточными остановками. Результаты выводятся для местного часового пояса.
Пример 1.3. hopdelta
tt'/usr/bin/perl
# hopdelta - по заголовку почтового сообщения выдает сведения
U о задержке почты на каждом промежуточном участке
use strict
use Date Manip qw (ParseDate UnixDate),
# Заголовок печати, из-за сложностей printf следовало
# бы использовать format/write
printf %-20 20s %-20 20s 96-20 20s %s\n ,
Sender , Recipient , Time , Delta ,
$/ = # Режим абзаца
$_ = о # Читать заголовок
s/\n\s+/ /g, й Объединить строки продолжения
# Вычислить, когда и где начался маршрут сообщения
my($start_from) = /"From *\@(["\s>]«)/m,
my($start_date) = /"Date \s+( *)/m,
my $then = getdate($start_date),
printf %-20 20s %-20 20s %s\n , Start , $start_from, fmtdate($then)
my $prevfrom = $start_from
# Обрабатывать строки заголовка снизу вверх
for (reverse split(/\n/)) {
my ($delta, $now, $from, $by, $when),
next unless /"Received /
s/\bon ( *?) (id *)/, $1/s, n Кажется, заголовок qmail
unless (($when) = / \s+( *)$/) { # where the date falls
warn bad received line $_ ,
next
($from) = /from\s+(\S+)/,
($from) = /\(( *9)\)/ unless $from # Иногда встречается
$from =~ s/\)$//, й Кто-то пожадничал
($by) = /by\s+(\S+\ \S+)/ # Отправитель для данного участка
# Операции, приводящие строку к анализируемому формату for ($when) {
s/ (for|via) *$//,
s/([+-]\d\d\d\d) \(\S+\)/$V,
s/id \S+,VW/.
next unless $now = getdate($when), tt Перевести в секунды
# с начала эпохи $delta = $now - $then,
printf %-20 20s %-20 20s %s , $from, $by, fmtdate($now), Sprevfrom = $by puttime($delta), $then = $now, }
exit,
продолжение rf>
11? Глава 3 • Дата и время Пример 1.3 (продолжение)
# Преобразовать произвольные строки времени в секунды с начала эпохи sub getdate {my Sstring = shift,
$stnng =" s/\s+\( *\)\s*$//, # Убрать нестандартные
# терминаторы
my $date = ParseDate($stnng)
my $epoch_secs = UmxDate($date %s ),
return $epoch_secs,
# Преобразовать секунды с начала эпохи в строку определенного формата sub fmtdate {
my Sepoch = shift,
my($sec, $mm, $hour, $mday, $mon, $year) = localtime($epoch), return sprintf %02d %02d %02d %04d/%02d/%02d Shour, $mm, $sec, $year + 1900, $mon + 1, $mday,
# Преобразовать секунды в удобочитаемый формат sub puttime {
fny($seconds) = shift,
my($days, Shours, Sminutes),
$days = pull_count($seconds 24 * 60 * 60),
Shours = puli_count($seconds 60 - 60),
Smmutes = pull_count($seconds 60)
put_field('s' $seconds),
put_field('n', $mmutes)
put_field('h , Shours),
put_field('d', $days)
print \n ,
# Применение $count = pull_count(seconds, amount)
# Удалить из seconds величину amount изменить версию вызывающей
# стороны и вернуть число удалений
sub pull_count {
my(Sanswer) = mt($_[0] / $_[1]), $_[0] -= Sanswer . $_[1], return Sanswer,
# Применение put_field(char, number)
# Вывести числовое поле в десятичном формате с 3 разрядами и суффиксом char
й Выводить лишь для секунд (char == s )
sub put_field {
my ($char, Snumber) = @_,
printf %3d%s , Snumber, $char if $numbet |[ $char eq 's',
|
Sender |
Recipient |
Time |
Delta |
|
|
Start |
wall.org |
09:17:12 |
1998/05/23 |
44s 3m |
|
wall.org |
mail.brainstorm.net |
09:20:56 |
1998/05/23 |
|
|
mail.brainstorm.net |
ihereg.perl.com |
09:20:58 |
1998/05/23 |
2s |
Массивы
Я считаю, что произведения искусства — единственные объекты
материальной Вселенной, обладающие внутренним порядком.
И потому, не веря в высшую ценность искусства,
я все же верю в Искусство ради Искусства.
Э. М. Фостер
Введение
Если попросить вас перечислить содержимое своих карманов, назвать имена трех последних президентов или объяснить, как пройти к нужному месту, в любом случае получится список: вы называете объекты один за другим в определенном порядке. Списки являются частью нашего мировоззрения. Мощные примитивы Perl для работы со списками и массивами помогают преобразовать мировоззрение в программный код.
Термины список (list) n массив (array) трактуются в этой главе в соответствии с канонами Perl. Например, ("Reagan' , "Bush", "Clinton") — это список трех последних американских президентов. Чтобы сохранить его в переменной, воспользуйтесь массивом: @рresidents = ("Reagan", "Bush", "Clinton"). Каждый из этих терминов относится к упорядоченной совокупности скалярных величин; отличие состоит в том, что массив представляет собой именованную переменную, размер которой можно непосредственно изменить, а список является скорее отвлеченным понятием. Можно рассматривать массив как переменную, а список — как содержащиеся в пей значения.
Отличие может показаться надуманным, но операции, изменяющие размер этой совокупности (например, push или pop), работают с массивом, а не списком. Нечто похожее происходит с $а и 4: в программе можно написать $а++, но не 4++. Аналогично, рор(@а) — допустимо, а рор(1, 2,3)— нет.
Главное — помнить, что списки и массивы в Perl представляют собой упорядоченные совокупности скалярных величин. Операторы и функции, работающие со списками и массивами, обеспечивают более быстрый или удобный доступ к элементам по сравнению с ручным извлечением. Поскольку размер массива изменяется не так уж часто, термины «массив» и «список» обычно можно считать синонимами.
Вложенные списки не создаются простым вложением скобок. В Perl следующие строки эквивалентны:
fanested = ('this , 'that , "the", order'), ©nested = ("this', "that", ('the', 'order')),
Почему Perl не поддерживает вложенные списки напрямую? Отчасти по историческим причинам, но также и потому, что это позволяет многим операциям (типа print или sort) работать со списками произвольной длины и произвольного содержания.
Что делать, если требуется более сложная структура данных — например, массив массивов или массив хэшей? Вспомните, что скалярные переменные могут хранить не только числа или строки, но и ссылки. Сложные (многоуровневые) структуры данных в Perl всегда образуются с помощью ссылок. Следовательно, «двумерные массивы» или «массивы массивов» в действительности реализуются как массив ссылок на массивы — по аналогии с двумерными массивами С, которые могут представлять собой массивы указателей на массивы.
Для большинства рецептов этой главы содержимое массивов несущественно. Например, проблема слияния двух массивов решается одинаково для массивов строк, чисел или ссылок. Решения некоторых проблем, связанных с содержимым массивов, приведены в главе 11 «Ссылки и записи». Рецепты этой главы ограничиваются обычными массивами.
Давайте введем еще несколько терминов. Скалярные величины, входящие в массив или список, называются элементами. Для обращения к элементу используется его позиция, или индекс. Индексация в Perl начинается с 0, поэтому в следующем списке:
<9>tune = ('The', 'Star-Spangled', 'Banner' );
элемент "The ' находится в первой позиции, но для обращения к нему используется индекс 0: $tune[O]. Это объясняется как извращенностью компьютерной логики, где нумерация обычно начинается с 0, так и извращенностью разработчиков языка, которые выбрали 0 как смещение внутри массива, а не порядковый номер элемента.
4.1. Определение списка в программе
Проблема
Требуется включить в программу список — например, при инициализации массива.
Решение
Перечислите элементы, разделяя их запятыми:
@а = ("quick", "brown", 'fox"),
При большом количестве однословных элементов воспользуйтесь оператором qw():
@а = qw(Why are you teasing me7);
Mines = (« END_OF_HERE_DOC =' m/~\s*( +)/gm),
The boy stood on the burning deck,
It was as hot as glass END_OF_HERE_DOC
Комментарий
Наиболее распространен первый способ — в основном из-за того, что в виде литералов в программе инициализируются лишь небольшие массивы. Инициализация большого массива загромождает программу и усложняет ее чтение, поэтому такие массивы либо инициализируются в отдельном библиотечном файле (см. главу 12 «Пакеты, библиотеки и модули»), либо просто читаются из файла данных:
@bigarray = (),
open(DATA, < mydatafile ) or die Couldn t read from datafile $'\n ,
while (<DATA>) {
chomp,
push(@bigarray, $_), }
Во втором способе используется оператор qw. Наряду с q(), qq() и qx() он предназначен для определения строковых величин в программе. Оператор q() интерпретируется по правилам для апострофов, поэтому следующие две строки эквивалентны:
$banner = 'The mines of Moria , Sbanner = q(The mines of Moria),
Оператор qq() интерпретируется по правилам для кавычек:
$name = Gandalf ,
Sbanner = Speak, $name, and enter1 ,
Sbanner = qq(Speak, Sname, and welcome1),
А оператор qx() интерпретируется почти так же, как и обратные апострофы, — то есть выполняет команду с интерполяцией неременных и служебными символами \ через командный интерпретатор. В обратных апострофах интерполяцию отменить нельзя, а в qx — можно. Чтобы отказаться от расширения переменных Perl, используйте в qx ограничитель ':
$his_host = 'www perl com ,
$host_info = nslookup $his_host , # Переменная Perl расширяется
$perl_info = qx(ps $$), # Значение $$ от Perl
$shell_mfo = qx ps $$', # Значение $$ от интерпретатора
Если операторы q(), qq() и qx() определяют одиночные строки, то qw() определяет список однословных строк. Строка- аргумент делится по пробелам без интерполяции переменных. Следующие строки эквивалентны:
@banner = ('Costs', 'only , $4 95 ),
@banner = qw(Costs only $4 95),
@banner = split( ', 'Costs only $4 95');
Во всех операторах определения строк, как и при поиске регулярных выражений, разрешается выбор символа-ограничителя, включая парные скобки. Допустимы все четыре типа скобок (угловые, квадратные, фигурные и круглые). Следовательно, вы можете без опасении использовать любые скобки при условии, что для открывающей скобки найдется закрывающая:
§brax = qw1 ()<>{}[]'.
brings = qw(Nenya Narya Vilya),
Stags = qw<LI TABLE TR TD A IMG H1 P>,
$sample = qw(The vertical bar (|) looks and behaves like a pipe ),
Если ограничитель встречается в строке, а вы не хотите заменить его другим, используйте префикс \:
©banner = qw)The vertical bar (\|) looks and behaves like a pipe |,
Оператор qw() подходит лишь для списков, в которых каждый элемент является отдельным словом, ограниченным пробелами. Будьте осторожны, а то у Колумба вместо трех кораблей появится четыре:
$ships = qw(Nica Pmta Santa Магна), и НЕВЕРНО1 " $ships = ('Nica1, 'Pinta', 'Santa Магна'), # Правильно
> Смотри также---------------------------------------------------------------------------------------------
Раздел «List Value Constructors» perldata(l); раздел «Quote and Quote-Like Operators» perlop(l); оператор s/// описай в perlop(l).
4.2. Вывод списков с запятыми
Проблема
Требуется вывести список с неизвестным количеством элементов. Элементы разделяются запятыми, а перед последним элементом выводится слово and.
Решение
Следующая функция возвращает строку, отформатированную требуемым образом:
sub commify_series { (@_ == 0) •> ' '
(@_ ==1)9 $_[0]
(@_ == 2) ? ]oin(" and ', @_)
(", ', @_[0 ($#_-1], 'and $_[-1]"),
Комментарий
При выводе содержимое массива порой выглядит довольно странно:
@array = ('red", "yellow", 'green'),
На самом деле вам нужна строка "I have red, yellow, and green marbles". Приведенная выше функция генерирует строку именно в таком формате. Между двумя последними элементами списка вставляется "and". Если в списке больше двух элементов, все они разделяются запятыми.
Пример 4.1 демонстрирует применение этой функции с одним дополнением: если хотя бы один элемент списка содержит запятую, в качестве разделителя используется точка с запятой.
Пример 4.1. commify_series
#'/usr/bin/perl -w
# commify_senes - демонстрирует вставку запятых при выводе описка
©lists = (
[ 'just one thing' ], [ qw(Mutt Jeff) ], [ qw(Peter Paul Mary) ],
[ 'To our parents', 'Mother Theresa', 'God' ],
[ 'pastrami', 'ham and cheese', 'peanut butter and jelly', 'tuna' ], [ 'recycle tired, old phrases', 'ponder big, happy thoughts' ], [ 'recycle tired, old phrases', 'ponder big, happy thoughts', 'sleep and dream peacefully ],
foreach $aref (@lists) {
print "The list is ' . commify_series((g>$aref) . \n",
sub commify_series {
my $sepchar = grep(/,/ => @_) 9 "; ' • ",",
(@_ == 0) ? '• :
(@_ == 1) ? $_[0] :
(@_ == 2) ? join(" and ', @_)
join("$sepchar ', @_[0 ($#_-1)], "and $_[-1]"); }
Результаты выглядят так:
The list is: just one thing.
The list is: Mutt and Jeff.
The list is: Peter, Paul, and Mary.
The list is: To our parents, Mother Theresa, and God.
The list is: pastrami, ham and cheese, peanut butter and jelly, and tuna.
The list is: recycle tired, old phrases and ponder big, happy thoughts.
4.3. Изменение размера массива 119'
The list is: recycle tired, old phrases; ponder
big, happy thoughts; and sleep and dream peacefully.
Как видите, мы отвергаем порочную практику исключения последней запятой из списка, что нередко приводит к появлению двусмысленностей.
> Смотри также---------------------------------------------------------------------------------------------
Описание функции grep в perlfunc(l); описание тернарного оператора выбора в perlop(l). Синтаксис вложенных списков рассматривается в рецепте 11.1.
4.3. Изменение размера массива
Проблема
Требуется увеличить или уменьшить размер массива. Допустим, у вас имеется массив работников, отсортированный по размерам оклада, и вы хотите ограничить его пятью самыми высокооплачиваемыми работниками. Другой пример — если окончательный размер массива точно известен, намного эффективнее выделить всю память сразу вместо того, чтобы увеличивать массив постепенно, добавляя элементы в конец.
Решение
Присвойте значение $#ARRAY:
U Увеличить или уменьшить ©ARRAY $#ARRAY = $NEW_LAST_ELEMENT_INDEX_NUMBER
Присваивание элементу, находящемуся за концом массива, автоматически увеличивает массив:
$ARRAY[$NEW_LAST_ELEMENT_INDEX_NUMBER] = $VALUE;
Комментарий
$#ARRAY — последний допустимый индекс массива @ARRAY. Если ему присваивается значение меньше текущего, массив уменьшается. Отсеченные элементы безвозвратно теряются. Если присвоенное значение больше текущего, массив увеличивается. Новые элементы получают неопределенное значение.
Однако $#ARRAY не следует путать с ©ARRAY. $#ARRAY представляет собой последний допустимый индекс массива, a @ARRAY (в скалярном контексте, то есть в числовой интерпретации) — количество элементов. $#ARRAY на единицу меньше @ARRAY, поскольку нумерация индексов начинается с 0.
В следующем фрагменте использованы оба варианта:
sub what_about_that_array {
print 'The array now has ", scalar(@people), ' elements.\n", print "The index of the last element is $#people \n"; print "Element #3 is '$people[3]',\n',
Результат:
The array now has 4 elements.
The index of the last element is 3.
Element «3 is 'Young'.
А другой фрагмент:
$#people--, what_about_that_array();
выводит следующий результат:
The array now has 3 elements.
The index of the last element is 2.
Element #3 is
Элемент с индексом 3 пропал при уменьшении массива. Если бы программа запускалась с ключом -w, Perl также выдал бы предупреждение об использовании неинициализированной величины, поскольку значение $people[3] не определено.
В следующем примере:
$#people = 10_000, what_about^that_array(),
результат выглядит так:
The array now has 10001 elements.
The index of the last element is 10000.
Element #3 is
Элемент ' Young" безвозвратно утерян. Вместо присваивания $ffpeople можно было сказать:
$people[10_000]=undef,
Массивы Perl не являются разреженными. Другими словами, если у вас имеется 10000-й элемент, то должны присутствовать и остальные 9999 элементов. Они могут быть неопределенными, но все равно будут занимать память. Из-за этого $array[time] или любая другая конструкция, где в качестве индекса используется очень большое целое число, является неудачным решением. Лучше воспользуйтесь хэшем.
При вызове print нам пришлось написать scalar @array, поскольку Perl интерпретирует большинство аргументов в списковом контексте, а требовалось значение @аггау в скалярном контексте.
> Смотри также------------------------------------------------------------------------------- ;-----------------
Описание $#ARRAY вperldata(l).
4.4. Выполнение операции с каждым элементом списка
Проблема
Требуется повторить некоторую операцию для каждого элемента списка.
Массивы часто используются для сбора интересующей информации - например, имен пользователей, превысивших свои дисковые квоты. Данные обрабатываются, при этом с каждым элементом массива выполняется некоторая операция. Скажем, в примере с дисковыми квотами каждому пользователю отправляется предупреждающее сообщение.
Решение
Воспользуйтесь циклом f о reach:
foreach $item (LIST) {
# Выполнить некоторые действия с $item }
Комментарий
Предположим, в массиве @bad_users собран список пользователей, превысивших свои дисковые квоты. В следующем фрагменте для каждого нарушителя вызывается процедура complain():
foreach $user (@bad_users) {
cornplain($user), >
Столь тривиальные случаи встречаются редко. Как правило, для генерации списка часто используются функции
foreach $var (sort keys %ENV) {
print '$var=$ENV{$var}\n , }
Функции sort и keys строят отсортированный список имен переменных окружения. Конечно, многократно используемые списки следует сохранять в массивах. Но для одноразовых задач удобнее работать со списком напрямую.
Возможности этой конструкции расширяются не только за счет построения списка в foreach, по и за счет дополнительных операций в блоке кода. Одно из распространенных применений foreach — сбор информации о каждом элементе списка и принятие некоторого решения на основании полученных данных. Вернемся к примеру с квотами:
foreach $user (@all_users) {
$disk_space = get_usage($user); ff Определить объем используемого
# дискового пространства
if ($disk_space > $MAX_QU0TA) { # Если он больше допустимого .
complain($user), й . предупредить о нарушении
Переменная, которой последовательно присваиваются все элементы списка, называется переменной цикла или итератором. Если итератор не указан, используется глобальная переменная $_. Она используется по умолчанию во многих строковых, списковых и файловых функциях Perl. В коротких программных блоках пропуск $_ упрощает чтение программы (хотя в длинных блоках излишек неявных допущений делает программу менее понятной). Например:
fо reach ( who ) { if (/tchrist/) { print,
Или в сочетании с циклом while:
while (<FH>) { и Присвоить $_ очередную прочитанную строку
chomp; # Удалить из $_ конечный символ \п,
# если он присутствует
foreach (split) { Я Разделить $_ по пропускам и получить @_
# Последовательно присвоить $_
# каждый из полученных фрагментов
$_ = reverse, и Переставить символы $_
# в противоположном порядке
print 8 Вывести значение $_
Многочисленные применения $_ заставляют понервничать. Особенно беспокоит то, что значение $_ изменяется как в foreach, так и в while. Возникает вопрос — не будет ли полная строка, прочитанная в $_ через <FH>, навсегда потеряна после выполнения foreach?
К счастью, эти опасения необоснованны — но крайней мере, в данном случае. Perl не уничтожает старое значение $_, поскольку переменная-итератор ($_) существует в течение всего выполнения цикла. При входе во внутренний цикл старое значение автоматически сохраняется, а при выходе — восстанавливается.
Однако причины для беспокойства все же есть. Если цикл while будет внутренним, a foreach — внешним, ваши страхи в полной мере оправдаются. В отличие от foreach конструкция while <FH> разрушает глобальное значение $_ без предварительного сохранения! Следовательно, в начале любой процедуры (или блока), где $_ используется в подобной конструкции, всегда должно присутствовать объявление local $ .
Если в области действия (scope) присутствует лексическая переменная (объявленная с ту), то временная переменная будет иметь лексическую область действия, ограниченную данным циклом. В противном случае она будет считаться глобальной переменной с динамической областью действия. Во избежание странных побочных эффектов версия 5.004 допускает более наглядную и понятную запись:
foreach my $item (@array) {
print 'l = $item\n , }
Цикл foreach обладает еще одним свойством: в цикле переменная-итератор является не копией, а скорее синонимом (alias) текущего элемента. Иными словами, изменение итератора приводит к изменению каждого элемента списка.
@аггау = (1,2,3), foreach $item (@array) {
$item--, }
print @array , 0 1 2
й Умножить каждый элемент @>a и @b на семь @а = ( 5, 3) @b = (0, 1) foreach $item (@a, @b) {
•$item *= 7,
print Sitem , > 3.5 21 0 7
Модификация списков в цикле foreach оказывается более понятной и быстрой, чем в эквивалентном коде с циклом for и указанием конкретных индексов. Это не ошибка; такая возможность была намеренно предусмотрена разработчиками языка. Не зная о ней, можно случайно изменить содержимое списка. Теперь вы знаете.
Например, применение s/// к элементам списка, возвращаемого функцией values, приведет к модификации только копий, но не самого хэша. Однако срез хэша (s>hash{ keys %hash} (см. главу 5 «Хэши») дает нам нечто, что все же можно изменить с пользой для дела:
# Убрать пропуски из скалярной величины, массива и всех элементов хэша foreach (Sscalar, @array, @hash{keys %hash}) {
s/\s+$//, }
По причинам, связанным с эквивалентными конструкциями командного интерпретатора Борна для UNIX, ключевые слова for и foreach взаимозаменяемы:
for $item (@array) { # То же, что и foreach $item (@array) # Сделать что-то
for (@array) { # То же, что и foreach $_ (@array)
Подобный стиль часто показывает, что автор занимается написанием или сопровождением сценариев интерпретатора и связан с системным администрированием UNIX. Жизнь таких людей н без того сложна, поэтому не стоит судить их слишком строго.
О Смотри также
Разделы «For Loops», «Foreach Loops» и «Loop Control» perlsyn(l); раздел «Temporary Values via local()» peiisub(l). Оператор local() рассматривается в рецепте 10.13, a my() — в рецепте 10.2.
4.5. Перебор массива по ссылке
Проблема
Имеется ссылка на массив. Вы хотите использовать foreach для обращения к каждому элементу массива.
Решение
Для перебора разыменованного (dereferenced) массива используется цикл foreach или for:
й Перебор элементов массива SARRAYREF foreach $item(@$ARRAYREF) { П Сделать что-то с $item
for ($i = 0, $1 <= $#$ARRAYREF, $i++) { й Сделать что-то с $ARARAYREF->[$i]
Комментарий
Приведенное решение предполагает, что у вас имеется скалярная переменная, содержащая ссылку па массив. Это позволяет делать следующее:
@fruits = ( Apple , Blackberry ), $fruit_ref = \@>fruits, foreach $fruit (@$fruit_ref) {
print $fruit tastes good in a pie \n , }
Apple tastes good in a pie. Blackberry tastes good in a pie.
Цикл foreach можно переписать в цикле for следующего вида:
for ($1=0, $i <= $#$fruit_ref, $i++) {
print $fruit_ref->[$i] tastes good in a pie \n",
Однако ссылка па массив нередко является результатом более сложного выражения. Для превращения такого результата в массив применяется конструкция @{ EXPR }:
$namelist{felines} = \@rogue_cats, foreach Scat ( @{ $namelist{felines} } ) {
print Scat purrs hypnotically \n , } print --More--\nYou are controlled \n
Как и прежде, цикл foreach можно заменшь эквивалентным циклом for:
for ($i=0, $i <= $#{ $namelist{felines} }, $i++) {
print $namelist{felines}[$i] purrs hypnotically \n ,
> Смотри также---------------------------------------------------------------------------------------------
perlref(i) и peillol(l); рецепты 4 4; 11.1.
4.6. Выборка уникальных элементов из списка
Проблема
Требуется удалить из списка повюряющиеся элементы — например, при построении списка из файла или на базе выходных данных некоей команды. Рецепт в равно]! мере относится как к удалению дубликатов при вводе, так и в уже заполненных массивах.
Решение
Хэш используется для сохранения встречавшихся ранее элементов, а функция keys — для их извлечения. Принятая в Perl концепция истинности позволит уменьшить объем программы и ускорить ее работу.
Прямолинейно
%seen = (), @uniq = ()
foreach Sitpm (@list) { unless ($seen{$item})
# Если мы попали сюда, значит, элемент не встречался ранее
$seen{$item} = 1
push(@umq $item),
Быстро
%seen = (),
foreach $item (ia>list) {
push((g>uniq Sitem) unless $seen{$item}++,
%seen =(),
foreach $item (@list) {
some_func($item) unless $seen{$item}++ }
Быстро, но по-другому
%seen = (),
foreach $item (@list) { $seen{$item}++,
V /
@uniq = keys %seen,
Быстро и совсем по-другому
%seen = (),
©unique = grep { ' $seen{$_} ++ } @list,
Комментарий
Суть сводится к простому вопросу — встречался ли данный элемент раньше? %эпш идеально подходят для подобного поиска. В первом варианте («Прямолинейно») массив уникальных значений строится но мере обработки исходного списка, а для регистрации встречавшихся значений используется хэш.
Второй вариант («Быстро») представляет собой самый естественный способ решения подобных задач в Perl. Каждый раз, когда встречается новое значение, в хэш с помощью оператора ++ добавляется новый элемент. Побочный эффект состоит в том, что в хэш попадают ж e повторяющиеся экземпляры. В данном случае хэш работает как множество.
Третий вариант («Аналогично, но с пользовательской функцией») похож на второй, однако вместо сохранения значения мы вызываем некоторую пользовательскую функцию и передаем ей это значение в качестве аргумента. Если ничего больше не требуется, хранить отдельный массив уникальных значений будет излишне.
В следующем варианте («Быстро, по по-другому») уникальные ключи извлекаются из хэша %seen лишь после того, как он будет полностью построен. Иногда это удобно, но исходный порядок элементов утрачивается.
В последнем варианте («Быстро и совсем по-другому») построение хэша %seen объединяется с извлечением уникальных элементов. При этом сохраняется исходный порядок элементов.
Использование хэша для записи значений имеет два побочных эффекта: при обработке длинных списков расходуется много памяти, а список, возвращаемый keys, не отсортирован в алфавитном или числовом порядке и не сохраняет порядок вставки.
# Построить список зарегистрированных пользователей с удалением дубликатов
%ucnt = (),
for ( who ) {
s/\s *\n//, # Стереть от первого пробела до конца строки -й остается имя пользователя
$ucnt{$_}++, # Зафиксировать присутствие данного пользователя >
# Извлечь и вывести уникальные ключи
@users = sort keys %ucnt,
print users logged in @users\n ,
> Смотри также---------------------------------------------------------------------------------------------
Раздел «Foreach Loops» perlsyn(l); описание функции keys вреИ/ипс(\). Аналогичное применение хэшей продемонстрировано в рецептах 4.7 и 4.8.
4.7. Поиск элементов одного массива, отсутствующих в другом массиве
Проблема
Требуется найти элементы, которые присутствуют в одном массиве, но отсутствуют в другом.
Решение
Мы ищем элементы @А, которых пет в @>В. Постройте хэш из ключей @В — он будет использоваться в качестве таблицы просмотра. Затем проверьте каждый элемент @А и посмотрите, присутствует ли он в @>В.
Простейшая реализация
# Предполагается, что @А и @В уже загружены
%seen = (), # Хэш для проверки принадлежности элемента В (Эаоп1у =(), й Ответ
# Построить таблицу просмотра
foreach $item (@B) { $seen{$item} = 1 }
# Найти элементы @А, отсутствующие в @В
foreach $item (@A) {
unless $item (@A) {
й Отсутствует в %seen, поэтому добавить в @aonly push(@aonly, $item),
128 Глава 4 • Массивы Идиоматическая версия
1my %seen, # Таблица просмотра ray @aonly, 8 Ответй Построить таблицу просмотра @seen{@B} = ().
foreach $item (@А) {
push(@aonly, $item) unless exists $seen{$item},
Комментарий
Практически любая проблема, при которой требуется определить принадлежность скалярной величины к списку или массиву, решается в Perl с помощью хэ-шей. Сначала мы обрабатываем @В и регистрируем в хэше %seen псе элементы @>В, присваивая соответствующему элементу хэша значение 1. Затем мы последовательно перебираем все элементы @А и проверяем, присутствует ли данный элемент в хэше %seen (то есть в @В).
В приведенном фрагменте ответ будет содержать дубликаты из массива @А. Ситуацию нетрудно исправить, для этого достаточно включать элементы @А в %seen но мере обработки:
foreach $item (@A) {
push (@aonly, $item) unless $seen{$item},
$seen{$item} =1 8 Пометить как уже встречавшийся
}
Эти решения в основном отличаются по способу построения хэша. В первом варианте перебирается содержимое @>В. Во втором для инициализации хэша используется срез. Следующий пример наглядно демонстрирует срезы хэша. Фрагмент:
$hash{ key1 } = 1, $hash{ key2 > = 2,
эквивалентен следующему:
gnash{ key1 , key2 } = (1,2),
Список в фигурных скобках содержит ключи, а список справа — значения. В первом решении %seen инициализируется перебором всех элементов @В и присваиванием соответствующим элементам %seen значения 1. Во втором мы просто говорим:
@seen{@iB> = ()
В этом случае элементы @>В используются в качестве ключей для %seen, а с ними ассоциируется undef, поскольку количество значений в правой части меньше количества позиций для их размещения. Показанный вариант работает,
@seen{§B} = (1) х @В,
Е> Смотри также-------------------------------------------------------------------------------------------
Описание срезов хэшей в perldata(i). Аналогичное применение хэшей продемонстрировано в рецептах 4.7 и 4.8.
4.8. Вычисление объединения, пересечения и разности уникальных списков
Проблема
Имеются два списка, каждый из которых содержит неповторяющиеся элементы. Требуется узнать, какие элементы присутствуют в обоих списках (пересечение), присутствуют в одном и отсутствуют в другом списке (разность) или хотя бы в одном нз списков (объединение).
Решение
В приведенных ниже решениях списки инициализируются следующим образом:
@а = (1, 3, 5, 6, 7, 8), (s>b = (2, 3, 5 7, 9),
@umon = (Sisect = @diff = (), %umon = %isect = (), %count =(),
Простое решение для объединения и пересечения
foreach $е(@а) { $union{$e} = 1 }
foreach $e (@b) {
if ( $umon{$e} ) { $isect{$e} = 1 }
$umon {$e} = 1, >
@umon = keys %umon, @>isect = keys %isect,
Идиоматическое решение
foreach $e (@a, @b) { $umon{$e}++ && $isect{$e}++ }
@union = keys %umons, @isect = keys %isect,
foreach $e (@a, §b) { $count{$e}++ }
foreach $e (keys %count) { push(@umon, $e), if ($count{$e} == 2) {
push @isect, $e, } else {
push @diff, $e,
Косвенное решение
@isect = @diff = @umon = (),
foreach $e (@a, @b) { $count{$e}++ }
foreach $e (keys %count) { push(@umon, $e), push @{ $count{$e} == 2 ? \@isect \@diff },
Комментарий
В первом решении происходит непосредственное вычисление объединения и пересечения двух списков, ни один из которых не содержит дубликатов. Для записи элементов, принадлежащих к объединению и пересечению, используются два разных хэша. Сначала мы заносим каждый элемент первого массива в хэш объединения и ассоциируем с ним истинное значение. Затем при последовательной обработке элементов второго массива мы проверяем, присутствует ли элемент в объединении. Если присутствует, он также включается и в хэш пересечения. В любом случае элемент заносится в хэш объединения. После завершения перебора мы извлекаем ключи обоих хэшей. Ассоциированные с ними значения не нужны.
Второе решение («Идиоматическое») в сущности делает то же самое, однако для него потребуется хорошее знание операторов Perl (а также awk, С, C++ и Java) ++ и &&. Если ++ находится после переменной, то ее старое значение используется до приращения. Когда элемент встречается впервые, он еще отсутствует в объединении, поэтому первая часть && будет ложной, а вторая часть попросту игнорируется. Когда тот же элемент встретится во второй раз, он уже присутствует в объединении, поэтому мы заносим его и в пересечение.
В третьем решении использован всего один хэш для хранения информации о том, сколько раз встретился тот или иной элемент. Записав элементы обоих массивов в хэш, мы последовательно перебираем его ключи. Каждый ключ автоматически попадает в объединение. Ключи, с которыми ассоциировано значение 2, присутствуют в обоих массивах и потому заносятся в массив пересече-
ния. Ключи с ассоциированным значением 1 встречаются лишь в одном из двух массивов и заносятся в массив разности. В отличие от исходного решения, порядок элементов в выходных массивах не совпадает с порядком элементов входных массивов.
В последнем решении, как и в предыдущем, используется всего один хэш с количеством экземпляров каждого элемента Однако на этот раз реализация построена на массиве в блоке @{ }.
Мы вычисляем не простую, а симметричную разность. Эти термины происходят из теории множеств. Симметричная разность представляет собой набор всех элементов, являющихся членами либо @А, либо @В, но не обоих сразу. Простая разность — набор всех элементов @А, отсутствующих в §В (см. рецепт 4,7).
> Смотри также---------------------------------------------------------------------------------------------
Аналогичное применение хэшей продемонстрировано в рецептах 4.7 и 4.8.
4.9. Присоединение массива
Проблема
Требуется объединить два массива, дописав все элементы одного из них в конец другого.
Решение
Воспользуйтесь функцией push:
# push
push(@ARRAY1, @ARRAY2),
Комментарий
Функция push оптимизирована для записи списка в конец массива. Два массива также можно объединить посредством сглаживания (flattening) списков Perl, однако в этом случае выполняется намного больше операций копирования, чем при использовании push:
@ARRAY1 = (©ARRAY1, @ARRAY2)
Ниже показан пример практического использования push-
©members = ( Time Flies ), ©initiates = ( An , Arrow ), push(@>members, ©initiates),
# ©members содержит элементы ( Time , Flies , An , Arrow )
Если содержимое одного массива требуется вставить в середину другого, воспользуйтесь функцией splice:
splice(@members, 2, 0, Like , ©initiates), print @members\n , splice(@members, 0, 1, Fruit ),
Результат выглядит так:
Time Flies Like An Arrow Fruit Flies Like A Banana
> Смотри также-------------------------------
Описание функций splice и push вperlfunc(l); раздел «List Value Constructors» perldata(l).
4.10. Обращение массива
Проблема
Требуется обратить массив (то есть переставить элементы в противоположном порядке).
Решение
Воспользуйтесь функцией reverse:
# Обращение ©ARRAY дает ©REVERSED ©REVERSED = reverse ©ARRAY,
Также можно воспользоваться циклом for:
for ($l = $#ARRAY, $i >= 0 $l--) { # Сделать что-то с $ARRAY[$i]
Комментарий
Настоящее обращение списка выполняется функцней reverse; цикл for просто перебирает элементы в обратном порядке. Если обращенная копия списка не нужна, цикл for экономит память и время.
Если функция reverse используется для обращения только что отсортированного списка, логичнее будет сразу отсортировать список в нужном порядке. Например:
№ Два шага сортировка, затем обращение ©ascending = sort { $a cmp $b } ©users, ©descending = reverse ©ascending,
# Один шаг сортировка с обратным сравнением ©descending = sort { $b cmp $a } ©users,
> Смотри также---------------------------------------------------------------------------------------------
Описание функции reverse в perlfunc{\). Она используется в рецепте 1.6.
4.11. Обработка нескольких элементов массива
Проблема
Требуется удалить сразу несколько элементов в начале или конце массива.
Решение
Воспользуйтесь функцией splice:
# Удалить $N элементов с начала ©ARRAY (shift $N)
CFRONT = splice(@ARRAY, 0, $N),
# Удалить $N элементов с конца массива (pop $N)
©END = spllce(@ARRAY, -$N),
Комментарий
Часто бывает удобно оформить эти операции в виде функций:
sub shift2
return splice(@{$_[0]}, 0, 2),
sub pop2 (\@) {
return splice(@{$_[0]}, 0, -2), >
Использование функций делает код более наглядным:
©friends = qw(Peter Paul Mary Jim Tim), ($this $that) = shift2(pfriends),
# $this содержит Peter, $that - Paul,
# a ©friends - Mary, Jim и Tim
©beverages = qw(Dew Jolt Cola Sprite Fresca),
@pair = pop2(©beverages),
U $pair[0] содержит $sprite, $pair[1] - Fresca,
# a ©beverages - (Dew, Jolt, Cola)
Функция splice возвращает элементы, удаленные из массива, поэтому shif t2 заменяет первые два элемента @ARRAY ничем (то есть удаляет их) и возвращает два удаленных элемента. Функция рор2 удаляет и возвращает два последних элемента.
В качестве аргументов этим функциям передается ссылка на массив — это сделано для того, чтобы они лучше имитировали встроенные функции shift и pop. При вызове ссылка не передается явно, с использованием символа \. Вместо этого компилятор, встречая прототип со ссылкой на массив, организует передачу массива по ссылке. Преимущества такого подхода — эффективность, наглядность и проверка параметров на стадии компиляции. Недостаток — передаваемый
$line[5] = \@list,
©got = рор2( @{ $lme[5] } ),
Перед вами еще один пример, когда вместо простого списка должен использоваться массив. Прототип \@ требует, чтобы объект, занимающий данную позицию в списке аргументов, был массивом. $line[5] представляет собой не массив, а ссылку на него. Вот почему нам понадобился «лишний» знак @.
> Смотри также ---------------------------------------------------------------------------------------------
Описание функции splice вperlfunc(l); раздел «Prototypes» perlsub(i). Функция splice используется в рецепте 4.9.
4.12. Поиск первого элемента списка, удовлетворяющего некоторому критерию
Проблема
Требуется найти первый элемент списка, удовлетворяющего некоторому критерию (или индекс этого элемента). Возможна и другая формулировка — определить, проходит ли проверку хотя бы один элемент. Критерий может быть как простым («Присутствует ли элемент в списке?»)1, так и сложным («Имеется список работников, отсортированный в порядке убывания оклада. У кого из менеджеров самый высокий оклад?»). В простых случаях дело обычно ограничивается значением элемента, но если сам массив может изменяться, вероятно, следует определять индекс первого подходящего элемента.
Решение
Перебирайте элементы в цикле f о reach и вызовите last, как только критерий будет выполнен:
ray($match, $found $itera), foreach $item(@array) { if (Scnterion) {
$match = $item, # Необходимо сохранить
$found = 1
last,
if($found) {
## Сделать что-то с $match } else {
Чтобы определить индекс, перебирайте все индексы массива и вызывайте last, как только критерий выполнится:
my($i, $match_idx), for ($1 =0, $i < @аггау $i++) { if ($cnterion) {
$match_idx = $i, # Сохранить индекс
last,
if(defmed $match_idx) {
## Найден элемент $array[$match_idx] } else {
## Неудачный поиск
Комментарий
Стандартных механизмов для решения этой задачи не существует, поэтому мы напишем собственный код для перебора и проверки каждого элемента. В нем используются циклы f о reach и for, а вызов last прекращает проверку при выполнении условия. Но перед тем, как прерывать поиск с помощью last, следует сохранить найденный индекс.
Одна из распространенных ошибок — использование функции g rep. Дело в том, что grep проверяет все элементы и находит все совпадения; если вас интересует только первое совпадение, этот вариант неэффективен.
Если нас интересует значение первого найденного элемента, присвойте его переменной $match. Мы не можем просто проверять $item в конце цикла, потому что f о reach автоматически локализует1 переменную-итератор и потому не позволяет узнать ее последнее значение после завершения цикла (см. рецепт АЛ)
Рассмотрим пример. Предположим, в массиве @employees находится список объектов с информацией о работниках, отсортированный в порядке убывания оклада. Мы хотим найти инженера с максимальным окладом; это будет первый инженер в массиве. Требуется только вывести имя инженера, поэтому нас интересует не индекс, а значение элемента.
foreach $employee (©employees) {
if ( $employee->category() eq engineer ) { $highest_engmeer = Semployee last,
print Highest paid engineer is , $highest_engineer->name(), \n ,
for ($1 =0, $1 < ©ARRAY, $l++) {
last if $cnterion, } If ($1 < @ARRAY) {
## Критерий выполняется по индексу $1 } else {
## Неудачный поиск
t> Смотри также
Разделы «For Loops», «Foreach Loops» и «Loop Control»perlsyn(l); описание функции grep вperlfunc(l).
4.13. Поиск всех элементов массива, удовлетворяющих определенному критерию
Проблема
Требуется найти все элементы списка, удовлетворяющие определенному критерию.
Проблема извлечения подмножества из списка остается прежней. Вопрос заключается в том, как найти всех инженеров в списке работников, всех пользователей в административной группе, все интересующие вас имена файлов и т. д.
Решение
Воспользуйтесь функцией grep. Функция применяет критерий ко всем элементам списка и возвращает лишь те, для которых он выполняется:
©РЕЗУЛЬТАТ = grep { КРИТЕРИЙ ($_) } ©СПИСОК,
Комментарий
То же самое можно было сделать в цикле foreach:
©РЕЗУЛЬТАТ = (), foreach (©СПИСОК) {
ризп(@РЕЗУЛЬТАТ, $_) If КРИТЕРИЙ ($_), }
Функция Perl g rep позволяет записать всю эту возню с циклами более компактно. В действительности функция дгер сильно отличается от одноименной команды UNIX — она не имеет параметров для нумерации строк или инвертирования критерия и не ограничивается проверками регулярных выражений. Например, чтобы отфильтровать из массива очень большие числа или определить, с какими ключами хэша ассоциированы очень большие значения, применяется следующая запись:
©bigs = grep { $_ > 1_000_000 } ©nums,
©pigs = grep { $users{$_} > 1e7 } keys %users,
В следующем примере в @matching заносятся строки, полученные от команды who и начинающиеся с gnat :
©matching = grep { /"gnat / } who , Или другой пример:
©engineers = grep { $_->position() eq Engineer' } ©employees,
Из массива @employees извлекаются только те объекты, для которых метод position() возвращает строку Engineer.
Grep позволяет выполнять и более сложные проверки:
@secondary_assistance = grep { $_->income >= 26_000 &&
$_->income < 30_000 } ©applicants,
Однако в таких ситуациях бывает разумнее написать цикл.
> Смотри также---------------------------------------------------------------------------------------------
Разделы «For Loops», «Foreach Loops» и «Loop Control» perlsyn(l); описание функции grep в perlfunc(l); страница руководства who(i) вашей системы (если есть); рецепт 4.12.
4.14. Числовая сортировка массива
Проблема
Требуется отсортировать список чисел, однако функция Perl sort (по умолчанию) выполняет алфавитную сортировку в ASCII-порядке.
Решение
Воспользуйтесь функцией Perl sort с оператором числового сравнения, оператор <=>:
©Sorted = sort { $a <=> $b } ©Unsorted,
При вызове функции sort можно передавать необязательный программный блок, с помощью которого принятый по умолчанию алфавитный порядок сравнения заменяется вашим собственным. Функция сравнения вызывается каждый раз, когда sort сравнивает две величины. Сравниваемые значения загружаются в специальные пакетные переменные $а и $Ь, которые автоматически локализуются.
Функция сравнения должна возвращать отрицательное число, если значение $а должно находиться в выходных данных перед $Ь; 0, если они совпадают или порядок несущественен; и положительное число, если значение $а должно находиться после $Ь. В Perl существуют два оператора с таким поведением: оператор <=> сортирует числа по возрастанию в числовом порядке, а стр сортирует строки по возрастанию в алфавитном порядке. По умолчанию sort использует сравнения в стиле стр.
Следующий фрагмент сортирует список идентификаторов процессов (PID) в массиве @pids, предлагает пользователю выбрать один PID и посылает сигнал TERM, за которым следует сигнал KILL. В необязательном программном блоке $а сравнивается с $Ь оператором <=>, что обеспечивает числовую сортировку.
# @>pids - несортированный массив идентификаторов процессов foreach my $pid (sort { $a <=> $b } @pids) {
print $pid\n , }
print Select a process ID to kill \n , chomp ($pid = <>),
die Exiting \n unless $pid && $pid =~ /~\d=$/, kill ( TERM ,$pid) sleep 2, kill ( KILL ,$pid),
При использовании условия $a<=>$b или $а cmp $b список сортируется в порядке возрастания. Чтобы сортировка выполнялась в порядке убывания, достаточно поменять местами $а и $Ь в функции сравнения:
©descending = sort { $b <=> $а } @unsorted,
Функции сравнения должны быть последовательными; иначе говоря, функция всегда должна возвращать один и тот же ответ для одинаковых величин. Непоследовательные функции сравнения приводят к зацикливанию программы или ее аварийному завершению, особенно в старых версиях Perl.
Также возможна конструкция вида sort ИМЯ СПИСОК, где ИМЯ — имя функции сравнения, возвращающей -1, 0 или +1. В интересах быстродействия нормальные правила вызова не соблюдаются, а сравниваемые значения, как по волшебству, появляются в глобальных пакетных переменных $а и $Ь. Из-за особенностей вызова этой функции в Perl рекурсия в ней может не работать.
Предупреждение: значения $а и $Ь задаются в пакете, активном в момент вызова sort, — а он может не совпадать с пакетом, в котором была откомпилирована передаваемая sort функция сравнения (ИМЯ)! Например:
package Sort_Subs,
sub revnum { $b <=> $a }
package Other_Pack,
@all = sort Sort_Subs revnum 4, 19, 8, 3,
Такая попытка тихо заканчивается неудачей — впрочем, при наличии ключа -хю о неудаче будет заявлено вслух. Дело в том, что вызов sort создает пакетные переменные $а и $Ь в своем собственном пакете, Other_Pack, а функция revnum будет использовать версии из своего пакета. Это еще один аргумент в пользу встроенных функций сортировки:
@all = sort { $b <=> $а } 4, 19 8, 3
За дополнительной информацией о пакетах обращайтесь к главе 10 «Подпрограммы».
> Смотри также---------------------------------------------------------------------------------------------
Описание операторов стр и <=> Bperlop(l); описание функций kill, sort и sleep в perlfunc(l); рецепт 4.15.
4.15. Сортировка списка по вычисляемому полю
Проблема
Требуется отсортировать список, руководствуясь более сложным критерием, нежели простыми строковыми или числовыми сравнениям.
Такая проблема часто встречается при работе с объектами или сложными структурами данных («отсортировать по третьему элементу массива, на который указывает данная ссылка»). Кроме того, она относится к сортировке по нескольким ключам — например, когда список сортируется по дню рождения, а затем по имени (когда у нескольких людей совпадают дни рождения).
Решение
Воспользуйтесь нестандартной функцией сравнения в sort: ©ordered = sort { compareQ } ©unordered, Для ускорения работы значение поля можно вычислить заранее:
@рrecomputed = map { [computeO, $_] } ©unordered,
@ordered_precomputed = sort { $a->[0] <=> $b->[0] } ©precomputed,
©ordered = map { $_->[1] } @ordered_precomputed,
Наконец, эти три шага можно объединить:
©ordered = map { $_->[1] }
sort { $a->[0] <=> $b->[0] } map { [computeO, $_] } ©unordered,
О том, как пользоваться функциями сравнения, рассказано в рецепте 4.14. Помимо использования встроенных операторов вроде <=>, можно конструировать более сложные условия:
©ordered = sort { $a->name cmp $b->name } ©employees,
Функция sort часто используется подобным образом в циклах foreach:
foreach $employee (sort {$a->name cmp $b->name } (^employees) {
print $employee->name, earns \$ , $employee->salary, \n , }
Если вы собираетесь много работать с элементами, расположенными в определенном порядке, эффективнее будет сразу отсортировать их и работать с отсортированным списком:
@sorted_employees = sort { $a->name cmp $b->name } ©employees, foreach $employee (©sorted_employees) {
print $employee->name, earns \$ , $employee->salary, \n , }
Я Загрузить %bonus foreach $employee (@sorted_employees) {
if ($bonus{ $employee->ssn } ) {
print $employee->name, got a bonus1\n ,
В функцию можно включить несколько условий и разделить их операторами ||. Оператор || возвращает первое истинное (ненулевое) значение Следовательно, сортировку можно выполнять по одному критерию, а при равенстве элементов (когда возвращаемое значение равно 0) сортировать по другому критерию. Получается «сортировка внутри сортировки»:
©sorted = sort {$a->name cmp $b->name
II $b->age <=> $a->age) ©employees,
Первый критерий сравнивает имена двух работников. Если они не совпадают, 11 прекращает вычисления и возвращает результат cmp (сортировка в порядке возрастания имен). Но если имена совпадают, 11 продолжает проверку и возвращает результат <=> (сортировка в порядке убывания возраста). Полученный список будет отсортирован по именам и по возрасту в группах с одинаковыми именами.
Давайте рассмотрим реальный пример сортировки. Мы собираем информацию обо всех пользователям в виде объектов User pwent, после чего сортируем их по именам и выводим отсортированный список:
use User pwent qw(getpwent), ©users = (),
# Выбрать всех пользователей while (aefined($user = getpwent)) { push(@users, $user),
gusers = sort { $a->name cmp $b-<name } ©users, foreach $user (©users) {
print $user->name, \n , }
Возможности не ограничиваются простыми сравнениями или комбинациями простых сравнений. В следующем примере список имен сортируется по второй букве имени. Вторая буква извлекается функцией substr:
©sorted = sort { substr($a 1,1) cmp substr($b,1 1) } @names, А ниже список сортируется по длине строки:
©sorted = sort { length $a <=> length $b } ©strings,
Функция сравнения вызывается sort каждый раз, когда требуется сравнить два элемента. Число сравнений заметно увеличивается с количеством сортируемых элементов. Сортировка 10 элементов требует (в среднем) 46 сравнений, однако при сортировке 1000 элементов выполняется 14 000 сравнений. Медленные операции (например, split или вызов подпрограммы) при каждом сравнении тормозят работу программы.
К счастью, проблема решается однократным выполнением операции для каждого элемента перед сортировкой. Воспользуйтесь тар для сохранения результатов операции в массиве, элементы которого являются анонимными массивами с исходным и вычисленным полем. Этот «массив массивов» сортируется по предварительно вычисленному полю, после чего тар используется для получения отсортированных исходных данных. Концепция map/sort/map применяется часто и с пользой, поэтому ее стоит рассмотреть более подробно.
Применим ее к примеру с сортировкой по длине строки:
©temp = map { [ length $_, $_ ] } ©strings, ©temp = sort { $a->[0] <=> $b->[0] } @temp, ©sorted = map { $_->[1] } ©temp,
В первой строке map создает временный массив строк с их длинами. Вторая строка сортирует временный массив, сравнивая их предварительно вычисленные длины. Третья строка превращает временный массив строк/длин в отсортированный массив строк. Таким образом, длина каждой строки вычисляется всего один раз.
Поскольку входные данные каждой строки представляют собой выходные данные предыдущей строки (массив @temp, созданный в строке 1, передается sort в строке 2, а результат сортировки передается тар в строке 3), их можно объединить в одну команду и отказаться от временного массива:
©sorted = map { $_->[1] >
sort {$a->[0] <=> $b->[0] } map { [ length $_, $_] } ©strings,
Теперь операции перечисляются в обратном порядке. Встречая конструкцию map/sort/map, читайте ее снизу вверх:
тар: нижний вызов тар строит временный список анонимных массивов. Список содержит пары из предварительно вычисленного поля (length $_) и исходного элемента ($_). В этой строке показано, как происходит вычисление поля.
sort: список анонимных массивов сортируется посредством сравнения предварительно вычисленных полей. По этой строке трудно о чем-то судить — разве что о том, будет ли список отсортирован в порядке возрастания или убывания.
тар: вызов тар в начале команды превращает отсортированный список анонимных массивов в список исходных отсортированных элементов. Как правило, во всех конструкциях map/sort/map он выглядит одинаково.
Ниже показан более сложный пример, в котором сортировка выполняется по первому числу, найденному в каждой строке §f ields:
@temp = map { [ /(\d+)/, $_ ] } ©fields, @sorted_temp = sort {$a->[0] <=> $b->[0] } @temp, <5>sorted_fields = map { $_->["!] } @sorted_temp,
Регулярное выражение в первой строке извлекает из строки, обрабатываемой тар, первое число. Мы используем регулярное выражение /(\d+)/ в списковом контексте.
Из этого фрагмента можно убрать временный массив. Код принимает следующий вид:
@sorted_fields = map { $_->[1] }
sort { $a->[0] <=> $b->[0] } пар { [ /(\d+)/, $_ ] } ©fields,
В последнем примере выполняется компактная сортировка данных, разделенных запятыми (они взяты из файла UNIX passwd). Сначала выполняется числовая сортировка файла по четвертому полю (идентификатору группы), затем — числовая сортировка по третьему полю (идентификатору пользователя) и алфавитная сортировка по первому полю (имени пользователя).
print map { $_->[0] } # Целая строка
sort {
$а->[1] <=> $Ь->[1] # Идентификатор группы
II $а->[2] <=> $Ь->[2] # Идентификатор пользователя
II
$а->[3] <=> $Ь->[3] # Имя пользователя }
тар { [ $_, (split / /)[3,2,0] ] } cat /etc/passwd',
Компактная конструкция map/sort/map больше напоминает программирование на Lisp и Scheme, нежели обычное наследие Perl — С и awk. Впервые она была предложена Рэндалом Шварцем (Randal Schwartz) и потому часто называется «преобразованием Шварца».
> Смотри также---------------------------------------------------------------------------------------------
Описание функции sort вperlfunc(l); описание операторов стр и <=> вperlop(l); рецепт 4.14.
4.16. Реализация циклических списков
Проблема
Требуется создать циклический список и организовать работу с ним.
Решение
Воспользуйтесь функциями unshift и pop (или push и shift) для обычного массива.
unshift(@circular, pop(@circular)), # Последний становится первым push (^circular, shift(@circular)), # И наоборот
Комментарий
Циклические списки обычно применяются для многократного выполнения одной и той же последовательности действий — например, обработки подключений к серверу. Приведенный выше фрагмент не является полноценной компьютерной реализацией циклических списков с указателями и настоящей цикличностью. Вместо этого мы просто перемещаем последний элемент на первую позицию, и наоборот.
sub grab_and_rotate (\@ ) { пу Slistref = shift, my $element = $listref->[0], push(@listref, shift @$listref), return $element;
§processes = ( 1, 2, 3, 4, 5 ),
while (1) {
Sprocess = grab_and_rotate(@>processes), print Handling process $process\n", sleep 1,
> Смотри также---------------------------------------------------------------------------------------------
Описание функций unshift и push в perlfunc(l); рецепт 13.13.
Проблема
Требуется случайным образом переставить элементы массива. Наиболее очевидное применение — тасование колоды в карточной игре, однако аналогичная задача возникает в любой ситуации, где элементы массива обрабатываются в произвольном порядке.
Решение
Каждый элемент массива меняется местом с другим, случайно выбранным элементом:
U fisher_yates_shuffle ( \@array ) генерация случайной перестановки # массива @аггау на месте sub fisher_yates_shuffle < my $array = shift, my $i,
for ($i = @$array, --$i, ) { my $] = int rand ($i+1), next if $i == $], @$array[$i,$j] = @$array[$j,$i],
fisher_yates_shuffle( \@array ), ft Перестановка массива @array на месте
Или выберите случайную перестановку, воспользовавшись кодом из примера 4.4:
Spermutations = factorial^ scalar @array ),
@shuffle = @>array [ n2perm( 1+int(rand Spermutations), $#array) ],
Комментарий
Случайные перестановки на удивление коварны. Написать плохую программу перестановки очень просто:
sub naive_sriuffle { # Не делайте так1
for (my $i = 0, $i < §_, $i++) {
my $j = int rand @_, # Выбрать случайный элемент
($_[$i], $_[$j]) = ($_[$j], $_[$i]), # Поменять местами
Такой алгоритм является смещенным — одни перестановки имеют большую вероятность, чем другие. Это нетрудно доказать: предположим, мы получили список из 3 элементов. Мы генерируем 3 случайных числа, каждое из которых может принимать 3 возможных значения — итого 27 возможных комбинаций. Однако для списка из трех элементов существует всего 6 перестановок. Поскольку 27 не делится на 6, некоторые перестановки появляются с большей вероятностью, чем другие.
В приведенном выше алгоритме Фишера— Йетса это смещение устраняется за счет изменения интервала выбираемых случайных чисел.
Смотри также
Описание функции rand B.peilfunc(\). Дополнительная информация о случайных числах приведена в Рецептах 2.7-2.9. В рецепте 4.19 показан другой способ построения случайных перестановок.
4.18. Программа: words
Описание
Вас когда-нибудь интересовало, каким образом программы типа Is строят столбцы отсортированных выходных данных, расположенных по столбцам, а не по строкам? Например:
|
aw k |
cp |
ed |
login |
mount |
rmdir |
sum |
|
basename |
csh |
egrep |
Is |
mt |
sed |
sync |
|
cat |
date |
fgrep |
mail |
mv |
sh |
tar |
|
chgrp |
dd |
grep |
mkdir |
ps |
sort |
touch |
|
chfflod |
df |
kill |
mknod |
pwd |
stty |
VI |
|
chown |
echo |
In |
more |
rm |
su |
|
|
В примере 4.2 |
показано, |
как это |
делается. |
|||
|
Пример |
4.2. words |
|||||
|
#' /usr/bm/perl |
-w |
|||||
|
# words • |
- вывод |
данных по |
столбцам |
my ($item, $cols, $rows, $maxlen), my (Sxpixel, Sypixel, $mask, @data),
getwinsize(),
# Получить все строки входных данных
# и запомнить максимальную длину строки
Smaxlen = 1,
while (о) { my $mylen, s/\s+$//,
Smaxlen = $mylen if (($mylen = length) > Smaxlen) push(@data, $_),
Smaxlen += 1, # Дополнительный пробел
# Определить границы экрана $cols = int($cols / Smaxlen) || 1,
продолжение
Глава 4 • Массивы
Пример 4.2. (продолжение)$rows = mt(($#data+$cols) / $cols),
# Задать маску для ускорения вычислений
$mask = sprintf( %%-%ds , $maxlen-1),
# Подпрограмма для обнаружения последнего элемента строки
sub EOL { ($item+1) % $cols == 0 }
й Обработать каждый элемент, выбирая нужный фрагмент
ft на основании позиции
for (Sitem = 0, $item < $rows * $cols, $item++) {
my Starget = ($itera % $cols) ¦ $rows + int($item/$cols)
my $piece = spnntf($mask $target < ©data ? $data[$target] ),
Ipiece =~ s/\s+$// if EOL(), # Последний элемент не выравнивать
print $piece,
print \n if EOL(),
# Завершить при необходимости
print \n if EOL(),
# He переносится -- только для Linux
sub getwmsize <
my Swinsize = \0 x 8,
my STIOCGWINSZ = 0x40087468,
if (ioctl(STDOUT, STIOCGWINSZ, Swinsize)) {
($rows, $cols, Sxpixel, Sypixel) = unpack( S4 , Swinsize), } else {
$cols = 80,
Наиболее очевидный способ вывести отсортированный список по столбцам — последовательно выводите каждый элемент списка, выравнивая его пробелами до определенной ширины. Когда вывод достигает конца строки, происходит переход на следующую строку. Но такой вариант хорош лишь тогда, когда строки читаются слева направо. Если данные должны читаться по столбцам, сверху вниз, приходится искать другое решение.
Программа words представляет собой фильтр, который генерирует выходные данные по столбцам. Она читает все входные данные и запоминает максимальную длину строки. После того как все данные будут прочитаны, ширина экрана делится на длину самой большой входной записи — результат равен ожидаемому количеству столбцов.
Затем программа входит в цикл, который выполняется для каждой входной записи. Однако порядок вывода неочевиден. Предположим, имеется список из девяти элементов:
Неправильно Правильно
Программа words производит все необходимые вычисления, чтобы элементы (1,4,7) выводились в одной строке, (2,5,8) — в другой и (3,6,9) — в последней строке.
Текущие размеры окна определяются вызовом loctl. Этот вариант прекрасно работает — в той системе, для которой он был написан. В любой другой он не подойдет. Если вас это устраивает, хорошо В рецепте 12.14 показано, как определить размер окна в вашей системе с помощью файла ioctl.pch или программы на С. Решение из рецепта 15.4 отличается большей переносимостью, однако вам придется установить модуль с CPAN.
> Смотри также---------------------------------------------------------------------------------------------
Рецепт 15.4.
4.19. Программа: permute
Проблема
Вам никогда не требовалось сгенерировать все возможные перестановки массива или выполнить некоторый фрагмент для всех возможных перестановок? Например:
% echo man bites dog | permute
dog bites man
bites dog man
dog man bites
man dog bites
bites man dog
man bites dog
Количество возможных перестановок для множества равно факториалу числа элементов в этом множестве. Оно растет чрезвычайно быстро, поэтому не стоит генерировать перестановки для большого числа элементов:
|
Размер множества |
Количество перестановок |
|
1 |
1 |
|
2 |
2 |
|
3 |
6 |
|
4 |
24 |
|
5 |
120 |
|
6 |
720 |
|
7 |
5040 |
|
8 |
40320 |
|
9 |
362880 |
|
10 |
3628800 |
|
11 |
39916800 |
|
12 |
479001600 |
|
13 |
6227020800 |
|
14 |
87178291200 |
|
15 |
1307674368000 |
use Math Biglnt,
sub factorial {
my $n = shift,
my $s = 1,
$s ¦= $n-while $n > 0,
return $s, }
print factorial(Math Biglnt->new( 500 )), +1220136...(1035 digits total)
Два решения, приведенных ниже, отличаются порядком возвращаемых перестановок.
Решение из примера 4.3 использует классический алгоритм списковых перестановок, используемый знатоками Lisp. Алгоритм относительно прямолинеен, однако в нем создаются ненужные копии. Кроме того, в решении жестко закодирован простой вывод перестановок без каких-либо дополнительных действий.
Пример 4.3. tdc-permute
й1/usr/bin/perl -п
# tsc_permute вывод всех перестановок введенных слов
permute([split], []),
sub permute {
my @items = (°>{ $_[0] }, my @perms = @{ $_[1] }, unless (@items) {
print @perms\n , } else {
my(@newitems,@newperms, $i),
foreach $i (0 Stfitems) {
@newitems = ©items,
@newperms = @perms,
unshift(@newperms, splice(@newitems, $i, 1)), permute([@newitems], Onewperms]),
Решение из примера 4.4, предложенное Марком-Джейсоном Доминусом (Mark-Jason Dominus), более элегантно и работает примерно на 25 % быстрее. Вместо того чтобы рассчитывать все перестановки, программа генерирует n-ю конкретную перестановку. Элегантность проявляется в двух аспектах. Во-первых, в программе удается избежать рекурсии, кроме как при вычислении факториала (который алгоритмом перестановок обычно не используется). Во-вторых, вместо перестановки реальных данных генерируется перестановка целых чисел.
149
В программе для экономии времени использована методика запоминания. Ее суть заключается в том, что функция, Которая всегда возвращает конкретный ответ для конкретного набора аргументов, запоминает этот ответ. При следующем вызове с теми же аргументами дальнейшие вычисления уже не потребуются. Функция factorial сохраняет ранее вычисленные значения факториала в закрытом массиве @f act ( 10.3).
Функция n2perm вызывается с двумя аргументами: номером генерируемой перестановки (от 0 до N!, где N — размер массива) и индексом последнего элемента массива. Функция n2perm для расчета шаблона перестановки вызывает подпрограмму n2pat. Затем шаблон преобразуется в перестановку целых чисел подпрограммой pat2perm. Шаблон представляет собой список вида (0 2 0 1 0), что означает: «Вырезать пулевой элемент, затем второй элемент оставшегося списка, затем нулевой, первый и снова пулевой».
Пример 4.4. mjd-permute
#' /usr/bm/perl -w
8 mjd_permute перестановка всех введенных слов
use strict,
while (о) {
my @data = split,
my $num_permutations = factorial(scalar @>data)
for (my $1=0, $i < $num_permutations $i++) {
my ©permutation = @data[n2perm($i, $#data)],
print @permutation\n ,
# Вспомогательная функция факториал с запоминанием BEGIN {
my ffact = (1), sub factonal($) { my $r> = shift,
return $fact[$n] if defined $fact[$n], $fact[$n] = $n * factorial($n - 1)
|
# n2pat($N, $len) построить |
||
|
sub n2pat { |
||
|
my $1 = |
1, |
|
|
my $N |
shift, |
|
|
my $len = |
shift, |
|
|
my @pat, |
||
|
while ($1 |
<= $len + |
1) { |
|
push |
@pat, $N % |
$i, |
|
$N = |
mt($N/$i), |
N—й шаблон перестановки длины $1еп
# На самом деле просто while ($N) {
продолжение
}
return @pat;
# pat2perm(@pat) : превратить шаблон, возвращаемый n2pat(),
# в перестановку целых чисел,
sub pat2perm {
my @pat = @_,
my @source = (0 .. $#pat);
my @perm;
push @perm, splice(@source, (pop @pat), 1) while @pat,
return @perm;
# n2perm($N, $len) • сгенерировать N-ю перестановку S объектов sub n2perm {
pat2perm(n2pat(@_));
> Смотри также
Описание функций unshift и splice вperlfunc(l); рецепты 2.7; 10.3.
Хэш и
Выполнять линейный просмотр в ассоциативном массиве — все равно что пытаться забить кого-нибудь до смерти заряженным «Узи».Ларри Уолл
Введение
Как люди, так и части компьютерных программ взаимодействуют между собой самым причудливым образом. Отдельные скалярные переменные похожи на отшельников, ведущих замкнутое существование в рамках собственной личности. Массив напоминает партию, где множество индивидуумов объединяется под именем харизматического предводителя. Где-то между ними расположилась удобная ниша, в которой живут совокупности связей «один-к-одному» — хэши. В старой документации по Perl хэши часто назывались ассоциативными массивами, но термин получается слишком длинным. Аналогичные структуры данных существуют и в других языках, где они обозначаются другими терминами — хэш-таблицы, таблицы, словари, отображения и даже а-списки, в зависимости от языка.
К сожалению, отношения хэшей являются не равными, а подчиненными — например, «Энди — начальник Ната»; «Кровяное давление пациента — 112/62» или «Название журнала с индексом ISSN 1087-903X — The Perl Journal». Хэш всего лишь предоставляет удобные средства для получения ответов на вопросы типа: «Кто является начальником Ната?» или «Как называется журнал 1087-903Х»? Вы не сможете спросить «Чьим начальником является Энди?» Впрочем, поиску ответов на подобные вопросы посвящен один из рецептов этой главы.
Однако у хэшей есть свои преимущества. В Perl хэш является встроенным типом данных. Благодаря применению хэшей многие сложные алгоритмы сводятся к простой выборке значений. Кроме того, хэши предоставляют быстрые и удобные средства для построения индексов и таблиц просмотра. Если для простой скалярной переменной применяется идентификатор типа $, а для массива — @, то для хэшей используется идентификатор %.
Префикс % относится лишь к ссылкам на хэш в целом. Значение ключа представляет собой скалярную величину, поэтому для него используется символ $ (по
В обычных массивах используются числовые индексы, но индексы хэшей всегда являются строковыми. Ассоциированные значения могут быть произвольными скалярными величинами, в том числе ссылками. Используя ссылки в качестве ассоциированных значений, можно создавать хэши для хранения не только строк и чисел, но и массивов, других хэшей или объектов (вернее, ссылок на массивы, хэшп или объекты).
Хэши могут инициализироваться с помощью списков, содержащих пары «ключ/ значение»:
%аде = ( "Nat", 24, "Jules", 25, "Josh", 17 );
Такая запись эквивалентна следующей:
$age{'Nat"} = 24, $age{"Jules"} = 25; $age<"Josh"} = 17;
Для упрощения инициализации хэшей был создан оператор, оператор =>. В основном он представляет собой более наглядную замену для запятой. Например, возможна следующая инициализация хэша:
%food_color = (
"Apple" => "red",
"Banana" => "yellow",
"Lemon" => "yellow",
"Carrot" => "orange"
);
(хэш %food_color используется во многих примерах этой главы). Такая инициализация также является примером списковой эквивалентности — в некоторых отношениях хэш ведет себя так, словно онявляется списком пар «ключ/значение». Мы воспользуемся этим в нескольких рецептах, в частности — для объединения и инвертирования.
В отличие от обычной запятой, оператор => обладает особым свойством: любое предшествующее ему слово интерпретируется как строковое значение. Это позволяет убрать кавычки и сделать программу более понятной. Однословные ключи хэшей также автоматически интерпретируются как строки, поэтому вместо $hash{"somekey"} можно написать просто $hash{somekey}. Приведенная выше инициализация %food_color записывается в следующем виде:
%food_color = (
Apple => "red",
Banana => "yellow",
Lemon => "yellow",
Carrot => "orange"
Одно из важных свойств хэшей заключается в том, что их элементы хранятся в особой последовательности, обесценивающей выборку. Следовательно, независимо от порядка занесения данных в хэш, порядок их хранения будет непредсказуемым.
> Смотри также--------------------------------------------------------------------------------------------
Описание функций unshift и splice вperlfunc(l).
5.1. Занесение элемента в хэш
Проблема
Требуется добавить в хэш новый элемент.
Решение
Присвойте нужное значение в записи вида:
$ХЭШ{$КЛЮЧ} = $ЗНАЧЕНИЕ;
Комментарий
Процесс занесения данных в хэш весьма тривиален. В языках, где хэш не относится к встроенным типам данных, приходится беспокоиться о переполнении, изменении размеров и коллизиях в хэш-таблицах. В Perl обычное присваивание решает сразу все проблемы. Если ключ уже занят, то есть содержит предыдущее значение, память автоматически освобождается (по аналогии с присваиванием скалярной переменной).
# Хэш %food_color определяется во введении
$food_color{Raspberry} = "pink";
print "Known foods:\п";
foreach $food (keys %food_color) {
print "$food\n"; >
Known foods: Banana Apple Raspberry Carrot Lemon
Если в качестве ключа хэша используется неопределенная величина undef, она преобразуется в пустую строку "" (что сопровождается предупреждением при запуске с параметром -w). Вероятно, неопределенный ключ undef — это не то, что вы хотели. С другой стороны, undef является вполне допустимым значением в хэ-шах. Однако при выборке значения для ключа, отсутствующего в хэше, вы также получите undef. Это означает, что для проверки существования ключа $кеу в хэше %hash простая логическая проверка if ($hash{$key}) не подходит. Присутствие ключа в хэше проверяется записью вида exists($hash{$key}); определенность ассоциированного значения — defined($hash{$key}), а его истинность — if ($hash{$key}).
> Смотри также---------------------------------------------------------------------------------------------
Раздел «List Value Constructors»peildata(\), рецепт 5 2
5.2. Проверка наличия ключа в хэше
Проблема
Требуется узнать, содержит ли хэш конкретный ключ независимо от ассоциированного с ним значения
Решение
Воспользуйтесь функцией exists
# Содержит ли %ХЭШ ключ $КЛЮЧ"?
if (exists($X3UJ{$MK)4})) {
# Ключ существует } else {
Я Ключ не существует }
Комментарий
В следующем фрагменте функция exists проверяет, присутствует ли ключ в хэше %food_color
# Хэш %food_color определяется во введении
foreach $name ( Banana Martini ) {
if (exists $food_color{$name}) {
print $name is a food \n } else {
print Sname is a drink \n
Banana is a food Martini is a drink
Функция exists проверяет только наличие ключа в хэше Она не сообщает об ассоциированном значении, определено ли оно, истинно или ложно На первый взгляд кажется, что отличия несущественны Однако в действительности проблемы такого рода плодятся быстро, как кролики Возьмем следующий фрагмент
= О Toddler } = 3
$age{ Unborn } = О $аде{ Phantasm } = undef
foreach $thmg ( Toddler Unborn Phantasm Relic } { print Sthing
print Exists if exists $age{$thmg} print Defined if defined $age{thmg} print True if $age{$thing} print \n
Toddler Exists Defined True Unborn Exists Defined Phantasm Exists Relic
Элемент $age{ Toddler } проходит все три проверки — существования, определенности и истинности Он существует, потому что мы присвоили ключу Toddle r значение в хэше Он определен, потому что значение не равно undef Наконец, он истинен, потому что присвоенная величина не является одним из ложных значений Perl
Элемент $age{ Unborn } проходит только проверки существования и опреде ленности Он существует, потому что ключу Unborn было присвоено значение в хэше, и определен, потому что это значение не равно undef Однако он не является истинным, потому что 0 интерпретируется в Perl как одна из ложных величин
Элемент $age{ Phantasm } проходит только проверку существования Он существует, потому что ключу Phantasm было присвоено значение в хэше Поскольку это значение представляет собой undef, проверка определенности не работает Так как undef также считается в Perl одним из ложных значений, проверка истинности тоже не работает
Наконец, $age{ Relic } не проходит ни одну из проверок Значение для Relic не заносилось в хэш, поэтому проверка на существование завершается неудачей Из-за отсутствия ассоциированного значения попытка обратиться к $age{ Relic } дает undef Как мы знаем из примера с Phantasm , undef не проходит проверки определенности и истинности
Иногда undef полезно сохранить в хэше Это означает «такой ключ встречается, но с ним не связано никакого полезного значения» Например, рассмотрим программу, которая определяет размер файлов из переданного списка Следующий фрагмент пытается пропускать файлы, которые уже встречались в списке, однако это не касается файлов нулевой длины и встречавшихся ранее несуществующих файлов
%name = () while (<>) {
chomp
next if $name{$_} # НЕВЕРНО i
$name{$_} = -s $_
next if exists $name{$_},
В самом первом примере предполагается, что все, что не является едой (food), относится к напиткам {dunk). В реальном мире подобные допущения весьма опасны
> Смотри также---------------------------------------------------------------------------------------------
Описание функций exists и defined в perlfunc(i). Концепция истинности рассматривается в разделе «Scalar Values»perldala(l).
5.3. Удаление из хэша
Проблема
Требуется удалить элемент из хэша, чтобы он не опознавался функцией keys, values или each. Например, если в хэше имена работников ассоциируются с окладами, после увольнения работника необходимо удалить его строку из хэша.
Решение
Воспользуйтесь функцией delete:
# Удалить $КЛЮЧ и ассоциированное значение из хэша %ХЭШ
delete($X3UI{$KniO4}),
Комментарий
Многие ошибочно пытаются удалять элементы из хэша с помощью undef — undef ${ХЭШ{$КЛЮЧ} или $ХЭШ{$КЛЮЧ} = undef. В обоих случаях в хэше будет присутствовать элемент с ключом $КЛЮЧ и значением undef.
Функция delete — единственное средство для удаления конкретных элементов из хэша. Удаленный элемент не появится ни в списке keys, пи в итерациях each; функция exists возвращает для цего ложное значение.
Следующий фрагмент демонстрирует отличия undef от delete:
# Хэш %food_color определяется во введении
sub print_foods {
my @foods = keys %food_color, my $food,
print Keys @foods\n , print Values
foreach $food (@foods) {
my $color = $food_color{$food},
if (defined $color) { print $color ,
} else {
print (undef)
print \n ,
print Initially \n , prmt_foods()
print \nWith Banana undef\n undef $food_color{ Banana }, print_foods(),
print \nWith Banana deleted\n , delete $food_color{ Banana }, print_foods(),
Initially
Keys: Banana Apple Carrot Lemon
Values: yellow red orange yellow
With Banana undef
Keys: Banana Apple Carrot Lemon
Values: (undef) red orange yellow
With Banana deleted Keys Apple Carrot Lemon Values: red orange yellow
Как видите, после присвоения $food_color{ Banana } = undef ключ Banana остается в хэше. Элемент не удаляется; просто мы присвоили ему undef. С другой стороны, функция delete действительно удалила данные из хэша — ключ Banana исчезает из списка, возвращаемого функцией keys.
Функция delete также может вызываться для среза хэша, это приводит к удалению всех указанных ключей.
delete @food_color{ Banana Apple Cabbage },
\> Смотри также--------------------------------------------------------------------------------------------
Описание функций delete и keys в perlfunc(l). Применение keys продемонстрировано в рецепте 5.4.
5.4. Перебор хэша
Проблема
Требуется выполнить некоторые действия с каждым элементом (то есть парой «ключ/значение») хэша.
Воспользуйтесь функцией each в цикле while:
и/1и1е(($КЛЮЧ, $ЗНАЧЕНИЕ) = each(%X3UJ)) {
# Сделать что-то с $КЛЮЧ и $ЗНАЧЕНИЕ
}
Если хэш не очень велик, можно вызвать keys в цикле f о reach:
fо reach $КЛЮЧ (keys %ХЭШ) {
$ЗНАЧЕНИЕ = $ХЭШ{$ШЧ}
# Сделать что-то с $КЛЮЧ и $ЗНАЧЕНИЕ
}
Комментарий
Следующий простой пример перебирает элементы хэша %food_color из введения:
# Хэш %food_color определяется во введении while(($food, $color) = each(%food_color)) {
print $food is Scolor \n , }
Banana is yellow. Apple is red. Carrot is orange. Lemon is yellow.
В примере с f о reach можно обойтись без переменной $color, поскольку она используется всего один раз. Достаточно написать:
print $food is $food_color{$food} \n .
При каждом вызове each для одного и того же хэша функция возвращает «следующую» пару ключ/значение. Слово «следующую» взято в кавычки, потому что пары возвращаются в порядке, соответствующем внутренней структуре хэша, и этот порядок почти никогда не совпадает с числовым или алфавитным. За последним элементом each возвращает пустой список (); результат интерпретируется как ложный, и цикл while завершается.
В примере с foreach использована функция keys, которая строит список всех ключей из хэша еще перед началом выполнения цикла. Преимущество each заключается в том, что пары «ключ/значение» извлекаются по одной. Если хэш содержит много ключей, отказ от предварительного построения полного списка существенно экономит память и время. Однако функция each не позволяет управлять порядком обработки пар.
Применение foreach и keys для перебора списка позволяет установить свой порядок обработки Предположим, нам понадобилось вывести содержимое хэша в алфавитном порядке ключей:
foreach $food (sort keys %food_color) { print $food is $food_color{$food} \n
Apple is red. Banana is yellow. Carrot is orange. Lemon is yellow.
Подобное применение f о reach встречается довольно часто. Функция keys строит список ключей в хэше, после чего foreach перебирает их. Если хэш состоит из большого числа элементов, возникает опасность, что возвращаемый keys список займет много памяти. Приходится выбирать между затратами памяти и возможностью обработки элементов в определенном порядке. Сортировка подробнее рассматривается в рецепте 5.9.
Поскольку функции keys, values и each используют одни и те же внутренние структуры данных, следует внимательно следить за чередованием вызовов этих функций или преждевременным выходом из цикла each. При каждом вызове keys или values текущая позиция each сбрасывается. Следующий фрагмент зацикливается и бесконечно выводит первый ключ, возвращаемый each:
while ( ($k,$v) = each %food_color) {
print Processing $k\n ,
keys %food_color, # Возврат к началу %food_color
}
Модификация хэша во время его перебора в each или foreach, как правило, сопряжена с опасностью. При добавлении или удалении ключей из хэша функция each ведет себя по-разному для связанных и несвязанных хэшей. Цикл foreach перебирает заранее построенный список ключей, поэтому после начала цикла он ничего не знает о добавленных или удаленных ключах. Ключи, добавленные внутри цикла, не включаются автоматически в список перебираемых ключей, а удаленные внутри цикла ключи не удаляются из этого списка.
Программа countfrom из примера 5.1 читает файл почтового ящика и выводит количество сообщений от каждого отправителя. Отправитель определяется по строке From: (в этом отношении сценарий не очень интеллектуален, однако нас сейчас интересуют операции с хэшами, а не обработка почтовых файлов). Передайте имя почтового ящика в командной строке или используйте - для перенаправления.
Пример 5.1. countfrom
й1 /usr/bin/perl
# countfrom - подсчет сообщений от каждого отправителя
$filename = $ARGV[O] || - ,
open(FILE, <$filename ) or die Can t open $filename $' ,
while(<FILE>) {
if (/"From ( *)/) { $from<$1}++ }
foreach $person (sort keys %from) { print $person $from{$person}\n
Описание функций each и keys в perlfunc(i); описание циклов for и foreach в рецепте 4.5.
5.5. Вывод содержимого хэша
Проблема
Требуется вывести содержимое хэша, однако конструкции print %ХЭШ и print %ХЭШ не работают.
Решение
Одно из возможных решений — перебрать все пары «ключ/значение» в хэше (см. рецепт 5.4) и вывести их:
while ( ($k $v) = each %hash) {
print $k => $v\n }
Также можно построить список строк с помощью тар:
print тар { $_ => $hash{$_}\n } keys %hash
Или воспользуйтесь фокусом из рецепта 1.10 и интерполируйте хэш как список:
print @{[ %hash ]}\n
Или сохраните хэш во временном массиве и выведите его:
{
my @temp = %hash, print istemp ,
Комментарий
Все перечисленные приемы обладают различными возможностями по управлению порядком и форматированием вывода, а гакже различно]"! эффективностью.
Первый способ (перебор хэша) чрезвычайно гибок и эффективен по затратам памяти Вы можете как угодно форматировать выходные данные, при этом понадобятся всего две скалярные переменные — текущий ключ и значение. Использование цикла foreach позволяет вывести хэш с упорядочением ключей (ценой построения отсортированного списка):
foreach $k (sort keys %hash) { print $k => $hash{$k}\n , >
Функция map не уступает перебору по богатству возможностей Сортировка ключей по-прежнему позволяет работать с элементами в произвольном порядке. Выходные данные можно как угодно форматировать. На этот раз создается
список строк (например, КЛЮЧ=>ЗНАЧЕНИЕ , как в приведенном выше примере), передаваемый print
Два последних приема представляют собой фокусы, связанные с интерполяцией. Интерпретация хэша как списка не позволяет предсказать или управлять порядком вывода пар «ключ/значение». Более того, данные в этом случае выводятся в виде списка ключей и значений, элементы которого разделяются текущим содержимым переменной $ В отличие от других приемов, вам не удастся вывести каждую пару на новой строке или отделить ключи от значений символом =>.
Смотри также
Описание переменной $ в perlvar(l); описание функций foreach, map, keys, sort и each в perlfunc(l). Строковая интерполяция рассматривается в рецепте 1.10, а перебор хэша — в рецепте 5.4
5.6. Перебор элементов хэша в порядке вставки
Проблема
Функции keys и each извлекают элементы хэша в довольно странном порядке. Вы хотите получить элементы в порядке вставки.
Решение
Воспользуйтесь модулем Tie::IxHash
use Tie IxHash,
tie %ХЭШ Tie IxHash ,
# Операции с хэшем %ХЭШ
gkeys = keys %ХЭШ # Массив @keys отсортирован в порядке вставки
Комментарий
Модуль Tie::IxHash заставляет функции keys, each и values возвращать элементы в порядке занесения в хэш. Это часто избавляет от необходимости заранее обрабатывать ключи хэша какой-нибудь сложной сортировкой или поддерживать отдельный массив, содержащий ключи в порядке их вставки.
Tie- IxHash также представляет объектно-ориен тированный интерфейс к функциям splice, push, pop, shift, unshift, keys, values и delete, а также многим другим.
Следующий пример демонстрирует использование keys и each:
# Инициализировать
use Tie IxHash,
tie %food_color, Tie IxHas , $food_color{Banana} = Yellow ,
$food_color{Apple} = Green
$food_color{Lemon} = Yellow
print "Still in insertion order, the foods' colors are:\n" while (( $food, $color ) = each %food_color ) { print '$food is colored $color.\n",
In insertion order, the foods are:
Banana
Apple
Lemon
Still in insertion order, the foods' colors are: Banana is colored Yellow. Apple is colored Green. Lemon is colored Yellow.
t> Смотри также
Документация по модулю Tie::IxHash от CPAN; рецепт 13.15.
5.7. Хэши с несколькими ассоциированными значениями
Проблема
Требуется хранить в хэше несколько значений, ассоциированных с одним ключом.
Решение
Сохраните в хэше ссылку на массив для хранения ассоциированных значений.
Комментарий
В хэше могут храниться только скалярные величины. Однако ссылки являются скалярными величинами. Таким образом, проблема решается сохранением в $ХЭШ {$КЛЮЧ} ссылки на массив со значениями, ассоциированными с ключом $КЛЮЧ. Обычные операции с хэшами — вставка, удаление, перебор и проверка существования — переписываются для операций с массивами (push, splice и foreach).
Следующий фрагмент реализует простую вставку в хэш. Он обрабатывает выходные данные команды who(l) на компьютере с UNIX и выводит краткий список пользователей с терминалами, на которых они зарегистрированы:
%ttys =();
open(WHO, "who|") or die "can't open who: $!' ; while (<WHO>) {
($user, $tty) = split,
push( @{$ttys{$user}}, $tty ),
foreach $user (sort keys %ttys) {
print "$user @t$ttys{$user}}\n", >
Вся суть этого фрагмента заключена в строке push, где содержится версия $tty{$user} = $tty для многозначного хэша. Все имена терминалов интерполируются в строке print конструкцией @{$ttys{user}}. Если бы, например, нам потребовалось вывести владельца каждого терминала, мы бы организовали перебор анонимного массива:
foreach $user (sort keys %ttys) {
print "$user. ", scalar( @{$ttys{$user}} ), 'ttys \n"; foreach $tty (sort @{$ttys{$user}}) {
@stat = state/dev/$tty' );
$user = @stat "> ( getpwuid($stat[4]) )[0] . (not available)',
print "\t$tty (owned by $user)\n ;
Функция exists может иметь два значения: «Существует ли в хэше хотя бы одно значение для данного ключа?» и «Существует ли данное значение для данного ключа?» Чтобы реализовать вторую интерпретацию, придется просмотреть массив в поисках нужной величины. Первая трактовка exists косвенно связана с функцией delete: если мы можем гарантировать, что ни один анонимный массив никогда не остается пустым, можно воспользоваться встроенной функцией exists. Чтобы убедиться, что анонимные массивы не остаются пустыми, их следует проверять после удаления элемента:
sub multihash_delete {
my {$hash, $key, Svalue) = @_, my $1;
return unless ref( $hash->{$key} ); for ($1 = 0, $i < <®{ $hash->{$key} }; $i++) { if ($hash->{$key}->[$i] eq $value) { splice( @{$hash->{$key}}, $i, 1), last,
delete $hash->{$key} unless @{$hash-><$key}}, }
Альтернативная реализация многозначных хэшей приведена в главе 13 «Классы, объекты и связи», где они реализуются как связанные обычные хэши.
> Смотри также---------------------------------------------------------------------------------------------
Описание функций splice, delete, push, foreach и exists вperlfunc(l); рецепт 11.1. Связи рассматриваются в рецепте 13.15.
Проблема
Хэш связывает ключ с ассоциированным значением. У вас имеется хэш и значение, для которого требуется определить ключ.
Решение
Воспользуйтесь функцией reverse для создания инвертированного хэша, где ассоциированные значения исходного хэша являются ключами, и наоборот.
# %ХЭШ связывает ключи со значениями
%ОБРАТНЫЙ = reverse %ХЭШ;
Комментарий
В этом решении используется списковая эквивалентность хэшей, о которой упоминалось во введении. В списковом контексте reve rse интерпретирует %ХЭШ как список и меняет местами составляющие его элементов. Одно из важнейших свойств списковой интерпретации хэша заключается в том, что элементы списка представляют собой пары «ключ/значение». После инвертирования такого списка первым элементом становится значение, а вторым — ключ. Если интерпретировать такой список как хэш, его значения будут являться ключами исходного хэша, и наоборот. Приведем пример:
%surname = ( Mickey' => Mantle , "Babe => 'Ruth ), %first_name = reverse %surname, print $first_narae{"Mantle' , '\n", Mickey
Если интерпретировать % surname как список, мы получим следующее:
('Mickey", "Mantle', "Babe', 'Ruth")
(а может быть, ("Babe", "Ruth", "Mickey", "Mantle' ), поскольку порядок элементов непредсказуем). После инвертирования список выглядит так:
('Ruth', "Babe", 'Mantle", 'Mickey')
Интерпретация его в качестве хэша дает следующее:
('Ruth' => "Babe', 'Mantle" => 'Mickey')
В примере 5.2 приведена программа foodfind. Если передать ей название продукта, она сообщает цвет, а если передать цвет — она сообщает название.
Пример 5.2. foodfind
#' /usr/bm/perl -w
# foodfind - поиск продуктов по названию или цвету
$given = shift @ARGV or die 'usage foodfind food_or_color\n ;
%color = (
'Apple ' => "red' ,
"Banana" => "yellow', "Lemon' => 'yellow", "Carrot" => 'orange'
%food = reverse %color,
if (exists $color{$given}) {
print "$given is a food with color $color{$given} \n',
>
if (exists $food{$given>) {
print '$food{$given} is a food with color $given \n' ; }
Если два ключа исходного хэша имеют одинаковые значения ("Lemon' и "Banana" в предыдущем примере), то инвертированный хэш будет содержать лишь один из них (какой именно — зависит от порядка хэширования, так что непредсказуемо). Дело в том, что хэши в Perl по определению имеют уникальные ключи.
Чтобы инвертировать хэш с повторяющимися значениями, следует воспользоваться методикой рецепта 5.7 — то есть построить хэш, ассоциированные значения которого представляют собой списки ключей исходного хэша:
# Хэш %food_color определяется во введении while (($food,$color) = each(%food_color)) { push(@{foods_with_color{$color}}, $food),
print @{$foods_with_color{yellow}} were yellowfoods.n', Banana Lemon were yellow foods.
Кроме того, это позволит модифицировать программу foodfind так, чтобы она работала с цветами, соответствующими сразу нескольким продуктам. Например, при вызове foodfmd yellow будут выводиться и Banana, и Lemon.
Если какие-либо значения исходного хэша были не простыми строками и числами, а ссылками, при инвертировании возникает проблема — ссылки не могут использоваться в качестве ключей, если только вы не воспользуетесь модулем Tie::RefHash (см. рецепт 5.12).
> Смотри также---------------------------------------------------------------------------------------------
Описание функций reverse в perlfunc{\); рецепт 13.15.
5.9. Сортировка хэша
Проблема
Требуется работать с элементами хэша в определенном порядке.
Решение
Воспользуйтесь функцией keys для построения списка ключей, а затем отсортируйте их в нужном порядке:
@keys = sort { criterionO } (keys %hash),
foreach $key (@keys) { lvalue = $hash{$key}, # Сделать что-то с $key, Svalue
Комментарий
Хотя хранить элементы хэша в заданном порядке невозможно (без использования модуля Tie:IxHash, упомянутого в рецепте 5.6), перебирать их можно в любом порядке.
Существует множество разновидностей одного базового механизма: вы извлекаете ключи, упорядочиваете их функцией sort и обрабатываете элементы в новом порядке. Допускается применение любых хитростей сортировки, упоминавшихся в главе 4 «Массивы». Рассмотрим пару практических примеров.
В первом фрагменте sort просто используется для упорядочения ключей по алфавиту:
foreach $food (sort keys %food_color) {
print $food is $food_color($food) \n , }
Другой фрагмент сортирует ключи по ассоциированным значениям:
foreach $food (sort { $food_color{$a} cmp $food_color{$b} } ) keys %food__color) {
print $food is $food_color{$food} \n , }
Наконец, сортировка выполняется по длине ассоциированных значений:
@foods = sort { length($food_color{$a}) <=> length($food_color{$b}) }
keys %food_color, foreach $food (@foods) {
print $food is $food_color{$food} \n , }
> Смотри также---------------------------------------------------------------------------------------------
Описание функций sort и keys вperlfunc(l); рецепт 5.6. Сортировка списков рассматривается в рецепте 4.15.
5.10. Объединение хэшей
Проблема
Требуется создать новый хэш, содержащий элементы двух существующих хэшей.
Решение
Интерпретируйте хэши как списки и объедините их так, как это делается со списками:
%merged =
Для экономии памяти можно организовать перебор элементов и построить новый хэш следующим образом:
%merged = (),
while ( ($k,$v) = each(%A) ) { $merged{$k} = $v,
}
while ( ($k,$v) = each(%B) ) { $merged{$k} = $v,
Комментарий
В первом варианте, как и в предыдущем рецепте инвертирования хэшей, используется списковая эквивалентность, о которой говорилось во введении. (%А, %В) интерпретируется как список пар «ключ/значение». Когда он присваивается объединенному хэшу %merged, Perl преобразует список пар снова в хэш. Рассмотрим, как эта методика реализуется на практике:
# Хэш %food_color определяется во Введении
%drink_color = ( Galliano => yellow ,
Mai Tai => blue ),
%mgested_colors = (%drink_color %food_color),
Ключи обоих входных хэшей присутствуют в выходном не более одного раза. Если в хэшах найдутся совпадающие ключи, в итоговый хэш включается тот ключ, который встретился последним.
Прямое присваивание компактно и наглядно, но при больших размерах хэшей оно приводит к большим расходам памяти. Это связано с тем, что перед выполнением присваивания итоговому хэшу Perl разворачивает оба хэша во временный список. Пошаговое объединение с помощью each, показанное ниже, избавит вас от этих затрат. Заодно вы сможете решить, как поступать с совпадающими ключами.
С применением each первый фрагмент записывается следующим образом:
# Хэш %food_color определяется во Введении
%drink_color = ( Galliano => yellow ,
Mai Tai => blue ),
%substance_color = (),
while (($k, $v) = each %food_color) {
$substance_color{$k} = $v } while (($k, $v) = each %drmk_color) {
$substance_color{$k) = $v, }
Обратите внимание на повторяющийся код присваивания в циклах while. Проблема решается так:
Если в объединяемых хэшах присутствуют одинаковые ключи, можно вставить код для обработки дубликатов:
foreach Ssubstanceref (\%food_color, \%drink_color ) { while (($k, $v) = each %substanceref) { if (exists $substance_color{$k}) {
print Warning $k seen twice Using the first definition \n , next, } $substance_color{$k} = $v,
В частном случае присоединения одного хэша к другому можно воспользоваться срезом для получения более элегантной записи:
@>all_colors{keys %new_colors} = values %new_colors,
Потребуется память в объеме, достаточном для хранения списков всех ключей и значений %new_colors. Как и в первом варианте, расходы памяти при большом размере списков могут сделать эту методику неприемлемой.
> Смотри также---------------------------------------------------------------------------------------------
Описание функции each вperlfunc(l); рецепт 4.9.
5.11. Поиск общих или различающихся ключей в двух хэшах
Проблема
Требуется найти в хэше ключи, присутствующие в другом хэше, — или наоборот, не входящие в другой хэш.
Решение
Организуйте перебор ключей хэша с помощью функции keys и проверяйте, присутствует ли текущий ключ в другом хэше.
Поиск общих ключей
ту @соттоп = (), foreach (keys %hash1) {
push(@common, $_) if exists $hash2{$_}, } # ^common содержит общие ключи
5.12. Хэширование ссылок 169 Поиск ключей, отсутствующих в другом хэше
my @this_not_that = (), foreach (keys %hash1) {push(@this_not_that, $_) unless exists $hash2{$_}, }
Комментарий
При поиске общих или различающихся ключей хэшей можно воспользоваться рецептами для поиска общих или различающихся элементов в массивах ключей хэшей. За подробностями обращайтесь к рецепту 4.8.
В следующем фрагменте поиск различающихся ключей применяется для нахождения продуктов, не входящих в хэш с описаниями цитрусовых:
# Хэш %food_color определяется во введении
# %citrus_color - хэш, связывающий названия цитрусовых плодов с их цветами
%citrus_color = (Lemon => yellow ,
Orange => orange , Lime => green ),
# Построить список продуктов не входящих в хэш цитрусовых
@non-citrus = (),
foreach (keys %food_color) {
push (@non_citrus, $_) unless exists $citrus_color{$_}, }
t> Смотри также--------------------------------------------------------------------------------------------
Описание функции each вperlfunc(l). Срезы хэшей рассматриваются вperldata(l).
5.12. Хэширование ссылок
Проблема
Если функция keys вызывается для хэша, ключи которого представляют собой ссылки, то возвращаемые ей ссылки не работают. Подобная ситуация часто возникает при создании перекрестных ссылок в двух хэшах.
Решение
Воспользуйтесь модулем Tie::Refflash:
use Tie RefHash,
tie %hash, Tie RefHas ,
it Теперь в качестве ключей хэша %hash можно использовать ссылки
Комментарий
Ключи хэшей автоматически преобразуются в строки — то есть интерпретируются так, словно они заключены в кавычки. Для чисел и строк при этом ничего не теряется. Однако со ссылками дело обстоит иначе.
Class::Somewhere=HASH(0x72048) ARRAY(0x72048)
Преобразованную ссылку невозможно вернуть к прежнему виду, поскольку она перестала быть ссылкой и превратилась в обычную строку. Следовательно, при использовании ссылок в качестве ключей хэша они теряют свои «волшебные свойства».
Для решения этой проблемы обычно создается специальный хэш, ключами которого являются ссылки, преобразованные в строки, а значениями — настоящие ссылки. Именно это и происходит в модуле Tie::RefHash. Мы воспользуемся объектами ввода/вывода для работы с файловыми манипуляторами и покажем, что даже такие странные ссылки могут использоваться для индексации хэша, связанного с Tie::RefHash.
Приведем пример:
use Tie RefHash, use 10 File,
tie %nane, Tie RefHash ,
foreach $filename ( /etc/termcap , /vnumx , /bin/cat ) {
$fh = 10 File->( < Sfilename ) or next,
$name{$fh} = Sfilename, }
print open files , ]oin( , values %name \n , foreach $file (keys %name) {
seek($file, 0, 2), # Позиционирование в конец файла
pnntf ( %s is %d bytes long \n $name{$file}, tell($file)) }
Однако вместо применения объекта в качестве ключа хэша обычно достаточно сохранить уникальный атрибут объекта (например, имя или идентификатор).
> Смотри также---------------------------------------------------------------------------------------------
Документация по стандартному модулю Tie::RefHash; раздел «Warning» perl-ref(l).
5.13. Предварительное выделение памяти для хэша
Проблема
Требуется заранее выделить память под хэш, чтобы ускорить работу программы — в этом случае Perl не придется выделять новые блоки при каждом добавлении элемента. Окончательный размер хэша часто бывает известен в начале построения, и эта информация пригодится для повышения быстродействия.
Решение
Присвойте количество пар «ключ/значение» конструкции keys(%X3lll):
# Выделить в хэше %hash память для $num элементов
keys(%hash) = $num,
Комментарий
Новая возможность, впервые появившаяся в Perl версии 5.004, может положительно повлиять на быстродействие вашей программы (хотя и не обязательно). В хэшах Perl и так применяются общие ключи, поэтому при наличии хэша с ключом 'Apple Perl уже не выделяет память под другую копию Apple при включении этого ключа в другой хэш.
# В %users резервируется место для 512 элементов
keys(%users) = 512,
Внутренние структуры данных Perl требуют, чтобы количество ключей было равно степени 2. Если написать:
keys(%users) = 1000,
Perl выделит для хэша 1024 «гнезда». Количество ключей не всегда равно количеству гнезд. Совпадение обеспечивает оптимальное быстродействие, однако конкретное соответствие между ключами и гнездами зависит от ключей и внутреннего алгоритма хэширования Perl.
> Смотри также---------------------------------------------------------------------------------------------
Функция keys описана вperlfunc(l). Также обращайтесь к рецепту 4.3.
5.14. Поиск самых распространенных значений
Проблема
Имеется сложная структура данных (например, массив или хэш). Требуется узнать, как часто в ней встречается каждый элемент массива (или ключ хэша). Допустим, в массиве содержатся сведения о транзакциях Web-сервера и вы хотите узнать, какой файл запрашивается чаще остальных. Или для хэша, в котором имя пользователя ассоциируется с количеством регистрации в системе, требуется определить наиболее распространенное количество регистрации.
Решение
Воспользуйтесь хэшем и подсчитайте, сколько раз встречается тот или иной элемент, ключ или значение:
%count = (),
foreach $element (©array) {
Глава 5 • Хэши
$count{$element}++ }Комментарий
Каждый раз, когда возникает задача подсчета различных объектов, вероятно, стоит воспользоваться хэшем. В приведенном выше цикле foreach для каждого экземпляра $element значение $count{$element} увеличивается на 1.
> Смотри также---------------------------------------------------------------------------------------------
Рецепты 4.6 и 4.7.
5.15. Представление отношений между данными
Проблема
Требуется представить отношения между данными — например, отношения «предок/потомок» в генеалогическом дереве или «родительский/порожденный процесс» в таблице процессов. Задача тесно связана с представлением таблиц в реляционных базах данных (отношения между записями) и графов в компьютерных технологиях (отношения между узлами графа).
|
Решение |
||
|
Воспользуйтесь хэшем. |
||
|
Комментарий |
||
|
Следующий хэш представляет часть г |
||
|
%father = ( Cam |
=> |
Adam , |
|
Abel |
=> |
Adam , |
|
Seth |
=> |
Adam |
|
Enoch |
=> |
Cain , |
|
Irad |
=> |
Enoch , |
|
Mehujael |
=> |
Irad , |
|
Methusael |
=> |
Mehujael |
|
Lamech |
=> |
Methusael |
|
Jabal |
=> |
Lamech , |
|
Jubal |
=> |
Lamech |
Tubalcain => Lamech , Enos => Seth )
Например, мы можем легко построить генеалогическое дерево любого персонажа:
while (о) { chomp, do {
print $_ , # Вывести текущее имя $_ = $father{$_}, # Присвоить $_ отца $_ } while defined, # Пока отцы находятся print \п , }
Просматривая хэш %father, можно отвечать на вопросы типа: «Кто родил Сета?» При инвертировании хэша отношение заменяется противоположным Это позволяет использовать рецепт 5.8 для ответов на вопросы типа: «Кого родил Ламех?»
while ( ($k, $v) = each %father ) { push( @{ $children{$v} }, $k )
$ = , й Выходные данные разделяются запятыми while (о) {
chomp
if ($children{$J) {
(^children = @{$children{$_}}
} else {
©children = nobody
}
print $_ begat (^children \n , }
Хэши также могут представлять такие отношения, как директива «include языка С — А включает В, если А содержит ttinclude В Следующий фрагмент строит хэш (он не проверяет наличие файлов в /usr/include, как следовало бы, но этого можно добиться ценой минимальных изменений):
foreach $file (@files) {
local *F, # На случай если понадобится
tt локальный файловый манипулятор unless (open (F, <$file )) {
warn Couldn t read file $' skipping \n , next,
while (<F>) {
next unless /"\s*#\s+include\s+<([~>\+)>/, push(@{$includes{$1}} $file), }
close F, }
Другой фрагмент проверяет, какие файлы не включают других:
<3>mclude_fгее = () # Список файлов, не включающих других файлов @umq{map { @$_ } values %includes} = undef foreach $file (sort keys %umq) {
push( @include_free , $file ) unless $mcludes{$file}
> Смотри также---------------------------------------------------------------------------------------------
Рецепт 4.6; описание более сложных структур данных в рецептах 11.9—11.14.
5.16. Программа: dutree
Программа dutree (см. пример 5.3) преобразует выходные данные du:
|
% di |
cookbook |
||
|
19 |
pcb/fix |
||
|
20 |
pcb/rev/maybe/yes |
||
|
10 |
pcb/rev/maybe/not |
||
|
705 |
pcb/rev/maybe |
||
|
54 |
pob/rev/web |
||
|
1371 |
pcb/rev |
||
|
3 |
pcb/pending/mine |
||
|
1016 |
pcb/pending |
||
|
2412 |
pcb |
||
|
в отсортированную иера] |
эхичеа |
||
|
2412 |
pcb |
||
|
1371 rev |
|||
|
| 705 maybe |
|||
|
I |
675 . |
||
|
I |
20 yes |
||
|
I |
10 not |
||
|
612 . |
|||
|
54 web |
|||
|
101 |
6 pending |
||
|
1013 |
|||
|
3 |
mine |
||
|
19 fix |
|||
|
e |
% dutree
% dutree /usr
% dutree -a
% dutree -a /bin
Хэш %Dirsize сопоставляет имена с размерами файлов. Например, значение $Dirsize{"pcb"} в нашем примере равно 2412. Этот хэш используется как для вывода, так и для сортировки подкаталогов каждого каталога по размерам.
Хэш %Kids представляет больший интерес. Для любого пути $path значение $Kids{path} содержит (ссылку на) массив с именами подкаталогов данного каталога. Так, элемент с ключом "pcb" содержит ссылку на анонимный массив со строками "fix", "rev" и "pending". Элемент "rev" содержит "maybe" и "web". В свою очередь, элемент "maybe" содержит "yes" и "по", которые не имеют собственных элементов, поскольку являются «листами» (конечными узлами) дерева.
Функции output передается начало дерева — последняя строка, прочитанная из выходных данных du. Сначала функция выводит этот каталог и его размер, затем сортирует его подкаталоги (если они имеются) так, чтобы подкаталоги наибольшего размера оказались наверху. Наконец, output вызывает саму себя, рекурсивно перебирая все подкаталоги. Дополнительные аргументы используются при форматировании.
Программа получается рекурсивной, поскольку рекурсивна сама файловая система. Однако ее структуры данных не рекурсивны — по крайней мере, не в том смысле, в котором рекурсивны циклические связанные списки. Каждое ассоциированное значение представляет собой массив ключей для дальнейшей обработки. Рекурсия заключается в обработке, а не в способе хранения.
Пример 5.3. dutree
#'/usr/bin/perl -w
# dutree - печать сортированного иерархического представления
# выходных данных du
use strict,
my %Dirsize, my %Kids,
getdots(my $topdir = mput()), output($topdir),
# Запустить du, прочитать входные данные, сохранить размеры и подкаталоги
# Вернуть последний прочитанный каталог (файл9)
sub input {
™y($size, $name, Sparent),
@ARGV = ( du @ARGV | ), fl Подготовить аргументы
while (о)
(Ssize, $name) = split,
$Dirsize{$name} = $size,
(Sparent = $name) =' s#/["/]+$#», fl Имя каталога
push @{ $Kids{$parent} }, $name unless eof, > return $name;
fl Рассчитать, сколько места занимают файлы каждого каталога,
# не находящиеся в подкаталогах Добавить новый фиктивный
# подкаталог с именем ' ', содержащий полученную величину
sub getdots {
продолжение
my $root = $_[0],
my($size, $cursize),
$size = Scursize = $Dirsize{$root},
if \$Kids<$root}) {
for my $kid (@{ $ Kids {$ root} }) {
$cursize -= $Dirsize{$kid},
getdots($kid),
if ($size •= $cursize) { my $dot = $root/ , $Dirsize{$dot} = $cursize, push @{ $Kids{$root} }, $dot,
ft Рекурсивно вывести все данные,
# передавая при рекурсивных вызовах
# выравнивающие пробелы и ширину числа
sub output {
my($root, Sprefix, $width) = (shift, shift || ", shift || 0),
my $path,
($path = $root) =" s# */##, # Базовое имя
my $size = $Dirsize{$root},
my $line = spnntf( %${width}d %s', Ssize, $path),
print Sprefix, $lme, \n',
for ($prefix = $line) { # Дополнительный вывод
s/\d /| /,
s/["|]/ /g, } if ($Kids{$root}) { в Узел имеет подузлы
my isKids = §{ $Kids{$root} },
@Kids = sort { $Dirsize{$b} <=> $Dirsize{$a} } @Kids,
$Dirsize{$Kids[0]} =- /(\d+)/,
my $width = length $1,
for my $kid (@Kids) { output($kid, $prefix, $width) }
До того как в Perl появилась прямая поддержка хэшей массивов, эмуляция подобных конструкций высшего порядка требовала титанических усилий. Некоторые программисты использовали многократные вызовы split и join, но это работало чрезвычайно медленно.
В примере 5.4 приведена версия программы dutree из тех далеких дней. Поскольку у нас не было прямых ссылок на массивы, приходилось самостоятельно залезать в символьную таблицу Perl. Программа на ходу создавала переменные с жутковатыми именами. Удастся ли вам определить, какой хэш используется этой программой?
Массив @{"pcb"> содержит ссылку на анонимный массив, содержащий "pcb/ fix", "pcb/rev' и "pcb/pendmg". Массив @{"pcb/rev"} содержит "pcb/rev/maybe" и "pcb/rev/web". Массив @{"pcb/rev/maybe"} содержит "pcb/rev/maybe/yes" и ¦•pcb/rev/maybe/not'.
Когда вы присваиваете *kid что-нибудь типа 'pcb/f ix", строка в правой части преобразуется в тип-глоб. @kid становится синонимом для @{ 'pcb/f ix"}, но это отнюдь не все. &kid становится синонимом для &{" pcb/f ix"} и т. д.
Если эта тема покажется неинтересной, подумайте, как local использует динамическую область действия глобальных переменных, чтобы избежать передачи дополнительных аргументов. Заодно посмотрите, что происходит с переменной width в процедуре output.
Пример 5.4. dutree-orig
tt> /usr/bm/perl
# dutree_orig старая версия, которая появилась
й до выхода perl$ (начало 90-х)
(alines = du @ARGV ,
chop(@lines),
&input($top = pop @lines),
&output($top),
exit,
sub input {
local($root, *kid, $him) = @_[0,0],
while (©lines && Schildof($root, $lines[$#lmes])) {
&input($him = pop(@lmes)),
push(@kid, $him), i} if (@kid) {
local($mysize) = ($root =" /"(\d+)/),
for (@kid) { $mysize -= (/"(\d+)/)[0], }
push(@kid, $mysize ) if $size ' = $mysize, } @kid = &sizesort(*kid),
sub output {
local($root, *kid, $prefix) = @_[0,0,1],
local($size, $path) = split( , $root),
$path =~ s1 */'',
$line = sprintf('%${width}d %s , $size, $path),
print $prefix, $lme, '\n',
$prefix = $line,
Sprefix =~ s/\d /I /,
$prefix =- s/["|]/ /g,
local(Swidth) = $kid[O] =" /(\d+)/ && length( $1 ),
for (iakid) { &output($_, Sprefix), },
} продолжение
sub sizesort {
local(*list, ©index) = shift; sub bynum { $mdex[$b] <=> $index[$a]; for (©list) { push(@mdex, /(\d+)/), } @list[sort bynum O..$#list];
sub childof {
local(@pair) = $_;
for (@pair) { s/~\d+\s+//g, s/$/\//, }
index($pair[1], $pair[0]) >= 0, }
Итак, какой же хэш используется старой программой dutree? Правильный ответ — %mam ¦ :, то есть символьная таблица Perl. He стоит и говорить, что эта программа не будет работать с use strict. Мы рады сообщить, что новая версия работает втрое быстрее старой. Дело в том, что старая версия постоянно ищет переменные в символьной таблице, а новая обходится без этого. Кроме того, нам удалось избежать медленных вызовов split для занимаемого места и имени каталога. Однако мы приводим и старую версию, поскольку она весьма поучительна.
 |
Поиск по шаблону
[Искусство — это] шаблон, наполняемый разумом. Сэр Герберт Рид, «Значение Искусства»
Введение
В большинстве современных языков программирования существуют примитивные средства поиска по шаблону (обычно вынесенные в дополнительные библиотеки), но шаблоны Perl интегрируются на уровне самого языка. Они обладают возможностями, которыми не могут похвастаться другие языки; возможностями, которые позволяют взглянуть на данные с принципиально новой точки зрения. Подобно тому, как шахматист воспринимает расположение фигур на доске как некий образ, адепты Perl рассматривают данные с позиций шаблонов. Шаблоны записываются на языке регулярных выражений1, богатом знаками препинания, и позволяют работать с замечательными алгоритмами, обычно доступными лишь экспертам в области компьютерных технологий.
«Если поиск по шаблону — такая потрясающая и мощная штука, — спросите вы, — то почему же эта глава не содержит сотни рецептов по применению регулярных выражений?» Да, регулярные выражения обеспечивают естественное решение многих проблем, связанных с числами, строками, датами, Web-документами, почтовыми адресами и буквально всем, что встречается в этой книге. В других главах поиск по шаблону применяется свыше 100 раз. А в этой главе в основном представлены те рецепты, в которых шаблоны являются частью вопроса, а не ответа.
Обширная и тщательно проработанная поддержка регулярных выражений в Perl означает, что в вашем распоряжении оказываются не только те средства, которые не встречаются ни в одном другом языке, но и принципиально новые возможности их использования. Программисты, недавно познакомившиеся с Perl, часто ищут в нем функции поиска и подстановки:
180 Глава 6 • Поиск по шаблону
match( $строка $шаблон)subst( $строка $шаблон, $замена)
Однако поиск и подстановка — настолько распространенные задачи, что они заслуживают собственного синтаксиса'
$meadow =~ m/sheep/, # Истинно если $meadow содержит sheep Smeadow '" m/sheep/ # Истинно если $meadow не содержит sheep $meadow =~ s/old/new # Заменить в $meadow old на new
Поиск по шаблону даже в упрощенном виде не похож на обычные строковые сравнения. Он больше похож на поиск строк с применением универсальных символов-мутантов, к тому же накачанных допингом. Без специального «якоря» позиция, в которой ищется совпадение, свободно перемещается по всей строке. Допустим, если вы захотите найти слово ovine или ovmes и воспользуетесь выражением $meadow =~ /ovine/, то в каждой из следующих строк произойдет ложное совпадение-Fine bovmes demand fine toreadors Muskoxen are a polar ovibovine species Groovmess went out of fashion decades ago
Иногда нужная строка находится прямо у вас перед глазами, а совпадение все равно не происходит
Ovmes are found typically in ovianes
Проблема в том, что вы мыслите категориями человеческого языка, а механизм поиска по шаблону — нет. Когда этот механизм получает шаблон /ovine/ и другую строку, в которой происходит поиск, он ищет в строке символ о , за которым сразу же следует v , затем 1 , п и е Все, что находится до этой последовательности символов или после нее, не имеет значения.
Итак, выясняется, что шаблон находит совпадения там, где они не нужны, и не узнает то, что действительно нужно. Придется усовершенствовать его. Например, для поиска последовательности ovine или ovmes шаблон должен выглядеть примерно так:
if (Smeadow =~ /\bovinesAb/i) { print Here be sheep1 }
Шаблон начинается со метасимвола \Ь, который совпадает только с границей слова. s? обозначает необязательный символ s — он позволяет находить как ovine, так и ovmes. Модификатор /i в конце шаблона означает, что поиск осуществляется без учета регистра.
Как видите, некоторые символы и последовательности символов имеют особый смысл для механизма поиска по шаблону. Метасимволы фиксируют шаблон в начале или конце строки, описывают альтернативные значения для частей шаблона, организуют повторы и позволяют запомнить часть найденной подстроки, чтобы в дальнейшем использовать ее в шаблоне или программном коде.
Освоить синтаксис поиска по шаблону не так уж сложно. Конечно, служебных символов много, но существование каждого из них объясняется вескими причинами. Регулярное выражение — это не просто беспорядочная груда знаков... это тщательно продуманная груда знаков! Если вы что-нибудь забыли, всегда можно
заглянуть в документацию. Сводка по синтаксису регулярных выражений имеется в страницах руководстваperlre(i) nperlop(i), входящих в любую поставку Perl.
Три затруднения
Но синтаксис регулярных выражений — это еще цветочки по сравнению с их хитроумной семантикой. Похоже, большинство трудностей вызывают три особенности поиска по шаблону: жадность, торопливость (а так же то, как эти три аспекта взаимодействуют между собой) и возврат.
Принцип жадности: если квантификатор (например, *) может совпасть в не скольких вариантах, он всегда совпадает со строкой наибольшей длины. Объяснения приведены в рецепте 6.15.
Принцип торопливости: механизм поиска старается обнаружить совпадение как можно скорее, иногда даже раньше, чем вы ожидаете. Рассмотрим конструкцию Fred =" /x*/. Если попросить вас объяснить ее смысл, вы, вероятно, скажете. «Содержит ли строка Fred символы х?» Вероятно, результат поиска окажется неожиданным — компьютер убежден, что символы присутствуют. Дело в том, что /х*/ означает не просто «символы х», а «любое количество символов х». Или более формально — ноль и более символов. В данном случае нетерпеливый механизм поиска удовлетворяется нулем.
Приведем более содержательный пример:
$string = good food Sstring =~ s/o*/e/
Как вы думаете, какое из следующих значений примет $string после подстановки?
goof food geod food geed food geed feed ged food ged fed egood food
Правильный ответ — последний, поскольку первая точка, в которой встречается ноль и более экземпляров о , находится прямо в начале строки. Удивлены? С регулярными выражениями это бывает довольно часто.
А теперь попробуйте угадать, как будет выглядеть результат при добавлении модификатора /д, который делает подстановку глобальной? Строка содержит много мест, в которых встречается ноль и более экземпляров о , — точнее, восемь. Итак, правильный ответ — egeede efeede .
Приведем другой пример, в котором жадность уступает место торопливости:
% echo ababacaca | perl -ne print $&\n if /(a|ba|b)+(a|ac)+/ ababa
Это объясняется тем, что при поиске в Perl используются так называемые традиционные неопределенные конечные автоматы (в отличие от неопределенных конечных автоматов POSIX). Подобные механизмы поиска гарантируют возврат не самого длинного общего совпадения, а лишь самого длинного левого совпаде-
Но дело не обязательно обстоит именно так. В следующем примере используется awk — язык, от которого Perl позаимствовал немало:
% echo ababacaca |
awk match($O,/(a|ba|b)+(a|ac)+/) { print substr($0, RSTART, RLENGTH) } ababacaca
Выбор реализации поиска по шаблону в основном зависит от двух факторов: нерегулярности выражений (то есть наличия в них обратных ссылок) и типа возвращаемой величины (логическое «да/нет», все совпадение, подвыражения). Такие инструменты, как awk, egrep и lex, используют регулярные выражения и возвращают либо логическое «да/нет», либо все совпадение. Подобные возможности поддерживаются определенными конечными автоматами; поскольку определенные конечные автоматы работают быстрее и проще, реализация в перечисленных инструментах основана именно на них. Поиск по шаблону в таких программах и библиотеках, как ed, regex или perl, — совсем другое дело. Обычно приходится поддерживать нерегулярные выражения и знать, какие части строки совпали с различными частями шаблона. Эта задача намного сложнее и отличается экспоненциальным ростом времени выполнения. Естественный алгоритм ее реализации основан на неопределенных конечных автоматах; в этом заключается и проблема, и возможности. Проблема — в том, что неопределенные конечные автоматы работают медленно. Возможности — в том, что формулировка шаблона с учетом особенностей конкретной реализации позволяет существенно повысить быстродействие.
Последняя и самая интересная из трех особенностей — возврат. Чтобы шаблон совпал, должно совпасть все регулярное выражение, а не лишь его отдельная часть. Следовательно, если начало шаблона с квантификатором совпадает, а одна из последующих частей шаблона — нет, механизм поиска возвращается к началу и пытается найти для него другое совпадение — отсюда и термин «возврат». Фактически это означает, что механизм поиска должен систематически перебирать разные возможности до тех пор, пока не найдет полное совпадение. В некоторых реализациях поиска возврат используется для поиска других совпадающих компонентов, которые могли бы увеличить длину найденного совпадения. Механизм поиска Perl этого не делает; найденное частичное совпадение используется немедленно, — если позднее другая часть шаблона сделает полное совпадение невозможным, происходит возврат и поиск другого частичного совпадения (см. рецепт 6.16).
Модификаторы
Модификаторы, используемые при поиске по шаблону, намного проще перечислить и понять, чем другие метасимволы. Ниже приведена краткая сводка:
/i Игнорировать регистр (с учетом национальных алфавитов).
/х Игнорировать большинство пропусков в шаблонах и разрешить комментарии.
/д Глобальный модификатор — поиск/замена выполняются всюду, где это возможно.
/gc He сбрасывать позицию при неудачном поиске.
/s Разрешить совпадение . с переводом строки; кроме того, игнорировать устаревшее значение $*.
/т Разрешить совпадение " и $ соответственно для начала и конца строки во внутренних переводах строк.
/о Однократная компиляция шаблонов.
/е Правая часть s/// представляет собой выполняемый код.
/ее Правая часть s/// выполняется, после чего возвращаемое значение ин-терпретируеся снова.
Наиболее распространены модификаторы /i и /д. Шаблон /ram/i совпадает со строками ram , RAM , Ram и т. д. При наличии этого модификатора обратные ссылки проверяются без учета регистра (пример приведен в рецепте 6.16) При вызове директивы use locale в сравнениях будет учитываться состояние текущих локальных настроек. В текущей реализации модификатор /i замедляет поиск по шаблону, поскольку подавляет некоторые оптимизации скорости.
Модификатор /д используется с s/// для замены всех найденных совпадений, а не только первого Кроме того, /д используется с т// в циклах поиска (но не замены!) всех совпадений:
while (m/(\d+)/g) {
print Found number $1\n }
В списковом контексте /g извлекает все совпадения в массив-
©numbers = m/(\d+)/g
В этом случае будут найдены только неперекрывающиеся совпадения. Для поиска перекрывающихся совпадений придется идти на хитрость — организовать опережающую проверку нулевой ширины с помощью конструкции С?= ). Раз ширина равна нулю, механизм поиска вообще не смещается вперед. При этом найденные данные сохраняются внутри скобок. Однако Perl обнаруживает, что при наличии модификатора /д мы остались на прежнем месте, и перемещается на один символ вперед.
Продемонстрируем отличия на примере:
$digits = 123456789 ,
@nonlap = Sdigits =~/(\d\d\d)/g
@yeslap = $digits =V('?=(\d\d\d))/g
print Non-overlapping @nonlap\n
print Overlapping @yeslap\n
Non-overlapping- 123 456 789
Overlapping: 123 234 345 456 567 678 789
Модификаторы /s и / m используются для поиска последовательностей, содержащих внутренний перевод строки. При указании /s точка совпадает с \п — в обычных условиях этого не происходит. Кроме того, при поиске игнорируется значение устаревшей переменной $*. Модификатор /т приводит к тому, что " и $ совпадают в позициях до и после \п соответственно Он полезен в режиме
При наличии модификатора /е правая часть выполняется как программный код, и затем полученное значение используется в качестве заменяющей строки. Например, подстановка s/(\d+)/spnntf("%#x ', $1)/ge преобразует все числа в шестнадцатеричную систему счисления — скажем, 2581 превращается в 0хЬ23.
В разных странах существуют разные понятия об алфавите, поэтому стандарт POSIX предоставляет в распоряжение систем (а следовательно, и программ) стандартные средства для представления алфавитов, упорядочения наборов символов и т. д. Директива Perl use locale предоставляет доступ к некоторым из них; дополнительную информацию можно найти в странице руководства perllocale. При действующей директиве use locale в символьный класс \w попадают символы с диакритическими знаками и прочая экзотика. Служебные символы изменения регистра \u, \U, \1 и \1_ (а также соответствующие функции uc, ucfirst и т. д.) также учитывают use locale, поэтому \u превратит а в £, если этого потребует локальный контекст.
Специальные переменные
В результате некоторых операций поиска по шаблону Perl устанавливает значения специальных переменных. Так, переменные $1, $2, $3 и т. д. до бесконечности (Perl не останавливается на $9) устанавливаются в том случае, если шаблон содержит обратные ссылки (то есть часть шаблона заключена в скобки). Каждая открывающая скобка, встречающаяся в шаблоне слева направо, начинает заполнение новой переменной. Переменная $+ содержит значение последней обратной ссылки для последнего успешного поиска. Это помогает узнать, какой из альтернативных вариантов поиска был обнаружен (например, при обнаруженном совпадении для /(х,*у)|(у *z)/b переменной $+ будет находиться содержимое $1 или $2 — в зависимости от того, какая из этих переменных была заполнена). Переменная $& содержит полный текст совпадения при последнем успешном поиске. В переменных $ и $' хранятся строки соответственно до и после совпадения при успешном поиске:
$stnng = And little lambs eat ivy»,
$stnng =~ /l["s]*s/,
print ($ ) ($&) ($ )\n ,
(And ) (little lambs) ( eat ivy)
Переменные $', $& и $' соблазнительны, но опасны. Само их присутствие в любом месте программы замедляет поиск по шаблону, поскольку механизм должен присваивать им значения при каждом поиске. Сказанное справедливо даже в том случае, если вы всего один раз используете лишь одну из этих переменных, — или даже если они совсем не используются, а лишь встречаются в программе. В версии 5.005 переменная $& перестала обходиться так дорого.
После всего сказанного возникает впечатление, что шаблоны могут все. Как ни странно, это не так (во всяком случае, не совсем так). Регулярные выражения в принципе не способны решить некоторые задачи. В этом случае на помощь при-
ходят специальные модули. Скажем, регулярные выражения не обладают средствами для работы со сбалансированным вводом, то есть любыми данными произвольной вложенности — например, парными скобками, тегами HTML и т. д. Для таких целей приходится строить настоящий анализатор наподобие HTML::Parser из рецептов главы 20 «Автоматизация в Web». Еще одна задача, не решаемая шаблонами Perl, — неформальный поиск. В рецепте 6.13 показано, как она решается с помощью специального модуля.
6.1. Копирование с подстановкой
Проблема
Вам надоело многократно использовать две разные команды для копирования и подстановки.
Решение
Замените фрагменты вида:
$dst = $src,
$dst =" s/this/that/,
следующей командой:
($dst = $src) =~ s/this/that/,
Комментарий
Иногда подстановка должна выполняться не в исходной строке, а в ее копии, однако вам не хочется делить ее на два этапа. Например:
# Выделить базовое имя
(Sprogname = $0) =~ s'~ ¦/''.
# Начинать Все Слова С Прописной Буквы
($capword = Sword) =" s/(\w+)/\u\L$1/g,
# /usr/man/man3/foo .1 заменяется на /usr/man/man/cat3/foo 1
(Scatpage = $manpage) =~ s/man(9=\d)/cat/,
Подобная методика работает даже с массивами:
@bindirs = qw( /usr/bin /bin /usr/local/bin ), for (@libdirs = @bindirs) { s/bin/lib/ } print @>libdirs\n , /usr/lib /lib /usr/local/lib
Если подстановка должна выполняться для правой переменной, а в левую заносится результат, следует изменить расположение скобок. Обычно результат подстановки равен либо "" в случае неудачи, либо количеству выполненных замен. Сравните с предыдущими примерами, где в скобки заключалась сама операция присваивания. Например:
Глава 6 • Поиск по шаблону
($а = $b) =~ s/x/y/g # Скопировать $Ь и затем изменить $а $а = ($b =~ s/x/y/g) # Изменить $Ь и занести в $ количество подстановокD> Смотри также-------------------------------------------------------------------------------
Раздел «Assignment Operators» perlop(l)
6.2. Идентификация алфавитных символов
Проблема
Требуется узнать, состоит ли строка только из алфавитных символов
Решение
Наиболее очевидное решение не подходит для общего случая
if ($var - /~[A-Za-z]+$/) {
# Только алфавитные символы }
Дело в том, что такой вариант не учитывает локальный контекст пользователя Если наряду с обычными должны идентифицироваться символы с диакритическими знаками, воспользуйтесь директивой use locale и инвертированным символьным классом
use locale
if ($var -" /~[-\W\d_]+$/) {
print var is purely alphabetic\n
Комментарий
В Perl понятие «алфавитный символ» тесно связано с локальным контекстом, поэтому нам придется немного схитрить Регулярное выражение \w совпадает с одним алфавитным или цифровым символом, а также символом подчеркивания Следовательно, \W не является одним из этих символов Инвертируемый символьный класс ["\W\d_] определяет байт, который не является алфавитным символом, цифрой или подчеркиванием После инвертирования остаются одни алфавитные символы которые нас и интересуют В программе это выглядит так
use locale
use POSIX locale_h
Я На вашем компьютере строка локального контекста может выглядеть иначе unless (setlocale(LC_ALL fr_CA IS08859-1 )) { die couldn t set locale to French Canadian\n
while (<DATA>) {
chomp
if (/T\W\dJ+$/) }
print $_ alphabetic\n } else [
print $_ line noise\n
__END__ silly fa3ade couperate nico Renne Molmre hxanoglobin nanve tschbfl random1stuff#here
> Смотри также---------------------------------------------------------------------------------------------
Описание работы с локальным контекстом в perllocale(l), страница руководства /оса/е(3) вашей системы, рецепт 6 12
6.3. Поиск слов
Проблема
Требуется выделить из строки отдельные слова
Решение
Хорошенько подумайте, что должно считаться словом и как одно слово отделяется от остальных Затем напишите регулярное выражение, в котором будут воплощены ваши решения Например
/\S+/ # Максимальная серия байтов не являющихся пропусками /[A-Za z -]+/ # Максимальная серия букв апострофов и дефисов
Комментарий
Концепция «слова» зависит от приложения, языка и входного потока, поэтому в Perl не существует встроенного определения слов Слова приходится собирать вручную из символьных классов и квантификаторов, как это сделано выше Во втором примере мы пытаемся сделать так, чтобы shepherd s и sheep-sheering воспринимались как отдельные слова
У большинства реализаций имеются ограничения, связанные с вольностями
письменного языка Например, хотя второй шаблон успешно опознает слова
spank d и counter-clockwise , он выдернет rd из строки 23rd Psalom Чтобы
/\b([A-Za-z]+\b/ # Обычно наилучший вариант
/\s([A-Za-z]+)\s/ # Не работает в конце строки или без знаков препинания
В Perl существует метасимвол \w, который совпадает с одним символом, разрешенным в идентификаторах Perl. Однако идентификаторы Perl редко отвечают нашим представлениям о словах — обычно имеется в виду последовательность алфавитно-цифровых символов и подчеркиваний, но не двоеточий с апострофами. Поскольку метасимвол \Ь определяется через \w, он может преподнести сюрпризы при определении границ английских слов (и тем более — слов языка суахили).
И все же метасимволы \Ь и \ В могут пригодиться. Например, шаблон /\Bis\B/ совпадает со строкой "is" только внутри слова, но не на его границах. Скажем, в thistle совпадение будет найдено, а в vis-a-vis —нет.
> Смотри также---------------------------------------------------------------------------------------------
Интерпретация \b, \w и \s в perlre(l); шаблоны для работы со словами из рецепта 6.23.
6.4. Комментирование регулярных выражений
Проблема
Требуется сделать ваше сложное регулярное выражение более понятным и упростить его изменение в будущем.
Решение
В вашем распоряжении четыре способа: внешние комментарии, внутренние комментарии с модификатором /х, внутренние комментарии в заменяющей части s/// и альтернативные ограничители.
Комментарий
Во фрагменте из примера 6.1 использованы все четыре способа. Начальный комментарий описывает, для чего предназначено регулярное выражение. Для относительно простых шаблонов ничего больше не потребуется В сложных шаблонах (вроде приведенного) желательно привести дополнительные комментарии.
Пример 6.1. resname
ft'/usr/bin/perl -p
# resname - заменить все имена в стиле foo bar com во входном потоке
6.4. Комментирование регулярных выражений 189
8 на foo bar com [204 148 40 9] (или аналогичными)
use Socket, 8 Загрузить met_addr
s{ #
( # Сохранить имя хоста в $1
(? # Скобки только для группировки
(91 [-_] ) # Ни подчеркивание ни дефис
[\w-] + # Компонент имени хоста
\ # и точка домена
) + # Повторяется несколько раз
[A-Za-z] # Следующий символ должен быть буквой
[\w-] + # Завершающая часть домена
) # Конец записи $1
}{ # Заменить следующим
$1 8 Исходная часть плюс пробел
( ($addr = gethostbyname($1)) # Если имеется адрес
? [ inet_ntoa($addr) ] # отформатировать
# иначе пометить как сомнительный
}дех # /д - глобальная замена
# /е - выполнение
# /х - улучшенное форматирование
Для эстетов в этом примере использованы альтернативные ограничители. Когда шаблон поиска или замены растягивается на несколько строк, наличие парных скобок делает его более понятным. Другая частая причина для использования альтернативных ограничителей — присутствие в шаблоне символов / (например, s/\/\//\/ \//g) Альтернативные ограничители упрощают чтение такого шаблона (например, s'//'/ /' g или s{//}{/ /}g).
При наличии модификатора /х Perl игнорирует большинство пропусков в шаблоне (в символьных классах они учитываются) и интерпретирует символы # и следующий за ними текст как комментарий Такая возможность весьма полезна, однако у вас могут возникнуть проблемы, если пропуски или символы # являются частью шаблона В таких случаях снабдите символы префиксом \, как это сделано в следующем примере:
s/ 8 Заменить
\# # знак фунта
(\w+) # имя переменной
\8 # еще один знак фунта
/${$1}/хд 8 значением глобальной переменной
Помните, комментарий должен пояснять программу, а не пересказывать ее. Комментарии типа $i++ # Увеличить $i на 1 станут причиной плохих оценок на курсах программирования или подорвут вашу репутацию среди коллег
Остается модификатор /е, при котором заменяющая строка вычисляется как полноценное выражение Perl, а не как (заключенная в кавычки и интерполированная) строка. Результат выполнения этого кода используется в качестве заменяю-
Удвоение /е напоминает конструкцию eval STRING . Это позволит применить лексические переменные вместо глобальных в предыдущем примере с заменой.
s/ # Заменить
\# # знак фунта
(\w+) # имя переменной
\# Я еще один знак фунта
/ $ $1/хеед # значением «любой* переменной
После подстановки /ее проверьте переменную $@ Она содержит сообщения об ошибках, полученные в результате работы вашего кода, — в отличие от /е, в данном случае код действительно генерируется во время работы программы.
> Смотри также---------------------------------------------------------------------------------------------
Описание модификатора /х в perlre(l).
6.5. Поиск N-ro совпадения
Проблема
Требуется найти не первое, a N-e совпадение шаблона в строке. Допустим, вы хотите узнать, какое слово предшествует третьему экземпляру слова fish:
One fish two fish red fish blue fish
Решение
Воспользуйтесь модификатором /g и считайте совпадения в цикле while:
$WANT = 3, Scount = О
while (/(\w+)\s+fish\b/gi) { if (++$count == $WANT) {
print The third fish is a $1 one \n ,
# Предупреждение не выходите из этого цикла с помощью last
The third fish is a red one.
Или воспользуйтесь счетчиком и шаблоном следующего вида:
/С \w+\s+fish\s+){2}(\w+)\s+fish/i,
Комментарий
Как объяснялось во введении к этой главе, при наличии модификатора /д в скалярном контексте происходит многократный поиск. Его удобно использовать в циклах while — например, для подсчета совпадений в строке:
# Простой вариант с циклом while
$count = 0,
while($strmg =" /PAT/g) {
$count++, # Или что-нибудь другое
}
# То же с завершающим циклом while
$count = 0
$count++ while Sstnng =~ /PAT/g
# С циклом for
for (Scount = 0, Sstring =" /PAT/g, $count++) { }
# Аналогично, но с подсчетом перекрывающихся совпадений
$count++ while $stnng =" /(7=PAT)/g
Чтобы найти N-й экземпляр, проще всего завести отдельный счетчик Когда он достигнет N, сделайте то, что считаете нужным. Аналогичная методика может применяться и для поиска каждого N-ro совпадения — в этом случае проверяется кратность счетчика N посредством вычисления остатка при делении. Например, проверка (++$count % 3) == 0 находит каждое третье совпадение.
Если вам не хочется брать на себя дополнительные хлопоты, всегда можно извлечь все совпадения и затем выбрать из них то, что вас интересует.
$pond = One fish two fish red fish blue fish ,
# С применением временного массива
©colors = ($pond =" /(w+)\s+fish\b\gi), # Найти все совпадения
$color = $colors[2], # Выбрать одно,
# интересующее нас
# Без временного массива
Scolor = ( $pond =~ /(\w+)\s+fish\b/gi )[2], # Выбрать третий элемент
print The third fish is the pond is Scolor \n The third fish in the pond is red.
В другом примере находятся все нечетные совпадения:
Scount = 0,
$_ = One fish two fish red fish blue fish ,
@evens = grep {$count++ % 2 == 1} /(\w+)\s+fish\b/gi,
print Even numbered fish are @evens \n ,
Even numbered fish are two blue.
При подстановке заменяющая строка должна представлять собой программное выражение, которое возвращает соответствующую строку. Не забывайте возвращать оригинал как заменяющую строку в том случае, если замена не нужна. В следующем примере мы ищем четвертый экземпляр fish и заменяем предшествующее слово другим:
|
$count = 0 |
|||
|
s{ |
|||
|
\b |
|||
|
( |
\w+) |
||
|
\s+ fish |
\b |
||
|
Я |
|||
|
if |
(++$count |
== |
4) { |
|
sushi |
$2, |
||
|
} |
else { |
||
|
$1 |
$2 |
||
|
}gex |
|||
|
One |
fish two |
fish |
red fish sushi fish |
Другой способ — глобальный поиск в списковом контексте для получения всех совпадений и последующее извлечение нужного элемента этого списка
$pond = One fish two fish red fish blue fish swim here $color = ( $pond =~ /\b(\w+)\s+fish\b/gi )[-1], print Last fish is $color \n , Last fish is blue.
Если потребуется найти последнее совпадение без применения /д, то же самое можно сделать с отрицательной опережающей проверкой (?l НЕЧТО) Если вас интересует последний экземпляр произвольного шаблона А, вы ищете А, сопровождаемый любым количеством «не-А», до конца строки Обобщенная конструкция имеет вид А(9! *А) *$, однако для удобства чтения ее можно разделить
т{
А # Найти некоторый шаблон А
С1 # При этом не должно находиться
¦ # что-то другое А # и А )
$ # До конца строки }х
В результате поиск последнего экземпляра fish принимает следующий вид:
$pond = One fish two fish red fish blue fish if ($pond =" m{
\b ( \w+) \s+ fish \b C' * \b fish \b ) }six ) {
print Last fish is $1/\n } else <
print Failed'\n ,
}
Last fish is blue.
Такой подход имеет свои преимущества — он ограничивается одним шаблоном и потому подходит для ситуаций, аналогичных описанной в рецепте 6.17. Впрочем, имеются и недостатки. Он однозначно труднее записывается и воспринимается — впрочем, если общий принцип понятен, все выглядит не так плохо. К тому же это решение медленнее работает — для протестированного набора данных быстродействие снижается примерно в два раза.
> Смотри также---------------------------------------------------------------------------------------------
Поведение конструкции m//g в скалярном контексте описано в разделе «Regexp Quote-like Operators» perlop(l). Отрицательные опережающие проверки нулевой ширины продемонстрированы в разделе «Regular Expressions» perlre(i).
6.6. Межстрочный поиск
Проблема
Требуется использовать регулярные выражения для последовательности, состоящей из нескольких строк Специальные символы (любой символ, кроме перевода строки), " (начало строки) и $ (конец строки), кажется, не работают Это может произойти при одновременном чтении нескольких записей или всего содержимого файла.
Решение
Воспользуйтесь модификатором /m, /s или обоими сразу. Модификатор /s разрешает совпадение с переводом строки (обычно этого не происходит). Если последовательность состоит из нескольких строк, шаблон /foo «bar/s совпадет с f оо и ba r , находящимися в двух соседних строках. Это не относится к точкам в символьных классах (например, [#% ]), которые всегда представляют собой обычные точки.
Модификатор /т разрешает совпадение " и $ в переводах строк. Например, совпадение для шаблона /~=head[ 1 -7]$/m возможно не только в начале записи, но и в любом из внутренних переводов строк.
Комментарий
При синтаксическом анализе документов, в которых переводы строк не имеют значения, часто используется «силовое» решение — файл читается по абзацам (а иногда даже целиком), после чего происходит последовательное извлечение лексем. Для успешного межстрочного поиска необходимо, чтобы символ совпадал с переводом строки — обычно этого не происходит. Если в буфер читается сразу несколько строк, вероятно, вы предпочтете, чтобы символы " и $ совпадали с началом и концом внутренних строк, а не всего буфера.
Необходимо хорошо понимать, чем /т отличается от /s: первый заставляет " и $ совпадать на внутренних переводах строк, а второй заставляет совпадать с пере-
Фильтр из примера 6.2 удаляет теги HTML из всех файлов, переданных в @ARGV, и отправляет результат в STDOUT. Сначала мы отменяем разделение записей, чтобы при каждой операции чтения читалось содержимое всего файла. Если @ARGV содержит несколько аргументов, файлов также будет несколько. В этом случае при каждом чтении передается содержимое всего файла. Затем мы удаляем все открывающие и закрывающие угловые скобки и все, что находится между ними. Мы не можем просто воспользоваться * по двум причинам: во-первых, этот шаблон не учитывает закрывающих угловых скобок, а во-вторых, он не поддерживает межстрочных совпадений Проблема решается применением *'в сочетании с модификатором /s — по крайней мере, в данном случае.
Пример 6.2. killtags
#'/usr/bin/perl
# killtags - очень плохое удаление тегов HTML
under" $/ # При каждом чтении передается весь файл
while (<>) { # Читать по одному файлу
s/< *?>//gs # Удаление тегов (очень скверное)
print # Вывод файла в STDOUT
>
Шаблон s/<[">]*>//g работает намного быстрее, но такой подход наивен: он приведет к неправильной обработке тегов в комментариях HTML или угловых скобок в кавычках (<IMG SRC= here gif ALT= <<0oh la la1» >). В рецепте 20 6 показано, как решаются подобные проблемы.
Программа из примера 6.3 получает простой текстовый документ и ищет в начале абзацев строки вида Chapter 20 Better Living Through Chemisery . Такие строки оформляются заголовками HTML первого уровня. Поскольку шаблон получился довольно сложным, мы воспользовались модификатором /х, который разрешает внутренние пропуски и комментарии.
Пример 6.3. headerfy
#Vusr/bm/perl
# headerfy оформление заголовков глав в HTML
|
$/ = |
|||
|
while ( <> |
) { |
# |
Получить абзац |
|
s{ |
|||
|
\A |
# |
Начало записи |
|
|
( |
# |
Сохранить в $1 |
|
|
Chapter |
# |
Текстовая строка |
|
|
\s+ |
Обязательный пропуск |
||
|
\d+ |
# |
Десятичное число |
|
|
\s* |
# |
Необязательный пропуск |
|
|
# |
Двоеточие |
||
|
* |
Все, кроме перевода строки, |
||
|
}{<H1>$K/H1>}gx, |
|||
|
print |
до конца строки
Если комментарии лишь затрудняют понимание, ниже тот же пример переписан в виде короткой командной строки:
% perl -OOpe s{\A(Chapter\s+\d+\s* *)}{<H1>$1</H1>}gx datafile
Возникает интересная проблема: в одном шаблоне требуется указывать как начало записи, так и конец строки. Начало записи можно было бы определить с помощью ", но символ $ должен определять не только конец записи, но и конец строки. Мы добавляем модификатор /ш, отчего изменяется смысл как ", так и $. Начало записи вместо " определяется с помощью \А. Кстати говоря, метасимвол \Z (хотя в нашем примере он не используется) совпадает с концом записи даже при наличии модификатора /т.
Следующий пример демонстрирует совместное применение /s и /т. На этот раз мы хотим, чтобы символ " совпадал с началом любой строки абзаца, а точка — с переводом строки. Эти модификаторы никак не связаны, и их совместное применение ничем не ограничено. Стандартная переменная $ содержит число записей последнего прочитанного файла. Стандартная переменная $ARGV содержит файл, автоматически открываемый при обработке <ARGV>.
$/ = # Режим чтения абзацев while (<ARGV>) {
while (m#"START( *?)~END&sm) { # /s - совпадение с переводом строки
# /m - совпадение " с началом
внутренних строк print chunk $ in $ARGV has «$1»\n ,
Если вы уже привыкли работать с модификатором /т, то " и $ можно заменить на \А и \Z. Но что делать, если вы предпочитаете /s и хотите сохранить исходный смысл ? Воспользуйтесь конструкцией [~\п] Если вы не намерены использовать /s, но хотите иметь конструкцию, совпадающую с любым байтом, сконструируйте символьный класс вида [\000-\377] или даже [\d\D]. Использовать [ \п] нельзя, поскольку в символьных классах не обладает особой интерпретацией.
> Смотри также---------------------------------------------------------------------------------------------
Описание переменной $/ вperlvar{\)\ описание модификаторов /s и /тврег1ге(\). Мы вернемся к специальной переменной $/ в главе 8.
6.7. Чтение записей с разделением по шаблону
Проблема
Требуется прочитать записи, разделение которых описывается некоторым шаблоном. Perl не позволяет присвоить регулярное выражение переменной-разделителю входных записей.
196 Глава 6 • Поиск по шаблону
Многие проблемы — в первую очередь связанные с синтаксическим анализом сложных файловых форматов, — заметно упрощаются, если у вас имеются удобные средства для чтения записей, разделенных в соответствии с определенным шаблоном.Решение
Прочитайте весь файл и воспользуйтесь функцией split:
undef $/,
©chunks = зр11г(/шаблон/,<ФАЙЛОВЫЙ_МАНИПУЛЯТОР>),
Комментарий
Разделитель записей Perl должен быть фиксированной строкой, а не шаблоном (ведь должен awk быть хоть в чем-то лучше!). Чтобы обойти это ограничение, отмените разделитель входных записей, чтобы следующая операция чтения прочитала весь файл. Иногда это называется режимом поглощающего ввода (slurp mode), потому что весь файл поглощается как одна большая строка. Затем разделите эту большую строку функцией split, используя шаблон разделения записей в качестве первого аргумента.
Рассмотрим пример. Допустим, входной поток представляет собой текстовый файл, содержащий строки " Se", " Ch" и " Ss" — служебные коды для макросов troff. Эти строки представляют собой разделители. Мы хотим найти текст, расположенный между ними.
# Ch, Se и Ss отделяют фрагменты данных STDIN {
local $/ = undef,
©chunks = split(/"\.(Ch|Se|Ss)$/m, о), } print "I read ", scalar(@chunks), chunks \n",
Мы создаем локальную версию переменной $/, чтобы после завершения блока было восстановлено ее прежнее значение. Если шаблон содержит круглые скобки, функция split также возвращает разделители. Это означает, что данные в возвращаемом списке будут чередоваться с элементами "Se", "Ch" и "Ss".
Если разделители вам не нужны, но вы все равно хотите использовать круглые скобки, воспользуйтесь «несохраняющими» скобками в шаблоне вида /-\.(':Ch|Se|Ss)$/m.
Чтобы записи разделялись перед шаблоном, но шаблон включался в возвращаемые записи, воспользуйтесь опережающей проверкой: /? (?=\. (9: Ch | Se | Ss)) /т. В этом случае каждый фрагмент будет начинаться со строки-разделителя.
Учтите, что для больших файлов такое решение потребует значительных расходов памяти. Однако для современных компьютеров и типичных текстовых файлов эта проблема уже не так серьезна. Конечно, не стоит применять это решение для 200-мегабайтного файла журнала, не располагая достаточным местом на диске для подкачки. Впрочем, даже при избытке виртуальной памяти ничего хорошего не выйдет.
6.8. Извлечение строк из определенного интервала
> Смотри такжеОписание переменной $/ Bperlvar(l) и в главе 8; описание функции perlfunc(l).
6.8. Извлечение строк из определенного интервала
Требуется извлечь все строки, расположенные в определенном интервале. 0нтеР" вал может быть задан двумя шаблонами (начальным и конечным) или ноМеР0М первой и последней строки.
Часто встречающиеся примеры — чтение первых 10 строк файла (строки с 1 ^° ™> или основного текста почтового сообщения (все, что следует после пустой сТр0КИ)-
Решение
Используйте оператор .. или ... для шаблонов или номеров строк. В of-личие от .. оператор ... не возвращает истинное значение, если оба условия выг*олня" ются в одной строке.
while (<>) {
if (/НАЧАЛЬНЫЙ ШАБЛОН/ .. /КОНЕЧНЫЙ ШАБЛОН/) { # Строка находится между начальным 9 и конечным шаблонами включительно.
while (о) {
if ($НОМЕР_НАЧАЛЬНОЙ_СТРОКИ . $НОМЕР_КОНЕЧНОЙ_СТРОКИ)
# Строка находится между начальной
# и конечной включительно.
Если первое условие оказывается истинным, оператор ... не проверяет второе условие.
while (<>) {
if (/НАЧАЛЬНЫЙ ШАБЛОН/ ... /КОНЕЧНЫЙ ШАБЛОН/) {
# Строка находится между начальным
# и конечным шаблонами, расположенными в разных строках.
while (<>) {
if ($НОМЕР_НАЧАЛЬНОЙ_СТРОКИ .. $НОМЕР_КОНЕЧНОЙ_СТРОКИ) # Строка находится между начальной и и конечной, расположенными в разных строках.
Глава 6 • Поиск по шаблону
КомментарийИз бесчисленных операторов Perl интервальные операторы . . и ..., вероятно, вызывают больше всего недоразумений. Они создавались для упрощения выборки интервалов строк, чтобы программисту не приходилось сохранять информацию о состоянии. В скалярном контексте (например, в условиях операторов if и while) эти операторы возвращают true или false, отчасти зависящее от предыдущего состояния. Выражение левый_операнд . . правый_операнд возвращает false до тех пор, пока левый_операнд не станет истинным. Когда это условие выполняется, левый_операнд перестает вычисляться, а оператор возвращает true до тех пор, пока не станет истинным правый операнд. После этого цикл начинается заново. Другими словами, истинность первого операнда «включает» конструкцию, а истинность второго операнда «выключает» ее.
Условия могут быть абсолютно произвольными. В сущности, границы интервала могут быть заданы проверочными функциями mytestfunc(1) ., mytestfunc(2), хотя на практике это происходит редко. Как правило, операндами интервальных операторов являются либо номера строк (первый пример), шаблоны (второй пример) или их комбинация.
# Командная строка для вывода строк с 15 по 17 включительно (см. ниже)
perl -ne 'print if 15 .. 17' datafile
# Вывод всех фрагментов <ХМР> .. </ХМР> из документа HTML
while (о) {
print if m#<XMP>#i ., m#</XMP>#i;
# To же, но в виде команды интерпретатора
% perl -ne 'print if m#<XMP>#i .. m#</XMP>#i' document.html
Если хотя бы один из операндов задан в виде числовой константы, интервальные операторы осуществляют неявное сравнение с переменной $. ($NR или $INPUT_LINE_NUMBER при действующей директиве use English). Поосторожнее с неявными числовыми сравнениями! В программе необходимо указывать числовые константы, а не переменные. Это означает, что в условии можно написать 3 .. 5, но не $п .. $т, даже если значения $п и $т равны 3 и 5 соответственно. Вам придется непосредственно проверить переменную $..
# Команда не работает
perl -ne 'BEGIN { $top=3; $bottom=5 } print if Stop .. $bottom' /etc/passwd
# Работает
perl -ne 'BEGIN {$top=3; $bottom=5 } \
print if $. == Stop .. $. == Sbottom' /etc/passwd
# Тоже работает
perl -ne 'print if 3 .. 5' /etc/passwd
Операторы .. и ... отличаются своим поведением в том случае, если оба операнда могут оказаться истинными в одной строке. Рассмотрим два случая:
print if /begin/ .. /end/; print if /begin/ ... /end/;
Для строки "You may not end here you begin" оба интервальных оператора возвращают true. Однако оператор .. не будет выводить дальнейшие строки. Дело в том, что после выполнения первого условия он проверяет второе условие в той же строке; вторая проверка сообщает о найденном конце интервала. С другой стороны, оператор . . . продолжит поиск до следующей строки, в которой найдется /end/, — он никогда не проверяет оба операнда одновременно.
Разнотипные условия можно смешивать:
|
while (<>) { |
|||
|
$in_header |
= |
1 . |
. /"$/; |
|
$in_body |
$/ • |
. eof(); |
Рассмотрим пример. Следующий фрагмент читает файлы с почтовыми сообщениями и выводит адреса, найденные в заголовках. Каждый адрес выводится один раз. Заголовок начинается строкой "From:" и завершается первой пустой строкой. Хотя это определение и не соответствует RFC-822, оно легко формулируется.
%seen = (); while (о) {
next unless /"From:?\s/i .. /"$/;
while (/(["<>(),;\s]+\@["<>().;\s]+)/g) { print "$1\n" unless $seen{$1}++;
Если интервальные операторы Perl покажутся вам странными, записывайтесь в команды поддержки s2p и а2р — трансляторов для переноса кода sed и awk в Perl. В обоих языках есть свои интервальные операторы, которые должны работать в Perl.
> Смотри также---------------------------------------------------------------------------------------------
Описание операторов .. и ... в разделе «Range Operator» perlop(i); описание переменной $NR в perlvariX).
Проблема
Вы хотите, чтобы вместо регулярных выражений Perl пользователи могли выполнять поиск с помощью традиционных универсальных символов командного интерпретатора. В тривиальных случаях шаблоны с универсальными символами выглядят проще, нежели полноценные регулярные выражения.
Решение
Следующая подпрограмма преобразует четыре универсальных символа командного интерпретатора в эквивалентные регулярные выражения; все остальные символы интерпретируются как строки.
sub glob2pat {
my $globstr = shift, my %patmap = (
'• =>'.*,
">¦ => ' ',
¦[ => •['. ¦]• => ¦]•
);
Sglobstr =" s{(.)} < $patmap{$1> || '\0$1- }ge; return " Sglobstr . '$'; }
Комментарий
Шаблоны Perl отличаются от применяемых в командных интерпретаторах конструкций с универсальными символами. Конструкция * * интерпретатора не является допустимым регулярным выражением. Она соответствует шаблону /". *\.. *$/, который совершенно не хочется вводить с клавиатуры.
Функция, приведенная в решении, выполняет все преобразования за вас. При этом используются стандартные правила встроенной функции glob.
Интерпретатор Perl
|
list 1 |
"list\. $ |
|
|
project * |
"project\ |
4 |
|
•old |
" *old$ |
|
|
type* [ch] |
"type *\ |
[ch]$ |
|
* * * |
- Л 4 |
В интерпретаторе действуют другие правила. Шаблон неявно закрепляется на концах строки. Вопросительный знак соответствует любому символу, звездочка —
произвольному количеству любых символов, а квадратные скобки определяют интервалы. Все остальное, как обычно.
Большинство интерпретаторов не ограничивается простыми обобщениями в одном каталоге. Например, конструкция */* означает: «все файлы во всех подкаталогах текущего каталога». Более того, большинство интерпретаторов не выводит имена файлов, начинающиеся с точки, если точка не была явно включена в шаблон поиска. Функция glob2pat такими возможностями не обладает, если они нужны — воспользуйтесь модулем File::KGlob с CPAN.
> Смотри также---------------------------------------------------------------------------------------------
Страницы руководства csh(l) и ksh(l) вашей системы; описание функции glob в perlfunc(l); документация по модулю Glob::DosGlob от CPAN; раздел «I/O Operators» perlop(l); рецепт 9.6.
6.10. Ускорение интерполированного поиска
Проблема
Требуется, чтобы одно или несколько регулярных выражений передавались в качестве аргументов функции или программы. Однако такой вариант работает медленнее, чем при использовании литералов.
Решение
Если имеется всего один шаблон, который не изменяется в течение всей работы программы, сохраните его в строке и воспользуйтесь шаблоном /$pattern/o:
while ($line = о) {
if ($lme =~ /$pattern/o) { # Сделать что-то
Однако для нескольких шаблонов это решение не работает. Три приема, описанные в комментарии, позволяют ускорить поиск на порядок или около того.
Комментарий
Во время компиляции программы Perl преобразует шаблоны во внутреннее представление. На стадии компиляции преобразуются шаблоны, не содержащие переменных, однако преобразование шаблонов с переменными происходит во время выполнения. В результате интерполяция переменных в шаблонах (например, /$pattern/) замедляет работу программы. Это особенно заметно при частых изменениях $pattern.
Применяя модификатор /о, автор сценария гарантирует, что значения интерполируемых в шаблоне переменных остаются неизменными, а если они все же
Модификатор /о в шаблонах без интерполированных переменных не дает никакого выигрыша в скорости. Кроме того, он бесполезен в ситуации, когда у вас имеется неизвестное количество регулярных выражений и строка должна поочередно сравниваться со всеми шаблонами Не поможет он и тогда, когда интерполируемая переменная является аргументом функции, поскольку при каждом вызове функции ей присваивается новое значение.
В примере 6 4 показана медленная, но очень простая методика многострочного поиска для нескольких шаблонов. Массив @>popstates содержит стандартные сокращенные названия тех штатов, в которых безалкогольные газированные напитки обозначаются словом pop. Задача — вывести все строки входного потока, в которых хотя бы одно из этих сокращений присутствует в виде отдельного слова. Модификатор /о не подходит, поскольку переменная, содержащая шаблон, постоянно изменяется
Пример 6.4. popgrepl
# popgrepl - поиск строк с названиями штатов
# версия 1 медленная, но понятная
@popstates = qw(CO ON MI WI MN),
LINE while (defined($line = <>)) {
for $state (@popstates) {
if ($line =' /\b$state\b/) { print, next LINE,
Столь примитивное, убогое, «силовое» решение оказывается ужасно медленным — для каждой входной строки все шаблоны приходится перекомпилировать заново. Мы рассмотрим три варианта решения этой проблемы. Первый вариант генерирует строку кода Perl и вычисляет ее с помощью eval; второй кэширует внутренние представления регулярных выражений в замыканиях, третий использует модуль Regexp с CPAN для хранения откомпилированных регулярных выражений.
Традиционный подход к ускорению многократного поиска в Perl — построе ние строки, содержащей нужный код, и последующий вызов eval $code . Подобная методика использована в примере 6.5.
Пример 6.5. рордгер2
#'/usr/bin/perl
# рордгер2 - поиск строк с названиями штатов
# версия 2 eval, быстрая, но сложная в написании
@popstates = qw(CO ON MI WI MN)
$code = while (defmed($line = <>)) { ,
6.10. Ускорение интерполированного поиска 203
for $state (@popstates) {
$code = \tif (\$lme =' /\\b$state\\b/) { print \$line, next, }\n ,
|
$code |
= } , |
|||||||
|
print |
CODE IS\n------- \n$code\n----- \n if |
0, # |
Отладочный вывод |
|||||
|
eval $code, |
||||||||
|
die if |
$e>, |
|||||||
|
Программа popgrep2 генерирует |
1 строки следующего вида: |
|||||||
|
while ( |
;defined($lme = <>) |
{ |
||||||
|
if |
($line = |
" /bCO\b/) |
{ |
print |
$line, |
next, |
} |
|
|
if |
($lme = |
- /bON\b/) |
{ |
print |
$line, |
next |
} |
|
|
if |
($line = |
" /bMI\b/) |
{ |
print |
$lme |
next, |
} |
|
|
if |
($lme = |
" /bWIW) |
{ |
print |
$line, |
next, |
> |
|
|
if |
(Sline = |
" /bMN\b/) |
{ |
print |
$line, |
next, |
} |
Самое неприятное в таком решении — то, что правильно записать все строки и служебные символы довольно трудно. Функция dequote из рецепта 1.11 может упростить чтение программы, но проблема с конструированием переменных, используемых позже, остается насущной. Кроме того, в строках нельзя использовать символ /, поскольку он служит ограничителем в операторе ш//.
Существует изящный выход, впервые предложенный Джеффри Фридлом (Jeffrey Fnedl). Он сводится к построению анонимной функции, которая кэширу-ет откомпилированные шаблоны в созданном ей замыкании. Для этого функция eval вызывается для строки, содержащей определение анонимной функции, которая проверяет совпадения с передаваемыми ей шаблонами. Perl компилирует шаблон всего только при определении анонимной функции. После вызова eval появляется возможность относительно быстрого поиска.
В примере 6. 6 приведена очередная версия программы popgrep, в которой используется данный прием.
Пример 6.6. рордгерЗ
й1/usr/bin/perl
# рордгерЗ - поиск строк с названиями штатов
# версия 3 алгоритм с построением вспомогательной функции
@popstates = qw(CO ON MI WI MN),
$expr = ]om( || , map { m/\\b\$popstates[$_]\\b/o } 0 $#popstates), $match_any = eval sub < $expr } , die if $@, while (<>) {
print if &$match_any, >
В результате функции eval передается следующая строка (за вычетом форматирования):
204 Глава 6 • Поиск по шаблонуsub {
m/\b$popstates[0]\b/o || m/\b$popstates[1]\b/o ||
m/\b$popstates[2]\b/o || m/\b$popstates[3]\b/o ||
m/\b$popstates[4]\b/o >
Ссылка на массив @popstates находится внутри замыкания. Применение модификатора /о в данном случае безопасно.
Пример 6.7 представляет собой обобщенный вариант этой методики. Создаваемые в нем функции возвращают true, если происходит совпадение хотя бы с одним (и более) шаблоном.
Пример 6.7. grepauth
O'/usr/bin/perl
ff grepauth - вывод строк, в которых присутствуют Тот и Nat
Smultimatch = build_match_all(q/Tom/, q/Nat/), while (<>) {
print if &$multimatch, } exit,
sub build_match_any { build_match_func( 11 , @_) }
sub build_match_all { build_match_func( && , §_) }
sub build_match_func { my Scondition = shift, my ©pattern = @_, 9 Переменная должна быть лексической,
# а не динамической
my $expr = join Scondition => map { m/\$pattern[$_]/o } (0 $#pattern), ту $match_func = eval sub { local \$_ = shift if \@_, $expr } , die if $@, # Проверить $@, переменная должна быть пустой1 return $match_func,
}
Конечно, вызов eval для интерполированных строк (см. popgrep2) представляет собой фокус, кое-как но работающий. Зато применение лексических переменных в замыканиях, как в рордгерЗ и функциях build_match_*, — это уже высший пилотаж. Даже матерый программист Perl не сразу поверит, что такое решение действительно работает. Впрочем, программа будет работать независимо от того, поверили в нее или нет.
На самом деле нам хотелось бы, чтобы Perl один раз компилировал каждый шаблон и позволял позднее ссылаться на него в откомпилированном виде. Такая возможность появилась в версии 5.005 в виде оператора определения регулярных выражений qr//. В предыдущих версиях для этого был разработан экспериментальный модуль Regexp с CPAN. Объекты, создаваемые этим модулем, представляют откомпилированные регулярные выражения. При вызове метода match объекты выполняют поиск по шаблону в строковом аргументе. Существуют специальные методы для извлечения обратных ссылок, определения позиции совпадения и передачи флагов, соответствующих определенным модификаторам — например, /i.
В примере 6.8 приведена версия программы popgrep, демонстрирующая простейшее применение этого модуля.
Пример 6.8. рордгер4
Л'/usr/bin/perl
tt рордгер4 - поиск строк с названиями штатов # версия 4 применение модуля Regexp use Regexp,
@popstates = qw(CO ON MI WI MN),
@poppats = map { Regexp->new( \b $_ \b ) } @popstates, while (defined($lme = <>)) { for $patob] (@poppats) {
print $line if $patobj->match($line),
Возможно, вам захочется сравнить эти решения по скорости. Текстовый файл, состоящий из 22 000 строк («файл Жаргона»), был обработан версией 1 за 7,92 секунды, версией 2 — всего за 0,53 секунды, версией 3 — за 0,79 секунды и версией 4 — за 1,74 секунды. Последний вариант намного понятнее других, хотя и работает несколько медленнее. Кроме того, он более универсален.
> Смотри также--------------------------------------------------------------------------------------------
Описание интерполяции в разделе «Scalar Value Constructors» perldata(i); описание модификатора /о в perlre(l); документация по модулю Regexp с CPAN.
6.11. Проверка правильности шаблона
Проблема
Требуется, чтобы пользователь мог ввести свой собственный шаблон. Однако первая же попытка применить неправильный шаблон приведет к аварийному завершению программы.
Решение
Сначала проверьте шаблон с помощью конструкции eval {} для какой- нибудь фиктивной строки. Если переменная $@ не устанавливается, следовательно, исключение не произошло и шаблон был успешно откомпилирован. Следующий цикл работает до тех пор, пока пользователь не введет правильный шаблон.
do {
print Pattern? ,
chomp($pat = о),
eval { =~ /$pat/ },
warn INVALID PATTERN $@ if $@ } while $@>,
Отдельная функция для проверки шаблона выглядит так*
206 Глава б • Поиск по шаблону
sub is_valid_pattern { my Spat = shift; return eval { "" =" /Spat/; 1 } I| 0,Работа функции основана на том, что при успешном завершении блока возвращается 1. При возникновении исключения этого никогда не произойдет.
Комментарий
Некомпилируемые шаблоны встречаются сплошь и рядом. Пользователь может по ошибке ввести "<Is*["> ","*** GET RICH ***" или "+5-1". Если слепо воспользоваться введенным шаблоном в программе, возникнет исключение — как правило, это приводит к аварийному завершению программы.
Крошечная программа из примера 6.9 показывает, как проверяются шаблоны.
Пример 6.9. paragrep
#'/usr/bin/perl
# paragrep - простейший поиск
die "usage: $0 pat [files]\n" unless @ARGV,
$/ =
Spat = shift;
eval { "" =" /Spat/, 1 } or die '$0: Bad pattern Spat $@\n',
while (<>) {
print "$ARGV $ : $_" if /$pat/o;
Модификатор /о обещает Perl, что значение интерполируемой переменной останется постоянным во время всей работы программы — это фокус для повышения быстродействия. Даже если значение $pat изменится, Perl этого не заметит.
Проверку можно инкапсулировать в функции, которая возвращает 1 при успешном завершении блока и 0 в противном случае {см. выше функцию is_valid_ pattern). Хотя исключение можно также перехватить с помощью eval "/Spat/", у такого решения есть два недостатка. Во-первых, во введенной пользователем строке не должно быть символов / (или других выбранных ограничителей). Во-вторых, в системе безопасности открывается зияющая брешь, которую было бы крайне желательно избежать. Некоторые строки могут сильно испортить настроение:
Spat = "You lose @{[ system('rm -rf *')]} big here",
Если вы не желаете предоставлять пользователю настоящие шаблоны, сначала всегда можно выполнить метапреобразование строки:
$safe_pat = quotemeta(Spat), somethingO if /$safe_pat/;
Или еще проще:
somethingO if /\Q$pat/,
Но если вы делаете нечто подобное, зачем вообще связываться с поиском по шаблону? В таких случаях достаточно простого применения index.
Разрешая пользователю вводить настоящие шаблоны, вы открываете перед ним много интересных и полезных возможностей. Это, конечно, хорошо. Просто придется проявить некоторую осторожность, вот и все. Допустим, пользователь желает выполнять поиск без учета регистра, а вы не предусмотрели в своей программе параметр вроде -1 в дгер. Работая с полными шаблонами, пользователь сможет ввести внутренний модификатор /\ в виде (9i) — например,/('i)stuff/.
Что произойдет, если в результате интерполяции получается пустая строка? Если $pat — пустая строка, с чем совпадет /$pat/ — иначе говоря, что произойдет при пустом поиске //? С началом любой возможной строки? Неправильно. Как ни странно, при поиске по пустому шаблону повторно используется шаблон предыдущего успешного поиска. Подобная семантика выглядит сомнительно, и ее практическое использование в Perl затруднительно.
Даже если шаблон проверяется с помощью eval, учтите: время поиска по неко
торым шаблонам связано с длиной строки экспоненциальной зависимостью. На
дежно идентифицировать такие шаблоны не удается. Если пользователь введет
один из них, программа надолго задумается и покажется «зависшей». Возможно,
из тупика можно выйти с помощью установленного таймера, однако в версии 5.004
прерывание работы Perl в неподходящий момент может привести к аварийному
завершению. '
> Смотри также---------------------------------------------------------------------------------------------
Описание функции eval вperlfunc(l).
6.12. Локальный контекст в регулярных выражениях
Проблема
Требуется преобразовать регистр в другом локальном контексте или заставить метасимвол \w совпадать с символами национальных алфавитов — например, Jose или dejd vu.
Предположим, у вас имеется полгигабайта текста на немецком языке, для которого необходимо составить предметный указатель. Вы хотите извлекать слова (с помощью \w+) и преобразовывать их в нижний регистр (с помощью 1с или \L). Однако обычные версии \w и 1с не находят слова немецкого языка и не изменяют регистр символов с диакритическими знаками.
Решение
Регулярные выражения и функции обработки текста Perl имеют доступ к локальному контексту POSIX. Если включить в программу директиву use locale, Perl
use locale,
Комментарий
По умолчанию \w+ и функции преобразования регистра работают с буквами верхнего и нижнего регистров, цифрами и подчеркиваниями. Преобразуются лишь простейшие английские слова, и даже в очень распространенных заимствованных словах происходят сбои. Директива use locale помогает справиться с затруднениями.
Пример 6.10 показывает, чем отличаются выходные данные для английского (en) и немецкого (de) локальных контекстов.
Пример 6.10. localeg
й'/usr/bin/perl -w
tt localeg - выбор локального контекста
use locale,
use POSIX locale_h ,
$name = andreas k\xF6mg ,
@locale{qw(German English)} = qw(de_DE IS0_8859-1 us-ascn),
setlocale(LC_CTYPE, $locale{English})
or die Invalid locale $locale{English} , @english_names = (), while ($name =" /\b(\w+)\b/g) {
push(@english_names, ucfirst($1)), } setlocale(LC_CTYPE, $locale{German})
or die Invalid locale $locale{German> , @german_names = (), while ($name =' /\b(\w+)\b/g) {
push(@german_names, ucfirst($1)), >
print English names @english_names\n , print German names @gerraan_names\n , English names: Andreas К Nig German names: Andreas Konig
Решение основано на поддержке локальных контекстов в POSIX. Ваша система может обладать, а может и не обладать такой поддержкой. Но даже если система заявляет о поддержке локальных контекстов POSIX, в стандарте не определены имена локальных контекстов. Разумеется, переносимость такого решения не гарантирована.
t> Смотри также--------------------------------------------------------------------------------------------
Описание метасимволов \b, \w и \s врег/ге(1), описание локальных контекстов Perl вperllocale(l) и странице руководства locale(3) вашей системы; рецепт 6.2.
6.13. Неформальный поиск
Проблема
Требуется выполнить неформальный поиск по шаблону.
Задача часто возникает в ситуации, когда пользовательский ввод может быть неточным или содержащим ошибки.
Решение
Воспользуйтесь модулем String :Арргох от CPAN:
use Strin Approx qw(amatch),
if (amatch( ШАБЛОН , ©list)) {
# Совпадение }
©matches = amatch( ШАБЛОН , ©list),
Комментарий
Модуль String::Approx вычисляет, насколько шаблон отличается от каждой строки списка. Если количество односимвольных вставок, удалений или замен для получения строки из шаблона не превышает определенного числа (по умолчанию 10 процентов длины шаблона), строка «совпадает» с шаблоном. В скалярном контексте amatch возвращает количество успешных совпадений. В списковом контексте возвращаются совпавшие строки.
use String Approx qw(amatch),
open(DICT /usr/dict/words or die Can t open diet $' ,
while(<DICT>) {
print if amatch( balast ),
ballast
ballustrade
blast
blastula
sandblast
Функции amatch также можно передать параметры, управляющие учетом регистра и количеством допустимых вставок, удалений и подстановок. Параметры передаются в виде ссылки на список. Они полностью описаны в документации по String::Approx.
Следует заметить, что поисковые функции модуля работают в 10-40 раз медленнее встроенных функций Perl. Используйте String::Approx лишь в том случае, если регулярные выражения Perl не справляются с неформальным поиском.
> Смотри также---------------------------------------------------------------------------------------------
Документация по модулю String:'Approx от CPAN; рецепт 1.16.
Проблема
Требуется возобновить поиск с того места, где было найдено последнее совпадение.
Такая возможность пригодится при многократном извлечении фрагментов данных из стрЪки.
Решение
Воспользуйтесь комбинацией модификатора /д, метасимвола \G и функции pos.
Комментарий
При наличии модификатора /д механизм поиска запоминает текущую позицию в строке. При следующем поиске с /д совпадения ищутся, начиная с сохраненной позиции. Это позволяет создать цикл while для извлечения необходимой информации из строки:
while (/(\d+)/g) {
print "Found $1\n"; i
Присутствие \G в шаблоне привязывает поиск к концу предыдущего совпадения. Например, если число хранится в строке с начальными пробелами, замена каждого пробела нулем может выполняться так:
$п = " 49 here"; $п =¦ s/\G /0/g; print $n; 00049 here
\G часто применяется в циклах while. Например, в следующем примере анализируется список чисел, разделенных запятыми:
while (/\G,?(\d+)/g) {
print "Found number $1\n";
} ' ;
Если поиск закончился неудачей (например, если в последнем примере кончились числа), сохраненная позиция по умолчанию перемещается в начало строки. Если это нежелательно (например, требуется продолжить поиски с текущей позиции, но с другим шаблоном), воспользуйтесь модификатором /с в сочетании с /д:
$_ = "The year 1752 lost 10 days on the 3rd of September";
while (/(\d+)/gc) {
print "Found number $1\n";
if (/\G(\S+)/g) {
print "Found $1 after the last number.\n";
Found numeral 1752
Found numeral 10
Found numeral 3
Found rd after the last number.
Как видите, при последовательном применении шаблонов можно изменять позицию начала поиска с помощью модификатора /д. Позиция последнего совпадения связывается со скалярной величиной, в которой происходит поиск, а не с шаблоном. Позиция не копируется вместе со строкой и не сохраняется оператором local.
Позиция последнего совпадения читается и задается функцией pos. Аргумен том функции является строка, для которой читается или задается позиция последнего совпадения. Если аргумент не указан, pos работает с переменной $_:
print "The position in \$a is ", pos($a); pos($a) = 30;
print 'The position in \$_ is ", pos; pos = 30;
> Смотри также---------------------------------------------------------------------------------------------
Описание модификатора /g в perlre( 1).
6.15. Максимальный и минимальный поиск
Проблема
Имеется шаблон с максимальным квантификатором — *,+,? или {}. Требуется перейти от максимального поиска к минимальному.
Классический пример — наивная подстановка для удаления тегов из HTML-документа. Хотя s#<TT>. *</TT>##gsi выглядит соблазнительно, в действительности будет удален весь текст от первого открывающего до последнего закрывающего тега ТТ. От строки "Even <TT>vi</TT> can edit <TT>troff</TT> effectively." остается лишь "Even effectively" — смысл полностью изменился!
Решение
Замените максимальный квантификатор соответствующим минимальным. Другими словами, *, +, ? или {} соответственно заменяются *?,+?, ??и{}?.
Комментарий
В Perl существуют два набора квантификаторов: максимальные (*, +, ? и {}) и
минимальные1
(*?, +?, ?? и {}?). Например, для строки "Perl is a Swiss Army Chainsaw!" шаблон/(г. *s)/совпадет с "rl is a Swiss Army Chains", а шаблон /(r.*?s)/ —с "rl is".
# Максимальный поиск •*
s/< *>//gs, # Неудачная попытка удаления тегов
# Минимальный поиск
s/< *?>//gs, tt Неудачная попытка удаления тегов
Показанное решение не обеспечивает правильного удаления тегов из HTML-документа, поскольку отдельное регулярное выражение не заменит полноценного анализатора. Правильное решение этой проблемы продемонстрировано в рецепте 20.6.
Впрочем, с минимальными совпадениями дело обстоит не так просто. Не стоит ошибочно полагать, что BEGIN *?END в шаблоне всегда соответствует самому короткому текстовому фрагменту между соседними экземплярами BEGIN и END. Возьмем шаблон /BEGIN(. *?)END/. После поиска в строке "BEGIN and BEGIN and END" переменная $1 будет содержать "and BEGIN and". Вероятно, вы рассчитывали на другой результат.
Представьте, что мы хотим извлечь из HTML-документа весь текст, оформленный полужирным и курсивным шрифтом одновременно:
<b><i>this</i> and <i>that</i> are iraportant</b> Oh, <bxi>me too'</ix/t»
Может показаться, что шаблон для поиска текста, находящегося между парами тегов HTML (то есть не включающий теги), должен выглядеть так:
ш{ <Ь><1>( «?)</i></b> }sx,
Как ни странно, шаблон этого не делает. Многие ошибочно полагают, что он сначала находит последовательность ЧЬ><1>', затем нечто отличное от "<Ь><1>', а затем — ' </i></b> ', оставляя промежуточный текст в $1. Хотя по отношению к входным данным он часто работает именно так, в действительности делается совершенно иное. Шаблон просто находит левую строку минимальной длины, которая соответствует всему шаблону. В данном примере это вся строка. Если вы хотели ограничиться текстом между "<Ь><1> ' и ' </ix/b> ', не включающим другие теги полужирного или курсивного начертания, результат окажется неверным.
Если искомая строка состоит всего из одного символа, инвертированный класс (например, /Х["Х]*)Х/) заметно превосходит минимальный поиск по эффективности. Однако обобщенный шаблон, который находит «сначала BEGIN, затем не-BEGIN, затем END» для произвольных BEGIN и END и сохраняет промежуточный текст в $1, выглядит следующим образом:
/BEGIN»? ("BEGIN) )*)END/
Наш пример с тегами HTML выглядит примерно так:
)* ) </1></Ь> }sx, или так:
m{ <bxi>( С C?l</[ib]>) )* ) </ix/b> }sx,
Как замечает Джеффри Фридл, это скороспелое решение не очень эффектив
но. В ситуациях, где скорость действительно важна, он предлагает воспользовать
ся более сложным шаблоном: .*
т{
["<]• # Заведомо допустимо
С
Символ <' возможен, если он не входит в недопустимую конструкцию
С1 </'[ib]> ) # Недопустимо
< tt Все нормально, найти <
["<]* й и продолжить
) *
}sx
> Смотри также---------------------------------------------------------------------------------------------
Описание минимальных квантификаторов в разделе «Regular Expressions» perlre(\).
6.16. Поиск повторяющихся слов
Проблема
Требуется найти в документе повторяющиеся слова.
Решение
Воспользуйтесь обратными ссылками в регулярных выражениях.
Комментарий
Механизм поиска запоминает часть строки, которая совпала с частью шаблона, заключенной в круглые скобки. Позднее в шаблоне обозначение \1 ссылается на первый совпавший фрагмент, \2 — на второй и т. д. Не используйте обозначение $1 — оно интерпретируется как переменная и интерполируется до начала поиска. Шаблон /([A-Z])\1/ совпадает с символом верхнего регистра, за которым следует не просто другой символ верхнего регистра, а именно тот, что был сохранен в первой паре скобок.
Следующий фрагмент читает входной файл по абзацам. При этом используется принятое в Perl определение абзаца как фрагмента, заканчивающегося двумя и более смежными переводами строк. Внутри каждого абзаца находятся все по-
Модификатор /х разрешает внутренние пропуски и комментарии, упрощающие чтение регулярных выражений. Модификатор /i позволяет найти оба экземпляра "is " в предложении "Is is this ok?". Модификатор /g в цикле while продолжает поиск повторяющихся слов до конца текста. Внутри шаблона метасимволы \Ь (граница слова) и \s (пропуск) обеспечивают выборку целых слов.
$/ = ¦, while (о) { while ( m{
\b
(\S+) \Ь (
\s+ \1 \b ) + }xig ) {
print "dup word -$1' at paragraph $.\n";
Приведенный фрагмент найдет удвоенное test в следующем примере:
This is a test
test of the duplicate word funder.
Проверка \S+ между двумя границами слов обычно нежелательна, поскольку граница слова определяется как переход между \w (алфавитно-цифровым символом или подчеркиванием) и либо концом строки, либо He-\w. Между двумя \Ь обычный смысл \S+ (один и более символов, не являющихся пропусками) распространяется до последовательности символов, не являющихся пропусками, первый и последний символ которой должны быть алфавитно-цифровыми символами или подчеркиваниями.
Рассмотрим другой интересный пример использования обратных ссылок. Представьте себе два слова, причем конец первого совпадает с началом второго — например, "nobody" и "bodysnatcher". Требуется найти подобные «перекрытия» и сформировать строку вида "nobodysnatcher". Это вариация на тему нашей основной проблемы — повторяющихся слов.
Чтобы решить эту задачу, программисту на С, привыкшему к традиционной последовательной обработке байтов, придется написать длинную и запутанную программу. Но благодаря обратным ссылкам задача сводится к одному простому поиску:
$а = 'nobody';
$b = 'bodysnatcher';
if ("$a $b' =- /-(\w+)(\w+) \2(\w+)$/) {
print "$2 overlaps in $1-$2-$3\n";
}
body overlaps in no-body-snatcher
Казалось бы, из-за наличия максимального квантификатора переменная $1 должна захватывать все содержимое "nobody". В действительности так и происходит — на некоторое время. Но после этого не остается ни одного символа, который можно было бы занести в $2. Механизм поиска дает задний ход, и $1 неохотно уступает один символ переменной $2. Пробел успешно совпадает, но далее в шаблоне следует переменная \2, которая в настоящий момент содержит просто "у". Следующий символ в строке — не "у", а "Ь". Механизм поиска делает следующий шаг назад; через некоторое время $1 уступит $2 достаточно символов, чтобы шаблон нашел фрагмент, пробел и затем тот же самый фрагмент.
Этот прием не работает, если само перекрытие содержит повторяющиеся фрагменты — как, например, для строк "rococo " и "cocoon". Приведенный выше алгоритм решит, что перекрываются символы "со", а не "coco". Однако мы хотим получить не "rocococoon", a "гососооп". Задача решается включением минимального квантификатора в $1:
/"(\w+')(\w+) \2(\w+)$/
Трудно представить, насколько мощными возможностями обладают обратные ссылки. Пример 6.11 демонстрирует принципиально новый подход к проблеме разложения числа на простые множители (см. главу 2 «Числа).
Пример 6.11. prime-pattern
#'/usr/bin/perl
# pnme_pattern - разложение аргумента на простые множители по шаблону
for ($N = ('о1 х shift); $N =" /~(оо+?)\1+$/, $N =" s/$1/o/g) {
print length($1), " "; i print length ($N), "\n";
Несмотря на свою непрактичность, этот подход отлично демонстрирует возможности обратных ссылок и потому весьма поучителен.
Приведем другой пример. Гениальная идея, предложенная Дугом Макилро-ем (Doug Mcllroy) — во всяком случае, так утверждает Эндрю Хьюм (Andrew Hume), — позволяет решать диофантовы уравнения первого порядка с помощью регулярных выражений. Рассмотрим уравнение 12х + 15у + 16z = 281. Сможете ли вы найти возможные значения х, у и z? А вот Perl может!
# Решение 12х + 15у + 16z = 281 для максимального х
if (($X, $Y, $Z) =
(( о' х 281) =- /-(о.)\1<11>(о.)\2{14}(о.)\3{15>$/)) {
($х, $у, $2) = (length(JX), length($Y), length($Z));
print "One solution is- x=$x, y=$y; z=$z.\n", } else {
print "No solution.\n"; } One solution is: x=17; y=3; z=2.
(( о х 281) =- /"(о+)\1{11}(о+)\2{14}(о+)\3{15}$/))
One solution is: x=17; y=3; z=2.
(( о х 281) =- /-(о«?)\1{11}(о.)\2{14}(о.)\3{15}$/))
One solution is: x=0; y=17; 2=11.
(( о х 281) =" /"(о+-?)\1{11}(о.)\2{14}(о*)\3{15}$/))
One solution is' x=1; y=3; z=14.
Подобные демонстрации математических возможностей выглядят потрясающе, но из них следует вынести один важный урок: механизм поиска по шаблону (особенно с применением обратных ссылок) всей душой желает предоставить вам ответ и будет трудиться с феноменальным усердием. Однако обратные ссылки в регулярных выражениях могут привести к экспоненциальному росту времени выполнения. Для любых нетривиальных данных программа будет работать так медленно, что даже дрейф континентов по сравнению с ней покажется быстрым
> Смотри также------------------------------------------------------------------------
Описание обратных ссылок в разделе «Regular Expressions» perlre(l).
6.17. Логические AND, OR и NOT в одном шаблоне
Проблема
Имеется готовая программа, которой в качестве аргумента или входных данных передается шаблон. В нее невозможно включить дополнительную логику — например, параметры для управления учетом регистра при поиске, AND и NOT. Следовательно, вы должны написать один шаблон, который будет совпадать с любым из двух разных шаблонов (OR), двумя шаблонами сразу (AND) или менять смысл поиска на противоположный (NOT).
Подобная задача часто возникает при получении данных из конфигурационных файлов, Web-форм или аргументов командной строки. Пусть у вас имеется программа, в которой присутствует следующий фрагмент:
chomp($pattern = <CONFIG_FH>), if ( $data =" /Spattern/ ) { }
Если вы отвечаете за содержимое CONFIG_FH, вам понадобятся средства для передачи программе поиска логических условий через один-единственный шаблон.
Решение
Выражение истинно при совпадении /ALPHA/ или /BETA/ (аналогично /ALPHA/ 11 / BETA/):
/ALPHA|BETA/
Выражение истинно, если и /ALPHA/, и /BETA/ совпадают при разрешенных перекрытиях (то есть когда подходит строка BETALPHA ). Аналогично /ALPHA/ && / BETA/:
/-(?=•ALPHA)(?= *BETA)/s
Выражение истинно, если и /ALPHA/, и /BETA/ совпадают при запрещенных перекрытиях (то есть когда BETALPHA не подходит):
/ALPHA -BETA|BETA *ALPHA/s
Выражение истинно, если шаблон /PAT/ не совпадает (аналогично $var i" /PAT/):
/-(? (?iPAT) )*$/s
Выражение истинно, если шаблон BAD не совпадает, а шаблон GOOD — совпадает:
/(9=-(? (?|BAD) )*$)GOOD/s
Комментарий
Предположим, вы пишете программу и хотите проверить некоторый шаблон на несовпадение. Воспользуйтесь одним из вариантов:
if (i ($string =" /pattern/)) {somethmgO } # Некрасиво if ( Sstring •" /pattern/) {somethingO } № Рекомендуется
Если потребовалось убедиться в совпадении обоих шаблонов, примените следующую запись:
if ($string =" /pati/ && $stnng =" /pat2/ ) { somethingO >
Проверка совпадения хотя бы одного из двух шаблонов выполняется так:
if ($stnng =" /pati/ || $stnng =" /pat2/ ) { somethingO }
Короче говоря, нормальные логические связки Perl позволяют комбинировать логические выражения вместо того, чтобы объединять их в одном шаблоне. Но давайте рассмотрим программу minigrep из примера 6.12, которая в качестве аргумента получает всего один шаблон.
Пример 6.12. minigrep
#'/usr/bin/perl
# minigrep - тривиальный поиск
$pat = shift,
while (о) {
print if /$pat/o, >
Если потребуется сообщить minigrep, что некоторый шаблон не должен совпадать или что должны совпасть оба мини-шаблона в произвольном порядке, вы оказываетесь в тупике. Программа просто не предусматривает подобных конструкций. Как сделать все в одном шаблоне? Другими словами, вы хотите выполнить программу minigrep с параметром PAT, который не совпадает или содержит несколько логически связанных шаблонов. Такая задача нередко возникает в программах, читающих шаблоны из конфигурационных файлов.
В случае с AND придется различать перекрывающиеся и неперекрывающиеся совпадения. Допустим, вы хотите узнать, совпадают ли в некоторой строке шаблоны bell и lab . Если разрешить перекрытия, слово labelled пройдет проверку, а если отказаться от перекрытий — нет. Случай с перекрытиями потребует двух опережающих проверок:
labelled =" /"('= •bell)(?= *lab)/s
Помните- в нормальной программе подобные извращения не нужны. Достаточно сказать:
Sstnng =" /bell/ && $stnng =" /lab/
Мы воспользуемся модификатором /х с комментариями. Развернутая версия шаблона выглядит так:
if ($murray_hill =~ m{
tt Начало строки (?= # Опережающая проверка нулевой ширины
• # Любое количество промежуточных символов
bell # Искомая строка bell
) # Вернуться, мы лишь проверяем
С= * Повторить
* # Любое количество промежуточных символов
lab о Искомая строка labs
)
>sx ) # /s разрешает совпадение с переводом строки {
print Looks like Bell Labs might be in Murray Hill1\n , >
Мы не воспользовались *9 для раннего завершения поиска, поскольку минимальный поиск обходится дороже максимального. Поэтому для произвольных входных данных, где совпадение с равной вероятностью может произойти как в начале, так и в конце строки, * будет эффективнее нашего решения. Разумеется, выбор между * и *? иногда определяется правильностью программы, а не эффективностью, но не в данном случае.
Для обработки перекрывающихся совпадений шаблон будет состоять из двух частей, разделенных OR. В первой части lab' следует после bell , а во второй — наоборот:
labelled =* /(? " «bell -lab)|С? " *lab «bell)/ или в развернутой форме:
$brand = labelled ,
if ($brand =* m{
(? # Группировка без сохранения
*? # Любое количество начальных символов bell в Искомая строка bell •9 # Любое количество промежуточных символов
6.17. Логические AND, OR и NOT в одном шаблоне 219
lab # Искомая строка lab
) # Конец группировки
| # Или попробовать другой порядок
С # Группировка без сохранения
~ *? # Любое количество начальных символов
lab # Искомая строка lab
¦' # Любое количество промежуточных символов
bell # Искомая строка bell
) # Конец группировки
}sx ) # /s разрешает совпадение с переводом строки
{
print Our brand has bell and lab separate \n , }
Такие шаблоны не всегда работают быстрее. $murray_hill =" /bell/ && $murray_ hille ="7lab/ сканирует строку не более двух раз, однако для ('=" *9Ье11)('?=" *?lab) механизм поиска ищет lab для каждого экземпляра bell , что в наихудшем случае приводит к квадратичному времени выполнения.
Тем, кто внимательно рассмотрел эти два случае, шаблон NOT покажется тривиальным. Обобщенная форма выглядит так:
$тар =" /"С C'walclo) )*$/s То же в развернутой форме:
if ($map =* m{
# Начало строки
(' # Группировка без сохранения
С1 # Опережающая отрицательная проверка
waldo и Нашли впереди' ) # Если да, отрицание не выполняется
# Любой символ (благодаря /s)
) * # Повторить группировку 0 и более раз
$ # До конца строки
}sx ) # /s разрешает совпадение с переводом строки {
print There s no waldo here'\n ,
>
Как объединить в одном шаблоне AND, OR и NOT? Результат выглядит отвратительно, и в обычных программах делать нечто подобное практически никогда не следует. Однако при обработке конфигурационных файлов или командных строк, где вводится всего один шаблон, у вас нет выбора. Объедините все изложенное выше. Будьте осторожны.
Предположим, вы хотите запустить программу UNIX w и узнать, зарегистрировался ли пользователь tchrist с любого терминала, имя которого начинается не с ttyp; иначе говоря, шаблон ' tchrist должен совпадать, a "ttyp* — нет.
Примерный вывод w в моей системе Linux выглядит так:
7:15am up 206 days, 13:30, 4 users, load average: 1.04, 1.07, 1.04
USER TTY FROM LOGIN» IDLE JCPU PCPU WHAT
tchrist ttyl 5:16pm 36days 24:43 0.03s xinit
|
tchrist |
tty2 |
|
|
tchrist |
ttypO |
chthon |
|
gnat |
ttys4 |
coprolith |
Посмотрим, как поставленная задача решается с помощью приведенной выше программы minigrep или программы tcgrep, приведенной в конце главы:
% w | minigrep "(?i *ttyp) «tchrist Расшифруем структуру шаблона:
m {
# Привязка к началу строки
С1 # Опережающая проверка нулевой ширины
* # Любое количество любых символов (быстрее *7)
ttyp # Строка, которая не должна находиться
) # Опережающая отрицательная проверка, возврат к началу
¦ # # Любое количество любых символов (быстрее *?)
tchrist # Пытаемся найти пользователя tchrist
}х
Неважно, что любой нормальный человек в такой ситуации дважды вызывает дгер (из них один - с параметром -v, чтобы отобрать несовпадения):
% w | grep tchrist | grep -v ttyp
Главное — что логические конъюнкции и отрицания можно закодировать в одном шаблоне. Однако подобные вещи следует снабжать комментариями — пожалейте тех, кто займется ими после вас.
Как внедрить модификатор /s в шаблон, передаваемый программе из командной строки? По аналогии с /i, который в шаблоне превращается в (?i). Модификаторы /s и /т также безболезненно внедряются в шаблоны в виде /Cs) или /Cm). Их даже можно группировать — например, /Csmi). Следующие две строки фактически эквивалентны:
% grep -1 ШАБЛОН ФАЙЛЫ
% minigrep ('1)ШАБЛ0Н ФАЙЛЫ
> Смотри также------------------------------------------------------------------------
Описание опережающих проверок в разделе «Regular Expressions» perlre(l); man-страницы grep(i) и w(l) вашей системы. Работа с конфигурационными файлами рассматривается в рецепте 8.16.
6.18. Поиск многобайтовых символов
Проблема
Требуется выполнить поиск регулярных выражений для строк с многобайтовой кодировкой символов.
Кодировка определяет соответствие между символами и их числовыми представлениями. В кодировке ASCII каждый символ соответствует ровно одному
байту, однако языки с иероглифической письменностью (китайский, японский и корейский) содержат так много символов, что в их кодировках символы приходится представлять несколькими байтами.
Perl исходит из предположения, что один байт соответствует одному символу. В ASCII все работает нормально, но поиск по шаблону в строках, содержащих многобайтовые символы, — задача по меньшей мере нетривиальная. Механизм поиска не понимает, где в последовательности байтов расположены границы символов, и может вернуть «совпадения» от середины одного символа до середины другого.
Решение
Воспользуйтесь кодировкой и преобразуйте шаблон в последовательность байтов, образующих многобайтовые символы. Основная мысль заключается в построении шаблона, который совпадает с одним (многобайтовым) символом кодировки, а затем применить этот шаблон «любого символа» в более сложных шаблонах.
Комментарий
В качестве примера мы рассмотрим одну из кодировок японского языка, EUC-JP, и разберемся, как воспользоваться ей для решения многих проблем, связанных с многобайтовыми символами. В EUC-JP можно представить тысячи символов, но в сущности эта кодировка является надмножеством ASCII. Байты с 0 по 127 (0x00 - 0x7F) почти точно совпадают с ASCII-аналогами и соответствуют однобайтовым символам. Некоторые символы представляются двумя байтами; первый байт равен 0х8Е, а второй принимает значения из интервала OxAO-OxOF. Другие символы представляются тремя байтами; первый байт равен 0x8F, а остальные принадлежат интервалу 0хА1—OxFE. Наконец, часть символов представляется двумя байтами, каждый из которых принадлежит интервалу 0хА1—OxFE.
Исходя из этих данных, можно построить регулярное выражение. Для удобства последующего применения мы определим строку $eucjp с регулярным выражением, которое совпадает с одним символом кодировки EUC-JP:
my $euc]p = q{ ft Компоненты кодировки EUC-JP
[\xOO-\x7F] # ASCII/JIS-Roman (один байт/символ)
| \x8E[\xA0-\xDF] # катакана половинной ширины (два байта/символ)
| \x8F[\xA1-xFE][\xA1-\xFE] # JIS X 0212-1990 (три байта/символ)
| [\xA1-\xFE][\xA1-\xFE] ft JIS X 0208 1997 (два байта/символ)
},
(строка содержит комментарии и пропуски, поэтому при ее использовании для поиска или замены необходимо указывать модификатор /х). Располагая этим шаблоном, мы расскажем, как:
• Выполнить обычный поиск без «ложных» совпадений.
• Подсчитать, преобразовать (в другую кодировку) и/или отфильтровать
символы.
• Убедиться в том, что проверяемый текст содержит символы данной коди
ровки.
• Узнать, какая кодировка используется в некотором тексте.
222 Глава б • Поиск по шаблону
Во всех приведенных примерах используется кодировка EUC-JP, однако они будут работать и в большинстве других распространенных многобайтовых кодировок, встречающихся при обработке текстов — например, Unicode, Big-5 и т. д.Страховка от ложных совпадений
Ложное совпадение происходит, когда найденное совпадение приходится на середину многобайтового представления одного символа. Чтобы избежать ложных совпадений, необходимо контролировать процесс поиска и следить, чтобы механизм поиска синхронизировался с границами символов.
Для этого можно связать шаблон с началом строки и вручную пропустить байты, для которых в текущей позиции не может произойти нормальное совпадение. В примере с EUC-JP за «пропуск символов» отвечает часть шаблона /(? :$eucjp)*?/. $eucjp совпадает с любым допустимым символом. Поскольку он применяется с минимальным квантификатором *?, совпадение возможно лишь в том случае, если не совпадает то, что идет после него (искомый текст). Рассмотрим реальный пример:
/" (?: $eucjp )*? \xC5\xEC\xB5\xFE/ox n Пытаемся найти Токио
В кодировке EUC- JP японское название Токио записывается двумя символами — первый кодируется двумя байтами \xC5\xEC, а второй — двумя байтами \xB5\xFE. С точки зрения Perl мы имеем дело с обычной 4-байтовой последовательностью \xC5\xEC\xB5\xFE. Однако, поскольку использование (9:$еис]р)*? обеспечивает перемещение в строке только по символам целевой кодировки, мы знаем, что синхронизация сохраняется.
Не забывайте о модификаторах /ох. Модификатор /х особенно важен из-за наличия пропусков в шаблоне $eucjp. Модификатор /о повышает эффективность, поскольку значение $eucjp заведомо остается неизменным.
Аналогично выполняется и замена, но поскольку текст перед настоящим совпадением также является частью общего совпадения, мы должны заключить его в круглые скобки и включить в заменяющую строку. Предположим, переменным $Токуо и $0saka были присвоены последовательности байтов с названиями городов Токио и Осака в кодировке EUC-JP. Замена Токио на Осаку происходит следующим образом:
/" ( (?:eucjp).? ) $Tokyo/$10saka/ox
При использовании модификатора /д поиск должен быть привязан не к началу строки, а к концу предыдущего совпадения. Для этого достаточно заменить " на \G:
/\G ( C:eucjp)«? ) $Tokyo/$10saka/gox
Разделение строк в многобайтовой кодировке
Другая распространенная задача — разбивка входной строки на символы. Для однобайтовой кодировки достаточно вызвать функцию split//, но для многобайтовых конструкция будет выглядеть так:
©chars = /$eucjp/gox; # По одному символу на каждый элемент списка
6.18. Поиск многобайтовых символов 223
Теперь каждый элемент ©chars содержит один символ строки. В следующем фрагменте этот прием используется для создания фильтра:
while (о) {
my @chars = /$eucjp/gox; # Каждый элемент списка содержит один символ for my $char (@chars) { if (length($char) == 1) {
# Сделать что-то интересное с однобайтовым символом
} else {
# Сделать что-то интересное с многобайтовым символом
my $line = join("",(g>chars); # Объединить символы списка в строке print $line; }
Любые изменения $char в двух фрагментах, где происходит «что-то интересное», отражаются на выходных данных при объединении символов @chars.
Проверка многобайтовых строк
Успешная работа приемов, подобных /$eucjp/gox, существенно зависит от правильного форматирования входных строк в предполагаемой кодировке (EUC-JP). Если кодировка не соблюдается, шаблон /$eucj p/ не будет работать, что приведет к пропуску байтов.
Одно из возможных решений — использование /\6$eucjp/gox. Этот шаблон запрещает механизму поиска пропускать байты при поиске совпадений (модификатор \G означает, что новое совпадение должно находиться сразу же после предыдущего). Но и такой подход не идеален, потому что он просто прекращает выдавать совпадения для входных данных неправильного формата.
Более удачный способ убедиться в правильности кодировки строки — воспользоваться конструкцией следующего вида:
$is_eucjp = m/"C:$eucjp)*$/xo;
Если строка от начала до конца состоит только из допустимых символов, значит, она имеет правильную кодировку.
И все же существует потенциальная проблема, связанная с особенностями работы метасимвола конца строки $: совпадения возможны как в конце строки (что нам и требуется), так и перед символом перевода строки в ее конце. Следовательно, успешное совпадение возможно даже в том случае, если символ перевода строки не является допустимым в кодировке. Проблема решается заменой $ более сложной конструкцией (?!\п).
Базовая методика проверки позволяет определить кодировку. Например, японский текст обычно кодируется либо в EUC-JP, либо в другой кодировке, которая называется Shift-JIS. Имея шаблоны $eucjp и $sjis, можно определить кодировку следующим образом:
$is_eucjp = m/"(?:$eucjp)«$/xo; $is_sjis = m/~(?:$sjis)*$/xo;
224 Глава 6 • Поиск по шаблону
Если обе проверки дают истинный результат, вероятно, мы имеем дело с ASCII-текстом (поскольку ASCII, в сущности, является подмножеством обеих кодировок). Однако такое решение не дает стопроцентной гарантии, поскольку некоторые строки с многобайтовыми символами могут оказаться допустимыми в обеих кодировках. В таких случаях автоматическое распознавание становится невозможным, хотя по относительным частотам символов можно выдвинуть разумное предположение.
Преобразование кодировок
Преобразование может сводиться к простому расширению описанного выше процесса перебора символов. Для некоторых взаимосвязанных кодировок достаточно тривиальных математических операций с байтами, в других случаях потребуются огромные таблицы соответствия. В любом случае код вставляется в те фрагменты, где происходит «что-то интересное» (см. выше).
Следующий пример преобразует строки из EUC-JP в Unicode, при этом в качестве таблицы соответствия используется хэш %euc2um:
while (о) {
my ©chars = /$eucjp/gox, # Каждый элемент списка содержит один символ for my $char (§chars) { my $um = $euc2um{$char}, if (defined $um) {
$euc = $um, > else { # Обработать неизвестное преобразование из EUC в Unicode
my $line = jom( ,@>chars), print $line, }
Поиск и обработка многобайтовых символов играет особенно важную роль в Unicode, имеющей несколько разновидностей. В UCS-2 и UCS-4 символы кодируются фиксированным числом байтов. UTF-8 использует от одного до шести байтов на символ. UTF-16, наиболее распространенный вариант Unicode, представляет собой 16-битную кодировку переменной длины.
6.19. Проверка адресов электронной почты
Проблема
Требуется построить шаблон для проверки адресов электронной почты.
Решение
Задача в принципе неразрешима, проверка адреса электронной почты в реальном времени невозможна. Приходится выбирать один из возможных компромиссов.
Комментарий
Многие шаблоны, предлагаемые для решения этой проблемы, попросту неверны. Допустим, адрес f red&barney@stonehedge com правилен и по нему возможна доставка почты (на момент написания книги), однако большинство шаблонов, претендующих на проверку почтовых адресов, бесславно споткнутся на нем.
Документы RFC- 822 содержат формальную спецификацию синтаксически правильного почтового адреса. Однако полная обработка требует рекурсивного анализа вложенных комментариев — задача, с которой одно регулярное выражение не справится. Если предварительно удалить комментарии:
1 while $addr =" s/\([-()]A)//g,
тогда теоретически можно воспользоваться довольно длинным шаблоном для проверки соответствия стандарту RFC, но и это недостаточно хорошо по трем причинам.
Во-первых, не по всем адресам, соответствующим спецификации RFC, возможна доставка. Например, адрес foo@foo foo foo foo теоретически правилен, но на практике доставить на него почту невозможно. Некоторые программисты пытаются искать записи MX на серверах DNS или даже проверяют адрес на хосте, обрабатывающем его почту. Такой подход неудачен, поскольку большинство узлов не может напрямую подключиться к любому другому узлу, но даже если бы это было возможно, получающие почту узлы обычно либо игнорируют команду SMTP VRFY, либо откровенно врут.
Во-вторых, почта может прекрасно доставляться по адресам, не соответствующим RFC. Например, сообщение по адресу postmaster почти наверняка будет доставлено, но этот адрес не соответствует канонам RFC — в нем нет символа @.
В-третьих (самая важная причина), даже если адрес правилен и по нему возможна доставка, это еще не означает, что он вам подойдет. Например, адрес president@whitehouse gov соответствует стандартам RFC и обеспечивает доставку. И все же крайне маловероятно, чтобы этот адресат стал поставлять информацию для вашего сценария CGI.
Отважная (хотя и далеко не безупречная) попытка приведена в сценарии по адресу http://www.perl.com/CPAN/authors/Tom_Christiansen/scripts/ckaddr.gz. Эта программа выкидывает множество фортелей, среди которых — проверка регулярного выражения на соответствие RFC-822, просмотр записей MX DNS и стоп-спис-ки для ругательств и имен знаменитостей. Но и такой подход оказывается откровенно слабым.
При проверке почтового адреса мы рекомендуем организовать его повторный ввод, как это часто делается при проверке пароля. При этом обычно исключаются опечатки. Если обе версии совпадут, отправьте на этот адрес личное сообщение следующего содержания:
Дорогой someuser@host com,
Просим подтвердить почтовый адрес, сообщенный вами в 09 38 41 6 мая 1999 года Для этого достаточно ответить на настоящее сообщение Включите в ответ строку Rumpelstiltskin , но в обратном порядке (то есть начиная с Nik ') После этого ваш подтвержденный адрес будет занесен в нашу базу данных
Возможна и другая стратегия, которая обеспечивает лучшую защиту от подде-'лок, — присвойте своему адресату личный идентификатор (желательно случайный) и сохраните его вместе с адресом для последующей обработки. В отправленном сообщении попросите адресата включать личный идентификатор в свои ответы. Однако идентификатор будет присутствовать и при возврате недоставленного сообщения, и при включении рассылки в сценарий. Поэтому попросите адресата слегка изменить идентификатор — например, поменять порядок символов, прибавить или вычесть 1 из каждой цифры и т. д.
> Смотри также Рецепт 18.9.
6.20. Поиск сокращений
Проблема
Предположим, у вас имеется список команд — например, "send", "abort", "list" и "edit". Пользователь вводит лишь часть имени команды, и вы не хотите заставлять его вводить всю команду до конца.
Решение
Воспользуйтесь следующим решением, если все строки начинаются с разных символов или если одни совпадения имеют более высокий приоритет по сравнению с другими (например, если "SEND" отдается предпочтение перед STOP"):
chomp ($answer = о);
if ('SEND" =" /"\Q$answer\i) { print 'Action is send\n" }
elsif ("STOP" =" /~\Q$answer\i) { print "Action is stop\n" }
elsif ("ABORT" =" /"\Q$answer\i) { print 'Action is abort\n" }
elsif ("LIST" =" /~\Q$answer\i) { print "Action is list\n" }
elsif ('EDIT" =" /"\Q$answer\i) { print "Action is edit\n ' }
Кроме того, можно воспользоваться модулем Text::Abbrev:
use Text. Abbrev;
$href = abbrev qw(send abort list edit),
for (print "Action: "; <>; print "Action1 ") {
chomp;
my $action = $href->{ lc($_) },
print "Action is $action\n";
Комментарий
В первом решении изменяется стандартный порядок поиска; обычно слева указывается переменная, а справа — шаблон. Мы бы также могли попытаться опре-
делить, какое действие выбрал пользователь, с помощью конструкции $answer= =~ /"ABORT/i. Выражение будет истинным, если $answer начинается со строки "ABORT". Однако совпадение произойдет и в случае, если после "ABORT" в $answer следует что-то еще — скажем, для строки "ABORT LATER". Обработка сокращений обычно выглядит весьма уродливо: $answer =~ /"A(B(O(R(T)?)?)?)?$/i.
Сравните классическую конструкцию "переменная =~ шаблон" с "ABORT" =~ / "\Q$answer/i. \Q подавляет интерпретацию метасимволов, чтобы ваша программа не «рухнула» при вводе пользователем неверного шаблона. Когда пользователь вводит что-нибудь типа "ab", после замены переменной шаблон принимает вид "ABORT" =" /"ab/i. Происходит совпадение.
Стандартный модуль Text::Abbrev работает иначе. Вы передаете ему список слов и получаете ссылку на хэш, ключи которого представляют собой все однозначные сокращения, а значения — полные строки. Если ссылка Shref создается так, как показано в решении, $href->{$var} возвращает строку "abort".
Подобная методика часто используется для вызова функции по имени, вводимому пользователем. При этом применяется символическая ссылка:
$name = 'send'; &$name();
Впрочем, это небезопасно — пользователь сможет выполнить любую функцию нашей программы, если он знает ее имя. Кроме того, такое решение противоречит директиве use strict 'refs'.
Ниже приведена часть программы, создающая хэш, в котором ключ представляет собой имя команды, а значение — ссылку на функцию, вызываемую этой командой:
# Предполагается, что &invoke_editor, &deliver_message,
# $flie и $PAGER определяются в другом месте,
use Text' Abbrev,
my($href, %actions, Serrors); %actions = (
"edit" => \&mvoke_editor,
'send" => \&deliver_message,
"list" => sub { system($PAGER, $file) },
"abort" => sub {
print "See ya'\n"; exit; }, => sub {
print "Unknown command $cmd\n", $errors++;
$href = abbrev(keys factions),
local $_;
for (print 'Action' "; <>; print "Action: ") <
s/\s+$//;
$actions->{ $href->{ lc($_) } }->(); >
Если вы не любите слишком кратких выражений или хотите приобрести навыки машинистки, последнюю команду можно записать так:
$abbreviation =
Sexpansion = $href->{$abbreviation};
$coderef = $actions->{$expansion};
&$coderef();
> Смотри также
Документация по стандартному модулю Text::Abbrev. Интерполяция рассматривается в разделе «Scalar Value Constructors» perldata(l).
6.21. Программа: urlify
Программа urlify оформляет URL-адреса, найденные в файлах, в виде ссылок HTML. Она работает не для всех возможных URL, но справляется с наиболее распространенными. Программа старается избежать включения знаков препинания, завершающих предложения, в помеченный URL.
Программа является типичным фильтром Perl и потому может использоваться для перенаправленного ввода:
% gunzip -с ~/mail/archive.gz | urlify > archive.urlified Исходный текст программы приведен в примере 6.13.
Пример 6.13. urlify
#!/usr/bin/perl
# urlify - оформление URL-подобных конструкций в виде ссылок HTML
$urls = '(http|telnet(gopher 1 file(waisfftp)';
$ltrs = AW;
$gunk = •/»--. .?+=&»©! V;
$punc = '. :?\-';
$any = "${ltrs}${gunk}${punc}";
while (<>) { s{
\b # Начать с границы слова
( It Начать сохранение $1 {
$urls : Я Искать имя ресурса и двоеточие,
[$апу] +•? # за которыми следует один или более
# любых допустимых символов, но
# проявлять умеренность и брать лишь то,
# что действительно необходимо ....
) # Завершить сохранение $1 }
6.22. Программа: tcgrep 229
(?= # Опережающая проверка без смещения
[$punc]* # либо 0, либо знак препинания,
[~$апу] # за которыми следует символ, не входящий в url,
| # или
$ # конец строки
HREF="$1">$K/A>}igox;
print; }
6.22. Программа: tcgrep
Ниже приведена программа UNIX grep, написанная на Perl. Хотя она работает медленнее версий, написанных на С (особенно GNU-версии grep), зато обладает многими усовершенствованиями.
Первая и самая важная особенность — эта программа работает везде, где работает Perl. Имеется ряд дополнительных возможностей — tcgrep игнорирует все файлы, кроме простых текстовых; распаковывает сжатые или обработанные утилитой gzip файлы; выполняет просмотр в подкаталогах; ищет полные абзацы или записи, определенные пользователем; ищет более свежие версии файлов, а также подчеркивает или выделяет найденные совпадения. Кроме того, параметр -с выводит количество найденных записей, а параметр -С — число найденных совпадений, которые могут содержать несколько записей.
Распаковка сжатых файлов выполняется утилитами gzcat или zcat, поэтому данная возможность отсутствует в системах, где эти программы недоступны, а также в системах, не позволяющих запускать внешние программы (например, Macintosh).
При запуске программы без аргументов на экран выводится краткая справка по ее использованию (см. процедуру usage в программе). Следующая командная строка рекурсивно и без учета регистра ищет во всех файлах почтового ящика "/mail сообщения с отправителем "kate" и выводит имена найденных файлов:
% tcgrep -ril '"From: .*kate' "/mail
Исходный текст программы приведен в примере 6.14.
Пример 6.14. tcgrep
#!/usr/bin/perl -w
# tcgrep: версия grep, написанная на Perl
# версия 1.0: 30 сентября 1993 года
# версия 1.1: 1 октября 1993 года
# версия 1.2: 26 июля 1996 года
# версия 1.3: 30 августа 1997 года
# версия 1.4: 18 мая 1998 года
use strict;
# Глобальные переменные
продолжение
use vars qw($Me $Errors $Grand_Total $Mult %Compress SMatches);
my ($matcher, $opt);
8 matcher - анонимная функция
# для поиска совпадений
# opt - ссылка на хэш, содержащий
# параметры командной строки
# Инициализировать глобальные переменные
($opt, $matcher) = parse_args(); # Получить параметры командной строки
# и шаблоныmatchfile($opt, Smatcher, @ARGV); # Обработать файлы
exit(2) if SErrors; exit(O) if $Grand_Total; exit(1);
sub init {
($Me = $0) =" s!.*/!!; SErrors = $Grand_Total = 0; $Mult = "•'; $| = 1;%Compress = (
2 => 'gzcaf, gz => 'gzcaf, Z => 'zcaf,
# Получить базовое имя программы, "tcgrep"
# Инициализировать глобальные счетчики
# Флаг для нескольких файлов в @ARGV
# Автоматическая очистка выходного буфера
# Расширения и имена программ
# для распаковки
sub usage {
die «EOFusage: $Me [flags] [files]
Standard grep options:
l case insensitive
n number lines
с give count of lines matching
С ditto, but >1 match per line possible
w word boundaries only
s silent mode
x exact matches only
v invert search sense (lines that DON'T match)
h hide filenames
e expression (for exprs beginning with -)
6.22. Программа: tcgrep 231
f file with expressions
1 list filenames matching
Specials:
1 1 match per file
H highlight matches
u underline matches
r recursive on directories or dot if none
t process directories in 'Is -f order
p paragraph mode (default: line mode)
P ditto, but specify separator, e.g. -P '%%\\n'
a all files, not just plain text files
q quiet about failed file and dir opens
T trace files as opened
May use a TCGREP environment variable to set default options.
EOF
sub parse_args { use Getopt::Std;
my (Soptstring, $zeros, $nulls, %opt, Spattern, ^patterns, $match_code); my ($S0, $SE);
if ($_ = $ENV{TCGREP}) { и Получить переменную окружения TCGREP s/"([~\-])/-$V; * Если начальный - отсутствует, добавить unshift(@ARGV, $_); # Включить строку TCGREP в @ARGV
Soptstring = "incCwsxvhe:f :HHurtpP:aqT";
Szeros = 'mCwxvhelut'; # Параметры, инициализируемые О
й (для отмены предупреждений)
Snulls = 'рР'; # Параметры, инициализируемые ""
# (для отмены предупреждений)
split //, Szeros } = ( о ) х length($zeros); split //, Snulls } = ( " ) х length(Snulls);
getopts($optstring, \%opt) or usage();
if ($opt{f}) { # -f файл с шаблонами
open(PATFILE, $opt{f}) or die qq($Me: Can't open '$opt{f}': $!);
# Проверить каждый шаблон в файле
while ( defined($pattern = <PATFILE>) ) {
продолжение
232 Глава 6 * Поиск по шаблону Пример 6.14 (продолжение)
chomp Spattern,eval { 'foo =~ /$pattern/, 1 } or
die "$Me: $opt{f}'$.. bad pattern: $<g>"
push ©patterns, $pattern; > close PATFILE;
}
else { # Проверить шаблон
Spattern = $opt{e} || shift(@ARGV) || usage(); eval { 'foo' =~ /Spattern/, 1 } or
die "$Me: bad pattern: $@"; ©patterns = ($pattern);
if ($opt{H> || $opt{u}) { # Выделить или подчеркнуть my $term = $ENV<TERM} || 'vt100'; my Sterminal;
eval { й Попытаться найти служебные
й последовательности для выделения require POSIX; # или подчеркнуть через Term''Cap use Term::Cap;
my $termios = POSIX::Termios->new();
$termios->getattr;
my $ospeed = $termios->getospeed;
$termmal = Tgetent Term: Cap { TERM=>undef, OSPEED=>$ospeed >
unless ($@) { # Если успешно, получить служебные
# последовательности для выделения (-Н)
local $~W =0; К или подчеркивания (-и)
($S0, $SE) = $opt{H>
? ($terminal->Tputs('so'), $terminal->Tputs('se'))
: ($terminal->Tputs('us'), $terminal->Tputs('ue'));
>
else { # Если попытка использования Term::Cap
# заканчивается неудачей, получить
($S0, $SE) = $opt<H} й служебные последовательности
Я командой tput
' ('tput -T $term smso', 'tput -T $term rmso') : ('tput -T $term smul', 'tput -T $term rmul')
if ($opt{i>) <
©patterns = map C'(7i)$_"} ©patterns;
6.22. Программа: tcgrep 233
if ($opt<p} || $opt<P}) <
©patterns = map Г(?т)$_") ©patterns;
$opt{p} && ($/ = ¦¦);
$opt{P> && ($/ = eval(qq("$opt{P}"))); # for -P '%%\n
$opt{w> && (©patterns = map {'\b' . $_ . '\b'> ©patterns);
$opt{'x'} && (©patterns = map {""$_\$"} ©patterns);
if (@ARGV) {
$Mult = 1 if ($opt{r} || (©ARGV > 1) || -d $AR6V[0]) && !$opt{h>, >
$opt{1) += $opt<l); tt Единица и буква 1
$opt{H> += $opt{u}; $opt{c> += $opt{C}; $opt{'s'} += $opt{c}; $opt{1> += $opt{'s'} && !$opt{c), # Единица
©ARGV = ($opt{r} ' ¦.' : ¦-') unless ©ARGV;
$opt{r} = 1 if '$opt{r} && grep(-d, ©ARGV) == ©ARGV;
$match_code = '';
$match_code = 'study; if ©patterns > 5; # Может немного
# ускорить работу
foreach (©patterns) { s(/)(\\/)g }
if ($opt<H}) <
foreach Spattern (©patterns) {
$match_code = "\$Matches += s/($pattern)/${S0}\$1${SE}/g, ';
elsif ($opt{v}) {
foreach $pattern (©patterns) {
$match_code .= "\$Matches += !/$pattern/,';
elsif ($opt{C>) {
foreach $pattern (©patterns) {
$match_code = "\$Matches++ while /$pattern/g;
else {
foreach $pattern (©patterns) {
$match_code = "\$Matches++ if /$pattern/;";
продолжение
234 Глава 6 • Поиск по шаблону Пример 6.14 (продолжение)
$matcher = eval "sub { $matcti_code }"; die if $@;return (\%opt, Smatcher);
sub matchfile {
$opt = shift; # Ссылка на хэш параметров
$matcher = shift; # Ссылка на функцию поиска совпадений
ray ($file, ©list, $total, $name);
local($_);
Stotal = 0;
FILE: while (defined ($file = shift(@_))) {
if (-d $file) {
if (-1 $file && @ARGV != 1) {
warn "$Me: \"$file\" is a symlink to a directory\n" if $opt->{T};
next FILE; } if (!$opt->{r}) {
warn "$Me: \"$file\" is a directory, but no -r given\n" if $opt->{T};
next FILE; } unless (opendir(DIR, $file)) {
unless ($opt->{'q'}) {
warn "$Me: can't opendir $file: $!\n"; $Errors++;
>
next FILE; }
@list =(); for (readdir(DIR)) {
push(@list, "$file/$ ") unless /~\.{1.2}$/; }
closedir(OIR); if ($opt->{t}) {
my (©dates);
for (©list) { push(@dates, -M) }
@list = @list[sort { $dates[$a] <=> $dates[$b] } O..$#dates]; } else {
@list = sort ©list;
6.22. Программа: tcgrep 23S
matchfile($opt, Smatcher, ©list); # process files next FILE;
if (Sfile eq '-¦) {
warn "$Me: reading from stdin\n" if -t STDIN && !$opt->{'q'}; $name = '<STDIN>';
} else {
$name = $file; unless (-e Sfile) {
warn qq($Me: file "$file" does not exist\n)
unless $opt->{'q'}; $Errors++; next FILE; } unless (-f $file || $opt->{a}) {
warn qq($Me: skipping non-plain file "$file"\n)
if $opt->{T}; next FILE;
my ($ext) = Sfile =" /\.([".]+)$/;
if (defined Sext && exists SCompress{$ext}) {
Sfile = "$Conpress{$ext} <$file |"; } elsif (! (-T Sfile || $opt->{a})) {
warn qq($Me: skipping binary file "$file"\n) if $opt->{T};
next FILE;
warn "$Me: checking $file\n" if $opt->{T};
unless (open(FILE, Sfile)) { unless ($opt->{'q'}) {
warn "$Me; Sfile: $!\n";
$Errors++; } next FILE;
Stotal = 0; SMatches = 0;
LINE: while (<FILE>) < SMatches = 0;
продолжение
##############
&{$matcher}(); # Поиск совпадений
##############
next LINE unless $Matches; $total += $Matches;
if ($opt->{p} || $opt->{P}) {
s/\n{2,}$/\n/ if $opt->{p};
chomp if $opt->{P};
pnnt("$name\n"), next FILE if $opt->{l};
$opt->{'s'} || print $Mult && "$name:", $opt->{n} ? "$. :" : ¦•", $_, ($opt->{p} || $opt->{P}) && ('-¦ x 20) . "\n";
next FILE if $opt->{1}; # Единица
continue {
print $Mult && "$name:", $total, "\n" if $opt->{c};
$Grand_Total += $total; }
6.23. Копилка регулярных выражений
Следующие регулярные выражения показались нам особенно полезными или интересными.
Римские цифры
m/~m*(d'c{0,3}|c[dm])(1?x{0,3}|x[1c])(v?i{0,3}|i[vx])$/i
Перестановка двух первых слов
s/(\S+))\s+)(\S+)/$3$2$1/
Ключевое слово = значение
m/(\w+)\s*=\s*(.*)\s*$/ # Ключевое слово в $1, значение - в $2
Строка содержит не менее 80 символов
т/ {80,}/
ММ/ДД/ГГ ЧЧ:ММ:СС
т| (\d+)/(\d+)/\d+) (\d+):(\d+):(\d+) |
Смена каталога
s(/usr/bin)(/usr/local/bm)g
Расширение служебных последовательностей %7Е(шестн.)
s/%([O-9A-Fa-f][O-9A-Fa-f])/chr hex 41/ge
Удаление комментариев С (не идеальное)
s{
/\» # Начальный ограничитель
. •? # Минимальное количество символов
\*/ и Конечный ограничитель ) []gsx;
Удаление начальных и конечных пропусков
s/\s+$//;
Преобразование символа \ и следующего за ним п в символ перевода строки
s/\\n/\n/g;
Удаление пакетных префиксов из полностью определенных символов 1Р-адрес
m/-[01]?\d\d|2[0-4]\d|25[0-5])\.([01]'\d\d|2[0-4]\d|25[0-5])\. ([01]Ad\d|2[0-4]\d|25[0-5])\.([01]'\d\d|2[0-4]\d|25[0-5])$/;
Удаление пути из полного имени файла
Определение ширины строки с помощью TERMCAP
$cols = ( ($ENV{TERMCAP} ]| " ") =~ m/:co#(\d+):/ ) ? $1 : 80;
Удаление компонентов каталогов из имени программы и аргументов
($name = join(" ", map { s,"\S+/,.: $_ } ($0 @ARGV));
Проверка операционной системы
die "This isn't Linux" unless $"0 =~m/linux/i;
Объединение строк в многострочных последовательностях
s/\n\s+/ /g,
Извлечение всех чисел из строки
@nums = ra/(\d+\-?\d*|\.\d+)/g;
Поиск всех слов, записанных символами верхнего регистра
@capwords = m/(\b["\Wa-zO-9_]+\b)/g;
Поиск всех слов, записанных символами нижнего регистра
@capwords = m/(\b["\WA-Z0-9_]+\b)/g;
Поиск всех слов, начинающихся с буквы верхнего регистра
@icwords = m/(\b["\Wa-z0-9_][-\WA-Z0-9_]*\b)/;
238 Глава 6 • Поиск по шаблону Поиск ссылок в HTML-документах
©links = m/<A[->]+?HREF\s*=\s*["-P(["-1 >]+?)[Поиск среднего инициала в $__
Sinitial = m/"\S+\s+(\s)\S*\s+\S/ ? $1 : "";
Замена кавычек апострофами
Выборка предложений (разделитель — два пробела)
< local $/ = "¦¦; while (о) { s/\n/ /g, s/ {3,}/ /g, push ^sentences, m/(\S.*?[i?.])(?= |\Z)/g,
ГГГГ-ММ-ДД
m/(\d{4})-(\d\d)-(\d\d)/ # ГГГГ в $1, MM в $2 и ДД в $3
Выборка строк независимо от терминатора (завершающего символа)
push(@lines, $1)
while ($input =" s/"(["\012\015].)(\012\015?|\015\012?)//),
Доступ к файлам
Я — вечности наследник В анналах времени...
А. Теннисоп, "Локсли-Холл"
Введение
Файлы занимают центральное место в обработке данных. Как и во всем остальном в Perl, простые операции с файлами выполняются просто, а сложные... как-нибудь да выполняются. Стандартные задачи (открытие файлов, чтение данных, запись данных) используют простые функции ввода/вывода и операторы, а более экзотические функции способны даже на асинхронный ввод/вывод и блокировку (locking) файлов.
В этой главе рассматривается механика доступа к файлам: открытие файлов, передача сведений о том, с какими файлами вы собираетесь работать, блокировка и т. д. Глава 8 «Содержимое файлов» посвящена работе с содержимым файлов: чтению, записи, перестановке строк и другим операциям, которые становятся возможными после получения доступа к файлу.
Следующий фрагмент выводит все строки файла /usr/local/widgets/data, содержащие слово "blue":
open (INPUT, '< /usr/local/widgets/data")
or die "Couldn't open /usr/local/widgets/data for reading' $'\n",
while (<INPUT>) {
print if /blue/, } close(INPUT),
Получение файлового манипулятора
Доступ к файлам в Perl организуется при помощи файловых манипуляторов (filehandle) — таких, как INPUT из предыдущего примера. Манипулятор — это символическое имя, которое представляет файл в операциях чтения/записи. Файло-
$var = *STDIN, mysub($var, «LOGFILE),
Файловые манипуляторы, сохраняемые в переменных подобным образом, не используются напрямую. Они называются косвенными файловыми манипуляторами (indirect filehandle), поскольку косвенно ссылаются на настоящие манипуляторы. Два модуля, IO::File (стал стандартным, начиная с версии 5.004) и FileHandle (стандартный с версии 5.000), могут создавать анонимные файловые манипуляторы.
Когда в наших примерах используются модули IO::File или IO::Handle, аналогичные результаты можно получить с применением модуля FileHandle, поскольку сейчас он является интерфейсным модулем (wrapper).
Ниже показано, как выглядит программа для поиска blue" с применением модуля IO::File в чисто объектной записи:
use 10 File,
Sinput = 10 File->new( < /usr/local/widgets/data )
or die Couldn t open /usr/local/widgets/data for reading $'\n ,
while (defmed($line = $input->getline())) <
chomp($line),
STDOUT->prmt($line) if $line =' /blue/, } $input->close(),
Как видите, без прямого использования файловых манипуляторов программа читается намного легче. Кроме того, она гораздо быстрее работает.
Но поделимся одним секретом: из этой программы можно выкинуть все стрелки и вызовы методов. В отличие от большинства объектов, объекты IOr.File не обязательно использовать объектно-ориентированным способом. В сущности, они представляют собой анонимные файловые манипуляторы и потому могут использоваться везде, где допускаются обычные косвенные манипуляторы. В рецепте 7.16 рассматриваются эти модули и префикс *. Модуль IO::File и символические файловые манипуляторы неоднократно встречаются в этой главе.
Стандартные файловые манипуляторы
Каждая программа при запуске получает три открытых глобальных файловых манипулятора: STDIN, STDOUT и STDERR. STDIN {стандартный ввод) является источником входных данных по умолчанию. В STDOUT (стандартный вывод) по умолчанию направляются выходные данные. В STDERR (стандартный поток ошибок) по умолчанию направляются предупреждения и ошибки. В интер-
Введение 241
активных программах STDIN соответствует клавиатуре, a STDOUT и STDERR — экрану монитора:
while(<STDIN>) { # Чтение из STDIN
unless (/W) {
warn "No digit found \n', й Вывод в STDERR
}
print Read , $_, # Запись в STDOUT > END { close(STDOUT) or die "couldn't close STDOUT- $' }
Файловые манипуляторы существуют на уровне пакетов. Это позволяет двум пакетам иметь разные файловые манипуляторы с одинаковыми именами (по аналогии с функциями и переменными). Функция open связывает файловый манипулятор с файлом или программой, после чего его можно использовать для ввода/ вывода. После завершения работы вызовите для манипулятора функцию close, чтобы разорвать установленную связь.
Операционная система работает с файлами через файловые дескрипторы, значение которых определяется функцией f lleno. Для большинства файловых операций хватает манипуляторов Perl, однако в рецепте 7.19 показано, как файловый дескриптор преобразуется в файловый манипулятор, используемый в программе.
Операции ввода/вывода
Основные функции для работы с файлами в Perl — open, print, < > (чтение записи) и close. Они представляют собой интерфейсные функции для процедур буферизованной библиотеки ввода/вывода С stdio. Функции ввода/вывода Perl документированы в perlfunc(i) и страницах руководства stdio(3S) вашей системы. В следующей главе операции ввода/вывода — такие, как оператор> о, print, seek и tell — рассматриваются более подробно.
Важнейшей функцией ввода/вывода является функция open. Она получает два аргумента — файловый манипулятор и строку с именем файла и режимом доступа. Например, открытие файла /tmp/log для записи и его связывание с манипулятором LOGFILE выполняется следующей командой:
open(LOGFILE, '> /tmp/log ) or die Can't write /trap/log $• ,
Три основных режима доступа — < (чтение), > (запись) и » (добавление). Дополнительные сведения о функции open приведены в рецепте 7.1.
При открытии файла или вызове практически любой системной функции1 необходимо проверять возвращаемое значение. Не каждый вызов open заканчивается успешно; не каждый файл удается прочитать; не каждый фрагмент данных, выводимый функцией print, достигает места назначения. Многие программисты для повышения устойчивости своих программ проверяют результаты open, seek, tell и close. Иногда приходится вызывать и другие функции. В документации Perl описаны возвращаемые значения всех функций и операторов. При неудачном завершении системная функция возвращает undef (кроме функций wait, waitpid и
Для чтения записей в Perl применяется оператор <МАНИПУЛЯТОР>, также часто дублируемый функцией readline. Обычно запись представляет собой одну строку, однако разделитель записей можно изменить (см. главу 8). Если МАНИПУЛЯТОР не указывается, Perl открывает и читает файлы из @ARGV, а если они не указаны — из STDIN. Нестандартные и просто любопытные применения этого факта описаны в рецепте 7.7.
С абстрактной точки зрения файл представляет собой обычный поток байтов. Каждый файловый манипулятор ассоциируется с числом, определяющим текущую позицию внутри файла. Текущая позиция возвращается функцией tell и устанавливается функцией seek. В рецепте 7.10 мы перезаписываем файл, обходясь без закрытия и повторного открытия, — для этого мы возвращаемся к началу файла функцией seek.
Когда надобность в файловом манипуляторе отпадает, закройте его функцией close. Функция получает один аргумент (файловый манипулятор) и возвращает true, если буфер был успешно очищен, а файл — закрыт, и false в противном случае. Закрывать все манипуляторы функцией close необязательно. При открытии файла, который был открыт ранее, Perl сначала неявно закрывает его. Кроме того, все открытые файловые манипуляторы закрываются при завершении программы.
Неявное закрытие файлов реализовано для удобства, а не для повышения надежности, поскольку вы не узнаете, успешно ли завершилась системная функция. Не все попытки закрытия завершаются успешно. Даже если файл открыт только для чтения, вызов close может завершиться неудачей — например, если доступ к устройству был утрачен из-за сбоя сети. Еще важнее проверять результат close, если файл был открыт для записи, иначе можно просто не заметить переполнения диска:
close(FH) or die "FH didn't close: $'";
Усердный программист даже проверяет результат вызова close для STDOUT в конце программы на случай, если выходные данные были перенаправлены в командной строке, а выходная файловая система оказалась переполнена. Вообще-то об этом должна заботиться runtime-система, Но она этого не делает.
Впрочем, проверка STDERR выглядит сомнительно. Даже если этот поток не закроется, как вы собираетесь на это реагировать?
Манипулятор STDOUT по умолчанию используется для вывода данных функциями print, printf и write. Его можно заменить функцией select, которая получает новый и возвращает предыдущий выходной манипулятор, используемый по умолчанию. Перед вызовом select должен быть открыт новый манипулятор вывода:
$old_fh = select(LOGFILE); « Переключить вывод на LOGFILE
print "Countdown initiated ...\n";
select($old_fh); # Вернуться к выводу на прежний манипулятор
print "You have 30 seconds to reach minumum safety distance.\n";
Некоторые специальные переменные Perl изменяют поведение текущего файлового манипулятора вывода. Особенно важна переменная $ |, которая управляет
буферизацией вывода для файловых манипуляторов. Буферизация рассматривается в рецепте 7.12.
Функции ввода/вывода в Perl делятся на буферизованные и небуферизованные (табл. 7.1). Несмотря на отдельные исключения, не следует чередовать их вызовы в программе. Связь между функциями, находящимися в одной строке таблицы, весьма условна. Например, по семантике функция sys read отличается от <...>, однако они находятся в одной строке, поскольку выполняют общую задачу — получение входных данных из файлового манипулятора.
Таблица 7.1 Функции ввода/вывода в Perl
Действие Буферизованные функции Небуферизованные функции
|
Открытие |
open, sysopen |
sysopen |
|
Закрытие |
close |
close |
|
Ввод |
<.. >, readline |
sysread |
|
Вывод |
print |
syswrite |
|
Позиционирование |
seek, tell |
sysseek |
7.1. Открытие файла
Проблема
Известно имя файла. Требуется открыть его для чтения или записи в Perl.
Решение
Функция open отличается удобством, sysopen — точностью, а модуль IO::File позволяет работать с анонимным файловым манипулятором.
Функция open получает два аргумента: открываемый файловый манипулятор и строку с именем файла и специальными символами, определяющими режим открытия:
open(SOURCE, "< $path")
or die "Couldn't open $path for reading: $!\n";
open(SINK, "> $path")
or die "Couldn't open $path for writing: $!\n";
где SOURCE — файловый манипулятор для ввода, a SINK — для вывода.
Функции sysopen передаются три или четыре аргумента: файловый манипулятор, имя файла, режим и необязательный параметр, определяющий права доступа. Режим представляет собой число, конструируемое из констант модуля Fcntl:
use Fcntl;
sysopen(SOURCE, $path, O_RDONLY)
244 Глава 7 • Доступ к файлам
or die "Couldn't open $path for reading: $!\n";sysopen(SINK, $path, O_WRONLY)
or die "Couldn't open $path for writing: $!\n";
Аргументы метода new модуля IO::File могут задаваться в стиле как open, так и sysopen. Метод возвращает анонимный файловый манипулятор. Кроме того, также возможно задание режима открытия в стиле fopen(3):
use 10':File,
# По аналогии с open
$smk = 10:'File->new("> $filename")
or die 'Couldn't open $filename for writing $'\n";
# По аналогии с sysopen
$fh = IO:-File->new($filename, O_WRONLY|O_CREAT)
or die "Couldn't open $filename for reading: $'\n";
# По аналогии с fopen(3) библиотеки stdio
$fh = 10' File->new($filename, "r+")
or die "Couldn't open $filename for read and write: $'\n";
Комментарий
Все операции ввода/вывода осуществляются через файловые манипуляторы независимо от того, упоминаются манипуляторы в программе или нет. Файловые манипуляторы не всегда связаны с конкретными файлами — они также применяются для взаимодействия с другими программами (см. главу 16 «Управление процессами и межпроцессные взаимодействия») и в сетевых коммуникациях (см. главу 17 «Сокеты»). Функция open также применяется для работы с файловыми дескрипторами, данная возможность рассматривается в рецепте 7.19.
Функция open позволяет быстро и удобно связать файловый манипулятор с файлом. Вместе с именем файла передаются сокращенные обозначения стандартных режимов (чтение, запись, чтение/запись, присоединение). Функция не позволяет задать права доступа для создаваемых файлов и вообще решить, нужно ли создавать файл. Если вам потребуются подобные возможности, воспользуйтесь функцией sysopen, которая использует константы модуля Fcntl для управления отдельными компонентами режима (чтение, запись, создание и усечение).
Большинство программистов начинает работать с open задолго до первого использования sysopen. В таблице показано соответствие между режимами функции open («Файл»), константами sysopen («Флаги») и строками fopen(3), передаваемыми 10:: File->new («Символы»). Столбцы «Чтение» и «Запись» показывают, возможно ли чтение или запись для данного файлового манипулятора. «Присоединение» означает, что выходные данные всегда направляются в конец файла независимо от текущей позиции (в большинстве систем). В режиме усечения функция open уничтожает все существующие данные в открываемом файле.
|
7.1. ( |
Открытие |
файла 245 |
|||||
|
Файл |
Чтение |
Запись |
Присое- |
Созда- |
Очистка |
Флаги |
Символы |
|
динение |
ние |
содержи- |
О_ |
||||
|
мого |
|||||||
|
<файл |
Да |
Нет |
Нет |
Нет |
Нет |
RDONLY |
"г" |
|
> файл, |
Нет |
Да |
Нет |
Да |
Да |
WRONLY |
"w" |
|
режим |
TRUNC |
||||||
|
открытия> |
CREAT |
||||||
|
» файл>, |
Нет |
Да |
Да |
Да |
Нет |
WRONLY |
"a" |
|
режим |
APPEND |
||||||
|
открытия> |
CREAT |
||||||
|
+< файл |
Да |
Да |
Нет |
Нет |
Нет |
RDWR |
Mr+" |
|
+> файл, |
Да |
Да |
Нет |
Да |
Да |
RDWR |
"w+" |
|
режим |
TRUNC |
||||||
|
открытия> |
CREAT |
||||||
|
+» файл>, |
Да |
Да |
Да |
Да |
Нет |
RDWR |
"a+" |
|
режим |
APPEND |
||||||
|
открытия> |
CREAT |
Подсказка: режимы +> и +» почти никогда не используются. В первом случае файл уничтожается еще до того, как он будет прочитан, а во втором часто возникают затруднения, связанные с тем, что указатель чтения может находиться в произвольной позиции, но при записи на многих системах почти всегда происходит переход в конец файла.
Функция sysopen получает три или четыре аргумента:
sysopen(FILEHANDLE, $name, $flags) or die "Can't open $name : $!"; sysopen(FILEHANDLE, $name, $flags, $perms) or die "Can't open $name : $!";
Здесь $name — имя файла без «довесков» в виде < или +; $f lags — число, полученное объединением констант режимов O_CREAT, O_WRONLY, O_TRUNC и т. д. операцией OR. Конкретный состав доступных констант 0_ зависит от операционной системы. Дополнительные сведения модно найти в электронной документации (обычно open(2), но не всегда) или в файле /usr/include/fcntl.h. Обычно встречаются следующие константы:
O_RDONLY Только чтение.
0_WRONLY Только запись.
O_RDWR Чтение и запись.
O_CREAT Создание файла, если он не существует.
O_EXCL Неудачное завершение, если файл уже существует.
O_APPEND Присоединение к. файлу.
O_TRUNC Очистка содержимого файла.
O_NONBLOCK Асинхронный доступ.
К числу менее распространенных констант принадлежат O_SHLOCK, O_EXLOCK, O_BINARY, 0_N0CTTY и O_SYNC. Обращайтесь к странице руководства ореп(2) или к ее эквиваленту.
Если функции sysopen не передается аргумент $perms, Perl использует восьмеричное число 0666. Права доступа задаются в восьмеричной системе и учитыва-
Если у вас возникнут затруднения с масками доступа, воспользуйтесь про стым советом: передавайте значение 0666 для обычных файлов и 0777 для каталогов и исполняемых файлов. У пользователя появляется выбор: если ему понадобятся защищенные файлы, то может выбрать маску 022, 027 или антиобщественную маску 077. Как правило, решения из области распределения прав должны приниматься не программой, а пользователем. Исключения возникают при записи в файлы, доступ к которым ограничен: почтовые файлы, cookies в Web-броузерах, файлы .rhosts и т. д. Короче говоря, функция sysopen почти никогда не вызывается с аргументом 0644, так как у пользователя пропадает возможность выбрать более либеральную маску.
Приведем примеры практического использования open и sysopen.
Открытие файла для чтения:
open(FH, "< $path") or die$!;
sysopen(FH, $path, O_RDONLY) or die$!;
Открытие файла для записи (если файл не существует, он создается, а если существует — усекается):
open(FH, "> $path") or die$!
sysopen(FH, $path, O_WRONLY|O_TRUNC|O_CREAT) or die$!
sysopen(FH, $path, O_WRONLY|O_TRUNC|O_CREAT, 0600) or die$!
Открытие файла для записи с созданием нового файла (файл не должен существовать):
sysopen(FH, $path, O_WRONLY|O_EXCL|O_CREAT) or die$!;
sysopen(FH, $path, O_WRONLY|O_EXCL|O_CREAT, 0600) or die$!;
Открытие файла для присоединения (в случае необходимости файл создается):
open(FH, "» $path") or die$!;
sysopen(FH, $path, O_WRONLY|O_APPEND|O_CREAT) or die$!;
sysopen(FH, $path, O_WRONLY|O_APPEND|O_CREAT, 0600) or die$!;
Открытие файла для присоединения (файл должен существовать):
sysopen(FH, $path, O_WRONLY|O_APPEND) ordie$!;
Открытие файла для обновления (файл должен существовать):
open(FH, "+< $path") or die$!;
sysopen(FH, $path, O_RDWR) or die$!;
Открытие файла для обновления (в случае необходимости файл создается):
sysopen(FH, $path, O_RDWR|O_CREAT) or die$!;
sysopen(FH, $path, O_RDWR|O_CREAT, 0600) or die$!;
Открытие файла для обновления (файл не должен существовать):
sysopen(FH, $path, 0_RDWR|0_EXCL|0_CfiEAT) or die$!;
sysopen(FH, $path, O_RDWR|O_EXCL|O_CREAT, 0600) or die$!;
Маска 0600 всего лишь поясняет, как создаются файлы с ограниченным доступом. Обычно этот аргумент пропускается.
> Смотри также---------------------------------------------------------------------------------------------
Описание функций open, sysopen и umask в perlfunc(i); документация по стан- * дартным модулям IO::File и Fcntl; страницы руководства open(2), fopen(3) и umask(2); рецепт 7.2.
7.2. Открытие файлов с нестандартными именами
Проблема
Требуется открыть файл с нестандартным именем — например, "-"; начинающимся с символа <, > или |; содержащим начальные или конечные пропуски; заканчивающимся символом |. Функция open не должна принимать эти функции за служебные, поскольку вам нужно совершенно иное.
Решение
Выполните предварительное преобразование:
Sfilename =' s#"(\s)#./$1#;
open(HANDLE, "< $filename\0") or die "cannot open $filenaroe : $!\n";
Или просто воспользуйтесь функцией sysopen:
sysopen(HANDLE, Sfilename, O_RDONLY) or die "cannot open Sfilename : $!\n";
Комментарий
Функция open определяет имя файла и режим открытия по одному строковому аргументу. Если имя файла начинается с символа, обозначающего один из режимов, open вполне может сделать что-нибудь неожиданное. Рассмотрим следующий фрагмент:
Sfilename = shift @ARGV;
open(INPUT, $filename) or die "cannot open Sfilename : $!\n";
Если пользователь указывает в командной строке файл ">/etc/passwd", программа попытается открыть /etc/passwd для записи — со всеми вытекающими последствиями! Режим можно задать и явно (например, для записи):
open(OUTPUT, ">$filename")
or die "Couldn't open Sfilename for writing: $!\n";
но даже в этом случае пользователь может ввести имя ">data", после чего программа будет дописывать данные в конец файла data вместо того, чтобы стереть прежнее содержимое.
use Fcntl; # Для файловых констант
sysopen(OUTPUT, $filename, O_WRONLY|O_TRUNC)
or die "Couldn't open $filename for writing $'\n";
А вот как добиться того же эффекта с функцией open для имен файлов, содержащих начальные или конечные пропуски:
$file =' s#~(\s)# /$1#, open(HANDLE, ¦> $file\0")
or die "Could't open $file for OUTPUT $>\n";
Такая подстановка защищает исходные пропуски, но не в абсолютных именах типа " /etc/passwd", а лишь в относительных (" passwd"). Функция open не считает нуль-байт ("\0") частью имени файла, но благодаря ему не игнорируются конечные пропуски.
Волшебная интерпретация файловых имен в функции open почти всегда оказывается удобной. Вам никогда не приходится обозначать ввод или вывод с помощью особой формы " -'. Если написать фильтр и воспользоваться простой функцией open, пользователь сможет передать вместо имени файла строку "gzip -de bible.gz|" — фильтр автоматически запустит программу распаковки.
Вопросы безопасности open актуальны лишь для программ, работающих в особых условиях. Если программа должна работать под управлением чего-то другого — например, сценариев CGI или со сменой идентификатора пользователя, — добросовестный программист всегда учтет возможность ввода пользователем собственного имени файла, при котором вызов open для простого чтения превратится в перезапись файла или даже запуск другой программы. Параметр командной строки Perl -T обеспечивает проверку ошибок.
> Смотри также---------------------------------------------------------------------------------------------
Описание функций open и sysopen вperlfunc(l); рецепты 7.1, 7.7,16.2, 19.4 и 19.6.
7.3. Тильды в именах файлов
Проблема
Имя файла начинается с тильды (например, -username/blah), однако функция open не интерпретирует его как обозначение домашнего каталога (home directory).
Решение
Выполните ручное расширение с помощью следующей подстановки:
$filename =" s{ " " ( ["/]* ) } { $1
? (getpwnam($1))[7]
( $ENV{HOME} || $ENV{LOGDIR}
(getpwurd($>))[7]
) >ех,
Комментарий
Нас интересуют следующие применения тильды:
-user -user/blah
-/blah
где user — имя пользователя.
Если " не сопровождается никаким именем, используется домашний каталог текущего пользователя.
В данной подстановке использован параметр /е, чтобы заменяющее выражение интерпретировалось как программный код Perl. Если за тильдой указано имя пользователя, оно сохраняется в $1 и используется getpwnam для выбора домашнего каталога пользователя из возвращаемого списка. Найденный каталог образует заменяющую строку. Если за тильдой не указано имя пользователя, подставляется либо текущее значение переменной окружения НОМЕ или LOGOIR. Если эти переменные не определены, задается домашний каталог текущего пользователя.
С> Смотри также------------------------------------------------------------------------------------------
Описание функции getpwnam вperlfunc(l); man-страница getpwnam(2) вашей системы; рецепт 9.6.
7.4. Имена файлов в сообщениях об ошибках
Проблема
Программа работает с файлами, однако в предупреждения и сообщения об ошибках Perl включается только последний использованный файловый манипулятор, а не имя файла.
Решение
Воспользуйтесь именем файла вместо манипулятора:
open($path, "< $path")
or die "Couldn't open $path for reading • $!\n";
Комментарий
Стандартное сообщение об ошибке выглядит так:
Argument "3\п" isn't numeric in multiply at tallyweb line 16, <LOG> chunk 17.
Argument "3\n" isn't numeric in multiply at tallyweb line 16, </usr/local/data/mylog3.dat> chunk 17.
К сожалению, этот вариант не работает при включенной директиве strict ref s, поскольку переменная $path в действительности содержит не файловый манипулятор, а всего лишь строку, которая иногда ведет себя как манипулятор. Фрагмент (chunk), упоминаемый в предупреждениях и сообщениях об ошибках, представляет собой текущее значение переменной $..
> Смотри также---------------------------------------------------------------------------------------------
Описание функции open вperlfunc(l); рецепт 7.1.
7.5. Создание временных файлов
Проблема
Требуется создать временный файл и автоматически удалить его при завершении программы. Допустим, вы хотите записать временный конфигурационный файл, который будет передаваться запускаемой программе. Его имя должно быть известно заранее. В других ситуациях нужен временный файл для чтения и записи данных, причем его имя вас не интересует.
Решение
Если имя файла не существенно, воспользуйтесь методом класса new_tmpfile модуля IO::File для получения файлового манипулятора, открытого для чтения и записи:
use 10::File;
$fh = 10::File->new_tmpfile
or die "Unable to make new temporary file: $!";
Если имя файла должно быть известно, получите его функцией tmpnam из модуля POSIX и откройте файл самостоятельно:
use 10::File;
use POSIX qw(tmpnam);
# Пытаться получить временное имя файла до тех пор,
8 пока не будет найдено несуществующее имя
do { $name = tmpnamQ }
until $fh = IO::File->new($name, O_RDWR|O_CREAT|O_EXCL);
# Установить обработчик, который удаляет временный файл
# при нормальном или аварийном завершении программы
7.5. Создание временных файлов 251
END { unlmk($name) or die "Couldn't unlink $name : $!" } # Перейти к использованию файла...
Комментарий
Если все, что вам нужно, — область для временного хранения данных, воспользуйтесь методом new_tmpf ile модуля IO::File. Он возвращает файловый манипулятор для временного файла, открытого в режиме чтения/записи фрагментом следующего вида:
for (;;) {
$name = tmpnam();
sysopen(TMP, $tmpnam, O_RDWR | O_CREAT | O_EXC) 4& last; } unlink $tmpnam;
Файл автоматически удаляется при нормальном или аварийном завершении программы. Вам не удастся определить имя файла и передать другому процессу, потому что у него нет имени. В системах с поддержкой подобной семантики имя удаляется еще до завершения метода. Впрочем, открытый файловый манипулятор может наследоваться производными процессами1.
Ниже показан пример практического применения new_tmpf ile. Мы создаем временный файл, выполняем запись, возвращаемся к началу и выводим записанные данные:
use 10::File;
$fh = 10: :File->new_tmpfile or die "10:.File->new_tmpfile: $!";
$fh->autoflush(1);
print( $fh "$i\n" while $i++ < 10;
seek($fh, 0, 0);
print "Trap file has: ", <$fh>;
Во втором варианте создается временный файл, имя которого можно передать другому процессу. Мы вызываем функцию POSIX: :tmpnam, самостоятельно открываем файл и удаляем его после завершения работы. Перед открытием файла мы не проверяем, существует ли файл с таким именем, поскольку при этом может произойти подмена — кто-нибудь создаст файл между проверкой и созданием2. Вместо этого tmpnam вызывается в цикле, что гарантирует создание нового файла и предотвращает случайное удаление существующих файлов. Теоретически метод new_tmpf ile не должен возвращать одинаковые имена разным процессам.
> Смотри также---------------------------------------------------------------------------------------------
Документация по стандартным модулям IO::File и POSIX; рецепт 7.19; страница руководства tmpnam(3) вашей системы.
2 См. рецепт 19.4.
Проблема
Некоторые данные должны распространяться вместе с программой и интерпретироваться как файл, но при этом они не должны находиться в отдельном файле.
Решение
Лексемы_ DATA и__ END после исходного текста программы отмечают начало
блока данных, который может быть прочитан программой или модулем через файловый манипулятор DATA.
В модулях используется лексема____ DATA :
while (<DATA>) {
# Обработать строку
}
__DATA__
# Данные
Аналогично используется____ END в главном файле программы:
while (<main::DATA>) {
# Обработать строку
}
_ END
# Данные
Комментарий
Лексемы_ DATA и__ END_ обозначают логическое завершение модуля или
сценария перед физическим концом файла. Текст, находящийся после DATA
или END_ , может быть прочитан через файловый манипулятор DATA уровня па
кета. Предположим, у нас имеется гипотетический модуль Primes; текст пост
ле_ DATA в файле Primes.pm может быть прочитан через файловый манипуля
тор Primes: :DATA.
Лексема_ END________________________ представляет собой синоним DATA в главном пакете. Текст,
следующий после лексем___ END в модулях, недоступен.
Появляется возможность отказаться от хранения данных в отдельном файле и перейти к построению автономных программ. Такая возможность нередко используется для документирования. Иногда в программах хранятся конфигурационные или старые тестовые данные, использованные при разработке программ, — они могут пригодиться в процессе отладки.
Манипулятор DATA также применяется для определения размера или даты последней модификации текущей программы или модуля. В большинстве систем переменная $0 содержит полное имя файла для работающего сценария. В тех системах, где значение $0 оказывается неверным, можно воспользоваться манипулятором DATA для определения размера, даты модификации и т. д. Вставьте в конец файла
специальную лексему DATA________________________ (и предупреждение о том, что DATA не следует
удалять), и файловый манипулятор DATA будет связан с файлом сценария.
7.7. Создание фильтра 253
use POSIX qw(strftime);
$raw_time = (stat(DATA))[9];
$size = -s DATA;
$kilosize = mt($size / 1024) . 'k';
print "<p>Script size is $kilosize\n";
print strftime("<P>Last script update: %c (%Z)\n", localtime($raw_time));
__DATA__
DO NOT REMOVE THE PRECEDING LINE
Everything else in this file will be ignored.
> Смотри также---------------------------------------------------------------------------------------------
Раздел «Scalar Value Constructors» perldata(l).
7.7. Создание фильтра
Проблема
Вы хотите написать программу, которая получает из командной строки список файлов. Если файлы не заданы, входные данные читаются из STDIN. При этом пользователь должен иметь возможность передать программе " -" для обозначения STDIN или "someprogram |" для получения выходных данных другой программы. Программа может непосредственно модифицировать файлы или выводить результаты на основании входных данных.
Решение
Читайте строки оператором, оператор> <>:
while (о) {
# Сделать что-то со строкой
Комментарий
Встречая конструкцию:
while (о) {
Perl преобразует ее к следующему виду1:
unshift(@ARGV, ¦-') unless @ARGV; while($ARGV = shift @ARGV) {
unless (open(ARGV, $ARGV)) {
next; } while (defined($_ = <ARGV>)) {
#...
Внутри цикла с помощью ARGV и $ARGV можно получить дополнительные данные или узнать имя текущего обрабатываемого файла. Давайте посмотрим, как это делается.
Общие принципы
Если пользователь не передает аргументы, Perl заносит в @ARGV единственную строку,"-". Это сокращенное обозначение соответствует STDIN при открытии для чтения и STDOUT — для записи. Кроме того, пользователь может передать "-"в командной строке вместо имени файла для получения входных данных из STDIN.
Далее в цикле из @ARGV последовательно извлекаются аргументы, а имена файлов копируются в глобальную переменную SARGV. Если файл не удается открыть, Perl переходит к следующему файлу. В противном случае начинается циклическая обработка строк открытого файла. После завершения обработки открывается следующий файл, и процесс повторяется до тех пор, пока не будет исчерпано все содержимое @ARGV.
При вызове open не используется форма open(ARGV, "> $ARGV"). Это позволяет добиться интересных эффектов — например, передать в качестве аргумента строку "gzip -de file, gz |", чтобы программа получила в качестве входных данных результаты команды "gzip -de file. gz". Такое применение open рассматривается в рецепте 16.15.
Массив @ARGV может изменяться перед циклом или внутри него. Предположим, вы хотите, чтобы при отсутствии аргументов входные данные читались не из STDIN, а из всех программных и заголовочных файлов С и C++. Вставьте следующую строку перед началом обработки <ARGV>:
@ARGV = glob("*.[Cch]") unless @ARGV;
Перед началом цикла следует обработать аргументы командной строки — либо с помощью модулей Getopt (см. главу 15 «Пользовательские интерфейсы»), либо вручную:
# Аргументы 1: Обработка необязательного флага -с if ((°>ARGV && $ARGV[O] eq '-с') {
$chop_first++;
shift;
# Аргументы 2; Обработка необязательного флага -NUMBER if (@ARGV && $ARGV[0] =* /"-(\d+)$/) {
Scolumns = $1;
shift;
7.7. Создание фильтра 255
>
# Аргументы 3: Обработка сгруппированных флагов -a, -i -n, и -и while (@ARGV && $ARGV[0] =" /"-(.+)/ & (shift, ($_ = $1), 1)) {
next if /"$/;
s/a// && (++$append, redo);
s/i// && (++$ignore_ints, redo);
s/n// && (++$nostdout, redo);
s/u// && (++$unbuffer, redo);
die "usage: $0 [-ainu] [filenames] ...\n";
Если не считать неявного перебора аргументов командной строки, о не выделяется ничем особенным. Продолжают действовать все специальные переменные, управляющие процессом ввода/вывода (см. главу 8). Переменная $/ определяет разделитель записей, а $. содержит номер текущей строки (записи). Если $/ присваивается неопределенное значение, то при каждой операции чтения будет получено не объединенное содержимое всех файлов, а полное содержимое одного файла:
undef $/; while (о) {
# Теперь в $_ находится полное содержимое файла,
# имя которого хранится в $ARGV
Если значение $/ локализовано, старое значение автоматически восстанавливается при выходе из блока:
{ и Блок для local
local $/; # Разделитель записей становится неопределенным while (<>) {
# Сделать что-то; в вызываемых функциях
# значение $/ остается неопределенным
} # Восстановить $/
Поскольку при обработке <ARGV> файловые манипуляторы никогда не закрываются явно, номер записи $. не сбрасывается. Если вас это не устраивает, самостоятельно организуйте явное закрытие файлов для сброса $.:
while (о) {
print "$ARGV:$.:$_"; close ARGV if eof;
Функция eof проверяет достижение конца файла при последней операции чтения. Поскольку последнее чтение выполнялось через манипулятор ARGV, eof сообщает, что мы находимся в конце текущего файла. В этом случае файл закрывается, а переменная $. сбрасывается. С другой стороны, специальная запись eof () с круглыми скобками, но без аргументов проверяет достижение конца всех файлов при обработке <ARGV>.
В Perl предусмотрены специальные параметры командной строки —п, -р и -i,
упрощающие написание фильтров и однострочных программ.
Параметр -п помещает исходный текст программы внутрь цикла while(o). Обычно он используется в фильтрах типа grep или программах, которые накапливают статистику по прочитанным данным.
Пример 7.1. findloginl
#!/usr/bin/perl
# findloginl - вывести все строки, содержащие подстроку "login"
while (о) { # Перебор файлов в командной строке
print if /login/; >
Программу из примера 7.1 можно записать так, как показано в примере 7.2.
Пример 7.2. findlogin2
#!/usr/bin/perl -n
# findlogin2 - вывести все строки, содержащие подстроку "login"
print if /login/;
Параметр -n может объединяться с -е для выполнения кода Perl из командной строки:
% perl -ne 'print if /login/'
Параметр -р аналогичен -п, однако он добавляет print в конец цикла. Обычно он используется в программах для преобразования входных данных.
Пример 7.3. lowercasel
#!/usr/bin/perl
# lowercase - преобразование всех строк в нижний регистр
use locale;
while (<>) { # Перебор в командной строке
s/(["\W0-9_])/\l$1/g; # Перевод всех букв в нижний регистр
print; }
Программу из примера 7.3 можно записать так, как показано в примере 7.4. Пример 7.4. Iowercase2
#!/usr/bin/perl -p
# lowercase - преобразование всех строк в нижний регистр
use locale;
s/(["\W0-9_])/\l$1/g; # Перевод всех букв в нижний регистр
Или непосредственно в командной строке следующего вида:
% perl -Mlocale -pe 's/(["\W0-9_])/\1$1/g'
При использовании —п или —р для неявного перебора входных данных для всего цикла негласно создается специальная метка LINE:. Это означает, что из внутреннего цикла можно перейти к следующей входной записи командой next LINE (аналог next в awk). При закрытии ARGV происходит переход к следующему файлу (аналог nextfile в awk). Обе возможности продемонстрированы в примере 7.5.
Пример 7.5. countchunks
#'/usr/bin/perl -n
# countchunks - подсчет использованных слов
# с пропуском комментариев. При обнаружении _ END или DATA
# происходит переход к следующему файлу
for (split /\W+/) <
next LINE if /"#/;
close ARGV if /__(DATA|END)__/;
$chunks++; } END { print "Found $chunks chunks\n" }
В файле .history, создаваемым командным интерпретатором tcsh, перед каждой строкой указывается время, измеряемое в секундах с начала эпохи:
#+0894382237
less /etc/motd
#+0894382239
vi V.exrc
#+0894382242
date
#+0894382239
who
#+0894382288
telnet home
Простейшая однострочная программа приводит его к удобному формату:
%perl -ре ls/"#\+(\d+)\n/localtime($1) . " "/е1
Tue May 5 09:30:37 1998 less /etc/motd
Tue May 5 09:30:39 1998 vi "/.exrc
Tue May 5 09:30:42 1998 date
Tue May 5 09:30:42 1998 who
Tue May 5 09:30:28 1998 telnet home
Параметр -i изменяет каждый файл в командной строке. Он описан в рецепте 7.9 и обычно применяется в сочетании с -р.
Для работы с национальными наборами символов используется директива use
locale.
> Смотри также------------------
perlrun(l); рецепты 7.9; 16.6.
Проблема
Требуется обновить содержимое файла на месте. При этом допускается применение временного файла.
Решение
Прочитайте данные из исходного файла, запишите изменения во временный файл и затем переименуйте временный файл в исходный:
open(0LD, "< $old") or die "can't open $old. $!",
open(NEW, "< $new") or die "can't open $new $!";
select(NEW); # Новый файловый манипулятор,
# используемый print по умолчанию while (<OLD>) {
# Изменить $_, затем. .
print NEW $_ or die 'can't write $new: $'";
>
close(OLD) or die "can't close Sold $'";
close(NEW) or die 'can t close $new: $'";
rename($old, "$old.orig") or die "can t rename Sold to Sold orig: $! ';
rename($new, Sold) or die "can t rename $new to Sold. $!";
Такой способ лучше всего приходит для обновления файлов «на месте».
Комментарий
Этот метод требует меньше памяти, чем другие подходы, не использующие временных файлов. Есть и другие преимущества — наличие резервной копии файла, надежность и простота программирования.
Показанная методика позволяет внести в файл те же изменения, что и другие версии, не использующие временных файлов. Например, можно вставить новые строки перед 20-й строкой файла:
while (<OLD>) {
if ($. == 20) {
print NEW "Extra line 1\n";
print NEW "Extra line 2\n";
>
print NEW $_;
}
Или удалить строки с 20 по 30:
while (<OLD>) {
next if 20 .. 30; print NEW $_;
Программист-перестраховщик непременно заблокирует файл на время обновления.
£> Смотри также-------------------------------------------------------------------------------------------
Рецепты 7.1; 7.9-7.10
7.9. Непосредственная модификация файла с помощью параметра -i
Проблема
Требуется обновить файл на месте из командной строки, но вам лень1 возиться с файловыми операциями из рецепта 7.8.
Решение
Воспользуйтесь параметрами -i и -р командной строки Perl. Запишите свою программу в виде строки:
% perl -l.orig -p 'ФИЛЬТР' файл1 файл2 файлЗ ...
Или воспользуйтесь параметрами в самой программе:
#!/usr/bin/perl -l.orig -p # Фильтры
Комментарий
Параметр командной строки -i осуществляет непосредственную модификацию файлов. Он создает временный файл, как и в предыдущем рецепте, однако Perl берет на себя все утомительные хлопоты с файлами. Используйте -i в сочетании с -р (см. рецепт 7.7), чтобы превратить:
% perl -pi.ong -e 's/DATE/localtime/e' в следующий фрагмент:
while (о) {
if ($ARGV ne Soldargv) { # Мы перешли к следующему файлу'
rename($ARGV, $ARGV '.ong'), open(ARGVOUT, ">$ARGV); # Плюс проверка ошибок select(ARGVOUT); Soldargv = $ARGV; >
s/DATE/localtime/e; } continue!
}
select (STDOUT); # Восстановить стандартный вывод
Параметр -i заботится о создании резервных копий (если вы не желаете сохранять исходное содержимое файлов, используйте -i вместо -i.orig), а -р заставляет Perl перебирать содержимое файлов, указанных в командной строке (или STDIN при их отсутствии).
Приведенная выше однострочная программа приводит данные:
Dear Sir/Madam/Ravenous Beast,
As of DATE, our records show your account is overdue Please settle by the end of the month. Yours in cheerful usury,
--A. Moneylender
к следующему виду:
Dear Sir/Madam/Ravenous Beast,
As of Sat Apr 25 12¦ 28 33 1998, our records show your account is overdue. Please settle by the end of the month Yours in cheerful usury,
--A Moneylender
Этот параметр заметно упрощает разработку и чтение программ-трансляторов. Например, следующий фрагмент заменяет все изолированные экземпляры "hisvar" на "hervar" во всех файлах С, C++ иуасс:
%perl -I old -pe 's{\bhisvar\b}{hervar}g * [Cchy]
%perl -l.old -ne print unless /"STARTS/ . /"ENDS/ bigfile text
Действие -i может включаться и выключаться с помощью специальной переменной $"1. Инициализируйте @>ARGV и затем примените <> так, как применили бы -i для командной строки:
# Организовать перебор файлов *.с в текущем каталоге,
# редактирование на месте и сохранение ста'рого файла с расширением . опд
local $"I = '.orig'; # Эмулировать -l.ong
local @ARGV = glob('*.C); # Инициализировать список файлов while (о) {
if ($ == 1) {
print "This line should appear at the top of each file\n",
}
s/\b(p)earl\b/{1}erl/ig, # Исправить опечатки с сохранением регистра
print; } continue {close ARGV if eof)
Учтите, что при создании резервной копии предыдущая резервная копия уничтожается.
> Смотри также---------------------------------------------------------------------------------------------
Описание переменных $"1 и $. Bperlvar(l); описание оператора . . в разделе «Range Operator» perlop(l); perlrun{\).
Проблема
Требуется вставить, удалить или изменить одну или несколько строк файла. При этом вы не хотите (или не можете) создавать временный файл.
Решение
Откройте файл в режиме обновления ("+<"), прочитайте все его содержимое в массив строк, внесите необходимые изменения в массиве, после чего перезапишите файл и выполните усечение до текущей позиции.
open(FH, "+< FILE" or die "Opening: $'";
@ARRAY = <FH>;
# Модификация массива ARRAY
seek(FH,O,O) or die "Seeking: $!";
print FH ©ARRAY or die "Printing: $!";
truncate(FH,tell(FH)) or die "Truncating: $•";
close(FH) or die "Closing: $'";
Комментарий
Как сказано во введении, операционная система интерпретирует файлы как неструктурированные потоки байтов. Из-за этого вставка, непосредственная модификация или изменение отдельных битов невозможны (кроме особого случая, рассматриваемого в рецепте 8.13 — файлов с записями фиксированной длины). Для хранения промежуточных данных можно воспользоваться временным файлом. Другой вариант — прочитать файл в память, модифицировать его и записать обратно.
Чтение в память всего содержимого подходит для небольших файлов, но с большими возникают сложности. Попытка применить его для 800-мегабайтных файлов журналов на Web-сервере приведет либо к переполнению виртуальной памяти, либо общему сбою системы виртуальной памяти вашего компьютера. Однако для файлов малого объема подойдет такое решение:
open(F, "+< $infile") or die "can't read $infile: $'"; $out = "; while (<F>) {
s/DATE/localt ime/eg;
$out .= $_;
seek(F, 0, 0) print F $out truncate(F, tell(F)) close(F)
or die "Seeking: $!"; or die "Printing: $!"; or die "Truncating: $! or die "Closing: $!";
Другие примеры операций, которые могут выполняться на месте, приведены в рецептах главы 8.
Если вы особо мнительны, не забудьте заблокировать файл.
> Смотри также------------------------------------------------------------------------
Описание функций seek, truncate, open и sysopen вperlfunc{\); рецепты 7.8—7.9.
7.11. Блокировка файла
Проблема
Несколько процессов одновременно пытаются обновить один и тот же файл.
Решение
Организуйте условную блокировку с помощью функции flock:
open(FH, "+< $path") or die "can't open $path- $'";
flock(FH,2) or die "can't flock $path. $' ';
# Обновить файл, затем...
close(FH) or die "can't close $path. $'";
Комментарий
Операционные системы сильно отличаются по типу и степени надежности используемых механизмов блокировки. Perl старается предоставить программисту рабочее решение даже в том случае, если операционная система использует другой базовый механизм. Функция flock получает два аргумента: файловый манипулятор и число, определяющее возможные действия с данным манипулятором. Числа обычно представлены символьными константами типа LOCK_EX, имена которых можно получить из модуля Fcntl или IO::File.
Символические константы LOCK_SH, LOCK_EX, LOCK_UN и LOCK_NB появились в модуле Fcntl лишь начиная с версии 5.004, но даже теперь они доступны лишь по специальному запросу с тегом : flock. Они равны соответственно 1, 2, 4 и 8, и эти значения можно использовать вместо символических констант. Нередко встречается следующая запись:
sub LOCK_SH() { 1 > # Совместная блокировка (для чтения)
sub LOCK_EX() { 2 } # Монопольная блокировка (для записи)
sub LOCK_NB() { 4 } # Асинхронный запрос блокировки
sub LOCK_UN() { 8 } # Снятие блокировки (осторожно!)
Блокировки делятся на две категории: совместные (shared) и монопольные (exclusive). Термин «монопольный» может ввести вас в заблуждение, поскольку процессы не обязаны соблюдать блокировку файлов. Иногда говорят, что flock реализует условную блокировку, чтобы операционная система могла приостано-
вить все операции записи в файл до того момента, когда с ним закончит работу последний процесс чтения.
Условная блокировка напоминает светофор на перекрестке. Светофор работает лишь в том случае, если люди обращают внимание на цвет сигнала: красный или зеленый — или желтый для условной блокировки. Красный цвет не останавливает движение; он всего лишь сообщает, что движение следует прекратить. Отчаянный, невежественный или просто наглый водитель проедет через перекресток независимо от сигнала светофора. Аналогично работает и функция flock — она тоже блокирует другие вызовы flock, а не процессы, выполняющие ввод/вывод. Правила должны соблюдаться всеми, иначе могут произойти (и непременно произойдут) несчастные случаи.
Добропорядочный процесс сообщает о своем намерении прочитать данные из файла, запрашивая блокировку LOCK_SH. Совместная блокировка файла может быть установлена сразу несколькими процессами, поскольку они (предположительно) не будут изменять данные. Если процесс собирается произвести запись в файл, он должен запросить монопольную блокировку с помощью LOCK_EX. Затем операционная система приостанавливает этот процесс до снятия блокировок остальными процессами, после чего приостановленный процесс получает блокировку и продолжает работу. Можно быть уверенным в том, что на время сохранения блокировки никакой другой процесс не сможет выполнить flock(FH, LOCK_EX) для того же файла. Это похоже на другое утверждение — «в любой момент для файла может быть установлена лишь одна монопольная блокировка», но не совсем эквивалентно ему. В некоторых системах дочерние процессы, созданные функцией fork, наследуют от своих родителей не только открытые файлы, но и установленные блокировки. Следовательно, при наличии монопольной блокировки и вызове fork без exec производный процесс может унаследовать монопольную блокировку файла.
Функция flock по умолчанию приостанавливает процесс. Указывая флаг LOCK_NB, при запросе можно получить блокировку без приостановки. Благодаря этому можно предупредить пользователя об ожидании снятия блокировок другими процессами:
unless (flock(FH, LOCK_EX|LOCK_NB)) {
warn "can't immediately write-lock the file ($!), blocking ..."; unless (flock(FH, LOCK_EX)) {
die "can't get write-lock on numfile: $!";
Если при использовании LOCK_NB вам было отказано в совместной блокировке, следовательно, кто-то другой получил LOCK_EX и обновляет файл. Отказ в монопольной блокировке означает, что другой процесс установил совместную или монопольную блокировку, поэтому пытаться обновлять файл не следует.
Блокировки исчезают с закрытием файла, что может произойти лишь после завершения процесса. Ручное снятие блокировки без закрытия файла — дело рискованное. Это связано с буферизацией. Если между снятием блокировки и очисткой буфера проходит некоторое время, то данные, заменяемые содержимым буфера, могут быть прочитаны другим процессом. Более надежный путь выглядит так:
264 Глава 7 • Доступ к файлам
if ($] < 5.004) { # Проверить версию Perlmy $old_fh = select(FH);
local $|=1; # Разрешить буферизацию команд
local $\ = ''; # Очистить разделитель выходных записей
print ""; 8 Вызвать очистку буфера
select($old_fh); # Восстановить предыдущий манипулятор
}
flock(FH, LOCKJJN);
До появления Perl версии 5.004 очистку буфера приходилось выполнять принудительно. Программисты часто забывали об этом, поэтому в 5.004 снятие блокировки изменилось так, чтобы несохраненные буферы очищались непосредственно перед снятием блокировки.
А вот как увеличить число в файле с применением flock:
use Fcntl qw(:DEFAULT .-flock);
sysopen(FH, "numfile", O_RDWR|O_CREAT)
or die "can't open numfile: $!";
flock(FH, LOCK.EX) or die "can't write-lock numfile: $!";
# Блокировка получена, можно выполнять ввод/вывод
$num = <FH> || 0; # HE ИСПОЛЬЗУЙТЕ "or" !!
seek(FH, 0, 0) or die "can't rewind numfile : $'";
truncate(FH, 0) or die "can't truncate numfile: $!";
print FH $num+1, "\n" or die "can't write numfile: $!";
close(FH) or die "can't close numfile: $!";
Закрытие файлового манипулятора приводит к очистке буферов и снятию блокировки с файла. Функция truncate описана в главе 8.
С блокировкой файлов дело обстоит сложнее, чем можно подумать — и чем нам хотелось бы. Блокировка имеет условный характер, поэтому если один процесс использует ее, а другой — нет, все идет прахом. Никогда не используйте факт существования файла в качестве признака блокировки, поскольку между проверкой существования и созданием файла может произойти вмешательство извне. Более того, блокировка файлов подразумевает концепцию состояния и потому не соответствует моделям некоторых сетевых файловых систем — например, NFS. Хотя некоторые разработчики утверждают, что fcntl решает эти проблемы, практический опыт говорит об обратном.
В блокировках NFS участвует как сервер, так и клиент. Соответственно, нам не известен общий механизм, гарантирующий надежную блокировку в NFS. Это возможно в том случае, если некоторые операции заведомо имеют атомарный характер в реализации сервера или клиента. Это возможно, если и сервер, и клиент поддерживают flock или fcntl; большинство не поддерживает. На практике вам не удастся написать код, работающий в любой системе.
Не путайте функцию Perl flock с функцией SysV lockf. В отличие от lockf flock блокирует сразу весь файл. Perl не обладает непосредственной поддержкой lockf. Чтобы заблокировать часть файла, необходимо использовать функцию fcntl (см. программу lockarea в конце главы).
> Смотри также---------------------------------------------------------------------------------------------
Описание функций flock и fcntl в perlfunc(l); документация по стандартным модулям Fcntl и DB_File; рецепт 7.21—7.22.
7.12. Очистка буфера
Проблема
Операция вывода через файловый манипулятор выполняется не сразу. Из-за этого могут возникнуть проблемы в сценариях CGI на некоторых Web-серверах, враждебных по отношению к программисту. Если Web-сервер получит предупреждение от Perl до того, как увидит (буферизованный) вывод вашего сценария, он передает броузеру малосодержательное сообщение 500 Server Error. Проблемы буферизации возникают при одновременном доступе к файлам со стороны нескольких программ и при взаимодействии с устройствами или сокетами.
Решение
Запретите буферизацию, присвоив истинное значение (обычно 1) переменной $ | на уровне файлового манипулятора:
$old_fh = select(OUTPUT_HANDLE);
$1 = 1;
select($old_fh);
Или, если вас не пугают последствия, вообще запретите буферизацию вызовом метода autof lush из модулей 10:
use 10':Handle; OUTPUT_HANDLE->autoflush( 1);
Комментарий
В большинстве реализаций stdio буферизация определяется типом выходного устройства. Для дисковых файлов применяется блочная буферизация с размером буфера, превышающим 2 Кб. Для каналов (pipes) и сокетов часто применяется буфер размера от 0,5 до 2 Кб. Последовательные устройства, к числу которых относятся терминалы, модемы, мыши и джойстики, обычно буферизуются построчно; stdio передает всю строку лишь при получении перевода строки.
Функция Perl print не поддерживает по-настоящему небуферизованного вывода — физической записи каждого отдельного символа. Вместо этого поддерживается командная буферизация, при которой физическая запись выполняется после каждой отдельной команды вывода. По сравнению с полным отсутствием буферизации обеспечивается более высокое быстродействие, при этом выходные данные получаются сразу же после вывода.
Для управления буферизацией вывода используется специальная переменная $|. Присваивая ей true, вы тем самым разрешаете командную буферизацию.
Пример 7.6. seeme
#!/usr/bin/perl -w
# seeme - буферизация вывода в stdio
$| = (@ARGV > 0); # Командная буферизация при наличии аргументов
print "Now you don't see it...";
sleep 2;
print "now you do\n";
Если программа запускается без аргументов, STDOUT не использует командную буферизацию. Терминал (консоль, окно, сеанс telnet и т. д.) получит вывод лишь после завершения всей строки, поэтому вы ничего не увидите в течение 2 секунд, после чего будет выведена полная строка "Now you don't see it... now you do".
В сомнительном стремлении к компактности кода программисты включают возвращаемое значение select (файловый манипулятор, который был выбран в настоящий момент) в другой вызов select:
select((select(OUTPUT_HANDLE), $| = 1)[0]);
Существует и другой выход. Модули FileHandle и 10 содержат метод autof lush. Его вызов с аргументом true или false (по умолчанию используется true) управляет автоматической очисткой буфера для конкретного выходного манипулятора:
use FileHandle;
STDERR->autoflush; # Уже небуферизован в stdio $filehandle->autoflush(0);
Если вас не пугают странности косвенной записи (см. главу 13 «Классы, объекты и связи»), можно написать нечто похожее на обычный английский текст:
use 10: -.Handle;
# REMOTE_CONN - манипулятор интерактивного сокета,
# a DISK_F1LE - манипулятор обычного файла.
autoflush REMOTE_CONN 1; # Отказаться от буферизации для ясности autoflush DISK_FIIE 0; # Буферизовать для повышения быстродействия
Мы избегаем жутких конструкций select, и программа становится более понятной. К сожалению, при этом увеличивается время компиляции, поскольку включение модуля IO::Handle требует чтения и компиляции тысяч строк кода. Научитесь напрямую работать с $ |, этого будет вполне достаточно.
Чтобы выходные данные оказались в нужном месте в нужное время, необходимо позаботиться о своевременной очистке буфера. Это особенно важно для соке-тов, каналов и устройств, поскольку они нередко участвуют в интерактивном вводе/выводе, а также из-за того, что вы не сможете полагаться на построчную буферизацию. Рассмотрим программу из примера 7.7.
7.13. Асинхронное чтение из нескольких манипуляторов 267 Пример 7.7. getcomidx
#!/usr/bin/perl# getpcomidx - получить документ index.html с www.perl.com
use 10::Socket;
$sock = new 10::Socket::INET (PeerAddr => 'www.perl.com',
PeerPort => 'http(80)'); die "Couldn't create socket: $@" unless $sock;
# библиотека не поддерживает $!; в ней используется $@
$sock->autoflush(1);
# На Mac \n\n «обязательно» заменяется последовательностью \015\012\015\012.
# Спецификация рекомендует это и для других систем,
# однако в реализациях рекомендуется поддерживать и "\cJ\cJ".
# Наш опыт показывает, что именно так и получается.
$sock->print("GET /index.html http/1.1\n\n");
Sdocument = joinC', $sock->getlmes());
print "DOC IS: $document\n";
Ни один из рассмотренных нами типов буферизации не позволяет управлять буферизацией ввода. Для этого обращайтесь к рецептам 15.6 и 15.8.
> Смотри также---------------------------------------------------------------------------------------------
Описание переменной $| вperlvar(l); описание функции select вperlfunc(i); документация по стандартным модулям FileHandle и IO::Handle.
7.13. Асинхронное чтение из нескольких манипуляторов
Проблема
Вы хотите узнавать о наличии данных для чтения, вместо того чтобы приостанавливать процесс в ожидании ввода, как это делает о. Такая возможность пригодится при получении данных от каналов, сокетов, устройств и других программ.
Решение
Если вас не смущают операции с битовыми векторами, представляющими наборы файловых дескрипторов, воспользуйтесь функцией select с нулевым тайм-аутом:
$rin = ";
# Следующая строка повторяется для всех опрашиваемых манипуляторов
vec($rin, fileno(FHI), 1) = 1;
vec($rin, fileno(FH2), 1) = 1;
vec($rin, fileno(FH3), 1) = 1;
# На одном или нескольких манипуляторах имеются входные данные
if (vec($r,fileno(FH1),1)) { tt Сделать что-то с FH1
}
if (vec($r,fileno(FH2),1)) {
# Сделать что-то с FH2
}
if (vec($r,fileno(FH3),1)) {
# Сделать что-то с FH3
Модуль IO::Select позволяет абстрагироваться от операций с битовыми векторами:
use 10.-Select,
Sselect = 10:'Select->new();
# Следующая строка повторяется для всех опрашиваемых манипуляторов
$select->add(*FILEHANDLE);
if (@ready = $select->can_read(O)) {
# Имеются данные на манипуляторах из массива @>ready }
Комментарий
Функция select в действительности объединяет сразу две функции. Вызванная с одним аргументом, она изменяет текущий манипулятор вывода по умолчанию (см. рецепт 7.12). При вызове с четырьмя аргументами она сообщает, какие файловые манипуляторы имеют входные данные или готовы получить вывод. В данном рецепте рассматривается только 4-аргументный вариант select.
Первые три аргумента select представляют собой строки, содержащие битовые векторы. Они определяют состояние файловых дескрипторов, ожидающих ввода, вывода или сообщений об ошибках (например, сведений о выходе данных за пределы диапазона для срочной передачи сокету). Четвертый аргумент определяет тайм-аут — интервал, в течение которого select ожидает изменения состояния. Нулевой тайм-аут означает немедленный опрос. Тайм-аут также равен вещественному числу секунд или undef. В последнем варианте select ждет, пока состояние изменится:
$пп = '' ;
vec($nn, fileno(FILEHANDLE), 1) = 1;
Snfound = select($rin, undef, undef, 0); # Обычная проверка
if (Snfound) {
Sline = <FILEHANOLE>;
print "I read Sline"; }
Однако такое решение не идеально. Если среди передаваемых символов не встретится символ перевода строки, программа переходит в ожидание в <FILEHANDLE>.
Чтобы справиться с этой проблемой, мы последовательно читаем по одному символу и обрабатываем готовую строку при получении "\п". При этом отпадает необходимость в синхронном вызове <FILEHANDLE>. Другое решение (без проверки файлов) описано в рецепте 7.15.
Модуль IO::Select скрывает от вас операции с битовыми векторами. Метод 10: :Select->new() возвращает новый объект, для которого можно вызвать метод add, чтобы дополнить набор новыми файловыми манипуляторами. После включениях всех интересующих вас манипуляторов вызываются функции can_read, can_write и can_exception. Функции возвращают список манипуляторов, ожидающих чтения, записи или непрочитанных срочных данных (например, информации о нарушении диапазона TCP).
Вызовы 4- аргументной версии select не должны чередоваться с вызовами каких-либо функций буферизованного вывода, перечисленных во введении (read, о, seek, tell и т. д.). Вместо этого следует использовать sysread — вместе с sysseek, если вы хотите изменить позицию внутри файла для данного манипулятора.
Чтение данных из сокета или канала с немедленным продолжением работы описано в рецепте 17.13. Асинхронному чтению с терминала посвящены рецепты 15.6 и 15.8.
t> Смотри также--------------------------------------------------------------------------------------------
Описание функции select вperlfunc(l); документация по стандартному модулю IO::Select; рецепт 7.14.
7.14. Асинхронный ввод/вывод
Проблема
Требуется прочитать или записать данные через файловый манипулятор так, чтобы система не приостанавливала процесс до наступления готовности программы, файла, сокета или устройства на другом конце. Такая задача чаще возникает для специальных, нежели для обычных файлов.
Решение
Откройте файл функцией sysopen с параметром 0_NOCBLOCK: use Fcntl;
sysopen(MODEM, "/dev/cuaO", 0_N0NBLOCK|O_RDWR) or die "Can't open modem: $!\n";
Если у вас уже есть файловый манипулятор, измените флаги с помощью функции fcntl:
use Fcntl;
$flags = " ;
fcntl(HANDLE, F_GETFL, $flags)
or die "Couldn't get flags for HANDLE : $!\n";
or die "Couldn't set flags for HANDLE: $!\n";
После того как файловый манипулятор будет открыт для асинхронного ввода/вывода, измените флаги с помощью функции fcntl:
use POSIX qw(:errno_h);
$rv = syswrite(HANDLE, $buffer, length Sbuffer); if (!defined($rv) && $! == EAGAIM) {
# Ожидание
} elsif ($rv != length Sbuffer) {
U Незавершенная запись } else {
# Успешная запись
$rv = sysread(HANDLE, Sbuffer, $BUFSIZ);
or die "sysread: $!"; if (!defined($rv) 8.8, $! == EAGAIN) {
# Ожидание
} else {
# Успешно прочитано $rv байт из HANDLE
Комментарий
Константа O_NONBLOCK входит в стандарт POSIX и потому поддерживается большинством компьютеров. Мы используем модуль POSIX для получения числового значения ошибки EAGAIN.
> Смотри также------------------------------------------------------------------------
Описание функций sysopen и fcntl вperlfunc(l); документация по стандартному модулю POSIX; страницы руководства ореп(2) и/ся£/(2); рецепты 7.13 и 7.15.
7.15. Определение количества читаемых байтов
Проблема
Требуется узнать, сколько байтов может быть прочитано через файловый манипулятор функцией read или sysread.
Решение
Воспользуйтесь функцией ioctl в режиме FIONREAD:
$size = pack("L", 0);
ioctl(FH, $FIONREAD, $size) or die "Couldn't call ioctl: $!\n";
7.15. Определение количества читаемых байтов 271
$size = unpaokC'L", $size);
# Могут быть прочитаны $size байт
Комментарий
Функция Perl ioctl предоставляет прямой интерфейс к системной функции ioctl(2). Если ваш компьютер не поддерживает запросы FIONREAD при вызове ioctl(2), вам не удастся использовать этот рецепт. FIONREAD и другие запросы ioctl(2) соответствуют числовым значениям, которые обычно хранятся в заголовочных файлах С.
Вам может понадобиться утилита Perl h2ph, преобразующая заголовочные файлы С в код Perl. FIONREAD в конечном счете определяется как функция в файле sys/ioctl.ph:
require 'sys/ioctl.ph1;
$size = pack("L", 0);
ioctl(FH, FIONREADO, $size) or die "Couldn't call ioctl: $!\n";
$size = unpack("L", $size);
Если утилита h2ph не установлена или не подходит вам, найдите нужное место в заголовочном файле с помощью grep:
%grep FIONREAD /usr/include/*/*
/usr/include/asm/ioctls.h:«define FIONREAD 0x541B
Также можно написать небольшую программу на С в «редакторе настоящего программиста»:
% cat > fionread.c «include <sys/ioctl.h> main() {
pnntf("%#08x\n", FIONREAD); >
"D
% cc -o fionread fionread % ./fionread 0x4004667f
Затем жестко закодируйте полученное значение в программе. С переносимостью пускай возится ваш преемник:
SFIONREAD = 0x4004667f; # XXX: зависит от операционной системы
$size = pack("L", 0);
ioctl(FH, SFIONREAD, $size) or die "Couldn't call ioctl: $!\n";
$size = unpack("L", $size);
FIONREAD требует, чтобы файловый манипулятор был подключен к потоку. Следовательно, сокеты, каналы и терминальные устройства будут работать, а файлы — нет.
Если вам это покажется чем-то вроде системного программирования, взгляните на проблему под другим углом. Выполните асинхронное чтение данных из ма-
> Смотри также---------------------------------------------------------------------------------------------
Рецепт 7.14; страница руководства ioctl(2) вашей системы; описание функции ioctl вperlfunc(l).
7.16. Хранение файловых манипуляторов в переменных
Проблема
Вы собираетесь использовать файловый манипулятор как обычную переменную, чтобы его можно было передать или вернуть из функции, сохранить в структуре данных и т. д.
Решение
Если у вас уже имеется символьный файловый манипулятор (например, STDIN или LOGFILE), воспользуйтесь записью тип-глоба, «FH. Такой подход является самым эффективным.
Svanable = «FILEHANDLE, it Сохранить в переменной
subroutine(*FILEHANDLE); tt или передать функции
sub subroutine {
my $fh = shift;
print $fh "Hello, filehandle'\n"; >
Если вы хотите работать с анонимным файловым манипулятором, воспользуйтесь функцией return_fh (см. ниже) или новыми методами модулей IO::File или IO::Handle, сохраните его в скалярной переменной и используйте так, словно это обычный файловый манипулятор:
use FileHandle; # Анонимные манипуляторы
$fh = FileHandle->new();
use 10::File; » 5.004 и выше
$fh = I0::File->new();
Комментарий
Существует немало способов передать файловый манипулятор функции или сохранить его в структуре данных. Самое простое и быстрое решение заключается в применении тип-глоба, *FH. Рассматривайте запись *FH как обозначение типа файлового манипулятора, подобно тому, как представляли молекулы на уроках химии в виде цветных шариков — не совсем точно, зато удобно.
Когда вы начнете понимать недостатки этой модели, она вам уже не понадобится.
Конечно, в простых ситуациях этого вполне достаточно, но что если вам потребовался массив файловых манипуляторов с неизвестными именами? Как показано в главе 11 «Ссылки и записи», построение анонимных массивов, хэшей и даже функций во время выполнения программы оказывается исключительно удобным приемом. Нам хотелось бы иметь аналогичную возможность и для файловых манипуляторов. На помощь приходят модули 10.
Метод new модуля IO::Handle или IO::File генерирует анонимный файловый манипулятор. Его можно передать функции, сохранить в массиве и вообще применять везде, где используются именованные тип-глобы файловых манипуляторов — и не только. Эти модули также могут использоваться в иерархии наследования, поскольку конструктор new возвращает полноценные объекты, для которых могут вызываться методы.
Объекты могут косвенно использоваться в качестве файловых манипуляторов, что избавляет вас от необходимости придумывать для них имена.
Чтобы получить тип-глоб из именованного файлового манипулятора, снабдите его префиксом *:
$fh_a = 10::File->new("< /etc/motd") or die "open /etc/motd: $!"; $fh_b = «STDIN, some_sub($fh_a, $fh_b);
Существуют и другие способы, но этот проще и удобнее всех остальных. Единственное ограничение — в том, что его нельзя превратить в объект вызовом bless. Bless вызывается для ссылки на тип-глоб — именно это и происходит в IOr.Handle. Ссылки на тип-глоб, как и сами тип-глобы, можно косвенно использовать в качестве файловых манипуляторов, с приведением посредством bless или без него.
Создание и возврат нового файлового манипулятора из функции происходит следующим образом:
sub return_fh { и Создание анонимных файловых манипуляторов
local »FH; tt Должны быть 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"; }
либо локализовать тип-глоб и использовать файловый манипулятор напрямую:
local »FH = shift,
print FH Sending to localized filehandle\n }
Оба варианта работают как с объектами IO:-Handle, так и с тип-глобами и настоящими файловыми манипуляторами
accept_fh(*STDOUT) accept_fh($handle)
Perl позволяет использовать строки, тип-глобы и ссылки на тип-глобы в качестве косвенных файловых манипуляторов, но без передачи тип-глобов или объектов 10 Handle можно нарваться на неприятности Применение строк ( L06FILE вместо *LOGFILE) между пакетами потребует специальных усилий, а функции не могут возвращать ссылки на тип-глобы
В предыдущих примерах файловый манипулятор перед использованием присваивался скалярной переменной Дело в том, что во встроенных функциях (print или pnntf) или в операторе о могут использоваться только простые скалярные переменные, но не выражения или элементы хэшей и массивов Следующие строки даже не пройдут компиляцию
@fd = («STDIN -STDOUT *STDERR)
print $fd[1] Type it U НЕВЕРНО
$got = <$fd[O]> # НЕВЕРНО
print $fd[2] What was that $got # НЕВЕРНО
BprintHprintf это ограничение удается обойти — воспользуйтесь блоком и выражением, в котором находится файловый манипулятор
print { $fd[1] } funny stuff\n
pnntf { $fd[1] } Pity the poor %x \n 3_735_928_559
Pity the poor deadbeef
Внутри блока может находиться и более сложный код Следующий фрагмент отправляет сообщение в один из двух адресов
|
$ок = |
-x /bin/cat |
|||||
|
print |
{ $ok ' |
> $fd[1] |
$fd[2] } |
cat |
stat |
$ok\n |
|
print |
{ $fd[ |
1 + ($ok |
II 0) ] |
} cat |
stat |
$ok\n |
$got = readlme($fd[0])
> Смотри также---------------------------------------------------------------------------------------------
Рецепт 7 1, документация по стандартному модулю FileHandle, описание функции open в perlfunc(i)
7.17. Кэширование открытых файловых манипуляторов
Проблема
Требуется одновременно открыть больше файлов, чем позволяет ваша система.
Решение
Воспользуйтесь стандартным модулем FileCache:
use FileCache
cacheout ($path) # При каждом применении манипулятора
print $path output ,
Комментарий
Функция cacheout модуля FileCache позволяет одновременно открывать больше файлов, чем позволяет операционная система Если воспользоваться ей для открытия существующего файла, который FileCache видит впервые, этот файл без лишних вопросов усекается до нулевой длины Однако во время фонового открытия и закрытия файлов cacheout следит за открывавшимися ранее файлами и не стирает их, а присоединяет к ним данные Она не умеет создавать каталоги, поэтому, если попытаться открыть файл /usr/local/dates/menno ewe в несуществующем каталоге/usr/local/dates, из cacheout будет вызвана die
Функция cacheout () проверяет значение константы NOFILE уровня С из стандартного заголовочного файла sys/params h, чтобы определить, сколько файлов разрешается открывать одновременно. В некоторых системах это значение может быть неверным или вовсе отсутствовать (например, там, где максимальное количество дескрипторов является лимитом ресурса процесса и устанавливается командой limit или ulimit). Если cacheout() не может получить значение NOFILE, достаточно присвоить $FileCache maxopen значение, на 4 меньше правильного, или подобрать разумное число методом проб и ошибок.
В примере 7. 8 файл xferlog, создаваемый популярным FTP-сервером wuftpd, разбивается на файлы, имена которых соответствуют именам пользователей. Поля файла xferlog разделяются пробелами; имя пользователя хранится в четвертом поле с конца.
Пример 7.8. splitwulog
ff'/usr/bm/perl
# splitwulog - разделение журнала wuftpd по именам пользователей
use FileCache,
Soutdir = /var/log/ftp/by-user ,
while (о) <
unless (defined ($user = (split)[-4])) { warn Invalid line $ \n , next,
продолжение &
ir« глава 7 • Доступ к файлам Пример 7.8 (продолжение)
$path = "$outdir/$user"; cacheout $path; print $path $_;> Смотри также---------------------------------------------------------------------------------------------
Документация по стандартному модулю FileCache; описание функции open в perlfunc(l).
7.18. Одновременный вывод через несколько файловых манипуляторов
Проблема
Одни и те же данные требуется вывести через несколько разных файловых манипуляторов.
Решение
Если вы предпочитаете обходиться без создания новых процессов, напишите цикл f о reach для перебора файловых манипуляторов:
foreach $filehandle (@FILEHANDLES) { print $filehandle $stuff_to_print;
Если новые процессы вас не пугают, откройте файловый манипулятор, связав его с программой tee:
open(MANY, "| tee filei 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 в /dev/null:
open (FH, "| tee filei file2 file3 >/dev/null"); print FH "whatever\n";
Вы даже можете перенаправить процессу tee свой собственный STDOUT и использовать при выводе обычную функцию print:
# Продублировать STDOUT в трех файлах с сохранением исходного STDOUT
open (STDOUT, "| tee filei file2 file3") or die "Teeing off: $!\n";
print "whatever\n" or die "Writing: $!\n";
close(STDOUT) or die "Closing: $!\n";
> Смотри также---------------------------------------------------------------------------------------------
Описание функции print вperlfunc(l). Аналогичная методика используется в рецептах 8.19 и 13.15.
7.19. Открытие и закрытие числовых файловых дескрипторов
Проблема
Вам известны файловые дескрипторы, через которые должен выполняться ввод/вывод, но Perl вместо числовых дескрипторов требует манипуляторы.
Решение
Для открытия файлового дескриптора воспользуйтесь режимами "<&=" и "<&" или методом fdopen модуля IO::Handle:
open(FH, "<&=$FDNUM"); # FH открывается для дескриптора
open(FH, "<&$FDNUM"); и FH открывается для копии дескриптора
use 10::Handle;
$fh->fdopen($FDNUM, "r"); # Открыть дескриптор 3 для чтения
Чтобы закрыть дескриптор, воспользуйтесь функцией POSIX:: close или откройте его описанным выше способом.
Комментарий
Иногда вам известен файловой дескриптор, а не манипулятор. В системе ввода/ вывода Perl вместо дескрипторов используются манипуляторы, поэтому для уже открытого файлового дескриптора придется создать новый манипулятор. Режимы open "<&", ">&" и "+<&" решают эту задачу соответственно для чтения, записи и обновления. Режимы со знаком равенства ("<&=", ">&=" и "+<&=") работают с дескрипторами более экономно, при этом почти всегда делается именно то,
Если у вас установлена версия Perl 5.004 и выше, воспользуйтесь методом объекта IO::Handle:
use 10::Handle;
$fh = 10::Handle->new();
$fh->fdopen(3, "r"); # Открыть 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(l).
7.20. Копирование файловых манипуляторов
Проблема
Требуется создать копию файлового манипулятора.
Решение
Синоним файлового манипулятора создается следующей командой:
-СИНОНИМ = «ОРИГИНАЛ;
Чтобы создать независимую копию файлового дескриптора для существующего манипулятора, воспользуйтесь функцией open в режиме &:
7.20. Копирование файловых манипуляторов 279
open(OUTCOPY, ">&STDOUT") or die "Couldn't dup STDOUT: $!"; 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 : $!"; open(BYNUMBER, ">&=5") or die "Couldn't alias file descriptor 5: $!";
Комментарий
Если синоним манипулятора создан с помощью тип-глоба, программа по-прежнему работает лишь с одним объектом ввода/вывода Perl. При закрытии манипулятора-синонима закрывается и объект ввода/вывода. Все последующие попытки использования копий этого манипулятора лишь приводят к выдаче сообщений типа "print on closed filehandle". Чередование записи через разные синонимы не вызывает проблем, поскольку при этом не создаются дублирующиеся структуры данных, способные вызвать десинхронизацию.
При копировании дескриптора командой open (КОПИЯ, ">&МАНИПУЛЯТОР") вызывается системная функция dup(2). Вы получаете два независимых дескриптора с общей текущей позицией, блокировкой и флагами, но разными буферами ввода/вывода. Закрытие одного дескриптора не отражается на его копии. Одновременная работа с файлом через оба дескриптора — верный путь к катастрофе. Обычно этот прием используется для сохранения и восстановления STDOUT и STDERR:
# Получить копии дескрипторов
open(OLDOUT, ">&STDOUT");
open(OLDERR, ">&STDERR");
# Перенаправить stdout и stderr
open(STDOUT, "> /tmp/program.out") or die "Can't redirect stdout: $!";
open(STOERR, ">&STDOUT") or die "Can't dup stdout: $!";
й Запустить программу system($j oe_random_p rog ram);
# Закрыть измененные манипуляторы
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(3).
> Смотри также---------------------------------------------------------------------------------------------
Страница руководства dup(2) вашей системы; описание функции open в perl-/ияс(1).
7.21. Программа: netlock
При блокировке файлов мы рекомендуем по возможности использовать функцию flock. К сожалению, в некоторых системах блокировка через flock ненадежна. Допустим, функция flock может быть настроена на вариант блокировки без поддержки сети или вы работаете в одной из редких систем, в которой вообще не существует эмуляции flock.
Приведенная ниже программа и модуль содержат базовую реализацию механизма блокировки файлов. В отличие от обычной функции flock, данный модуль блокирует файлы по именам, а не по дескрипторам.
Следовательно, он может применяться для блокировки каталогов, сокетов и других нестандартных файлов. Более того, вы даже сможете блокировать несуществующие файлы. При этом используется каталог, созданный в иерархии на одном уровне с блокируемым файлом, поэтому вы должны иметь право записи в каталог, содержащий его. Файл в каталоге блокировки содержит сведения о владельце блокировки. Это пригодится в рецепте 7.8, поскольку блокировка сохраняется, несмотря на изменение файла, которому принадлежит данное имя.
Функция nf lock вызывается с одним или двумя аргументами. Первый определяет имя блокируемого файла; второй, необязательный — промежуток времени, в течение которого происходит ожидание. Функция возвращает true при успешном предоставлении блокировки и false при истечении времени ожидания. При возникновении различных маловероятных событий (например, при невозможности записи в каталог) инициируется исключение.
Присвойте true переменной $File:; LockOir:: Debug, чтобы модуль выдавал сообщения при неудачном ожидании. Если вы забудете снять блокировку, при выходе из программы модуль снимет ее за вас. Этого не произойдет, если ваша программа получит неперехваченный сигнал.
Вспомогательная программа из примера 7.9 демонстрирует применение модуля File::LockDir.
Пример 7.9. drivelock
#!/usr/bm/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 <path>\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::LockOir;
# Модуль, обеспечивающий простейшую блокировку
# на уровне имен файлов без применения хитрых системных функций.
# Теоретически информация о каталогах синхронизируется в NFS.
# Стрессовое тестирование не проводилось.
use strict;
use Exporter;
use vars qw(@ISA ©EXPORT); @ISA = qw(Exporter); ©EXPORT = qw(nflock nunflock);
use vars qw($Debug $Check);
$Debug ||= 0; # Может определяться заранее
$Check ||= 5; # Может определяться заранее
use Cwd;
use Fcntl;
use Sys::Hostname;
use File.:Basename;
use File::stat;
use Carp;
my %Locked_Files = ();
# Применение: пИоск(ФАЙЛ; ТАЙМАУТ)
sub nflock($;$) {
my $pathname = shift;
my $naptirae = shift 11 0;
my $lockname = name21ock($pathname);
my $whosegot = "$lockname/owner";
my $start = time();
продолжение &
282 Глава 7 • Доступ к файлам Пример 7.10 (продолжение)
my Smissed = 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 Slockname: $!" if $missed++ > 10
&& '-d Slockname; if (SDebug) {<
open(0WNER, "< $whosegot") || last; # exit "if"!
my Slockee = <OWNER>;
chomp($lockee);
printf STDERR "%s $0\[$$]: lock on %s held by %s\n",
scalar(localtime), Spathname, Slockee; close OWNER; И
sleep $Check;
return if $naptime && time > $start+$naptime; } sysopen(OWNER, Swhosegot, O_WRONLY|O_CREAT|O_EXCL)
or croak "can't create Swhosegot: S1' printf OWNER "$0\[$$] on %s since %s\n",
hostname(), scalar(localtime); close(OWNER)
or croak "close Swhosegot: $!"; $Locked_Files{$pathname}++; return 1;
# Освободить заблокированный файл sub nunflock(S) {
my Spathname = shift;
my Slockname = name21ock($pathname);
my Swhosegot = "Slockname/owner";
unlink(Swhosegot);
carp " releasing lock on Slockname" if SDebug;
delete $Locked_Files<Spathname};
return rmdir(Slockname);
# Вспомогательная функция
Функция Perl flock блокирует только целые файлы, но не отдельные их области. Хотя fcntl поддерживает частичную блокировку файлов, из Perl с ней работать трудно — в основном из-за отсутствия модуля XS, который бы обеспечивал переносимую упаковку необходимой структуры данных. Программа из примера 7.11 реализует fcntl, но лишь для трех конкретных архитектур: SunOS, BSD и Linux. Если вы работаете в другой системе, придется узнать формат структуры flock. Для этого мы просмотрели заголовочный файл С sys/ fcntl.h и запустили программу c2ph, чтобы получить информацию о выравнивании и типах. Эта программа, распространяемая с Perl, работает только в системах с сильным влиянием Беркли (как те, что перечислены выше). Вы не обязаны использовать c2ph, но эта программа несомненно облегчит ваше существование. Функция struct_flock в программе lockarea выполняет упаковку и распаковку структуры, руководствуясь переменной $"0 с именем операционной системы. Объявления функции struct_flock не существует, мы просто создаем синоним для версии, относящейся к конкретной архитектуре. Синонимы функции рассматриваются в рецепте 10.14. Программа lockarea открывает временный файл, уничтожая его текущее содержимое, и записывает в него полный экран (80x23) пробелов. Все строки имеют одинаковую длину. Затем программа создает производные процессы и предоставляет им возможность одновременного обновления файла. Первый аргумент, N, определяет количество порождаемых процессов (2**N). Следовательно, lockarea 1 порождает два процесса, lockarea 2 — четыре, lockarea 3 — восемь, lockarea 4 — шестнадцать |
sub name21ock($) {
my $pathname = shift;
my $dir = dirname($pathname);
my $file = basename(Spathname);
$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 Slockname",
unlink($whosegot);
return rmdir($lockname);
7.22. Программа: lockarea
7.22. Программа: lockarea 283
Каждый процесс выбирает из файла случайную строку, блокирует и обновляет ее. Он записывает в строку свой идентификатор процесса с префиксом — количеством обновлений данной строки:
4: 18584 was just here
Если в момент запроса блокировки строка уже была заблокирована, то после предоставления блокировки в сообщение включается идентификатор предыдущего процесса:
29: 24652 ZAPPED 24656
Попробуйте запустить программу lockarea в фоновом режиме и отображайте изменения файла с помощью программы гер из главы 15. Получается видеоигра для системных программистов.
%lockarea 5 &
% гер -1 'cat /tmp/lkscreen'
Если работа основной программы прерывается клавишами Ctrl+C или сигналом SIGINT из командной строки, она уничтожает всех своих потомков, посылая сигнал всей группе процессов.
Пример 7.11. lockarea
#!/usr/bin/perl -w
# lockarea - частичная блокировка с использованием fcntl
use strict;
my $FORKS = shift || 1; my $SLEEP = shift || 1;
use Fcntl;
use POSIX qw(:unistd_h :errno_h);
my $COLS = 80; my $ROWS = 23;
# Когда вы в последний раз видели «этот* режим правильно работающим?
open(FH, "+> /tmp/lkscreen") or die $!;
select(FH);
$l = 1; select STDOUT;
# Очистить экран
for (1 .. $ROWS) {
print FH " " x $COLS, 1-\n";
7.22. Программа: lockarea 285
my $progenitor = $$; fork while SFORKS-- > 0;
print "hello from $$\n";
if ($progenitor == $$) {
$SIG{INT> = \&genocide; } else {
$SIG{INT} = sub { die "goodbye from $$" };
while (1) {
my $line_num = mt rand($R0WS); my $line; my $n;
# Перейти к строке
seek(FH, $n = $line_num • ($C0LS+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 fcntl lock sub lock {
my ($fh, $start, Still) = @_;
##print "$$: Locking $start, $till\n";
продолжение
286 Глава 7 • Доступ к файлам Пример 7.11 (продолжение)
my $lock = struct_flock(F_WRLCK, SEEK_SET, Sstart, Still, 0);my Sblocker = 0;
unless (fcntl($fh, F_SETLK, Slock)) {
die "F_SETLK S$ @_: $!" unless $! == EAGAIN || $! == EDEADLK;
fcntl($fh, F_GETLK, Slock) or die "F_GETLK $$ @_: $!'
Sblocker = (struct_flock($lock))[-1J;
##print "lock $$ @_: waiting for $blocker\n";
Slock = struct_flock(F_WRLCK, SEEK_SET, $start, Still, 0);
unless (fcntl($fh, F_SETLKW, Slock)) { warn "F_SETLKW $$ @_: $!\n"; return; # undef
return Sblocker;
# unlock($handle, Soffset, Stimeout) - снять блокировку fcntl sub unlock {
my ($fh, Sstart, Still) = @_;
##print "$$: Unlocking Sstart, $till\n";
my Slock = struct_flock(F_UNLCK, SEEK_SET, Sstart, Still, 0);
fcntl($fh, F_SETLK, Slock) or die "FJJNLCK $$ @_: $!";
# Структуры flock для разных ОС
# Структура flock для Linux
# short l_type;
# short l_whence;
# off_t l_start;
# off_t l_len;
# pid_t l_pid;
BEGIN {
# По данным c2ph: typedef='s2 12 i', sizeof=16 my $FLOCK_STRUCT = 's s 1 1 Г;
sub linux_flock { if (wantarray) {
my (Stype, Swhence, Sstart, $len, Spid) =
unpack($FLOCK_STRUCT, $_[0]); return (Stype, Swhence, Sstart, Slen, Spid); } else {
my (Stype, Swhence, Sstart, Slen, $pid) = @_ return pack($FLOCK_STRUCT,
Stype, Swhence, Sstart, Slen, Spid);
# Структура flock для SunOS
# short l_type; /• F_RDLCK, F_WRLCK или F_UNLCK ¦/
# short l_whence; /* Флаг выбора начального смещения */
# long l_start; /* Относительное смещение в байтах */
# long l_len; /* Длина в байтах;
О - блокировка до EOF •/
# short l_pid; /* Возвращается F_GETLK */
# short l_xxx; /• Зарезервировано на будущее ¦/
BEGIN {
# По данным c2ph: typedef='s2 12 s2', sizeof=16 my $FLOCK_STRUCT = 'ssllss';
sub sunos_flock { if (wantarray) {
my ($type, Swhence, $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,
Stype, Swhence, $start, $len, $pid, 0);
# Структура flock для (Free)BSD:
# off_t l_start; /* Начальное смещение •/
# off_t l_len; /* len = 0 означает блокировку до конца файла */
# pid_t lpid; /¦ Владелец блокировки */
# short l_type; /* Тип блокировки: чтение/запись и т. д. */
# short l_whence, /* Тип l_start */
BEGIN {
# По данным c2ph: typedef="q2 l s2", size=24 my $FLOCK_STRUCT = 'lllliss';
sub bsd_flock {
if (wantarray) {
my (Sxxstart, $start, $xxlen, $len, $pid, $type, Swhence) =
unpack($FLOCK_STRUCT, $_[0]); return ($type, Swhence, Sstart, $len, $pid); } else <
my (Stype, Swhence, $start, $len, $pid) = @_; my (Sxxstart, Sxxlen) = (0,0); return pack($FLOCK_STRUCT,
Sxxstart, Sstart, Sxxlen, $len, Spid, Stype, Swhence);
продолжение
288 Глава 7 • Доступ к файлам Пример 7.11 (продолжение)
# Синоним структуры fcntl на стадии компиляции BEGIN {for ($"0) {
*struct_flock = do
/bsd/ && \&bsd_flock
II /lmux/ && \&linux_flock
II /sunos/ && \&sunos_flock
II die "unknown operating system $"0, bailing out";
# Установить обработчик сигнала для потомков BEGIN {
my $called = 0;
sub genocide {
exit if $called++;
print "$$. Time to die, kiddies.\n" if $$ == Sprogemtor;
my $job = getpgrpO;
$SIG{INT} = 'IGNORE-;
kill -2, $]ob if $]ob; # killpg(SIGINT, job)
1 while wait > 0; '
print "$$¦ My turn\n" if $$ == $progemtor?
exit;
END { Sgenocide }
 |
Содержимое файлов
Из всех решений UNIX самым гениальным был выбор одном символа для перевода строки.
Майк О'Цели, лишь с долей шутки
Введение
До революции UNIX всевозможные источники и приемники данных не имели ничего общего. Чтобы две программы пообщались друг с другом, приходилось идти на невероятные ухищрения и отправлять в мусор целые горы перфокарт. При виде этой компьютерной Вавилонской башни порой хотелось бросить программирование и подыскать себе менее болезненное хобби — например, податься в секту флаггелантов.
В наши дни этот жестокий и нестандартный стиль программирования в основном ушел в прошлое. Современные операционные системы всячески стараются создать иллюзию, будто устройства ввода/вывода, сетевые подключения, управляющие данные процессов, другие программы, системные консоли и даже терминалы пользователей представляют собой абстрактные потоки байтов, именуемые файлами. Теперь можно легко написать программу, которая нисколько не заботится о том, откуда взялись ее входные данные и куда отправятся результаты.
Поскольку чтение и запись данных осуществляется через простые байтовые потоки, любая программа может общаться с любой другой программой. Трудно переоцепить всю элегантность и мощь такого подхода. Пользователи перестают зависеть от сборников магических заклинаний JCL (или СОМ) и могут собирать собственные нестандартные инструменты, используя простейшее перенаправление ввода/вывода и конвейерную обработку.
Интерпретация файлов как неструктурированных байтовых потоков однозначно определяет круг возможных операций. Вы можете читать и записывать последовательные блоки данных фиксированного размера в любом месте файла, увеличивая его размер при достижении конца. Чтение/запись блоков переменной длины (например, строк, абзацев и слов) реализуется в Perl на базе стандартной библиотеки ввода/вывода С.
Самый распространенный тип файлов — текстовые файлы, а самый распространенный тип операций с ними — построчное чтение и запись. Для чтения строк используется оператор о (или его внутренняя реализация, readline), а для записи — функция print. Эти способы также могут применяться для чтения или записи любых блоков с конкретным разделителем. Строка представляет собой запись с разделителем "\п".
При достижении конца файла оператор о возвращает undef или ошибку, поэтому его следует использовать в цикле следующего вида:
while (defined ($lme = <OATAFILE>)) {
chomp $lme;
$size = length $line;
print f$size\n"; it Вывести длину строки
>
Поскольку эта операция встречается довольно часто, в Perl для нее предусмотрена сокращенная запись, при которой строки читаются в $_ вместо $line. Переменная $_ используется по умолчанию и в других строковых операциях и вообще куда удобнее, чем может показаться на первый взгляд:
while (<DATAFILE>) {
chomp;
print length, "\n\ # Вывести длину строки }
В скалярном контексте оператор <> читает следующую строку. В списковом контексте он читает оставшиеся строки:
@lines = <DATAFILE>;
При чтении очередной записи через файловый манипулятор <> увеличивает значение специальной переменной $. (текущий номер входной записи). Переменная сбрасывается лишь при явном вызове close и сохраняет значение при повторном открытии уже открытого манипулятора.
Заслуживает внимания и другая специальная переменная — $/, разделитель входных записей. По умолчанию ей присваивается "\п", маркер конца строки. Ей можно присвоить любое желаемое значение — например, "\0" для чтения записей, разделяемых нуль-байтами. Для чтения целых абзацев следует присвоить $/ пустую строку, "". Это похоже на присваивание "\п\п", поскольку для разделения записей используются пустые строки, однако "" интерпретирует две и более смежных пустых строки как один разделитель, а "\п\п" в таких случаях возвращает пустые записи. Присвойте $/ неопределенное значение, чтобы прочитать остаток файла как одну скалярную величину:
Введение 291
undef $/;
$whole_file = <FILE>; # Режим поглощения
Запуск Perl с флагом -0 позволяет задать $/ из командной строки:
% perl -040 -е 'Sword = <>; print "First word is $word\n"; '
Цифры после -0 определяют восьмеричное значение отдельного символа, который будет присвоен $/. Если задать недопустимое значение (например, -0777), Perl присваивает $/ неопределенное значение undef. Если задать -00, $/ присваивается "". Ограничение в один восьмеричный символ означает, что вы не сможете присвоить $/ многобайтовую строку — например, "%%\п" для чтения файлов программы fortune. Вместо этого следует воспользоваться блоком BEGIN:
% perl -ne 'BEGIN { $/='%%\n" } chomp, print if /Unix/i' fortune.dat
Запись строк и других данных выполняется функцией print. Она записывает свои аргументы в порядке указания и по умолчанию не добавляет к ним разделители строк или записей:
print HANDLE "One", "two", "three', # ' Onetwothree" print "Baa baa black sheep \n , # Передается выходному манипулятору
# по умолчанию
Между манипулятором и выводимыми данными не должно быть запятых. Если поставить запятую, Perl выдает сообщение об ошибке "No comma allowed after filehandle". По умолчанию для вывода используется манипулятор STDOUT. Для выбора другого манипулятора применяется функция select (см. главу 7 «Доступ к файлам»).
Во всех системах строки разделяются виртуальным разделителем "\п", который называется переводом строки (newline). He существует такого понятия, как символ перевода строки. Это всего лишь иллюзия, которая по общему сговору поддерживается операционной системой, драйверами устройств, библиотеками С и Perl. Иногда это приводит к изменению количества символов в прочитанных или записываемых строках. Подробности заговора изложены в рецепте 8.11.
Записи фиксированной длины читаются функцией read. Функция получает три аргумента: файловый манипулятор, скалярную переменную и количество читаемых байт. Возвращается количество прочитанных байт, а в случае ошибки — undef. Для записи используется функция print:
$rv = read(HANDLE, $buffer, 4096)
or die "Couldn't read from HANDLE ' $'\n'; # $rv - количество прочитанных байт, й Sbuffer содержит прочитанные данные
Функция truncate изменяет длину файла, который задается с помощью манипулятора или по имени. Функция возвращает true, если усечение прошло успешно, и false в противном случае:
truncate(HANDLE, Slength) >
or die "Couldn't truncate: $'\n"; truncate("/tmp/$$. pid", Slength)
or die 'Couldn't truncate. $'\n";
$pos = tell(DATAFILE),
print I m $pos bytes from the start of DATAFILE \n ,
Функция seek получает три аргумента файловый манипулятор, новое смещение (в байтах) и число, определяющее интерпретацию смещения. Если оно равно О, смещение отсчитывается от начала файла (в соответствии со значениями, возвращаемыми tell); 1 — от текущей позиции (положительное число означает прямое перемещение в файле, а отрицательное — обратное); 2 — от конца файла.
seek(LOGFILE 0, 2) or die Couldn t seek to the end $'\n , seek(DAtAFILE $pos, 0) or die Couldn t seek to $pos $'\n seek(0Ut, -20, 1) or die Couldn t seek back 20 bytes $'\n ,
Все сказанное выше относится к буферизованному вводу/выводу. Другими словами, операции о, print, read, seek и tell используют буферы для повышения скорости. В Perl также предусмотрены небуферизованные операции ввода/ вывода: sysopen, sysread, syswrite, sysseek и close. Буферизация, sysopen и close рассматриваются в главе 7.
Функции sysread и syswrite отличаются от своих аналогов, о и print. Они получают одинаковые аргументы — файловый манипулятор; скалярную переменную, с которой выполняется чтение или запись; и количество читаемых или записываемых байт. Кроме того, они могут получать необязательный четвертый аргумент — смещение внутри скалярной переменной:
$wntten = syswrite(DATAFILE Smystring length($myst ring)), die syswrite failed $'\n unless $written == length($mystring) $read = sysread(INFILE, $ block 256, 5) warn only read $read bytes not 256 if 256 ' = $read,
Функция syswrite посылает содержимое Smystring в DATAFILE. При вызове sysread из INFILE читаются 256 символов, сохраняемых с шестого символа в $Ыоск, при этом первые пять символов остаются без изменений. И sysread и syswrite возвращают фактическое количество переданных байт; оно может не совпадать с тем, которое пытались передать вы. Например, файл содержал меньше данных, чем вы рассчитывали, и чтение получилось укороченным. Может быть, произошло переполнение носителя, на котором находился файл. А может быть, процесс был прерван на середине записи. Stdio заботится о завершении записи в случае прерывания, но при вызовах sysread и syswrite этим придется заняться вам. Пример приведен в рецепте 9.3.
Функция sysseek является небуферизованной заменой для seek и tell. Она получает те же аргументы, что и seek, но возвращает новую позицию при успешном вызове или undef в случае ошибки. Текущая позиция внутри файла определяется следующим образом:
$pos = sysseek(HANDLE, 0, 1), # Не изменять позицию die Couldn t sysseek $'\n unless defined $pos,
Мы описали базовые операции с файлами, которые находятся в вашем распоряжении. Искусство программирования как раз и заключается в применении простейших операций для решения сложных проблем — например, определения количества строк в файле, перестановки строк, случайного выбора строки из файла, построения индексов и т д.
8.1. Чтение строк с символами продолжения
Проблема
Имеется файл с длинными строками, которые делятся на две и более строки. Символ \ означает, что данная строка продолжается на следующей. Вы хотите объединить разделенные строки. Подобное разделение длинных строк на короткие встречается в make-файлах, сценариях командного интерпретатора, конфигурационных файлах и многих языках сценариев.
Решение
Последовательно объединяйте прочитанные строки, пока не встретится строка без символа продолжения:
while (defined($lme = <FH>) ) { chomp $line, if ($line =- s/\\$//) { $line = <FH>, redo unless eof(FH) >
# Обработать полную запись в $line }
Комментарий
Рассмотрим пример входного файла:
OISTFILES = $(DIST_COMMON) $(SOURCES) $(HEADERS) \
$(TEXINFOS) $(INFOS) $(MANS) $(DATA) OEP_DISTFILES = $(DIST_COMMON) $(SOURCES) $(HEADERS) \
$(TEXINFOS) $(INFO_DEPS) $(MANS) $(DATA) \
$(EXTRA_DIST)
Вы хотите обработать текст, игнорируя внутренние разрывы строк. В приведенном примере первая запись занимает две строки, вторая — три строки и т. д.
У файлов такого формата имеется одна распространенная проблема — невидимые пробелы между \ и концом строки. Менее строгий вариант подстановки выглядит так:
if ($lme =~ s/\\\s*$//) {
# Как и прежде }
К сожалению, даже если ваша программа прощает мелкие погрешности, существуют и другие, которые этого не делают. Будьте снисходительны к входным данным и строги — к выходным.
t> Смотри также------------------------------------------------------------ ¦----------------------------
Описание функции chomp вperlfunc(l); описание ключевого слова redo в разделе «Loop Control» perlsyn(l).
8.2. Подсчет строк (абзацев, записей) в файле
Проблема
Требуется подсчитать количество строк в файле.
Решение
Во многих системах существует программа we, подсчитывающая строки в файле:
Scount = 'we -I < $file'; die 'we failed: P ' if $'; chomp($count),
Кроме того, можно открыть файл и последовательно читать строки до конца, увеличивая значение счетчика:
open(FILE, "< $file") or die "can't open $file: $'";
$count++ while <FILE>;
# $count содержит число прочитанных строк
Самое быстрое решение предполагает, что строки действительно завершаются "\п":
Scount += tr/\n/\n/ while sysread(FILE, $_, 2 ** 16);
Комментарий
Хотя размер файла в байтах можно определить с помощью -s $f lie, обычно полученная цифра никак не связана с количеством строк. Оператор -s рассматривается в главе 9 «Каталоги».
Если вы не хотите или не можете перепоручить черную работу другой программе, имитируйте работу we — самостоятельно откройте и прочитайте файл:
open(FILE, '< $file") or die "can't open $file. S1";
$count++ while <FILE>,
# $count содержит число прочитанных строк
Другой вариант выглядит так:
open(FILE, "< $flie' ) or die 'can't open $file: $'"; for ($count=0; <FILE>; $count++) { }
Если вы не читаете из других файлов, можно обойтись без переменной Scount. Специальная переменная $. содержит количество прочитанных строк с момента последнего явного вызова close для файлового манипулятора:
1 while <FILE>, Scount = $.,
В этом варианте все записи файла последовательно читаются без использования временных переменных.
Чтобы подсчитать абзацы, присвойте перед чтением глобальному разделителю входных записей $/ пустую строку (""), и тогда оператор о будет считывать не строки, а целые абзацы:
$/ = ' ; # Включить режим чтения абзацев open(FILE, $file) or die "can t open $file: $'"; 1 while <FILE>; $para_count = $ ;
t> Смотри также--------------------------------------------------------------------------------------------
Описание специальной переменной $/ вperlvar{\); введение главы 9; страница руководства wc{\).
8.3. Обработка каждого слова в файле
Проблема
Требуется выполнить некоторую операцию с каждым словом файла, по аналогии с функцией f о reach.
Решение
Разделите каждую строку по пропускам с помощью функции split:
while (о) {
for $chunk (split) {
Глава 8 • Содержимое файлов
# Сделать что-то с $chunkИли воспользуйтесь оператором m//g для последовательного извлечения фрагментов строки:
while (<>) {
while ( /(\w[\w -].)/9 ) { # Сделать что-то с $1
Комментарий
Сначала необходимо решить, что же подразумевается под «словом». Иногда это любые последовательности символов, кроме пропусков; иногда — идентификаторы программ, а иногда — слова английского языка. От определения зависит и используемое регулярное выражение.
Два варианта решения, приведенные выше, работают по-разному. В первом варианте шаблон определяет, что не является словом. Во втором варианте все наоборот — шаблон решает, что им является.
На основе этой методики нетрудно подсчитать относительные частоты всех слов в файле. Количество экземпляров каждого слова сохраняется в хэше:
8 Подсчет экземпляров слов в файле %seen = (), while (о) {
while ( /(\w[ \w-]*)/g ) { $seen{lc $1}++,
# Отсортировать выходной хэш по убыванию значений
foreach $word ( sort { $seen{$b} <=> $seen{$a} } keys %seen) {
printf %5d %s\n , $seen{$word}, Sword,
>
Чтобы программа подсчитывала количество строк вместо слов, уберите второй цикл while и замените его на $seen{lc $_}++:
# Подсчет экземпляров строк в файле
%seen = (),
while (о) {
$seen{lc $_}++, } foreach $line ( sort { $seen{$b} <=> $seen{$a} } keys %seen ) {
printf %5d %s , $seen{$line}, $line, }
Порой слова могут выглядеть довольно странно — например, «M.I.T», «Micro-Soft», «o'clock», «49ers», «street-wise», «and/or», «&», «с/о», «St.», «TschuB» или
> Смотри также---------------------------------------------------------------------------------------------
Описание функции split вperlfunc(l); рецепты 6.3; 6.23.
8.4. Чтение файла по строкам или абзацам в обратном направлении
Проблема
Требуется обработать каждую строку или абзац файла в обратном направлении.
Решение
Прочитайте все строки в массив и организуйте обработку элементов массива от конца к началу:
Wines = <FILE>,
while ($lme = pop (alines) {
# Сделать что-то с $line
}
Или занесите строки в массив в обратном порядке:
@lines = reverse <FILE>, foreach $line (@lines) {
# Сделать что-то с $lme
>
Комментарий
Ограничения, связанные с доступом к файлам (см. введение), не позволяют последовательно читать строки с конца файла. Приходится читать строки в память и обрабатывать их в обратном порядке. Конечно, расходы памяти при этом будут по крайней мере не меньше размера файла.
В первом варианте массив строк перебирается в обратном порядке. Такая обработка является деструктивной, поскольку при каждой итерации из массива выталкивается последний элемент. Впрочем, то же самое можно сделать и недеструктивно:
for ($1 = $#lines, $i i= -1, $i--) {
$line = $lines[$i], }
Во втором варианте генерируется массив строк, изначально расположенных в обратном порядке. Его тоже можно обработать недеструктивно. Мы получаем массив с обратным порядком строк, поскольку присваивание @lmes обеспечива-
Показанные решения легко распространяются на чтение абзацев, достаточно изменить значение $/:
# Внешний блок обеспечивает существование временной локальной копии $/ {
local $/ = ,
^paragraphs = reverse <FILE>,
foreach $paragraph (^paragraphs) { # Сделать что-то
> Смотри также---------------------------------------------------------------------------------------------
Описание функции reverse в perlfunc(l); описание специальной переменной $/ bperlvar{\); рецепты 4.10; 1.6.
8.5. Чтение из дополняемого файла
Проблема
Требуется читать данные из непрерывно растущего файла, однако при достижении конца файла (текущего) следующие попытки чтения завершаются неудачей.
Решение
Читайте данные, пока не будет достигнут конец файла. Сделайте паузу, сбросьте флаг EOF и прочитайте новую порцию данных. Повторяйте, пока процесс не прервется. Флаг EOF сбрасывается либо функцией seek:
for (,,) {
while (<FH>) { }
sleep $SOMETIME,
seek(FH, 0, 1), }
либо методом с lea re г г модуля IO::Handle:
use 10 Seekable,
for (,,) {
while (<FH>) { }
sleep $SOHETIME, FH->clearerr(),
Комментарий
При достижении конца файла во время чтения устанавливается внутренний флаг, который препятствует дальнейшему чтению. Для сброса этого флага проще всего воспользоваться методом clearer г, если он поддерживается (присутствует в модулях IO::Handle и FileHandle). Кроме того, можно вызвать метод POSIX¦ clearerr:
Snaptime = 1,
use 10 Handle,
open (LOGFILE, /tmp/logfile ) or die can t open /tmp/logfile $'
for (,,) {
while (<LOGFILE>) { print } # Или другая операция
sleep $naptime,
LOGFILE->clearerr(), # Сбросить флаг ошибки ввода/вывода }
Если простейший вариант в вашей системе не работает, воспользуйтесь функцией seek. Приведенный выше фрагмент с seek пытается переместиться на 0 байт от текущей позиции, что почти всегда завершается успехом. Текущая позиция при этом не изменяется, но зато для манипулятора сбрасывается признак конца файла, благодаря чему при следующем вызове <LOGFILE> будут прочитаны новые данные.
Если и этот вариант не работает (например, из-за того, что он полагается на так называемую «стандартную» реализацию ввода/вывода библиотек С), попробуйте следующий фрагмент — он явно запоминает старую позицию в файле и напрямую возвращается к ней:
for (,,) {
for ($curpos = tell(LOGFILE), <LOGFILE>, Scurpos = tell(LOGFILE}) { # Обработать $_
}
sleep $naptime,
seek(LOGFILE, $curpos, 0), # Вернуться к прежней позиции }
Некоторые файловые системы позволяют удалить файл во время чтения из него. Вероятно, в таких случаях нет смысла продолжать работу с файлом. Чтобы программа в подобных ситуациях завершалась, вызовите stat для манипулятора и убедитесь в том, что количество ссылок на него (третье поле возвращаемого списка) не стало равным нулю:
exit if (stat(L0GFILE))[3] == 0
Модуль File::stat позволяет записать то же самое в более понятном виде:
use File stat,
exit if stat(*LOGFILE)->nlink == 0,
t> Смотри также--------------------------------------------------------------------------------------------
Описание функции seek вperlfunc(l); документация по стандартным модулям POSIX и IO::Seekable; страницы руководства tail(l) и stdio(3).
Проблема
Требуется прочитать из файла случайную строку.
Решение
Воспользуйтесь функцией rand и переменной $ (текущим номером строки):
srand,
rand($ ) < 1 && ($lme = $__) while о,
# $lme - случайно выбранная строка
Комментарий
Перед вами — изящный и красивый пример неочевидного решения. Мы читаем все строки файла, но не сохраняем их в памяти. Это особенно важно для больших файлов. Вероятность выбора каждой строки равна 1/N (где N — количество прочитанных строк).
Следующий фрагмент заменяет хорошо известную программу fortune:
$/ = %%\п ,
$data = /usr/share/games/fortunes ,
srand,
rand($ ) < 1 && ($adage = $_) while <>,
print $adage,
Если вам известны смещения строк (например, при наличии индекса) и их общее количество, можно выбрать случайную строку и перейти непосредственно к ее смещению в файле. Впрочем, индекс доступен далеко не всегда.
Приведем более формальное пояснение работы данного алгоритма. Функция rand ($ ) выбирает случайное число от 0 до текущего номера строки. Строка с номером N сохраняется в возвращаемой переменной с вероятностью 1/N. Таким образом, первая строка сохраняется с вероятностью 100 %, вторая — с вероятностью 50%, третья — 33% и т. д. Вопрос лишь в том, насколько это честно для любого положительного целого N.
Начнем с конкретных примеров, а затем перейдем к абстрактным.
Разумеется, для файла из одной строки (N=1) все предельно честно: первая строка сохраняется всегда, поскольку 1/1 = 100 %. Для файла из двух строк N = 2. Первая строка сохраняется всегда; когда вы достигаете второй строки, она с вероятностью 50 % заменяет первую. Следовательно, обе строки выбираются с одинаковой вероятностью, и для N = 2 алгоритм тоже работает корректно. Для файла из трех строк N = 3. Третья строка сохраняется с вероятностью 1/3 (33 %). Вероятность выбора одной из двух первых строк равна 2/3 (66 %). Но как показано выше, две строки имеют одинаковую вероятность выбора (50 %). Пятьдесят процентов от 2/3 равны 1/3. Таким образом, каждая из трех строк файла выбирается с вероятностью 1/3.
В общем случае для файла из N+1 строк последняя строка выбирается с вероятностью l/(N+l),,a одна из предыдущих строк — N/(N+1). Деление N/(N+1) на
N дает вероятность 1/(N+1) для каждой из N первых строк и те же 1/(N+1) для строки с номером N+1. Следовательно, алгоритм корректно работает для любого положительного целого N.
Нам удалось случайным образом выбрать из файла строку со скоростью, пропорциональной количеству строк в файле. При этом максимальный объем используемой памяти даже в худшем случае равен размеру самой длинной строки.
t> Смотри также--------------------------------------------------------------------------------------------
Описание специальной переменной $ в perluar(l); рецепты 2.7—2.8.
8.7. Случайная перестановка строк
Проблема
Требуется скопировать файл и случайным образом переставить строки копии.
Решение
Прочитайте все строки в массив, перетасуйте элементы массива (см. рецепт 4.17) и запишите полученную перестановку:
# Используется функция shuffle из главы 4 while (<INPUT>) {
push(@lines, $_), }
©reordered = shuffle(@lines), foreach (^reordered) {
print OUTPUT $_, }
Комментарий
Самое простое решение — прочитать все строки файла и переставить их в памяти. Смещения строк в файле неизвестны, поэтому нельзя перетасовать список с номерами строк и затем извлечь строки в порядке их появления в файле. Впрочем, даже при известных смещениях такое решение, вероятно, будет работать медленнее, поскольку придется многократно перемещаться по файлу функцией seek вместо простого последовательного чтения.
> Смотри также---------------------------------------------------------------------------------------------
Рецепты 2.7-2.8; 4.17.
8.8. Чтение строки с конкретным номером
Проблема
Требуется извлечь из файла строку с известным номером.
Простейший выход — читать строки до обнаружения нужной:
# Выборка строки с номером $DESIRED_LINE_NUMBER
$ = О
do < $LINE = <HANOLE> } until $ == $DESIRED_LINE_NUMBER || eof,
Если подобная операция должна выполняться многократно, а файл занимает не слишком много места в памяти, прочитайте его в массив:
©lines = <HANDLE>
$LINE = $lmes[$DESIREO_LINE_NUMBER],
Если вы собираетесь многократно извлекать строки по номеру, а файл не помещается в памяти, постройте индекс смещений для отдельных строк и переходите к началу строки функцией seek:
# Применение build_inclex(*МАНИПУЛЯТОР_ДАННЫХ, *МАНИПУЛЯТОР_ИНДЕКСА)
sub build_index {
my $data_file = shift my $index_file = shift, my $offset = 0,
while (<$data_file>) {
print $mdex_file pack( N $offset), Soffset = tell($data_file)
П Применение linejvith_index(*MAHMnWlflTOPJlAHHblX *МАНИПУЛЯТОР_ИНДЕКСА,
$НОМЕР_СТРОКИ)
t) Возвращает строку или undef, если НОМЕР_СТРОКИ выходит за пределы файла sub lme_with_index {
my $data_file = shift
my $index_file = shift,
my $line_number = shift,
my Ssize, # Размер элемента индекса
my $i_offset, # Смещение элемента в индексе
my Sentry # Элемент индекса
my $d_offset, # Смещение в файле данных
$size = length(pack( N 0)), $i_offset = $size ¦ ($line_number-1), seek($mdex_file, $i_offset, 0) or return read($index_file, $entry, $size), $d_offset = unpack( N , Sentry), seek($data_file, $d_offset, 0), return scalar(<$data_file>),
# Применение
open(FILE, < $file ) or die Can t open $file for reading $'\n ,
open(INDEX, +>$file ldx )
or die Can t open $file ldx for read/write $'\n , build_mdex(*FILE, «INDEX), $line = line_with_index(*FILE, «INDEX, Sseeking),
При наличии модуля DB_File можно воспользоваться методом DB_RECNO, который связывает массив с файлом (по строке на элемент массива):
use DB_File, use Fcntl,
$tie = tie(@lines $FILE, O_RDWR 0666, $DB_RECNO) or die Cannot open file $FILE $'\n
# Извлечь строку
$line = $lines[$sought-1]
Комментарий
Каждый вариант имеет свои особенности и может пригодиться в конкретной ситуации. Линейное чтение легко программируется и идеально подходит для коротких файлов. Индексный метод обеспечивает ускоренную выборку, но требует предварительного построения индекса. Он применяется в случаях, когда индексируемый файл редко изменяется по сравнению с количеством просмотров. Механизму DB_File присущи некоторые начальные издержки, зато последующая выборка строк выполняется намного быстрее, чем при линейном чтении. Обычно он применяется для многократных обращений к большим файлам.
Необходимо знать, с какого числа начинается нумерация строк — с 0 или 1. Переменной $ присваивается 1 после чтения первой строки, поэтому при линейном чтении нумерацию желательно начинать с 1. В индексном механизме широко применяются смещения, и нумерацию лучше начать с 0. DB_File интерпретирует записи файла как элементы массива, индексируемого с 0, поэтому строки также следует нумеровать с 0.
Ниже показаны три реализации одной и той же программы, prmt_line. Программа получает два аргумента — имя файла и номер извлекаемой строки.
Версия print_line из примера 8. 1 просто читает строки файла до тех пор, пока не найдет нужную.
Пример 8.1. print_line-vl
#'/usr/bin/perl -w
# print_line-v1 - линейное чтение
(aARGV == 2 or die usage print_lme FILENAME LINE_NUMBER\n ,
(Sfilename, $line_number) = (a>ARGV,
open(INFILE, < Sfilename ) or die Can t open $filename for reading $!\n ,
while (<INFILE>) {
$lme = $_,
last if $ == $line_number,
продолжение #
304 Глава 8 • Содержимое файлов Пример 8.1 (продолжение)
if ($. != $line_number) {die "Didn't find line $line_number in $filenarae\n"; } print;
Версия из примера 8.2 сначала строит индекс. При большом количестве обращений индекс строится один раз, а затем используется во всех последующих чтениях.
Пример 8.2. printjine-v2
й!/usr/bin/perl -w
Я print_line-v2 - построение индекса
U Функции build_mdex и line_with_index приведены выше.
@argv == 2 or
die "usage: print_line FILENAME LINEJWMBER";
($filename, $line_number) = @ARGV; open(ORIG, "< Sfilename")
or die "Can't open Sfilename for reading: $!";
# Открыть индекс и при необходимости построить его
й Если две копии программы замечают, что индекс не существует, И они могут одновременно попытаться построить его.
# Проблема легко решается с применением блокировки.
Sindexname = "Sfilename.index";
sysopen(IDX, Sindexname, O_CREAT|O_RDWR)
or die "Can't open Sindexname for read/write: $!"; build_index(*ORIG, -IDX) if -z Sindexname;
$line = line_with_index(*ORIG, »IDX, $line_number);
die "Didn't find line $line_number in $filename" unless defined $line;
print $lme;
Версия с модулем DB_File из примера 8.3 похожа на волшебство. Пример 8.3. printjine-v3
#!/usr/bin/perl -w
# print_line-v3 - решение с применением DB_File
use DB_File;
use Fcntl;
(SiARGV == 2 or
die "usage: pnnt_line FILENAME LINE_NUMBER\n";
(Sfilename, $line_number) = @>ARGV;
$tie = tie(@lines, "DB_File", $filename, O_RDWR, 0666, $DB_RECNO) or die "Cannot open file Sfilename: $!\n";
unless ($line__number < $tie->length) {
8.9. Обработка текстовых полей переменной длины 305
die "Didn't find line $line_number in $filename\n" }
print $lines[$line_number-1]; # Легко, правда9
> Смотри также---------------------------------------------------------------------------------------------
Описание функции tie в perlfunc(l); описание специальной переменной $. в perlvar(l); документация по стандартному модулю DB_File.
8.9. Обработка текстовых полей переменной длины
Проблема
Требуется извлечь из входных данных поля переменной длины.
Решение
Воспользуйтесь функцией split с шаблоном, совпадающим с разделителями полей:
# Имеется $ЗАПИСЬ с полями, разделенными шаблоном ШАБЛОН. П Из записи извлекаются @ПОЛЯ. (ЭПОЛЯ = splltC/ШАБЛОН/, $ЗАПИСЬ);
Комментарий
Функция split вызывается с тремя аргументами: шаблон, выражение и лимит (максимальное количество извлекаемых полей). Если количество полей во входных данных превышает лимит, лишние ноля возвращаются неразделенными в последнем элементе списка. Если лимит не указан, возвращаются все поля (кроме завершающих пустых полей). Выражение содержит разделяемую строковую величину. Если выражение не указано, разделяется переменная $_. Шаблон совпадает с разделителем полей. Если шаблон не указан, в качестве разделителей используются смежные последовательности пропусков, а начальные пустые поля отбрасываются.
Если разделитель входных полей не является фиксированной строкой, можно вызвать split так, чтобы функция возвращала разделители полей вместе с данными, — для этого в шаблон включаются круглые скобки. Например:
])/, "3+5-2");
возвращает список:
(3, '+¦, 5, ¦-', 2)
Поля, разделенные двоеточиями (в стиле файла /etc/passwd), извлекаются следующим образом:
^fields = split(/:/, $record);
©fields = split(/\s+/, Srecord);
Если $ЗАПИСЬ начинается с пропуска, в последнем варианте первому эле менту списка будет присвоена пустая строка, поскольку split сочтет, что запись имеет начальное пустое поле. Если это не подходит, используйте особую форму split:
@fields = splitC ", $ЗАПИСЬ);
В этом случае split ведет себя так же, как и с шаблоном /\s+/, но игнорирует начальный пропуск.
Если разделитель может присутствовать внутри самих полей, возникает проблема. Стандартное решение — снабжать экземпляры разделителя в полях префиксом \. См. рецепт 1.13.
D> Смотри также------------------------------------------------------------------------------------------
Описание функции split вperlfunc(l).
8.10. Удаление последней строки файла
Проблема
Требуется удалить из файла последнюю строку.
Решение
Читайте файл по одной строке и запоминайте байтовое смещение последней прочитанной строки. Когда файл будет исчерпан, обрежьте файл по последнему сохраненному смещению:
open (FH, "+< $file") or die "can't update $file: $!"; while ( <FH> ) {
$addr = tell(FH) unless eof(FH);
>
truncate(FH, $addr) or die "can't truncate $file: $!";
Комментарий
Такое решение намного эффективнее загрузки всего файла, поскольку в любой момент времени в памяти хранится всего одна строка. Хотя вам все равно приходится читать весь файл, программу можно использовать и для больших файлов, размер которых превышает объем доступной памяти.
> Смотри также-------------- ;--------------------------------------------------------------------------------------------------------
Описание функций open и binmode в perlfunc(l); man-страницы ореп(2) и /ореп(3) вашей системы.
8.11. Обработка двоичных файлов 307
8.11. Обработка двоичных файлов
Проблема
Операционная система отличает текстовые файлы от двоичных. Как это сделать в программе?
Решение
Вызовите функцию binmode для файлового манипулятора:
Ыптос)е(МАНИПУЛЯТОР);
Комментарий
Не существует единого мнения по поводу того, что является строкой текстового файла; текстовые символы одного компьютера могут превратиться в двоичную белиберду на другом. Но даже если все станут пользоваться кодировкой ASCII вместо EBCDIC, Rad50 или Unicode, могут возникнуть затруднения.
Как говорилось во введении, конкретного символа перевода строки не существует. Это чисто абстрактное понятие, которое поддерживается операционной системой, стандартными библиотеками, драйверами устройств и Perl.
В Unix или Р1ап9 "\п" представляет физическую последовательность "\cJ" (служебная последовательность Perl, соответствующая Ctrl+J). Однако на терминале, не работающем в «чистом» (raw) режиме, нажатие на клавишу Enter генерирует код "\сМ" (возврат курсора), транслируемый в "\cj", а выходной код "\cJ" транслируется в "\cM\cJ". Подобные странности характерны не для обычных файлов, а лишь для терминальных устройств, и обрабатываются строго на уровне драйвера устройства.
На Мае код "\п" обычно представляется "\сМ"; чтобы жизнь была интереснее (а также из-за стандартов, требующих различий между "\п" и "\г"), "V" соответствует "\cJ". Такая интерпретация в точности противоположна стандартам UNIX, Plan9, VMS, CP/M... словом, почти всем. Следовательно, программисты Мае, которые пишут файлы для других систем или общаются с ними по сети, должны проявлять осторожность. Если отправить "\п", вы получите "\сМ", a "\cJ" исчезнет. Многие сетевые службы предпочитают отправлять и принимать в качестве разделителя строк последовательность "\cM\cJ", однако большинство позволяет ограничиться простым "\cJ".
В VMS, DOS и их производных "\п" также представляет "\cJ", по аналогии с Unix и Р1ап9. С терминальной точки зрения UNIX и DOS ведут себя одинаково: при нажатии пользователем клавиши Enter генерируется "\сМ", однако в программу поступает уже "\п", то есть "\cJ". Код "\п", переданный терминалу, превращается в "\cM\cJ".
Эти странные преобразования выполняются и с файлами Windows. В тексто вых файлах DOS каждая строка завершается двумя-символами, "\cM\cJ". Последний блок файла содержит код "\cZ", определяющий окончание текста. В таких системах при записи строки "bad news\n" файл будет содержать "bad news\cM\cJ", как при выводе на терминал.
Такое наследие старой файловой системы СР/М, в которой хранились лишь сведения о количестве блоков, но не о размере файлов, бесит программистов уже несколько десятилетий, и конца-края этому не видно. Ведь DOS была совместима с файловым форматом СР/М, Windows — с форматом DOS, a NT — с форматом Windows. Грехи отцов преследуют потомков в четвертом поколении.
Впрочем, проблему одиночного "\п" можно обойти — достаточно сообщить Perl (и операционной системе), что вы работаете с двоичными данными. Функция binmode означает, что прочитанные или записанные через конкретный манипулятор данные не должны преобразовываться по правилам, установленным в системе для текстовых файлов.
Sgifname = 'picture gif",
open(GIF, Sgifname) or die 'can t open $gifname $'';
binmode(GIF), ft Теперь DOS не преобразует двоичные
ft входные данные GIF
binmode(STDOUT), й Теперь DOS не преобразует двоичные
# выходные данные STDOUT
while (read(GIF, $buff, 8 * 2**10)) {
print STDOUT Sbuff; }
Вызов binmode в системах, где отличия между текстовыми и двоичными файлами несущественны (в том числе UNIX, Mac и Plan9), не принесет никакого вреда. Однако несвоевременный вызов функции в других системах (включая MVS, VMS и всех разновидностей DOS) может исказить содержимое файлов.
Если функция bmmode не используется, в данных, прочитанных с помощью о, строковый терминатор системы заменяется на "\п", даже если $/ было присвоено другое значение. Аналогично, любой "\п", выводимый через манипулятор функцией print, превращается в строковый терминатор данной системы. Дополнительные сведения приведены во введении.
Если вы хотите, чтобы прочитанные данные совпадали с содержимым файла байт в байт, и при этом работаете в одной из перечисленных странных систем, — вызовите bmmode. Конечно, если вы захотите использовать их с о, вам придется присвоить $/ настоящий разделитель записей.
> Смотри также
Описание функций open и binmode вperlfunc(i); страницы руководства ореп(2) и fopen(3) вашей системы.
8.12. Ввод/вывод с произвольным доступом
Проблема
Нужно прочитать двоичную запись из середины большого файла, но вам не хочется добираться до нее, последовательно читая все предыдущие записи.
Решение
Определите размер записи и умножьте его на номер записи, чтобы получить смещение в байтах. Затем вызовите seek для полученного смещения и прочитайте запись:
$АДРЕС = SPA3MEP * $НОМЕР,
seek(FH, $АДРЕС, 0) or die 'seek $'' ,
read(FH, $БУФЕР, SPA3MEP);
Комментарий
В решении предполагается, что $НОМЕР первой записи равен нулю. Если нумерация начинается с единицы, измените первую строку фрагмента:
$АДРЕС = $РАЗМЕР * (SH0MEP-1),
Для текстовых файлов это решение не работает — только строки не имеют одинаковую длину. Но такие ситуации встречаются очень редко.
> Смотри также---------------------------------------------------------------------------------------------
Описание функции seek в perlfunc(l); рецепт 8.13.
8.13. Обновление файла с произвольным
доступом
Проблема
Требуется прочитать старую запись из двоичного файла, изменить ее содержимое и записать обратно.
Решение
Прочитайте (read) старую запись, упакуйте (pack) обновленное содержимое и запишите обратно.
use Fcntl; # Для SEEK_SET и SEEK_CUR
SADDRESS = SRECSIZE * $RECNO,
seek(FH, SADDRESS, SEEK_SET) or die 'Seeking. $' ';
or die Reading $' , ^FIELDS = unpack($FORMAT, $BUFFER), # Обновить содержимое, затем SBUFFER = pack($FORMAT, ©FIELDS),
seek(FH, -$RECSIZE SEEK_CUR) or die Seeking $i ,
print FH SBUFFER,
close FH or die Closing $i ,
Комментарий
Для вывода записей в Perl не потребуется ничего, кроме функции print Помните, что антиподом read является print, а не write, хотя, как ни странно, антиподом sysread все же является syswrite.
В примере 8 4 приведен исходный текст программы weekearly, которой передается один аргумент — имя пользователя. Программа смещает дату регистрации этого пользователя на неделю в прошлое Конечно, на практике с системными файлами экспериментировать не следует — впрочем, из этого все равно ничего не выйдет! Программа должна иметь право записи для файла, поскольку тот открывается в режиме обновления. После выборки и изменения записи программа упаковывает данные, возвращается на одну запись назад и записывает буфер.
Пример 8.4. weekearly
#'/usr/bin/perl
8 weekearly - смещение даты регистрации на неделю назад use User pwent, use 10 Seekable
Stypedef = L A12 A16 # Формат linux в sunos - L A8 A16
Ssizeof = length(pack($typedef ())),
$user = shift(@ARGV) || $ENV{USER} || $ENV{LOGNAME)
Saddress = getpwnam($user)->uid * $sizeof
open (LASTLOG, +</var/log/lastlog )
or die can t update /usr/adm/lastlog $' seek(LASTLOG, $address, SEEK_SET)
or die seek failed $t read(LASTLOG, $buffer, Ssizeof) == $sizeof
or die read failed V ,
(Stime, $line, $host) = unpack($typedef Sbuffer) $time -= 24 * 7 ¦ 60 * 60 # На неделю назад $buffer = pack($typedef, $time, $line, $time)
seek(LASTLOG, -Ssizeof SEEK_CUR) » Вернуться на одну запись
or die seek failed $' print LASTLOG Srecord,
close(LASTLOG)
or die close failed $' ,
> Смотри также
Описание функций open, seek, read, pack и unpack вperlfunc(l); рецепты 8.12; 8.14.
8.14. Чтение строки из двоичного файла
Проблема
Требуется прочитать из файла строку, завершенную нуль-символом, начиная с определенного адреса.
Решение
Присвойте $/ нуль-символ ASCII и прочитайте строку с помощью <>:
$old_rs = $/, # Сохранить старое значение $/
$/ = \0 й Нуль-символ
seek(FH, $addr, SEEK_SET) or die Seek error $i\n
$string = <FH> # Прочитать строку
chomp Sstring, # Удалить нуль-символ
$/ = $old_rs, # Восстановить старое значение $/
При желании сохранение и восстановление $/ можно реализовать с помощью
local:
local $/ = \0
#
} # $/ восстанавливается автоматически
Комментарий
Программа bgets из примера 8.5 получает в качестве аргументов имя файла и одно или несколько байтовых смещений. Допускается десятичная, восьмеричная или шестнадцатеричная запись смещений. Для каждого смещения программа читает и выводит строку, которая начинается в данной позиции и завершается нуль-символом или концом файла:
Пример 8.5. bgets
Jt'/usr/bin/perl
# bgets - вывод строк по смещениям в двоичном файле
use 10 Seekable,
($flie, @addrs) = @ARGV or die usage $0 addr
open(FH $file) or die cannot open $file S1 ,
$/ = \000 ,
foreach $addr (@addrs) {
$addr = oct $addr if $addr =~ /"0/, seek(FH, $addr, SEEK_SET)
продолжение ¦&
or die can t seek to $addr in $file $' , pnntf qq{%#x %#o %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(l); описание qq// в разделе «Quote and Quote-like Operators» man-страницы peiiop( 1)
8.15. Чтение записей фиксированной длины
Проблема
Требуется прочитать файл с записями фиксированной длины
Решение
Воспользуйтесь функциями pack и unpack:
# SRECORDSIZE - длина записи в байтах
U STEMPLATE - шаблон распаковки для записи
# FILE - файл из которого читаются данные
# @FIELDS - массив для хранения полей
until ( eof(FILE) ) {
read(FILE $record SRECORDSIZE) == SRECORDSIZE
or die short read\n (SFIELDS = unpack($TEMPLATE Srecord),
Комментарий
Поскольку мы работаем не с текстовым, а с двоичным файлом, для чтения записей нельзя воспользоваться оператором < > или методом getline модулей 10 Вместо этого приходится считывать конкретное количество байт в буфер
функцией read. После этого буфер содержит данные одной записи, которые декодируются функцией unpack с правильным форматом.
При работе с двоичными данными трудности часто начинаются как раз с правильного выбора формата. Если данные были записаны программой на С, приходится просматривать заголовочные файлы С или страницы руководства с описанием структур, для чего необходимо знание языка С. Заодно вы должны близко подружиться с компилятором С, поскольку без этого вам будет трудно разобраться с выравниванием полей (например, х2 в формате из рецепта 8 18) Если вам посчастливилось работать в Berkeley UNIX или в системе с поддержкой дсс, вы сможете воспользоваться утилитой c2ph, распространяемой с Perl, и заставить компилятор С помочь вам в этом.
Программа tailwtmp в конце этой главы использует формат, описанный в utmp(5) системы Linux, и работает с файлами /var/log/wtmp и /var/run/utmp Но стоит вам привыкнуть к работе с двоичными данными, как возникает другая напасть — особенности конкретных компьютеров Вероятно, программа не будет работать в вашей системе без изменений, но выглядит она поучительно. Приведем соответствующую структуру из заголовочного файла С для Linux:
|
«define UT_LINESIZE |
12 |
||
|
«define UT_NAMESIZE |
8 |
||
|
«define UT_HOSTSIZE |
16 |
||
|
struct utmp { |
/* Коды для шаблона распаковки |
*/ |
|
|
short ut_type, |
/* s - short должно быть дополнено |
Ч |
|
|
pid_t ut_pid, |
/* 1 для integer |
Ч |
|
|
char ut_lme[UT_LINESIZE] |
|
/* А12 - 12-символьная строка |
Ч |
|
char ut_id[2] |
/* А2, но для выравнивания |
||
|
необходимо х2 |
-/ |
||
|
time_t ut_time |
/* 1 - long |
Ч |
|
|
char ut_user[UT_NAMESIZE] |
|
/* А8 - 8-символьная строка |
* / |
|
char ut_host[UT_HOSTSIZE] |
|
/* А16 - 16-символьная строка |
ч |
|
long ut_addr |
/• 1 - long |
ч |
Если записи представляют собой текстовые строки, используйте шаблон распаковки а или А .
Записи фиксированной длины хороши тем, что n-я запись начинается в файле со смещения SIZE*(n-1), где SIZE — размер одной записи. Пример приведен в программе с построением индекса из рецепта 8.8.
> Смотри также---------------------------------------------------------------------------------------------
Описание функций unpack, pack и read в perlfunc(l), рецепт 1.1.
Проблема
Вы хотите, чтобы пользователи вашей программы могли изменить ее поведение с помощью конфигурационного файла.
Решение
Организуйте обработку файла в тривиальном формате ПЕРЕМЕННАЯ=ЗНАЧЕНИЕ, созда вая для каждого параметра элемент хэша «ключ/значение»:
while (<CONFIG>) {
chomp, # Убрать перевод строки
s/#.*//, # Убрать комментарии
s/"\s+//; # Убрать начальные пропуски
s/\s+$//; й Убрать конечные пропуски
next unless length; # Что-нибудь осталось9
my ($var, Svalue) = split(/\s*=\s*/, $_¦ 2);
$User_Preferences{$var} = Svalue; }
Существует другой более изящный вариант — интерпретировать конфигурационный файл как полноценный код Perl:
do '$ENV{HOME}/ progrc ,
Комментарий
В первом решении конфигурационный файл интерпретируется в тривиальном формате следующего вида (допускаются комментарии и пустые строки):
# Сеть класса С NETMASK = 255.255 255 О MTU = 296
DEVICE = cual RATE = 115200 MODE = adaptive
После этого можно легко получить значение нужных параметров — например, $User_Preferences{"RATE"} дает значение 115200. Если вы хотите, чтобы конфигурационный файл непосредственно устанавливал значения переменных в программе вместо заполнения хэша, включите в программу следующий фрагмент:
no strict 'refs'; $$var = Svalue;
и переменная $RATE будет содержать значение 115200.
Во втором решении do организует непосредственное выполнение кода Perl. Если вместо блока используется выражение, do интерпретирует его как имя файла. Это практически идентично применению require, но без риска фатальных
исключений. В формате второго решения конфигурационный файл принимает следующий вид:
# Сеть класса С
SNETMASK = '255.255.255 О';
$MTU = 0x128;
SDEVICE = 'сиаГ,
$RATE = 115_200;
$MODE = adaptive';
Если вам непонятно, зачем включать в файл лишние знаки препинания, задумайтесь — в вашем распоряжении оказывается весь синтаксис Perl. Теперь простые присваивания можно дополнить логикой и проверкой условий:
if (SDEVICE =' /1$/) {
SRATE = 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}/ myprogrc" }
Файл, прочитанный с помощью do (а также require и use), представляет собой отдельную, самостоятельную область действия. Это означает как то, что конфигурационный файл не может обратиться к лексическим (ту) переменным вызывающей стороны, так и то, что вызывающая сторона не сможет найти такие переменные, заданные в файле. Кроме того, пользовательский код не подчиняется директивам типа use strict или use integer, способным воздействовать на вызывающую сторону.
eval 'cat $ENV{HOME}/.myprogгс';
Мы еще Pie видели, чтобы кто-нибудь (кроме Ларри) использовал такой подход в рабочем коде.
Во-первых, do проще вводится. Кроме того, do учитывает @INC, который обычно просматривается при отсутствии полиостью указанного пути, но в отличие от require в do не выполняется неявная проверка ошибок. Следовательно, вам не придется заворачивать do в eval для перехвата исключений, от которых ваша программа может скончаться, поскольку do уже работает как eval.
При желании можно организовать собственную проверку ошибок:
$file = "someprog.pi": unless ($return = do $file) {
warn "couldn't parse $file: $@" if $@;
warn "couldn't do $file: $!" unless defined Sreturn;
warn "couldn't run $file" unless $return;
}
Программисту намного проще отследить это в исходном тексте, чем изобретать новый, сложный синтаксис. Проще будет и пользователю, которому не придется изучать правила синтаксиса очередного конфигурационного файла. Приятно и то, что пользователь получает доступ к мощному алгоритмическому языку программирования.
Однако не следует забывать о безопасности. Как убедиться в том, что файл не модифицировался никем, кроме пользователя? Традиционный подход — не делать ничего, полагаясь исключительно на права доступа каталогов и файлов. В девяти случаях из десяти такое решение оказывается правильным, поскольку большинство проектов попросту не оправдывает подобной паранойи. А если все же оправдывает, загляните в следующий рецепт.
> Смотри также-------------------------------- '¦----------------------------------------------------------
Описание функций eval и require вperlfunc{\); рецепты 8.17; 10.12.
8.17. Проверка достоверности файла
Проблема
Требуется прочитать файл (например, содержащий данные о конфигурации). Вы хотите использовать файл лишь в том случае, если правом записи в него (а возможно, даже правом чтения) не обладает никто, кроме его владельца.
Решение
Получите данные о владельце и правах доступа с помощью функции stat. Можно воспользоваться встроенной версией, которая возвращает список:
( $dev, $ipo, $mode, $nlink,
$uid, $gid, $rdev, $size,
$atime, $mtime, $ctime,
$blksize, $blocks ) = stat($filename)
or die "no $filename: $!";
$mode &= 07777; # Отбросить информацию о типе файла
Или воспользуйтесь интерфейсом с именованными полями:
$infо = stat($filename) or die "no $filename: $!";
if ($info->uid == 0) {
print "Superuser owns $filename\n"; } if ($info->atime > $mfo->mtime) {
print "$ filename has been read since it was written.\n"; }
Комментарий
Обычно мы доверяем пользователям и позволяем им устанавливать права доступа по своему усмотрению. Если они захотят, чтобы другие могли читать или даже записывать данные в их личные файлы — это их дело. Однако многие приложения (редакторы, почтовые программы, интерпретаторы) часто отказываются выполнять код конфигурационных файлов, если запись в них осуществлялась кем-то, кроме владельца. Это помогает избежать нападений «троянских» программ. Программы, следящие за безопасностью — например, ftp или rlogin, — могут даже отвергнуть конфигурационные файлы, прочитанные кем-то, кроме владельца.
Если файл может быть записан кем-то, кроме владельца, или принадлежит кому-то, отличному от текущего или привилегированного пользователя, он не признается достоверным. Информация о владельце и правах доступа может быть получена с помощью функции stat. Следующая функция возвращает true для достоверных файлов и false для всех остальных. Если вызов stat завершается неудачей, возвращается undef.
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
if ($info->mode & 022) { tt Если другие имеют право записи
# но каталоги с битом запрета (01000) - достоверны return 0 unless $info->mode & 01000; }
return 1; }
Каталог считается достоверным даже в том случае, если другие имеют право записи в него — при условии, что для него установлен бит 01000 (разрешающий удаление только владельцу каталога).
Осторожный программист также проследит, чтобы запись была запрещена и для всех каталогов верхнего уровня. Это связано с известной «проблемой chown», при которой любой пользователь может передать принадлежащий ему файл и сделать его владельцем кого-то другого. Приведенная ниже функция is_very_safe обращается к функции POSIX: :sysconf, чтобы выяснить, существует ли «проблема chown» в системе. Если проблема существует, далее функцией проверяются is_safe все каталоги верхнего уровня вплоть до корневого. Если в вашей системе установлена ограниченная версия chown, функция is_very_safe ограничивается простым вызовом is_safe.
use Cwd;
use POSIX qw(sysconf _PC_CHOWN_RESTRICTED); sub is_verysafe { ray $path = shift;
return is_safe($path) if sysconf(_PC_CHOWN_RESTRICTED); $path = getcwdO . '/' . $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}/.myprogrc"; readconfig($flie) if is_safe($file);
При этом возникает потенциальная опасность перехвата, поскольку предполагается, что файл открывается гипотетической функцией readconfig. Между получением сведений о файле (is_safe) и его открытием функцией readconfig теоретически может случиться что-нибудь плохое. Чтобы избежать перехвата, передавайте is_safe уже открытый файловый манипулятор;
$file = "$ENV{HOME}/.myprogrc"; if (open(FILE, -< $file")) {
readconfig(*FILE) if is_safe(*FILE); }
Впрочем, вам также придется позаботиться о том, чтобы функция readconfig принимала файловый манипулятор вместо имени.
8.18. Программа: tailwtmp
В начале и конце рабочего сеанса пользователя в системе UNIX в файл wtmp добавляется новая запись. Вам не удастся получить ее с помощью обычной программы tail, поскольку файл хранится в двоичном формате. Программа tailwtmp из примера 8.7 умеет работать с двоичными файлами и выводит новые записи по мере их появления. Формат pack придется изменить для конкретной системы.
Пример 8.7. tailwtmp
#!/usr/bin/perl
# tailwtmp - отслеживание начала/конца сеанса
# Использует структуру linux utmp, см. utmp(5)
$typedef = 's х2 i A12 A4 1 A8 A16 1';
$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) == Ssizeof) { ($type, $pid, $line, $id, Stime, $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,$adcir; >
for ($size = -s WTMP; $size == -s WTMP; sleep 1) {> WTMP->clearerr();
8.19. Программа: tctee
Во многих системах существует классическая программа tee для направления выходных данных в несколько приемников. Например, следующая команда передает выходные данные someprog ъ/tmp/output а через конвейер — в почтовую систему:
% someprog | tee /tmp/output | Mail -s 'check this' user@host.org
Программа tctee пригодится не только тем пользователям, которые работают вне UNIX и не имеют tee. Она обладает некоторыми возможностями, отсутствующими в стандартной версии tee.
При запуске программа может получать четыре флага:
-i — игнорировать прерывания,
-а — дописывать данные в конец выходных файлов,
-и — выполнять небуферизованный вывод,
-п — отменить копирование выходных данных в стандартный вывод.
% someprog | tctee f1 " | cat -n' f2 "»f3"
В примере 8.8 приведена программа-ветеран, написанная на Perl почти 10 лет назад и работающая до сих пор. Если бы нам пришлось писать ее заново, вероятно, мы бы использовали strict, предупреждения и модули с десятками тысяч строк. Но как известно, «лучшее — враг хорошего».
Пример 8.8. tctee
#'/usr/bin/perl
# tctee - клон tee
# Программа совместима с perl версии 3 и выше.
while ($ARGV[O] =" /"-(.+)/ && (shift, ($_ = $1), 1)) { next if /"$/;
s/i// && (++$ignore_ints, redo); s/a// && (++$append, redo), s/u// && (++$unbuffer, redo), s/n// && (++$nostdout, redo), die "usage tee [-aiun] [filenames] ..\n";
if ($ignore_ints) {
for $sig ('INT', 'TERM', 'HUP', 'QUIT') { $SIG{$sig} = 'IGNORE'; }
$SIG{'PIPE'} = 'PLUMBER'; $node = Sappend 9 '»' : '>'; $fh = 'FHOOO1,
unless ($nostdout) {
%fh = ('STDOUT', 'standard output'); # Направить в STDOUT
$| = 1 if Sunbuffer;
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 (<STDIN>) {
for $fh (keys %fh) {
8.20. Программа: laston 321
print $fh $_;
for $fh (keys %fh) {
next if close($fh) || Idefined $fh{$fh}; warn "$0: couldnt close $fh{$fh>: $!\n"; $status++;
exit Sstatus;
sub PLUMBER {
warn "$0: pipe to \"$fh{$fh}\" broke!\n"
$status++;
delete $fh{$fh};
8.20. Программа: laston
Во время регистрации в системе UNIX на экран выводятся сведения о времени последней регистрации. Эта информация хранится в двоичном файле с именем lastlog. Каждый пользователь имеет собственную запись в этом файле; данные пользователя с UID 8 хранятся в записи 8, UID 239 — в записи 239 и т. д. Чтобы узнать, когда пользователь с заданным UID регистрировался в последний раз, преобразуйте имя пользователя в числовое значение UID, найдите соответствующую запись в файле, прочитайте и распакуйте данные. Средствами интерпретатора это сделать очень сложно, зато в программе laston все очень легко. Приведем пример:
% 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'; # Формат lmux; для SunOS - "L A8 A16" $sizeof = length(pack($typedef, ()));
продолжение ¦&
322 Глава 8 • Содержимое файлов Пример 8.9 (продолжение)
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, $lme, $host) = unpack($typedef, $buffer),
printf "%-8s UID %5d %s%s%s\n", $U->name, $U->uid,
$time "? ("at " . localtime($time)) : "never logged in",
$lme && " on $lme' ,
$host && ' from $hosf ;
 |
Каталоги
У UNIX есть свои недостатки, но файловая система к ним не относится.
Крис Торек
Введение
Для полноценного понимания работы с каталогами необходимо понимать механизмы, заложенные в ее основу. Наш материал ориентирован на файловую систему UNIX, поскольку функции каталогов Perl разрабатывались для системных функций и особенностей именно этой системы, однако в определенной степени он относится и к большинству других платформ.
Файловая система состоит из двух компонентов: набора блоков данных, где хранится содержимое файлов и каталогов, и индекса к этим блокам. Каждому объекту файловой системы, будь то обычный файл, каталог, ссылка или специальный файл (вроде файлов из каталога /dev), соответствует определенный элемент индекса. Элементы индекса называются индексными узлами (inode). Поскольку индекс является одномерным, индексные узлы определяются по номерам.
Каталог представляет собой файл специального формата, помеченный в индексном узле как каталог. Блоки данных каталога содержат множество пар. Каждая пара содержит имя объекта каталога и соответствующий ему индексный узел. Блоки данных каталога /usr/bin могут содержать следующую информацию:
|
Имя |
Индексный узел |
|
be |
17 |
|
du |
29 |
|
nvi |
8 |
|
pine |
55 |
|
vi |
8 |
Имена, хранящиеся в каталогах, не являются полными. Файл /usr/bin/vi хранится в каталоге /usr/bin под именем vi. Если открыть каталог /usr/bin и последовательно читать его элементы, вы увидите имена файлов (patch, login и vi) вместо полных имен /usr/bin/patch, /usr/bin/rlogin и /usr/bin/vi.
Однако индексный узел — больше, чем просто указатель на блоки данных. Каждый индексный узел также содержит информацию о типе представляемого объекта (каталог, обычный файл и т. д.) и его размере, набор битов доступа, информацию о владельце и группе, время последней модификации объекта, количество элементов каталога, ссылающихся на данный узел, и т. д.
Одни операции с файлами изменяют содержимое блоков данных файла; другие ограничиваются изменением индексного узла. Например, при дополнении или усечении файла в его индексном узле изменяется информация о размере. Некоторые операции изменяют элемент каталога, содержащий ссылку на индексный узел файла. Изменение имени файла влияет только на элемент каталога; ни данные файла, ни его индексный узел не изменяются.
В трех полях структуры индексного узла хранится время последнего обращения, изменения и модификации: atime, ctime и mtime. Поле atime обновляется при каждом чтении данных файла через указатель на его блоки данных. Поле mtime обновляется при каждом изменении содержимого файла. Поле ctime обновляется при каждом изменении индексного узла файла. Ctime не является временем создания; в стандартных версиях UNIX время создания файла определить невозможно.
При чтении файла изменяется только значение atime. Переименование файла не отражается на atime, ctime или mtime, поскольку изменяется лишь элемент каталога (хотя при этом меняются atime и mtime для каталога, в котором находится файл). Усечение файла не влияет на atime (поскольку мы не читаем, а лишь изменяем поле размера в элементе каталога), но изменяет ctime (из-за изменения поля размера) и mtime (из-за изменения содержимого, хотя бы и косвенного).
Чтобы получить индексный узел по имени файла или каталога, можно воспользоваться встроенной функцией stat. Например, индексный узел файла /usr/bin/vi может быть получен следующим образом:
gentry = stat("/usr/bin/vi") Or die "Couldn't stat /usr/bin/vi : $!"; Следующий фрагмент получает индексный узел для каталога /usr/bin: gentry = stat("/usr/bin") or die "Couldn't stat /usr/bin : $!"; Функция stat также вызывается и для файловых манипуляторов:
@entry = stat(INFILE) or die "Couldn't stat INFILE : $!";
Функция stat возвращает список значений, хранящихся в полях элемента каталога. Если получить информацию не удалось (например, если файл не существует), функция возвращает пустой список. В приведенных примерах пустой список проверялся конструкцией о г die. Не путайте с конструкцией 11 die, поскольку выражение будет преобразовано в скалярный контекст и функция stat сообщит лишь о том, успешно ли она была вызвана. Список при этом не возвращается. Впрочем, кэш _ (см. ниже) все же будет обновлен.
Элементы списка, возвращаемые функцией stat, перечислены в следующей таблице.
Элемент Обозначение Описание
dev Номер устройства в файловой системе
ino Номер индексного узла
mode Режим файла (тип и права доступа)
nlink Количество (прямых) ссылок на файл
uid Числовой идентификатор пользователя владельца
файла
gid Числовой идентификатор группы владельца файла
rdev Идентификатор устройства (только
для специальных файлов)
size Общий размер файла в байтах
at ime Время последнего обращения (в секундах с начала
эпохи)
mtime Время последней модификации (в секундах с начала
эпохи)
ctime Время изменения индексного узла (в секундах с начала
эпохи)
blksize Предпочтительный размер блока для операций
ввода/вывода в файловой системе
blocks Фактическое количество выделенных блоков
Стандартный модуль File::stat предоставляет именованный интерфейс к этим значениям. Он переопределяет функцию stat, поэтому вместо массива, описанного выше, функция возвращает объект с методами для получения каждого атрибута:
use File::stat;$inode = statC'/usr/bin/vi"); $ctime = $inode->ctime; $size = $inode->size;
Кроме того, в Perl предусмотрен набор операторов, вызывающих функцию stat и возвращающих лишь один атрибут. Эти операторы совокупно называются «операторами -X», поскольку их имена состоят из дефиса, за которым следует один символ. Они построены по образцу операторов test командного интерпретатора.
326 Глава 9 • Каталоги
-X Поле stat Значение
|
-г |
mode |
|
-w |
mode |
|
-X |
mode |
|
-0 |
mode |
|
-R |
mode |
|
-W |
mode |
|
-X |
mode |
|
-0 |
mode |
|
-e |
|
|
-z |
size |
|
-s |
size |
|
-f |
mode, rdev |
|
-d |
mode, rdev |
|
-1 |
mode |
|
-P |
mode |
|
-S |
mode |
|
-b |
rdev |
|
-c |
rdev |
|
-t |
rdev |
|
-u |
mode |
|
-g |
mode |
|
-k |
mode |
|
-T |
_ |
|
-B |
- |
|
-M |
mtime |
|
-A |
atime |
Файл может читаться фактическими UID/GID Файл может записываться фактическими UID/GID Файл может исполняться фактическими UID/GID Владельцем файла является фактический UID
Файл существует
Размер файла равен нулю
Размер файла отличен от нуля (возвращает размер)
Файл является обычным файлом
Файл является каталогом
Файл является символической ссылкой
Файл является именованным каналом (FIFO)
Файл является сокетом
Файл является блочным специальным файлом
Файл является символьным специальным файлом
Файловый манипулятор открыт для терминала
У файла установлен бит setuid У файла установлен бит setgid У файла установлен бит запрета
Файл является текстовым
Файл является двоичным (противоположность-Т)
Возраст файла в днях на момент запуска сценария То же для времени последнего обращения
Функция stat и операторы -X кэшируют значения, полученные при вызове системной функции stat(2). Если stat или оператор -X вызывается для специального файлового манипулятора _ (один символ подчеркивания), то вместо повторного вызова stat будет использована информация, хранящаяся в кэше. Это позволяет проверять различные атрибуты файла без многократного вызова stat(2) или возникновения опасности перехвата:
ореп( F, "< $filename" )or die "Opening Sfilename1 $!\n";
Введение 327
unless (-s F && -T _) {
die "$filename doesn't have text in it.\n , }
Однако отдельный вызов stat возвращает информацию лишь об одном индексном узле. Как же получить список содержимого каталога? Для этой цели в Perl предусмотрены функции opendir, readdir и closedir:
opendir(DIRHANDLE, "/usr/bin") or die "couldn't open /usr/bin ' $!"; while ( defined ($filename = readdir(DIRHANDLE)) ) {
print 'Inside /usr/bin is something called $filename\n '; } closedir(DIRHANDLE),
Функции чтения каталога намеренно разрабатывались по аналогии с функциями открытия и закрытия файлов. Однако если функция open вызывается для манипулятора файла, то opendir получает манипулятор каталога. Внешне они похожи, но работают по-разному: в программе могут соседствовать вызовы open (BIN, "/a/file ') и opendir(BIN, "/a/dir'), и Perl не запутается. Вы — возможно, но Perl точно не запутается. Поскольку манипуляторы файлов отличаются от манипуляторов каталогов, вы не сможете использовать оператор о для чтения из манипулятора каталога.
Имена файлов в каталоге не обязательно хранятся в алфавитном порядке. Чтобы получить алфавитный список файлов, прочитайте все содержимое каталога и отсортируйте его самостоятельно.
Отделение информации каталога от информации индексного узла может быть связано с некоторыми странностями. Операции, изменяющие каталог, требуют права записи для каталога, но не для файла. Большинство операций, изменяющих содержимое файла, требует права записи в файл. Операции, изменяющие права доступа к файлу, требуют, чтобы вызов осуществлялся владельцем файла или привилегированным пользователем. Могут возникнуть странные ситуации — например, появляется возможность удаления файла, который нельзя прочитать, или записи в файл, который нельзя удалить.
Хотя из-за подобных ситуаций файловая система на первый взгляд кажется нелогичной, в действительности они способствуют широте возможностей UNIX. Реализация ссылок (два имени, ссылающиеся на один файл) становится чрезвычайно простой — в двух элементах каталога просто указывается один номер индексного узла. Структура индексного узла содержит количество элементов каталога, ссылающихся на данный файл (nlink в списке значений, возвращаемых stat), что позволяет операционной системе хранить и поддерживать лишь одну копию времени модификации, размера и других атрибутов файла. При уничтожении ссылки на элемент каталога блоки данных удаляются лишь в том случае, если это была последняя ссылка для индексного узла данного файла, а сам файл не остается открытым ни в одном процессе. Можно вызвать unlink и для открытого файла, но дисковое пространство будет освобождено лишь после его закрытия последним процессом.
Ссылки делятся на два типа. Тип, описанный выше (два элемента каталога, в которых указан один номер индексного узла), называется прямой (или жесткой)
Резюме
Имена файлов хранятся в каталогах отдельно от размера, атрибутов защиты и прочих метаданных, хранящихся в индексном узле.
Функция stat возвращает информацию индексного узла (метаданные).
Функции opendir, readdir и их спутники обеспечивают доступ к именам файлов в каталоге с помощью манипулятора каталога.
Манипулятор каталога похож на файловый манипулятор, но не идентичен ему. В частности, для манипулятора каталога нельзя вызвать о.
Права доступа к каталогу определяют, можете ли вы прочитать или записать список имен файлов. Права доступа к файлу определяют, можете ли вы изменить метаданные или содержимое файла.
В индексном узле хранятся три атрибута времени. Ни один из них не определяет время создания файла.
9.1. Получение и установка атрибутов времени
Проблема
Требуется получить или изменить время последней модификации (записи или изменения) или обращения (чтения) для файла.
Решение
Функция stat получает атрибуты времени, а функция utime устанавливает их значения. Обе функции являются встроенными в Perl:
(SREADTIME, SWRITETIME) = (stat($filename))[8,9]; utime($NEWREADTIME, $NEWWRITETIME, Sfilename);
Комментарий
Как говорилось во введении, в традиционной файловой системе UNIX с каждым индексным узлом связываются три атрибута времени. Любой пользователь может установить значения atime и mtime функцией utime, если он имеет право записи в каталог, содержащий файл. Изменить ctime практически невозможно. Следующий пример демонстрирует вызов функции utime:
$SECONDS_PER_DAY = 60 » 60 * 24; ($atime, Smtime) = (stat($file))[8,9]; Satime -= 7 * $SECONDS_PER_DAY; Smtime -= 7 ¦ $SEC0NDS_PER_0AY;
utime($atime, Smtime, $file)
or die "couldn't backdate $file by a week w/ utime: $!";
Функция utime должна вызываться для обоих атрибутов, atime и mtime. Если вы хотите задать лишь одно из этих значений, необходимо предварительно получить другое с помощью функции stat:
Smtime = (stat $file)[9J; utime(time, Smtime, Sfile);
Применение модуля File::stat упрощает этот фрагмент:
use File::stat;
utime(time, stat($file)->mtime, Sfile);
Функция utime позволяет сделать вид, будто к файлу вообще никто не притрагивался (если не считать обновления ctime). Например, для редактирования файла можно воспользоваться программой из примера 9.1.
Пример 9.1. uvi
#!/usr/bin/perl -w
# uvi - редактирование файла в vi без изменения атрибутов времени
Sfile = shift or die "usage: uvi filename\n"; ($atime, Smtime) = (stat($file))[8,9]; system($ENV{EDITOR} || "vi", Sfile); utime($atime, Smtime, Sfile)
or die "couldn't restore Sfile to orig times: $!";
D> Смотри также------------------------------------------------------------------------------------------
Описание функций stat и utime в perlfunc(l); стандартный модуль File;:stat и страница руководства utime(3).
9.2. Удаление файла
Проблема
Требуется удалить файл. Функция Perl delete вам не подходит.
Решение
Воспользуйтесь функцией Perl unlink:
unlink(SFILENAME) or die "Can't delete SFILENAME: $!\n"
unlink(@FILENAMES) == ^FILENAMES or die
"Couldn't unlink all of ©FILENAMES: $!\n";
Функция unlink была названа по имени системной функции UNIX. В Perl она получает список имен файлов и возвращает количество успешно удаленных файлов. Возвращаемое значение можно проверить с помощью | | или or:
unlmk($file) or die Can t unlink $file V
Функция unlink не сообщает, какие файлы не были удалены — лишь их общее количество. Следующий фрагмент проверяет, успешно ли состоялось удаление нескольких файлов, и выводит количество удаленных файлов:
unless (($count = unlmk(@filelist)) == @fllelist) { warn could only delete Scount of (@filelist) files , >
Перебор @fllelist в цикле foreach позволяет выводить отдельные сообщения об ошибках.
В UNIX удаление файла из каталога требует права записи для каталога1, а не для файла, поскольку изменяется именно каталог. В некоторых ситуациях появляется возможность удаления файла, в который запрещена запись, или записи в файл, который нельзя удалить.
Если удаляемый файл открыт некоторым процессом, операционная система удаляет элемент каталога, но не освобождает блоки данных до закрытия файла во всех процессах. Именно так работает функция newjtrnpf lie в IO.File (см рецепт 7.5).
> Смотри также---------------------------------------------------------------------------------------------
Описание функции unlink в perlfunc(l); страница руководства unhnk{2). Идея с удаленным файлом, который продолжает оставаться доступным, применяется в рецепте 7.5.
9.3. Копирование или перемещение файла
Проблема
Необходимо скопировать файл, однако в Perl не существует встроенной команды копирования.
Решение
Воспользуйтесь функцией сору стандартного модуля File::Copy.
use File Copy, copy($oldfile, Snewfile),
9.3. Копирование или перемещение файла 331 То же самое делается и вручную:
|
open(IN, |
< |
Soldfile ) |
or |
die |
can |
t |
open |
$oldfile |
$i |
|
open(OUT, |
> |
Snewfile ) |
or |
die |
can |
t |
open |
Snewfile |
$' |
while ($len = sysread IN, $buf, $blksize) { if (idefined $len) {
next if V =~ /"Interrupted/ die System read error $'\n , >
$offset = 0,
while ($len) { # Частичные операции записи
defmed($written = syswnte OUT $buf, $len, Soffset)
or die System write error $'\en $len -= $written, $offset += Swntten,
close(IN) close(OUT),
Также можно воспользоваться программой сору вашей системы:
system( cp $oldfile $newfile ), # unix
systera( copy Soldfile $newfile ) # dos, vms
Комментарий
Модуль File::Copy содержит функции copy и move. Они удобнее низкоуровневых функций ввода/вывода и обладают большей переносимостью по сравнению с вызовом system. Функция move допускает перемещение между каталогами, а стандартная функция Perl rename — нет (обычно).
use File Copy,
сору( datafile dat , datafile bak ) or die copy failed $'
move( datafile new , datafile dat ) or die move failed $' ,
Поскольку обе функции возвращают лишь простой признак успешного завершения, вы не сможете легко определить, какой файл помешал успешному копированию или перемещению. При ручном копировании файлов можно узнать, какие файлы не были скопированы, но в этом случае ваша программа забивается сложными вызовами sysread и syswnte.
Смотри также
Описание функций rename, read и syswnte вperlfunc(l); документация по стандартному модулю File::Copy.
Проблема
Требуется узнать, соответствуют ли два имени файла из списка одному и тому же файлу на диске (благодаря жестким и символическим ссылкам два имени могут ссылаться на один файл). Такая информация поможет предотвратить модификацию файла, с которым вы уже работаете.
Решение
Создайте хэш, кэшируемый по номеру устройства и индексного узла для уже встречавшихся файлов. В качестве значений хэша используются имена файлов:
%seen = ();
sub do_my_thing {
my $filename = shift;
my ($dev, $ino) = stat $filename;
unless (! $seen{$dev, $ino}++) {
# Сделать что-то с Sfilename, поскольку это имя
# нам еще не встречалось
Комментарий
Ключ %seen образуется объединением номеров устройства ($dev) и индексного узла ($ino) каждого файла. Для одного файла номера устройства и индексного узла совпадут, поэтому им будут соответствовать одинаковые ключи.
Если вы хотите вести список всех файлов с одинаковыми именами, то вместо подсчета экземпляров сохраните имя файла в анонимном массиве:
foreach $filenarne (©files) {
($dev, $ino) = stat Sfilename;
push( @< $seen{$dev,$ino} >, Sfilename);
foreach $devino (sort keys %seen) {
($dev, $ino) = split(/$;/o, $devino); if (@{$seen{$devino}> > 1) {
# @{$seen{$devino}} - список имен одного файла
Переменная $; содержит строку-разделитель и использует старый синтаксис эмуляции многомерных массивов, $hash{$x, $y, $z}. Хэш остается одномерным,
однако он имеет составной ключ. В действительности ключ представляет собой join($; =>$x, $y, $z). Функция split снова разделяет составляющие. Хотя многоуровневый хэш можно использовать и напрямую, здесь в этом нет необходимости и дешевле будет обойтись без него.
> Смотри также---------------------------------------------------------------------------------------------
Описание переменной $; вperlvai~(l); описание функции stat вperlfunc(\).
9.5. Обработка всех файлов каталога
Проблема
Требуется выполнить некоторые действия с каждым файлом данного каталога.
Решение
Откройте каталог функцией opendir и последовательно читайте имена файлов функцией readdir:
opendir(DIR, $dirname) or die "can't opendir $dirname: $!"; while (defined($file = readdir(DIR))) { # Сделать что-то с "$dirname/$file" } closedir(DIR);
Комментарий
Функции opendir, readdir и closedir работают с каталогами по аналогии с функциями open, read и close, работающими с файлами. В обоих случаях используются манипуляторы, однако манипуляторы каталогов, используемые opendir и другими функциями этого семейства, отличаются от файловых манипуляторов функции open и других. В частности, для манипулятора каталога нельзя использовать оператор о.
В скалярном контексте readdi г возвращает следующее имя файла в каталоге, пока не будет достигнут конец каталога — в этом случае возвращается undef. В списковом контексте возвращаются остальные имена файлов каталога или пустой список, если файлов больше нет. Как объяснялось во введении, имена файлов, возвращаемые readdir, не содержат имя каталога. При работе с именами, полученными от readdir, необходимо либо заранее перейти в нужный каталог, либо вручную присоединить его к имени.
Ручное присоединение может выглядеть так:
$dir = "/usr/local/bin"; print "Text files in $dir are:\n"; opendir(BIN, $dir) or die "Can't open $dir: $!"; wbile( defined ($file = readdir BIN) ) { print "$file\n" if -T "$dir/$file";
Мы проверяем $file с помощью defined, поскольку простое условие while ($file = readdi г BIN) проверяет истинность, а не определенность. Хотя наш цикл завершается после перебора всех файлов, возвращаемых readdi г, он также завершится преждевременно при наличии файла с именем "О".
Функция readdi г также возвращает специальные каталоги "." (текущий каталог) и ". ." (родительский каталог). Обычно они пропускаются фрагментом следующего вида:
while ( defined ($file = readdir BIN) ) {
next if $file =" /"\.\.?$/; # Пропустить . и ..
Манипуляторы каталогов, как и файловые манипуляторы, существуют на уровне пакетов. Более того, локальный манипулятор каталога можно получить двумя способами: с помощью local *DIRHANDLE или модуля (см. рецепт 7.16). В данном случае нужен модуль DirHandle. Следующий фрагмент использует DirHandle для получения отсортированного списка обычных файлов, которые не являются «скрытыми» (имена которых не начинаются с "."):
use DirHandle;
sub plainflies {
my $dir = shift;
my $dh = DirHandle->new($dir) or die "can't opendir $dir: $!";
return sort # Отсортировать имена
grep { -f } # Выбрать "обычные" файлы
map { "$dir/$_" } # Построить полные пути
grep { !/~\./ } # Отфильтровать скрытые файлы
$dh->read(); й Прочитать все элементы }
Метод read модуля DirHandle работает так же, как и readdir, и возвращает остальные имена файлов. Нижний вызов grep оставляет лишь те имена, которые не начинаются с точки. Вызов тар преобразует имена файлов, полученные от read, в полные, а верхний вызов g rep отфильтровывает каталоги, ссылки и т. д. Полученный список сортируется и возвращается.
В дополнение к readdir также существуют функции rewinddir (перемещает манипулятор каталога к началу списка файлов), seekdir (переходит к конкретному смещению в списке) и telldir (определяет смещение от начала списка).
> Смотри также---------------------------------------------------------------------------------------------
Описание функций closedir, opendir, readdir, rewinddir, seekdir и telldir в perlfunc(i); документация по стандартному модулю DirHandle.
9.6. Получение списка файлов по шаблону
Проблема
Требуется получить список файлов по шаблону, аналогичному конструкциям *.* (MS-DOS) и *.h (UNIX).
Решение
Семантика командного интерпретатора С shell системы UNIX поддерживается в Perl с помощью ключевого слова glob и оператора <>:
©list = о. о; @list = glob("*.c");
Для ручного извлечения имен файлов можно воспользоваться функцией readdir:
opendir(DIR, $path);
©files = grep { /\.c$/ } readdir(DIR);
closedir(DIR);
Модуль File::KGlob от CPAN получает список файлов без ограничений длины:
use File::KGlob;
©files = glob("*.c");
Комментарий
Встроенная функция Perl glob и запись <ШАБЛОН> (не путать с записью <МАНИПУ-ЛЯТОР>!) в настоящее время на большинстве платформ используют внешнюю программу для получения списка файлов. В UNIX это программа csh\ а в Windows — dosglob.exe. На Macintosh и в VMS это реализуется на внутреннем уровне, без внешних программ. Предполагается, что шаблоны обеспечивают семантику С shell во всех системах, отличных от UNIX, и улучшают переносимость. Из-за использования интерпретатора в UNIX такое решение не подходит для сценариев с атрибутом setuid.
Чтобы справиться с затруднениями, можно реализовать собственный механизм отбора с применением встроенного оператора opendir или модуля File::KGlob от CPAN — в обоих случаях внешние программы не используются. File::KGlob обеспечивает семантику отбора по типу интерпретаторов UNIX, тогда как opendir позволяет отбирать файлы с помощью регулярных выражений Perl.
В простейшем решении с opendir список, возвращаемый readdir, фильтруется с помощью grep:
©files = grep { /\.[ch]$/i } readdir(OH);
use DirHandle,
$dh = DirHandle->new($path) or die Can t open $path $'\n , @files = grep { /\ [ch]$/i } $dh->read(),
Как обычно, возвращаемые имена файлов не содержат каталога. При использовании имени каталог приходится присоединять вручную:
opendir(DH, $dir) or die Couldn t open $dir for reading $' ,
©files = ()
while( defined ($file = readdir(DH)) ) { next unless /\ [ch]$/i
my $filename = $dir/$file , push(@files, $filename) if -T $file,
В следующем примере чтение каталога и фильтрация для повышения эффективности объединяются с преобразованием Шварца (см. главу 4 «Массивы»), В массив @dirs заносится отсортированный список подкаталогов, имена которых представляют собой числа:
|
# |
Извлечение имен |
||
|
->[0] } |
# |
Числовая сортировка |
имен |
|
# |
Каталоги |
||
|
_ ] } |
# |
Сформировать (имя, |
путь) |
|
й |
Только числа |
||
|
# |
Все файлы |
sort { $а->[0] <=> grep { -d $_->[1] } тар { [ $_, $path/$_ grep { /~\d+$/ } readdir(DIR),
В рецепте 4.14 показано, как читать подобные странные конструкции. Как обычно, форматирование и документирование кода заметно упрощает его чтение и понимание.
D> Смотри также---------------------------------------------------------------------------------------------
Описание функций closedir, opendir, readdir, rewinddir, seekdir и telldir в perlfunc(l); документация по стандартному модулю DirHandle; раздел «I/O Operators» perlop(l); рецепты 6.9; 9.7.
9.7. Рекурсивная обработка всех файлов каталога
Проблема
Требуется выполнить некоторую операцию с каждым файлом и подкаталогом некоторого каталога.
Решение
Воспользуйтесь стандартным модулем File::Find.
use File Find, sub process_file {
# Делаем то, что хотели } find(\&process_file, @DIRLIST),
Комментарий
Модуль File:: Fmd обеспечивает удобные средства рекурсивной обработки файлов. Просмотр каталога и рекурсия организуются без вашего участия. Достаточно передать find ссылку на функцию и список каталогов. Для каждого файла в этих каталогах find вызовет заданную функцию.
Перед вызовом функции find переходит в указанный каталог, имя которого по отношению к начальному каталогу хранится в переменной $File Find dir. Переменной $_ присваивается базовое имя файла, а полный путь к этому файлу находится в переменной $File Find name. Ваша программа может присвоить $File Find prune истинное значение, чтобы функция find не спускалась в только что просмотренный каталог.
Использование File::Find демонстрируется следующим простым примером. Мы передаем find анонимную подпрограмму, которая выводит имя каждого обнаруженного файла и добавляет к именам каталогов /:
@ARGV = qw( ) unless @ARGV
use File Find,
find sub { print $File Find name, -d && / , \n }, @ARGV,
Для вывода / после имен каталогов используется оператор проверки -d, который при отрицательном результате возвращает пустую строку ''.
Следующая программа выводит суммарный размер всего содержимого каталога. Она передает find анонимную подпрограмму для накопления текущей суммы всех рассмотренных ей файлов. Сюда входят не только обычные файлы, но и все типы индексных узлов, включая размеры каталогов и символических ссылок. После выхода из функции find программа выводит накопленную сумму.
use File Find,
@ARGV = (' ') unless @ARGV,
my $sum = 0,
find sub { $sum += -s }, @ARGV,
print @ARGV contains $sum bytes\n ,
Следующий фрагмент ищет самый большой файл в нескольких каталогах:
use File Find,
@ARGV = ( ) unless @ARGV,
my ($saved_size, $saved_name) = (-1, ''),
sub biggest {
return unless -f && -s _ > $saved_size,
$saved_size = -s _,
$saved_name = $File Find name, }
find(\&biggest, @ARGV), print Biggest file $saved_name in @ARGV is $saved_size bytes long \n ,
Программу нетрудно изменить так, чтобы она находила файл, который изменялся последним:
use File::Find;
@ARGV = ('.') unless @ARGV;
my (Sage, $name);
sub youngest {
return if defined Sage && Sage > -M;
$age = (stat(_))[9];
$name = $File::Find::name; }
find(\&youngest, @ARGV); print "Sname " . scalar(localtime($age)) . "\n";
Модуль File::Find не экспортирует имя переменной $name, поэтому на нее следует ссылаться по полному имени. Пример 9.2 демонстрирует скорее работу с пространствами имен, нежели рекурсивный перебор в каталогах. Он делает переменную $name текущего пакета синонимом переменной File::Find (в сущности, именно на этом основана работа модуля Exporter). Затем мы объявляем собственную версию find с прототипом, обеспечивающим более удобный вызов.
Пример 9.2. fdirs
#!/usr/bin/perl -lw
# fdirs - поиск всех каталогов
@ARGV = qw(.) unless @ARGV;
use File::Find ();
sub find(&@) { &File::Find::find }
«name = *File::Find::name;
find { print $name if -d } @ARGV;
Наша версия find вызывает File::Find, импортирование которой предотвращается включением пустого списка () в команду use. Вместо записи вида:
find sub { print $File::Find::name if -d }, @ARGV; можно написать более приятное
find { print $name if -d > @>ARGV;
> Смотри также---------------------------------------------------------------------------------------------
Man-страница find(l); рецепт 9.6; документация по стандартным модулям File::Find и Exporter.
9.8. Удаление каталога вместе с содержимым
Проблема
Требуется рекурсивно удалить ветвь дерева каталога без применения гт -г.
Решение
Воспользуйтесь функцией f inddepth модуля File::Find (см. пример 9.3). Пример 9.3. rmtreel
#!/usr/bin/perl
# rmtreel - удаление ветви дерева каталогов (по аналогии с гт -г)
use File::Find qw(finddepth);
die "usage: $0 dir ..\n" unless @ARGV; «name = *File::Find::name; finddepth \&zap, @ARGV; sub zap {
if (!-l && -d _) {
print "rmdir $name\n";
rmdir($name) or warn "couldn't rmdir $name: $!"; } else {
print "unlink $name";
unlink($name) or warn "couldn't unlink $name: $!"; } }
Или воспользуйтесь функцией rmtree модуля File::Path (см. пример 9.4). Пример 9.4. rmtree2
#!/usr/bin/perl
# rmtree2 - удаление ветви дерева каталогов (по аналогии с гт -г)
use File::Path;
die "usage: $0 dir . .\n" unless @ARGV;
foreach $dir (@ARGV) {
rmtree($dir); }
> Предупреждение------------------------------------------------------------------------------ ¦——
Эти программы удаляют целые ветви дерева каталогов. Применяйте крайне осторожно!
Комментарий
Модуль File::Find экспортирует функцию find, которая перебирает содержимое каталога практически в случайном порядке следования файлов, и функцию finddepth, гарантирующую перебор всех внутренних файлов перед посещением самого каталога. Именно этот вариант поведения использован нами для удаления каталога вместе с содержимым.
Перед тем как проверять, является ли файл каталогом, необходимо узнать, не является ли он символической ссылкой, -d возвращает true и для каталога, и для символической ссылки на каталог. Функции stat, lstat и операторы проверки (типа -d) используют системную функцию stat(2), которая возвращает всю информацию о файле, хранящуюся в индексном узле. Эти функции и операторы сохраняют полученную информацию и позволяют выполнить дополнительные проверки того же файла с помощью специального манипулятора _. При этом удается избежать лишних вызовов системных функций, возвращающих старую информацию и замедляющих работу программы.
> Смотри также---------------------------------------------------------------------------------------------
Описание функций unlink, rmdir, lstat и stat в perlfunc(l); документация по стандартному модулю File::Find; man-страницы ?ти(1) и stat(2); раздел perl-func(l), посвященный операторам -X.
9.9. Переименование файлов
Проблема
Требуется переименовать файлы, входящие в некое множество.
Решение
Воспользуйтесь циклом foreach и функцией rename:
foreach $file (@NAMES) { my Inewname = $file; ft change $file rename($file, $newname) or
warn "Couldn't rename $file to Snewname: $!\n";
Комментарий
Программа вполне тривиальна. Функция rename получает два аргумента — старое и новое имя. Функция rename предоставляет интерфейс к системной функции переименования, которая обычно позволяет переименовывать файлы только в том случае, если старое и новое имена находятся в одной файловой системе.
После небольших изменений программа превращается в универсальный сценарий переименования вроде написанного Ларри Уоллом (см. пример 9.5).
Пример 9.5. rename
#'/usr/bin/perl -w
# rename - переименование файлов от Ларри
$ор = shift or die "Usage: rename expr [files]\n";
chomp(@ARGV = <STDIN>) unless @ARGV;
for (@ARGV) { $was = $_; eval Sop; die $@ if $@; rename($was,$_) unless $was eq $_;
Первый аргумент сценария — код Perl, который изменяет имя файла, хранящееся в $_, и определяет алгоритм переименования. Вся черная работа поручается функции eval. Кроме того, сценарий пропускает вызов rename в том случае, если имя осталось прежним. Это позволяет просто использовать универсальные символы (rename EXPR *) вместо составления длинных списков имен.
Приведем пять примеров вызова программы rename из командного интерпретатора:
% rename 's/\.orig$//' ¦.orig
% rename 'tr/A-Z/a-z/ unless /"Make/' *
% rename '$_ .= ".bad"' *.f
% rename 'print "$_: "; s/foo/bar/ if <STDIN> =~ /~y/i' *
% find /tmp -name '•"' -print | rename 's/"(.+)"$/.#$1/'
Первая команда удаляет из имен файлов суффикс .orig.
Вторая команда преобразует символы верхнего регистра в символы нижнего регистра. Поскольку вместо функции 1с используется прямая трансляция, такое преобразование не учитывает локальный контекст. Проблема решается следующим образом:
% rename 'use locale; $_ = lc($_) unless/"Make/' *
Третья команда добавляет суффикс .bad к каждому файлу Fortran с суффиксом ". f" — давняя мечта многих программистов.
Четвертая команда переименовывает файлы в диалоге с пользователем. Имя каждого файла отправляется на стандартный вывод, а из стандартного ввода читается ответ. Если пользователь вводит строку, начинающуюся с "у" или "Y", то все экземпляры "foo" в имени файла заменяются на "bar".
Пятая команда с помощью find ищет в /tmp файлы, имена которых заканчиваются тильдой. Файлы переименовываются так, чтобы они начинались с префикса .#. В сущности, мы переключаемся между двумя распространенными конвенциями выбора имен файлов, содержащих резервные копии.
В сценарии rename воплощена вся мощь философии UNIX, основанной на утилитах и фильтрах. Конечно, можно написать специальную команду для преобразования символов в нижний регистр, однако ничуть не сложнее написать гибкую, универсальную утилиту с внутренним eval. Позволяя читать имена файлов из стандартного ввода, мы избавляемся от необходимости рекурсивного перебора каталога. Вместо этого мы используем функцию find, которая прекрасно справляется с этой задачей. Не стоит изобретать колесо, хотя модуль File::Find позволяет это сделать.
> Смотри также---------------------------------------------------------------------------------------------
Описание функции rename вperifunc{\)\ страницы руководства mv(l) и гепате(2); документация по стандартному модулю File::Find.
342 Глава 9 • Каталоги
9.10. Деление имени файла на компонентыПроблема
Имеется строка, содержащая полное имя файла. Из нее необходимо извлечь компоненты (имя, каталог, расширение (-я)).
Решение
Воспользуйтесь функциями стандартного модуля File::Basename.
use File::Basename;
$base = basename(Spath);
$dir = dirname($path);
($base, $dir, $ext) = fileparse($path);
Комментарий
Функции деления имени файла присутствуют в стандартном модуле File::Base-name. Функции dirname и basename возвращают соответственно каталог и имя файла:
$path = '/usr/lib/libc.a'; $file = basename($path); $dir = dirname($path);
print "dir is $dir, file is $file\n"; tt dir is /usr/lib, file is libc.a
Функция fileparse может использоваться для извлечения расширений. Для этого передайте fileparse полное имя и регулярное выражение для поиска расширения. Шаблон необходим из-за того, что расширения не всегда отделяются точкой. Например, что считать расширением в ".tar.gz" — ".tar", ".gz" или ".tar.gz"? Передавая шаблон, вы определяете, какой из перечисленных вариантов будет возвращен:
$path = '/usr/lib/libc.a'; ($name,$dir,$ext) = fileparse($path,'\-¦*')'.
print "dir is $dir, name is $name, extension is $ext\n"; # dir is /usr/lib/, name is libc, extension is .a
По умолчанию в работе этих функций используются разделитель, определяемый стандартными правилами вашей операционной системы. Для этого используется переменная $~0; содержащаяся в ней строка идентифицирует текущую систему. Ее значение определяется в момент построения и установки Perl. Значение по умолчанию можно установить с помощью функции f ileparse_set_f stype. В результате изменится и поведение функций File::Basename при последующих вызовах:
9.11. Программа: symirror 343
fileparse_set_fstype("MacOS");
$path = "Hard%20Drive:System%20Folder:README.txt";
($nane,$dir,$ext) = fileparse($path,'\..*');
print "dir is $dir, name is $name, extension is $ext\n";
# dir is Hard%20Drive:System%20Folder, name is README, extension is .txt
Расширение можно получить следующим образом: ,
sub extension {
my $path = shift;
my $ext = (fileparse($path, Д.. *'))[2];
$ext =~ s/"\.//;
return $ext; }
Для файла source.c.bak вместо простого "bak" будет возвращено расширение "с. bak". Если вы хотите получить именно "bak", в качестве второго аргумента fileparse используйте ' \. . *?'.
Если передаваемое полное имя заканчивается разделителем каталогов (например, lib/), fileparse считает, что имя каталога равно "lib/", тогда как dirname считает его равным ".".
\> Смотри также--------------------------------------------------------------------------------------------
Описание переменной $"0 вperlvai-(l); документация по стандартному модулю File::Basename.
9.11. Программа: symirror
Программа из примера 9.6 рекурсивно воспроизводит каталог со всем содержимым и создает множество символических ссылок, указывающих на исходные файлы.
Пример 9.6. symirror
#! /usr/bin/perl -w
# symirror - дублирование каталога с помощью символических ссылок
use strict;
use File;:Find;
use Cwd;
my ($srcdir, Sdstdir);
my $cwd = getcwd();
die "usage: $0 realdir mirrordir" unless @ARGV == 2;
for ((Ssrcdir, $dstdir) = @ARGV) { my $is_dir = -d;
next if $is_dir; # Нормально
if (defined ($is_dir)) {
die "$0: $_ is not a directory\n";
продолжение &
344 Глава 9 • Каталоги Пример 9.6 (продолжение)
} else { # Создать каталогmkdir($dstdir, 07777) or die "can't mkdir $dstdir: $!"; } } continue {
s#~(?!/)#$cwd/#; # Исправить относительные пути
chdir $srcdir; find(\&wanted, '.');
sub wanted {
my($dev, $ino, $mode) = lstat($_); my $name = $File::Find::name;
$mode &= 07777; # Сохранить права доступа
$name =~ s!~\./!!.' # Правильное имя
if (-d _) { # Затем создать каталог
mkdir("$dstdir/$name", $mode)
or die "can't mkdir $dstdir/$name: $!";
} else { # Продублировать все остальное
symlink("$srcdir/$name", "$dstdir/$name")
or die "can't symlink $srcdir/$name to $dstdir/$name: $!'
9.12. Программа: 1st
Вам не приходилось отбирать из каталога самые большие или созданные последними файлы? В стандартной программе Is предусмотрены параметры для сортировки содержимого каталогов по времени (флаг -t) и для рекурсивного просмотра подкаталогов (флаг -R). Однако Is делает паузу для каждого каталога и выводит только его содержимое. Программа не просматривает все подкаталоги, чтобы потом отсортировать найденные файлы.Следующая программа 1st справляется с этой задачей. Ниже показан пример подробного вывода, полученного с использованием флага -1:
% 1st -1 /etc
|
12695 0600 1 |
root |
wheel |
|
/etc/ssh_random_seed |
||
|
12640 0644 1 |
root |
wheel |
|
/etc/Id.so.cache |
||
|
12626 0664 1 |
root |
wheel |
|
/etc/psdevtab |
||
|
12304 0644 1 |
root |
root |
|
/etc/exports |
||
|
12309 0644 1 |
root |
root |
|
/etc/inetd.conf |
||
|
12399 0644 1 |
root |
root |
|
/etc/sendmail.cf |
||
|
18774 0644 1 |
gnat |
perldoc |
10104 Моп May 25 7:39:19 1998
12288 Sun May 24 19:23:08 1998
237 Sun May 24 13:59:33 1998
3386 Sun May 24 13:24:33 1998
30205 Sun May 24 10:08:37 1998
2199 Sun May 24 9:35:57 1998
9.12. Программа: 1st 345
/etc/X11/XMetroconfig 12636 0644 1 root wheel 290 Sun May 24 9:05:40 1998
/etc/mtab 12627 0640 1 root root 0 Sun May 24 8:24:31 1998
/etc/wtmplock 12310 0644 1 root tchrist 65 Sun May 24 8:23:04 1998
/etc/issue
Файл /etc/X11/XMetroconfig оказался посреди содержимого /etc, поскольку листинг относится не только к /etc, но и ко всему, что находится внутри каталога.
К числу поддерживаемых параметров также относится сортировка по времени последнего чтения вместо записи (-и) и сортировка по размеру вместо времени (-s). Флаг -i приводит к получению списка имен из стандартного ввода вместо рекурсивного просмотра каталога функцией find. Если у вас уже есть готовый список имен, его можно передать 1st для сортировки.
Исходный текст программы приведен в примере 9.7.
Пример 9.7. 1st
#!/usr/bin/perl
# 1st - вывод отсортированного содержимого каталогов
use Getopt::Std;
use File::Find;
use File::stat;
use User::pwent;
use User::grent;
getopts('lusrcmi') or die «DEATH; Usage: $0 [-mucsril] [dirs ...] or $0 -i [-mucsrl] < filelist
Input format:
-i read pathnames from stdin Output format:
-1 long listing Sort on:
-m use mtime (modify time) [DEFAULT]
-u use atime (access time)
-c use ctime (inode change time)
-s use size for sorting Ordering:
-r reverse sort
NB: You may only use select one sorting option at a time. DEATH
unless ($opt_i || @ARGV) { @ARGV = ('.') }
if ($opt_c + $opt_u + $opt_s + $opt_m > 1) {
продолжение &
die can only sort on one time or size , }
$IDX = mtine ,
$IDX = atime if $opt_u,
$IDX = ctime if $opt_c,
$IDX = size if $opt_s,
$TIME_IDX = $opt_s ? mtime $IDX
*name = *File Find name, # Принудительное импортирование переменной
Я Флаг $opt_i заставляет wanted брать имена файлов # из ARGV вместо получения от find
if ($opt_i) {
•name = *_ # $name теперь является синонимом $_ while (о) { chomp, &wanted } В Все нормально это не stdin } else {
fmd(\&wanted, @ARGV)
# Отсортировать файлы по кэшированным значениям времени,
# начиная с самых новых
@skeys = sort { $time{$b} <=> $time{$a} } keys %time,
# Изменить порядок, если в командной строке был указан флаг -г
@skeys = reverse @skeys if $opt_r
for ((°>skeys) {
unless ($opt_l) { # Эмулировать Is -1, кроме прав доступа print $_\n , next, }
$now = localtine $stat{$_}->$TIME_IDX(), printf %6d %04o %6d %8s %8s %8d %s %s\n , $stat{$_}->mo(), $stat{$_}->mode() & 07777, $stat{$_}->nlink(), user($stat{$_}->uid()), group($stat{$J->gid()), $stat{$_}->size(), Snow, $_,
# Получить от stat информацию о файле сохраняя критерий
# сортировки (mtime, atime, ctime или size)
# в хэше %time, индексируемом по имени файла
# Если нужен длинный список, весь объект stat приходится
# сохранять в %stat Да, это действительно хэш объектов sub wanted {
my $sb = stat($_), # XXX stat или lstaf
return unless $sb,
$time{$name} = $sb->$IDX(), # Косвенный вызов метода
$stat{$name} = $sb if $opt_l,
# Кэширование преобразований идентификатора пользователя в имя sub user {
my $uid = shift,
$user{$uid} = getpwuid($uid)->name || #$uid unless defined $user{$uid}
return $user{$uid},
# Кэширование преобразований номера группы в имя sub group {
my $gid = shift,
$group{$gid> = getgrgid($gid)->name || unless defined $group{$gid},
return $group{$gid}
Подпрограммы
Огнем бессмертным наполняя смертных... В. Оден, «Три песни ко Дню святой Сесилии»
Введение
Практика вставки/копирования кода довольно опасна, поэтому в больших программах многократно используемые фрагменты кода часто оформляются в виде подпрограмм. Для нас термины «подпрограмма» (subroutine) и «функция» (function) будут эквивалентными, поскольку в Perl они различаются ничуть не больше, чем в С. Даже объектно-ориентированные методы представляют собой обычные подпрограммы со специальным синтаксисом вызова, описанным в главе 13 «Классы, объекты и связи».
Подпрограмма объявляется с помощью ключевого слова sub. Пример определения простой подпрограммы выглядит так:
sub hello {
$greeted++; # Глобальная переменная
print 'hi there\n'' ; }
Типичный способ вызова этой подпрограммы выглядит следующим образом:
helloQ; # Подпрограмма hello вызывается без аргументов/параметров
Перед выполнением программы Perl компилирует ее, поэтому место объявления подпрограммы не имеет значения. Определения не обязаны находиться в одном файле с основной программой. Они могут быть взяты из других файлов с помощью операторов do, require или use (см. главу 12 «Пакеты, библиотеки и модули»), создаваться «на месте» с помощью ключевого слова eval или механизма AUTOLOAD или генерироваться посредством замыканий, используемых в шаблонах функций.
Если вы знакомы с другими языками программирования, некоторые особенности функций Perl могут показаться странными. В большинстве рецептов этой главы показано, как применять эти особенности в свою пользу.
• Функции Perl не имеют формальных, именованных параметров, но это не
всегда плохо (см. рецепты 10.1 и 10.7).
• Все переменные являются глобальными, если обратное не следует из объяв
ления. Дополнительная информация приведена в рецептах 10.1 и 10.7.
• Передача или возвращение нескольких массивов или хэшей обычно приво
дит к потере ими «индивидуальности». О том, как избежать этого, расска
зано в рецептах 10.5, 10.8, 10.9 и 10.11.
• Функция может узнать свой контекст вызова (списковый или скалярный),
количество аргументов при вызове и даже имя функции, из которой она
была вызвана. О том, как это сделать, рассказано в рецептах 10.4 и 10.6.
• Используемое в Perl значение undef может использоваться в качестве при
знака ошибки, поскольку ни одна допустимая строка или число никогда не
принимает это значение. В рецепте 10.10 описаны некоторые неочевидные
трудности, связанные с undef, которых следует избегать, а в рецепте 10.12 по
казано, как обрабатываются другие катастрофические случаи.
• В Perl функции обладают рядом интересных возможностей, редко встреча
ющихся в других языках (например, анонимные функции, создание функ
ций «на месте» и их косвенный вызов через указатель на функцию). Эти
мистические темы рассматриваются в рецептах 10.14 и 10.16.
При вызове вида $х = &func; функция не получает аргументов, но зато может напрямую обращаться к массиву @_ вызывающей стороны! Если убрать ампер-санд и воспользоваться формой func() или func, создается новый, пустой экземпляр массива @_.
10.1. Доступ к аргументам подпрограммы
Проблема
В своей функции вы хотите использовать аргументы, переданные вызывающей стороной.
Решение
Все значения, переданные функции в качестве аргументов, хранятся в специальном массиве @_. Следовательно, первый аргумент хранится в элементе $_[0], второй — в $_[1] и т. д. Общее число аргументов равно scalar(@_). Например:
sub hypotenuse {
return sqrt( ($_[0] •• 2) + ($_[1] *¦ 2) );
$diag = hypotenuse(3,4); # $diag = 5
sub hypotenuse {
my ($side1, $side2) = <°>_;
return sqrt( ($side1 ** 2) + ($side1 ** 2) );
Комментарий
Говорят, в программировании есть всего три удобных числа: ноль, единица и «сколько угодно». Механизм работы с подпрограммами Perl разрабатывался для упрощения написания функций со сколь угодно большим (или малым) числом параметров и возвращаемых значений. Все входные параметры хранятся в виде отдельных скалярных значений в специальном массиве @_, который автоматически становится локальным для каждой функции (см. рецепт 10.13). Для возвращения значений из подпрограмм следует использовать команду return с аргументом. Если она отсутствует, возвращаемое значение представляет собой результат последнего вычисленного выражения.
Приведем несколько примеров вызова функции hypotenuse, определенной в решении:
print hypotenuse(3, 4), "\n"; # Выводит 5
@а = (3, 4);
print hypotenuse(@a), "\n"; # Выводит 5
Если взглянуть на аргументы, использованные во втором вызове hypotenuse, может показаться, что мы передали лишь один аргумент — массив @а. Но это не так — элементы @а копируются в массив @_ по отдельности. Аналогично, при вызове функции с аргументами (@>а, @Ь) мы передаем ей все аргументы из обоих массивов. При этом используется тот же принцип, что и при сглаживании списков:
@both = (@men, @women);
Скалярные величины в @_ представляют собой неявные синонимы для передаваемых значений, а не их копии. Таким образом, модификация элементов @_ в подпрограмме приведет к изменению значений на вызывающей стороне. Это тяжкое наследие пришло из тех времен, когда в Perl еще не было нормальных ссылок.
Итак, функцию можно записать так, чтобы она не изменяла свои аргументы — для этого следует скопировать их в закрытые переменные:
@nums = (1.4, 3.5, 6.7);
@ints = int_all((g>nums); # @nums не изменяется
sub int_all {
ray ©retlist = @_; 8 Сделать копию для return
for my $n (iaretlist) { $n = int($n) }
return @retlist;
Впрочем, функция также может изменять значения переменных вызывающей стороны:
@nums = (1.4, 3.5, 6.7);
trunc_en(@nums); # @nums = (1,3,6)
sub trunc_em {
for (@_) < $_ = int($_) } # Округлить каждый аргумент }
Таким функциям не следует передавать константы — например, trunc_em(1.4, 3.5, 6.7). Если попытаться это сделать, будет возбуждено исключение Modification of a read-only value attempted at... («Попытка модифицировать величину, доступную только для чтения»).
Встроенные функции chop и chomp работают именно так — они модифицируют переменные вызывающей стороны и возвращают удаленный символ(-ы). Многие привыкают к тому, что функции возвращают измененные значения, и часто пишут в программах следующее:
$line = chomp(o); # НЕВЕРНО
пока не поймут, что происходит в действительности. Учитывая широкие возможности для ошибок, перед модификацией @_ в подпрограмме стоит дважды подумать.
> Смотри также---------------------------------------------------------------------------------------------
perlsub(l).
10.2. Создание закрытых переменных в функциях
Проблема
В подпрограмме потребовалось создать временную переменную. Использование глобальных переменных нежелательно, поскольку другие подпрограммы могут получить к ним доступ.
Решение
Воспользуйтесь ключевым словом ту для объявления переменной, ограниченной некоторой областью программы:
sub somefunc {
my $variable; # Переменная $variable невидима
№ за пределами somefunc() my (Sanother, @an_array, %a_hash); # Объявляем несколько
# переменных сразу # ...
Оператор ту ограничивает использование переменной и обращение к ней определенным участком программы. За пределами этого участка переменная недоступна. Такой участок называется областью действия (scope).
Переменные, объявленные с ключевым словом ту, обладают лексической областью действия — это означает, что они существуют лишь в границах некоторого фрагмента исходного текста. Например, областью действия переменной $vanable из решения является функция somef unc, в которой она была определена. Переменная создается при вызове somef unc и уничтожается при ее завершении. Переменная доступна внутри функции, но не за ее пределами.
Лексическая область действия обычно представляет собой программный блок, заключенный в фигурные скобки, — например, определение тела подпрограммы somefunc или границы команд if, while, for, foreach и eval. Лексическая область действия также может представлять собой весь файл или строку, переданную eval. Поскольку лексическая область действия обычно является блоком, иногда мы говорим, что лексические переменные (переменные с лексической областью действия) видны только в своем блоке — имеется в виду, что они видны только в границах своей области действия. Простите нам эту неточность, иначе слова «область действия» и «подпрограмма» заняли бы половину этой книги.
Поскольку фрагменты программы, в которых видна переменная ту, определяются во время компиляции и не изменяются позднее, лексическая область действия иногда не совсем точно называется «статической областью действия». Ее противоположностью является динамическая область действия, рассмотренная в рецепте 10.13.
Объявление ту может сочетаться с присваиванием. При определении сразу нескольких переменных используются круглые скобки:
my ($name, $age) = @ARGV;
ту $start = fetch_time();
Эти лексические переменные ведут себя как обычные локальные переменные. Вложенный блок видит лексические переменные, объявленные в родительских по отношению к нему блоках, но не в других, не связанных с ними блоках:
my ($a, $b) = @pair; ту $с = fetch_time();
sub check_x {
ту $х = $_[0]; ту $у = 'whatever"; run_check(), if ($condition) { print "got $x\n";
В приведенном выше фрагменте блок if внутри функции может обращаться к закрытой переменной $х. Однако в функции run_check, вызванной из этой области, переменные $х и $у недоступны, потому что она предположительно определяется в другой области действия. Однако check_x может обращаться к $а, $Ь и $с из
внешней области, поскольку определяется в одной области действия с этими переменными.
Именованные подпрограммы не следует объявлять внутри объявлений других именованных подпрограмм. Такие подпрограммы, в отличие от полноценных замыканий, не обеспечивают правильной привязки лексических переменных. В рецепте 10.16 показано, как справиться с этим ограничением.
При выходе лексической переменной за пределы области действия занимаемая ей память освобождается, если на нее не существует ссылок, как для массива ^arguments в следующем фрагменте:
sub save_array {
my ©arguments = @_;
push(@Global_Array, \@arguments), }
Система сборки мусора Perl знает о том, что память следует освобождать лишь для неиспользуемых объектов. Это и позволяет избежать утечки памяти при возвращении ссылки на закрытую переменную.
> Смотри также---------------------------------------------------------------------------------------------
Раздел «Private Variables via my()» perlsub(l).
10.3. Создание устойчивых закрытых переменных
Проблема
Вы хотите, чтобы переменная сохраняла значение между вызовами подпрограммы, но не была доступна за ее пределами. Например, функция может запоминать, сколько раз она была вызвана.
Решение
«Заверните» функцию во внешний блок и объявите переменные ту в области действия этого блока, а не в самой функции:
{
my $variable, sub mysub {
П . обращение к $variable
Если переменные требуют инициализации, снабдите блок ключевым словом BEGIN, чтобы значение переменных заведомо задавалось перед началом работы основной программы:
BEGIN {
my $variable = 1, # Начальное значение
Глава 10 • Подпрограммы
sub othersub { # обращение к SvanableКомментарий
В отличие от локальных переменных в языках С и C++, лексические переменные Perl не всегда уничтожаются при выходе из области действия. Если нечто, продолжающее существовать, все еще помнит о лексической переменной, память не освобождается. В нашем примере mysub использует переменную $variable, поэтому Perl не освобождает память переменной при завершении блока, вмещающего определение mysub.
Счетчик вызовов реализуется следующим образом:
{
ray $counter,
sub next_counter { return ++$counter } }
При каждом вызове next_counter функция увеличивает и возвращает переменную $counter. При первом вызове переменная $counter имеет неопределенное значение, поэтому для оператора ++ она интерпретируется как 0. Переменная входит не в область действия next_counter, а в окружающий ее блок. Никакой внешний код не сможет изменить $counter без вызова next_counter.
Для расширения области действия обычно следует использовать ключевое слово BEGIN. В противном случае возможен вызов функции до инициализации переменной.
BEGIN {
my $counter = 42,
sub next_counter { return ++$counter }
sub prev_counter { return --$counter } }
Таким образом, в Perl создается аналог статических переменных языка С. В действительности он даже лучше — переменная не ограничивается одной функцией, и обе функции могут совместно использовать свою закрытую переменную.
t> Смотри также--------------------------------------------------------------------------------------------
Раздел «Private Variables via my()» perlsub{\); раздел «Package Constructors and Destructors» perlmod{l)\ рецепт 11.4.
10.4. Определение имени текущей функции
Проблема
Требуется определить имя функции, работающей в настоящий момент. Оно пригодится для сообщений об ошибках, которые не изменяются при копировании/ вставке исходного текста подпрограммы.
Решение
Воспользуйтесь функцией caller: $this_function = (caller(0))[3],
Комментарий
Программа всегда может определить текущей номер строки с помощью специ
альной метапеременной____ LINE____ . Текущий файл определяется с помощью мета-
переменной FILE_ , а текущий пакет — PACKAGE_ . Однако не существует ме
тапеременной для определения имени текущей подпрограммы, не говоря уже
об имени той, из которой она была вызвана.
Встроенная функция caller справляется со всеми затруднениями В скалярном контексте она возвращает имя пакета вызывающей функции, а в списковом контексте возвращается список с разнообразными сведениями. Функции также можно передать число, определяющее уровень вложенности получаемой информации: 0 — ваша функция, 1 — функция, из которой она была вызвана, и т. д.
Полный синтаксис выглядит следующим образом ($i — количество уровней вложенности):
(Spackage, $filenatne $line $subr $has_args $wantarray )= caller($i)
#0 1 2 3 4 5
Возвращаемые значения имеют следующий смысл:
Spackage
Пакет, в котором был откомпилирован код:
Sfilename
Имя файла, в котором был откомпилирован код Значение -е возвращается при запуске из командной строки, а значение - (дефис) — при чтении сценария из STDIN.
$line
Номер строки, из которой был вызван данный кадр стека:
$subr
Имя функции данного кадра, включающее ее пакет. Замыкания возвращают име
на вида main ____ ANON , вызов по ним невозможен. Для eval возвращается (eval) .
$has_args
Признак наличия аргументов при вызове функции:
$wantarray
Значение, возвращаемое функцией wantarray для данного кадра стека. Равно либо true, либо false, либо undef. Сообщает, что функция была вызвана в списковом, скалярном или неопределенном контексте.
Вместо непосредственного вызова caller, продемонстрированного в решении, можно написать вспомогательные функции:
$me = whoami(),
sub whoami { (caller(1))[3] } sub whowasi { (caller(2))[3] }
Аргументы 1 и 2 используются для функций первого и второго уровня вложенности, поскольку вызов whoami или whowasi будет иметь нулевой уровень.
> Смотри также---------------------------------------------------------------------------------------------
Описание функций wantarray и caller в perlfunc(l); рецепт 10.6.
10.5. Передача массивов и хэшей по ссылке
Проблема
Требуется передать функции несколько массивов или хэшей и сохранить их как отдельные сущности. Например, вы хотите выделить в подпрограмму алгоритм поиска элементов одного массива, отсутствующих в другом массиве, из рецепта 4.7, При вызове подпрограмма должна получать два массива, которые не должны смешиваться.
array_diff( \@>аггау1, \@аггау2 ),
Комментарий
Операции со ссылками рассматриваются в главе 11 «Ссылки и записи». Ниже показана подпрограмма, получающая ссылки на массивы, и вызов, в котором эти ссылки генерируются:
@а = (1, 2),
@Ь = (5, 8),
@с = add_vecpair( \@a, \@Ь ),
print @c\n ,
6 10
sub add_vecpair { и Предполагается, что оба вектора
й имеют одинаковую длину
ту ($х, $у) = @>_, # Скопировать ссылки на массивы
my @result,
for (my $i=0, $i < (Э$х $result[$i] = $x->[$i]
return ©result, }
Функция обладает одним потенциальным недостатком: она не проверяет, что ей были переданы в точности два аргумента, являющиеся ссылками на массивы. Проверку можно организовать следующим образом:
unless (@_ == 2 && ref($x) eq ARRAY && ref($y) eq ARRAY ) <
die usage add_vecpair ARRAYREF1 ARRAYREF2 , }
Если вы собираетесь ограничиться вызовом die в случае ошибки (см. рецепт 10.12), проверка обычно пропускается, поскольку при попытке разыменования недопустимой ссылки все равно возникает исключение.
> Смотри также---------------------------------------------------------------------------------------------
Раздел «Pass by Reference» perbub(l); раздел «Prototypes»perlsub(l); рецепт 10.11; глава 11.
10.6. Определение контекста вызова
Проблема
Требуется узнать, была ли ваша функция вызвана в скалярном или списковом контексте. Это позволяет решать разные задачи в разных контекстах, как это делается в большинстве встроенных функций Perl.
Решение
Воспользуйтесь функцией wantarray(), которая возвращает три разных значения в зависимости от контекста вызова текущей функции:
if (wantarray()) {
# Списковый контекст
>
elsif (defined wantarrayO) {
# Скалярный контекст
}
else {
# Неопределенный контекст
Комментарий
Многие встроенные функции, вызванные в скалярном контексте, работают совсем не так, как в списковом контексте. Пользовательская функция может узнать контекст своего вызова с помощью значения, возвращаемого встроенной функцией wantarray. Для спискового контекста wantarray возвращает true. Если возвращается ложное, но определенное значение, функция используется в скалярном контексте. Если возвращается undef, от функции вообще не требуется возвращаемого значения.
if (wantarray()) {
print "In list context\n';
return (9>many_things; } elsif (defined wantarrayO) {
print "In scalar context\n";
return $one_thmg; } else {
print "In void context\n';
return, # Ничего
mysub(); # Неопределенный контекст
$a = mysub(); # Скалярный контекст
if (mysubO) { } # Скалярный контекст
@>a = mysub(); # Списковый контекст
print mysubQ; # Списковый контекст
> Смотри также---------------------------------------------------------------------------------------------
Описание функций return и wantarray в perlfunc(l).
10.7. Передача именованных параметров
Проблема
Требуется упростить вызов функции с несколькими параметрами, чтобы программист помнил смысл параметров, а не порядок их следования.
Решение
Укажите имена параметров при вызове:
thefunc(INCREMENT => "20s", START => '+5m", FINISH => "+30m");
thefunc(START => '+5m", FINISH => "+30m");
thefunc(FINISH => "+30m");
thefunc(START => "+5m", INCREMENT => '15s");
Затем в подпрограмме создайте хэш, содержащий значения по умолчанию и массив пар:
|
sub |
thefunc { |
|||
|
my |
%args = ( |
|||
|
INCREMENT |
=> '10s', |
|||
|
FINISH |
=> 0, |
|||
|
START |
=> 0, |
|||
|
Ф_, |
# Список |
пар аргументов |
||
|
> |
if |
($args{INCREMENT} =" |
/m$/ ) { ... |
Комментарий
Функции, аргументы которых должны следовать в определенном порядке, удобны для небольших списков аргументов. Но с ростом количества аргументов становится труднее делать некоторые из них необязательными или присваивать им значения по умолчанию. Пропускать можно только аргументы, находящиеся в конце списка, и никогда — в начале.
Более гибкое решение — передача пар значений. Первый элемент пары определяет имя аргумента, а второй — значение. Программа автоматически документируется, поскольку смысл параметра можно понять, не читая полное определение функции. Более того, программистам, использующим такую функцию, не придется запоминать порядок аргументов, и они смогут пропускать любые аргументы.
Решение построено на объявлении в функции закрытого хэша, хранящего значения параметров по умолчанию. В конец хэша заносится массив текущих аргументов, @_ — значения по умолчанию заменяются фактическими значениями аргументов.
> Смотри также---------------------------------------------------------------------------------------------
Глава 4 «Массивы».
10.8. Пропуск некоторых возвращаемых значений
Проблема
Имеется функция, которая возвращает много значений, однако вас интересуют лишь некоторые из них. Классический пример — функция stat; как правило, требуется лишь одно значение из длинного возвращаемого списка (например, режим доступа).
Решение
Присвойте результат вызова списку, некоторые позиции которого равны undef: ($а, undef, $с) = func(),
Либо создайте срез списка возвращаемых значений и отберите лишь то, что вас интересует:
($а, $с) = (func())[0,2],
Комментарий
Применять фиктивные временные переменные слишком расточительно:
($dev,$mo,$DUMMY,$DUMMY,$uid) = stat($filename);
Чтобы отбросить ненужное значение, достаточно заменить фиктивные переменные на undef:
Также можно создать срез и включить в него лишь интересующие вас значения:
($dev,$ino,$uid,$gid) = (stat($filename))[O,1 4,5],
Если вы хотите перевести результат вызова функции в списковый контекст и отбросить все возвращаемые значения (вызывая его ради побочных эффектов), начиная с версии 5.004, можно присвоить его пустому списку:
() = some_function()
t> Смотри также--------------------------------------------------------------------------------------------
Описание срезов в perlsub(l); рецепт 3.1.
10.9. Возврат нескольких массивов или хэшей
Проблема
Необходимо, чтобы функция возвратила несколько массивов или хэшей, однако возвращаемые значения сглаживаются в один длинный список скалярных величин.
Решение
Возвращайте ссылки на хэши или массивы:
($array_ref, $hash_ref) = somefunc(),
sub somefunc { my @array, ray %hash,
й
return ( \@array \%hash ) }
Комментарий
Как говорилось выше, все аргументы функции сливаются в общий список скалярных величин. То же самое происходит и с возвращаемыми значениями. Функция, возвращающая отдельные массивы или хэши, должна возвращать их по ссылке, и вызывающая сторона должна быть готова к получению ссылок. Например, возвращение трех отдельных хэшей может выглядеть так:
sub fn {
return (\%a, \%b, \%c), ft или
return \(%a, %b, %с) # то же самое }
Вызывающая сторона должна помнить о том, что функция возвращает список ссылок на хэши. Она не может просто присвоить его списку из трех хэшей.
(%hO, %h1, %h2) = fn(), # НЕВЕРНО1
@array_of_hashes = fn() # например $array_of_hashes[2]->{ keystring }
($rO, $r1, $r2) = fn() # например $r2->{ keystring }
t> Смотри также--------------------------------------------------------------------------------------------
Общие сведения о ссылках в главе И; рецепт 10.5.
10.10. Возвращение признака неудачного вызова
Проблема
Функция должна возвращать значение, свидетельствующее о неудачной попытке вызова.
Решение
Воспользуйтесь командой return без аргументов, которая в скалярном контексте возвращает undef, а в списковом — пустой список ().
Комментарий
return без аргументов означает следующее:
sub enpty_retval {
return ( wantarray ? () undef ) }
Ограничиться простым retu rn undef нельзя, поскольку в списковом контексте вы получите список из одного элемента: undef. Если функция вызывается в виде:
if (@>а = yourfuncO) { }
то признак ошибки будет равен true, поскольку @а присваивается список (undef), интерпретируемый в скалярном контексте. Результат будет равен 1 (количество элементов в @а), то есть истинному значению. Контекст вызова можно определить с помощью функции wantarray, однако return без аргументов обеспечивает более наглядное и изящное решение, которое работает в любых ситуациях:
unless ($a = sfunc()) { die sfunc failed } unless (@a = afunc()) { die afunc failed } unless (%a = hfuncO) { die hfunc failed }
Некоторые встроенные функции Perl иногда возвращают довольно странные значения. Например, fcntl и loctl в некоторых ситуациях возвращают строку
ioctl(..,.) or die "can't ioctl: $!";
В этом случае программе не нужно отличать определенный ноль от неопределенного значения, как пришлось бы делать для функций read или glob. В числовой интерпретации "О but true" является нулем. Необходимость в возвращении подобных значений возникает довольно редко. Более распространенный (и эффектный) способ сообщить о неудаче при вызове функции заключается в инициировании исключения (см. рецепт 10.12).
> Смотри также---------------------------------------------------------------------------------------------
Описание функций wantarray и return вperlfunc(i); рецепт 10.12.
10.11. Прототипы функций
Проблема
Вы хотите использовать прототипы функций, чтобы компилятор мог проверить типы аргументов.
Решение
В Perl существует нечто похожее на прототипы, но это сильно отличается от прототипов в традиционном понимании. Прототипы функций Perl больше напоминают принудительный контекст, используемый при написании функций, которые ведут себя аналогично некоторым встроенным функциям Perl (например, push и pop).
Комментарий
Фактическая проверка аргументов функции становится возможной лишь во время выполнения программы. Если объявить функцию до ее реализации, компилятор сможет использовать очень ограниченную форму прототипизации. Не путайте прототипы Perl с теми, что существуют в других языках. В Perl прототипы предназначены лишь для эмуляции поведения встроенных функций.
Прототип функции Perl представляет собой ноль и более пробелов, обратных косых черт или символов типа, заключенных в круглые скобки после определения или имени подпрограммы. Символ типа с префиксом \ означает, что аргумент в данной позиции передается по ссылке и должен начинаться с указанного символа типа.
Прототип принудительно задает контекст аргументов, используемых при вызове данной функции. Это происходит во время компиляции программы и в большинстве случаев вовсе не означает, что Perl проверяет количество или тип аргументов функции. Если Perl встретит вызов func(3, 5) для функции с прото-
типом sub func($), он завершит компиляцию с ошибкой. Но если для того же прототипа встретится вызов func(@array), компилятор всего лишь преобразует @аггау в скалярный контекст; он не скажет: «Массив передавать нельзя — здесь должна быть скалярная величина».
Это настолько важно, что я повторю снова: не пользуйтесь прототипами Perl, если вы надеетесь, что компилятор будет проверять тип и количество аргументов.
Тогда зачем нужны прототипы? Существуют два основных применения, хотя во время экспериментов вы можете найти и другие. Во-первых, с помощью прототипа можно сообщить Perl количество аргументов вашей функции, чтобы опустить круглые скобки при ее вызове. Во-вторых, с помощью прототипов можно создавать подпрограммы с тем же синтаксисом вызова, что и у встроенных функций.
Пропуск скобок
Обычно функция получает список аргументов, и при вызове скобки ставить не
обязательно:
©results = myfunc 3 , 5;
Без прототипа такая запись эквивалентна следующей:
^results = myfunc(3 , 5);
При отсутствии скобок Perl преобразует правую часть вызова подпрограммы в списковый контекст. Прототип позволяет изменить такое поведение:
sub myfunc($);
©results = myfunc 3 , 5;
Теперь эта запись эквивалентна следующей:
@results = ( myfunc(3), 5 );
Кроме того, можно предоставить пустой прототип, показывающий, что функция вызывается без аргументов, как встроенная функция time. Именно так реализованы константы LOCK_SH, LOCK_EX и LOCK_UN в модуле Fcntl. Они представляют собой экспортируемые функции, определенные с пустым прототипом:
sub LOCK_SH (){1} sub LOCK_EX () { 2 } sub LOCKJJN () { 4 }
Имитация встроенных функций
Прототипы также часто применяются для имитации поведения таких встроенных функций, как push и shift, передающих аргументы без сглаживания. При вызове push (@а г ray, 1, 2, 3) функция получает ссылку на @а г ray вместо самого массива. Для этого в прототипе перед символом @ ставится обратная косая черта:
sub mypush (\@@) { my $array_ref = shift; my ©remainder = @_;
mypush( $х > 10 ? @а : @b , 3, 5 ); # НЕВЕРНО
Вместо этого приходится изощряться со ссылками: mypush( @{ $х > 10 ? @а : @b }, 3, 5 ); # ВЕРНО
Приведенная ниже функция hpush работает аналогично push, но для хэшей. Функция дописывает в существующий хэш список пар <<ключ/значение>>, переопределяя прежнее содержимое этих ключей.
sub hpush(\%@) {
my $href = shift;
while ( my ($k, $v) = splice(@_, 0, 2) ) {
$href->{$k} = $v;
> }
hpush(%pieces, "queen" => 9, "rook" => 5);
t> Смотри также--------------------------------------------------------------------------------------------
Описание функции prototype вperlfunc(l);perlsub(l); рецепт 10.5.
10.12. Обработка исключений
Проблема
Как организовать безопасный вызов функции, способной инициировать исключение? Как создать функцию, инициирующую исключение?
Решение
Иногда в программе возникает что-то настолько серьезное, что простого возвращения ошибки оказывается недостаточно, поскольку та может быть проигнорирована вызывающей стороной. Включите в функцию конструкцию die СТРОКА, чтобы инициировать исключение:
die "some message"; # Инициировать исключение
Чтобы перехватить исключение, вызывающая сторона вызывает функцию из eval, после чего узнает результат с помощью специальной переменной $@:
eval { func() }; if ($@) {
warn "func raised an exception; $@>";
Комментарий
Инициирование исключения — крайняя мера, и относиться к ней следует серьезно. В большинстве функций следует возвращать признак ошибки с помощью простого оператора return. Перехватывать исключения при каждом вызове функции скучно и некрасиво, и это может отпугнуть от применения исключений.
Но в некоторых ситуациях неудачный вызов функции должен приводить к аварийному завершению программы. Вместо невосстановимой функции exit следует вызвать die — по крайней мере, у программиста появится возможность вмешаться в происходящее. Если ни один обработчик исключения не был установлен с помощью eval, на этом месте программа аварийно завершается.
Чтобы обнаружить подобные нарушения, можно поместить вызов функции в блок eval. Если произойдет исключение, оно будет присвоено переменной $@; в противном случае переменная равна false.
eval { $val = func() };
warn "func blew up: $@" if $@;
Блок eval перехватывает все исключения, а не только те, что интересуют вас. Непредусмотренные исключения обычно следует передать внешнему обработчику. Предположим, функция инициирует исключение, описываемое строкой "Full moon!". Можно спокойно перехватить это исключение и дать другим обработчикам просмотреть переменную $@. При вызове die без аргументов новая строка исключения конструируется на основании содержимого $@ и текущего контекста.
eval { $val = func() };
if ($(Э && $(5> Г /Full moon!/) {
die; # Повторно инициировать неизвестные ошибки }
Если функция является частью модуля, можно использовать модуль Carp и вызвать croak или confess вместо die. Единственное отличие die от croak заключается в том, что croak представляет ошибку с позиции вызывающей стороны, а не модуля. Функция confess по содержимому стека определяет, кто кого вызвал и с какими аргументами.
Другая интересная возможность заключается в том, чтобы функция могла узнать о полном игнорировании возвращаемого ею значения (то есть о том, что она вызывается в неопределенном контексте). В этом случае возвращение кода ошибки бесполезно, поэтому вместо него следует инициировать исключение.
Конечно, вызов функции в другом контексте еще не означает, что возвращаемое значение будет должным образом обработано. Но в неопределенном контексте оно заведомо не проверяется.
if (defined wantarrayO) {
return; } else {
die "pay attention to my error!"; }
> Смотри также ——-----------------------------------------------------------------
Описание переменной $@ вperlvar(i); описание функций die и eval вperlfunc(l); рецепты 10.15, 12.2 и 16.21.
Проблема
Требуется временно сохранить значение глобальной переменной.
Решение
Воспользуйтесь оператором local, чтобы сохранить старое значение и автоматически восстановить его при выходе из текущего блока:
$аде = 18; # Глобальная переменная
if (CONDITION) {
local $age = 23;
func(); # Видит временное значение 23 } # Восстановить старое значение при выходе из блока
Комментарий
К сожалению, оператор Perl local не создает локальной переменной — это делается оператором my. local всего лишь сохраняет существующее значение на время выполнения блока, в котором он находится.
Однако в трех ситуациях вы должны использовать local вместо ту.
1. Глобальной переменной (особенно $_) присваивается временное значение.
2. Создается локальный манипулятор файла или каталога или локальная
функция.
3. Вы хотите временно изменить один элемент массива или хэша.
Применение local() для присваивания временных значений глобальным переменным
Первая ситуация чаще встречается для стандартных, нежели пользовательских переменных. Нередко эти переменные используются Perl в высокоуровневых операциях. В частности, любая функция, явно или косвенно использующая $_, должна иметь локальную копию $_. Об этом часто забывают. Одно из возможных решений приведено в рецепте 13.15.
В следующем примере используется несколько глобальных переменных. Переменная $/ косвенно влияет на поведение оператора чтения строк, используемого в операциях <FH>.
$para = get_paragraph(*FH); Я Передать glob файлового манипулятора $рага = get_paragraph(\*FH); # Передать манипулятор по ссылке на glob $para = get_paragraph(*IO{FH}); # Передать манипулятор по ссылке на 10 sub get_paragraph {
my $fh = shift;
local $/ = '';
my $paragraph = <$fh>;
chomp($paragraph);
return $paragraph;
Применение local() для создания локальных манипуляторов Вторая ситуация возникает в случае, когда требуется локальный манипулятор файла или каталога, реже — локальная функция. Начиная с Perl версий 5.000, можно воспользоваться стандартными модулями Symbol, Filehandle или IO::Handle, но и привычная методика с тип-глобом по-прежнему работает. Например:
$contents = get_motd(); sub getjnotd {
local *MOTD;
open(MOTD, "/etc/motd") or die "can't open motd: $!";
local $/ = undef; # Читать весь файл
local $_ = <MOTD>;
close (MOTD);
return $_; }
Открытый файловый манипулятор возвращается следующим образом:
return *MOTD;
Применение local() в массивах и хэшах
Третья ситуация на практике почти не встречается. Поскольку оператор local в действительности является оператором «сохранения значения», им можно воспользоваться для сохранения одного элемента массива или хэша, даже если сам массив или хэш является лексическим!
my @nums = (0 .. 5); sub first {
local $nums[3] = 3.14159;
secondO; } sub second {
print "@nums\n"; }
secondO; 0 12 3 4 5 firstO; 0 1 2 3.14159 4 5
Единственное стандартное применение — временные обработчики сигналов.
sub first {
local $SIG{INT> = 'IGNORE';
secondO; }
Теперь во время работы secondO сигналы прерывания будут игнорироваться. После выхода из first () автоматически восстанавливается предыдущее значение $SIG{INT}.
Хотя local часто встречается в старом коде, от него следует держаться подальше, если это только возможно. Поскольку local манипулирует значениями
Оператор local создает динамическую область действия. Она отличается от другой области действия, поддерживаемой Perl и значительно более понятной на интуитивном уровне. Речь идет об области действия ту — лексической области действия, иногда называемой «статической».
В динамической области действия переменная доступна в том случае, если она находится в текущей области действия — или в области действия всех кадров (блоков) стека, определяемых во время выполнения. Все вызываемые функции обладают полным доступом к динамическим переменным, поскольку последние остаются глобальными, но получают временные значения. Лишь лексические переменные защищены от вмешательства извне. Если и это вас не убедит, возможно, вам будет интересно узнать, что лексические переменные примерно на 10 процентов быстрее динамических.
Старый фрагмент вида:
sub func {
local($x $y) = @_
# }
почти всегда удается заменить без нежелательных последствий следующим фрагментом:
sub func {
my($x, $y) = @_,
# }
Единственный случай, когда подобная замена невозможна, — если работа программы основана на динамической области действия. Это происходит в ситуации, когда одна функция вызывает другую и работа второй зависит от доступа к временным версиям глобальных переменных $х и $у первой функции. Код, который работает с глобальными переменными и вместо нормальной передачи параметров издалека вытворяет нечто странное, в лучшем случае ненадежен. Хорошие программисты избегают подобных выкрутасов как чумы.
Если вам встретится старый код вида:
&func(*Global_Array) sub func {
local(*aliased_array) = shift,
for (@>aliased_array) { }
}
вероятно, его удастся преобразовать к следующей форме:
f unc(\(°>Global_Array), sub func {
my $array_ref = shift
for ((g>$array_ref) { }
До появления в Perl нормальной поддержки ссылок, использовалась старая стратегия передачи тип-глобов. Сейчас это уже дело прошлое.
Смотри также
Описание функций local и ту вperlfunc(l); разделы «Private Variables via my()» и «Temporary Values via local()» perlsub(l); рецепты 10.2; 10.16.
10.14. Переопределение функции
Проблема
Требуется временно или постоянно переопределить функцию, однако функциям нельзя «присвоить» новый код.
Решение
Чтобы переопределить функцию, присвойте ссылку на новый код тип-глобу имени функции. Используйте local для временной замены.
undef &grow, # Заглушить жалобы -w на переопределение
¦grow = \&expand
grow() ft Вызвать expandO
local ¦grow = \&shrnk, # Только в границах блока
grow() # Вызывает shnnk()
Комментарий
В отличие от переменных (но по аналогии с манипуляторами) функции нельзя напрямую присвоить нужное значение. Это всего лишь имя. Однако с ней можно выполнять многие операции, выполняемые с переменными, поскольку вы можете напрямую работать с таблицей символов с помощью тип-глобов вида *foo и добиваться многих интересных эффектов.
Если присвоить тип-глобу ссылку, то при следующем обращении к символу данного типа будет использовано новое значение. Именно это делает модуль Exporter при импортировании функции или переменной из одного пакета в другой. Поскольку операции выполняются непосредственно с таблицей символов пакета, они работают только для пакетных (глобальных) переменных, но не для лексических.
¦one var = \%two Table, # %one var становится синонимом для %two Table ¦one big = \&two small, # &one big становится синонимом для &two small
С тип-глобом можно использовать local, но не ту. Из-за local синоним действует только в границах текущего блока.
local ¦fred = \&barney, it временно связать &fred c &barney
Присваивание тип-глобов в сочетании с замыканиями позволяет легко и удоб но дублировать функции. Представьте, что вам понадобилась функция для генерации HTML-кода, работающего с цветами. Например:
Sstring = red("careful here");
print $string;
<FONT COLORS red ^careful here</FONT>
Функция red выглядит так:
sub red { "<FONT C0LOR='red'>@_</FONT>" }
Если вам потребуются другие цвета, пишется нечто подобное:
sub color_font {
my $color = shift;
return "<FONT COLOR='$color'>@_</FONT>"; }
sub red { color_font("red", @_) } sub green { color_font("green", @_) } sub blue { color_font("blue", @_) } sub purple { color_font("purple", @_) } # И т. д.
Сходство функций наводит на мысль, что общую составляющую можно как-то выделить. Для этого следует воспользоваться косвенным присваиванием тип-глобы. Если вы используете рекомендуемую директиву use strict, сначала отключите strict 'refs'для этого блока.
gcolors = qw(red blue green yellow orange purple violet); for my $name (©colors) {
no strict 'refs';
¦$narae = sub { "<FONT COLOR='$name'>
Функции кажутся независимыми, однако фактически код был откомпилирован лишь один раз. Подобная методика экономит время компиляции и память. Для создания полноценного замыкания все переменные анонимной подпрограммы должны быть лексическими. Именно поэтому переменная цикла объявляется с ключевым словом ту.
Перед вами одна из немногочисленных ситуаций, в которых создание прототипа для замыкания оправдано. Если вам захочется форсировать скалярный контекст для аргументов этих функций (вероятно, не лучшая идея), ее можно записать в следующем виде:
Однако прототип проверяется во время компиляции, поэтому приведенное выше присваивание произойдет слишком поздно и никакой пользы не принесет. Следовательно, весь цикл с присваиваниями следует включить в BEGIN-блок, чтобы форсировать его выполнение при компиляции.
> Смотри также---------------------------------------------------------------------------------------------
Описание замыканий в perlref(l); раздел «Symbol tables» perlmod(l); рецепты 10.11; 11.4.
10.15. Перехват вызовов неопределенных функций с помощью AUTOLOAD
Проблема
Требуется перехватить вызовы неопределенных функций и достойно обработать их.
Решение
Объявите функцию с именем AUTOLOAD для пакета, вызовы неопределенных функций которого вы собираетесь перехватывать. Во время ее выполнения переменная $AUTOLOAD этого пакета содержит имя вызванной неопределенной функции.
Комментарий
В подобных ситуациях обычно применяются вспомогательные функции (proxy). При вызове неопределенной функции вместо автоматического инициирования исключения также можно перехватить вызов. Если пакет, к которому принадлежит вызываемая функция, содержит функцию с именем AUTOLOAD, то она будет вызвана вместо неопределенной функции, а специальной глобальной переменной пакета $AUTOLOAD будет присвоено полное имя функции. Затем функция AUTOLOAD сможет делать все, что должна была делать исходная функция.
sub AUTOLOAD {
use vars qw($AUTOLOAD);
my $color = SAUTOLOAD;
$color =~ s/.¦:://;
return "<FONT COLOR='$color'xa_</FONT>"; }
# Примечание: функция sub chartreuse не определена print chartreuse("stuff');
При вызове несуществующей функции main: : chartreuse вместо инициирования исключения будет вызвана функция main: :AUTOLOAD с аргументами, переданными chartreuse. Пакетная переменная $AUTOLOAD будет содержать строку
main: :chartreuse.
{
local «yellow = \&violet;
local (*red, *green) = (\&green, \&red);
pnnt_stuff (); }
При работе pnnt_stuff или любой вызванной ей функции все, что должно выводиться желтым цветом, выводится фиолетовым; красный цвет заменяется зеленым, и наоборот.
Однако подстановка функций не позволяет обрабатывать вызовы неопределенных функций. AUTOLOAD справляется с этой проблемой.
> Смотри также---------------------------------------------------------------------------------------------
Раздел «Autoloading» perlsub(l); документация по стандартным модулям Auto-Loader и AutoSplit; рецепты 10.12; 12.10; 13.11.
10.16. Вложенные подпрограммы
Проблема
Требуется реализовать вложение подпрограмм, чтобы одна подпрограмма была видна и могла вызываться только из другой. Если попытаться применить очевидный вариант sub F00 { sub BAR { } .. }, Perl предупреждает о переменных, которые «не останутся общими».
Решение
Вместо того чтобы оформлять внутренние функции в виде обычных подпрограмм, реализуйте их в виде замыканий и затем временно присвойте их тип-глобу правого имени, чтобы создать локальную функцию.
Комментарий
Вероятно, в других языках программирования вам приходилось работать с вложенными функциями, обладающими собственными закрытыми переменными. В Perl для этого придется немного потрудиться. Интуитивная реализация приводит к выдаче предупреждения. Например, следующий фрагмент не работает:
sub outer {
my $x = $_[0] + 35,
sub inner { return $x * 19 } # НЕВЕРНО
return $x + inner();
Обходное решение выглядит так:
sub outer {
my $x = $_[0] + 35;
local *inner = sub { return $x * 19 };
return $x + inner(); }
Теперь благодаря временно присвоенному замыканию inner() может вызываться только из outer(). При вызове inner() получает нормальный доступ к лексической переменной $х из области действия outer().
В сущности, мы создаем функцию, которая является локальной для другой функции — подобная возможность не поддерживается в Perl напрямую. Впрочем, ее реализация не всегда выглядит понятно.
> Смотри также---------------------------------------------------------------------------------------------
Описание замыканий в perlref(l); раздел «Symbol tables» perlmod(l); рецепты 10.13-10.14.
10.17. Сортировка почты
Программа из примера 10. 1 сортирует почтовый ящик по темам. Для этого она читает сообщения по абзацам и ищет абзац, начинающийся с "From:". Когда такой абзац будет найден, программа ищет тему, удаляет из нее все пометки "Re:", преобразует в нижний регистр и сохраняет в массиве @suiD. При этом сами сообщения сохраняются в массиве @msgs. Переменная $msgno следит за номером сообщения.
Пример 10.1. bysubl
#'/usr/bin/perl
# bysubl - simple sort by subject
my(@)msgs, @>sub);
my $msgno = -1;
$/=''; й Чтение по абзацам
while (<>) {
if (/"From/m) {
/~Subjecf\s*(9:Re:\s*)*( *)M; $sub[++$msgno] = lc($1) || ';
}
$msgs[$msgno] .= $_; > for my $i (sort < $sub[$a] cmp $sub[$b] || $a <=> $b } (0 .. $#msgs)) {
print $msgs[$i]; }
В этом варианте сортируются только индексы массивов. Если темы совпадают, cmp возвращает 0, поэтому используется вторая часть | |, в которой номера сообщений сравниваются в порядке их исходного следования.
В примере 10.2 показано, как бы написал эту программу программист с большим опытом работы на awk. Ключ -00 используется для чтения абзацев вместо строк.
Пример 10.2. bysub2
#!/usr/bin/perl -n00
# bysub2 - сортировка по темам в стиле awk
BEGIN { $msgno = -1 }
$sub[++$msgno] = (/"Subject:\s*(?:Re:\s*)*(. »)/mi)[0] if /"From/rn;
$msg[$msgno] .= $_;
END { print <amsg[ sort { $sub[$a] cmp $sub[$b] || $a <=> $b } (0 .. $#msg) ] }
Параллельные массивы широко использовались лишь на ранней стадии существования Perl. Более элегантное решение состоит в том, чтобы сохранять сообщения в хэше. Анонимный хэш (см. главу 11) сортируется по каждому полю.
Программа из примера 10.3 построена на тех же принципах, что и примеры 10.1 и 10.2.
Пример 10.3. bysub3
#!/usr/bin/perl -00
# bysub3 - sort by subject using hash records
use strict;
my @msgs = (); while (<>) {
push @msgs, {
SUBJECT => /"Subject:\s*(?:Re:\s*)*(-*)/mi, NUMBER => scalar @>msgs, # Номер сообщения TEXT => ' ', > if /"From/m; $msgs[-1]{TEXT} .= $_;
for my $msg (sort {
$a->{SUBJECT} cmp $b->{SUBJECT}
II
$a->{NUMBER) <=> $b->{NUMBER} } (amsgs
print $msg->{TEXT}; }
Работая с полноценными хэшами, нетрудно добавить дополнительные критерии сортировки. Почтовые ящики часто сортируются сначала по теме, а затем по дате сообщения. Основные трудности связаны с анализом и сравнением дат. Модуль Date::Manip помогает справиться с ними и возвращает строку, которую можно сравнивать с другими. Тем не менее программа datesort из примера 10.4, исполь-
зующая Date::Manip, работает в 10 раз медленнее предыдущей. Анализ дат в непредсказуемых форматах занимает слишком много времени.
Пример 10.4. datesort
#!/usr/bin/perl -00
# datesort - сортировка почтового ящика по теме и дате
use strict;
use Date::Manip;
my @msgs = ();
while (<>) {
next unless /"From/m;
my $date = '';
if (/-Date:\s*(.*)/m) {
($date = $1) =" s/\s+\(-*//; $date = ParseDate($date); } push @msgs, {
SUBJECT => /~Subject:\s.(?:Re:\s*)*(-*)/mi, DATE => $date, NUMBER => scalar @msgs, TEXT => ' ',
};
} continue {
$msgs[-1]{TEXT} .= $_;
for my $msg (sort {
$a->{SUBJECT} cmp $b->{SUBJECT}
II $a->{DATE} cmp $b->{DATE}
II
$a->{NUMBER} <=> $b-><NUMBER} } @>msgs
print $msg->{TEXT}; }
Особого внимания в примере 10.4 заслуживает блок continue. При достижении конца цикла (нормальном выполнении или переходе по next) этот блок выполняется целиком. Он соответствует третьему компоненту цикла for, но не ограничивается одним выражением. Это полноценный блок, который может состоять из нескольких команд.
> Смотри также---------------------------------------------------------------------------------------------
Описание функции sort в perlfunc(l); описание переменной $/ в perlvar(l) и во введении главы 8 «Содержимое файлов»; рецепты 3.7, 4.15, 5.9 и 11.9.
Ссылки и записи
.,+ "¦¦> ¦.'Л ¦*-.*«• «\
В э/ш/ маленькую паутинку Я поймаю такую большую муху, как Кассио.
Шекспир, «Отелло», акт II, сцепа 1
Введение
В Perl существуют три основных типа данных: скалярные величины, массивы и хэши. Конечно, многие программы удается написать и без сложных структур данных, но обычно простых переменных и списков все же оказывается недостаточно.
Три встроенные структуры данных Perl в сочетании со ссылками позволяют строить сколь угодно сложные и функциональные структуры данных — те самые записи, которых так отчаянно не хватало в ранних версиях Perl. Правильно выбирая структуру данных и алгоритм, вы иногда выбираете между элегантной программой, которая быстро справляется со своей задачей, и убогой поделкой, работающей с черепашьей скоростью и нещадно пожирающей системные ресурсы.
Первая часть этой главы посвящена созданию и использованию простых ссылок. Во второй части рассказывается о применении ссылок для создания структур данных более высокого порядка.
Ссылки
Чтобы хорошо понять концепцию ссылок, сначала необходимо разобраться с тем, как в Perl хранятся значения переменных. С любой определенной переменной ассоциируется имя и адрес области памяти. Идея хранения адресов играет для ссылок особую роль, поскольку в ссылке хранятся данные о местонахождении другой величины. Скалярная величина, содержащая адрес области памяти, называется ссылкой. Значение, хранящееся в памяти по данному адресу, называется субъектом (referent) (рис. 11.1).
Субъект может относиться к одному из встроенных типов данных (скалярная величина, массив, хэш, ссылка, код или глоб) или представлять собой пользовательский тип, основанный на одном из встроенных типов.
Reference Ox83c6c Referent
ARRAY (0x83c6c)
(3, ' is a magic number' )
Субъекты в Perl типизованы. Это означает, что ссылку на массив нельзя интерпретировать как ссылку на хэш. При подобных попытках инициируется исключение. В Perl не предусмотрен механизм преобразования типов, и это было сделано намеренно.
На первый взгляд кажется, что ссылка — обычный адрес с сильной типизацией. На самом деле это нечто большее. Perl берет на себя автоматическое выделение и освобождение памяти (сборку мусора) для ссылок так же, как и для всего остального. С каждым блоком памяти в Perl связан счетчик ссылок, который определяет количество ссылок на данный субъект. Память, используемая субъектом, возвращается в пул свободной памяти процесса лишь при обнулении счетчика ссылок. Тем самым гарантируется, что вы никогда не получите недопустимую ссылку — забудьте об аварийных завершениях и ошибках защиты, часто возникающих при неправильной работе с указателями в С.
Освобожденная память передается Perl для последующего использования, но лишь немногие операционные системы возвращают ее себе. Это связано с тем, что в большинстве схем распределения памяти используется стек, а при освобождении памяти в середине стека операционная система не сможет вернуть ее без перемещения всех остальных блоков. Перемещение нарушит целостность указателей и прикончит вашу программу.
Чтобы перейти от ссылки к субъекту, снабдите ссылку символом типа для тех данных, к которым вы обращаетесь. Например, если $sref является ссылкой на скалярную величину, возможна следующая запись:
print $$sref, # Выводится скалярная величина, на которую ссылается Jsref $$sref =3, # Присваивается субъекту $sref
Для обращения к отдельному элементу массива или хэша, на который у вас имеется ссылка, используется ассоциативный оператор, оператор -> («стрелка») — например, $rv->[37] или $rv->{"wilma' }. Помимо разыменования ссылок на массивы и хэши, стрелка также применяется при косвенном вызове функций через ссылки — например, $code_ref->("arg1", "arg2") (см. рецепт 11.4). Если вы работаете с объектами, то с помощью стрелки можно вызывать их методы, $object->methodname("arg1", "arg2"), как показано в главе 13 «Классы, объекты и связи».
Правила синтаксиса Perl делают разыменование сложных выражений нетривиальной задачей. Чередование правых и левых ассоциативных операторов не рекомендуется. Например, $$х[4] — то же самое, что и $х->[4]; иначе говоря, $х интерпретируется как ссылка на массив, после чего из массива извлекается четвертый элемент. То же самое записывается в виде ${$х}[4]. Если вы имели в виду «взять четвертый элемент @х и разыменовать его в скалярное выражение», воспользуйтесь ${$х[4]}. Старайтесь избегать смежных символов типов ($@%&) везде, кроме простых и однозначных ситуаций типа %hash = %$hashref.
print ${$sref}; # Выводится скалярная величина, на которую ссылается $sref ${$sref} =3; # Присваивается субъекту $sref
Некоторые программисты для уверенности используют только эту форму.
Функция ref получает ссылку и возвращает строку с описанием субъекта. Строка обычно принимает одно из значений SCALAR, ARRAY, HASH или CODE, хотя иногда встречаются и другие встроенные типы GLOB, REF, 10, Regexp и LVALUE. Если ref вызывается для аргумента, не являющегося ссылкой, функция возвращает false. При вызове ref для объекта (ссылки, для субъекта которой вызывалась функция bless) возвращается класс, к которому был приписан объект: CGI, IO::Socket или даже ACME::Widget.
Ссылки в Perl можно создавать для субъектов уже определенных или определяемых с помощью конструкций [ ], { } или sub { }. Использовать оператор \ очень просто: поставьте его перед субъектом, для которого создается ссылка. Например, ссылка на содержимое массива @аггау создается следующим образом:
$rv = \@array;
Создавать ссылки можно даже для констант; при попытке изменить значение субъекта происходит ошибка времени выполнения:
$pi = \3.14159;
=4; # Ошибка
Анонимные данные
Ссылки на существующие данные часто применяются для передачи аргументов функции, но в динамическом программировании они бывают неудобны. Иногда ситуация требует создания нового массива, хэша, скалярной величины или функции, но вам не хочется возиться с именами.
Анонимные массивы и хэши в Perl могут создаваться явно. При этом выделяется память для нового массива или хэша и возвращается ссылка на нее:
$aref = [ 3, 4, 5 ]; # Новый анонимный массив
$href = { "How" => "Now", "Brown" => "Cow" }; # Новый анонимный хэш
В Perl также существует возможность косвенного создания анонимных субъектов. Если попытаться присвоить значение через неопределенную ссылку, Perl автоматически создаст субъект, который вы пытаетесь использовать.
undef $aref; @$aref = (1, 2, 3); print $aref; ARRAY(0x80c04f0)
Обратите внимание: от undef мы переходим к ссылке на массив, не выполняя фактического присваивания. Perl автоматически создает субъект неопределенной ссылки. Благодаря этому свойству программа может начинаться так:
$а[4][23][53][21] = "fred"; print $a[4][23][53][21];
В следующей таблице перечислены способы создания ссылок для именован
ных и анонимных скалярных величин, массивов, хэшей и функций. Анонимные
тип-глобы выглядят слишком страшно и практически никогда не используются.
Вместо них следует применять 10: :Handle->new().
Ссылка на Именованный субъект Анонимный субъект
|
Скалярная величина |
\$scalar |
|
Массив |
\@array |
|
Хэш |
\%hash |
|
Функция |
\&function |
{ СПИСОК }
{ СПИСОК }
_______________________________________________________________ sub { КОД }_____________________
Отличия именованных субъектов от анонимных поясняются на приведенных далее рисунках. На рис. 11.2 изображены именованные субъекты, а на рис. 11.3 — анонимные.
Иначе говоря, в результате присваивания $а = \$Ь переменные $$а и $Ь занимают одну и ту же область памяти. Если вы напишете $$а = 3, значение $Ь станет равно 3.
|
Initial state: |
0x305108 |
0x3051f00 |
|
|
5 |
|||
|
$a=\$b; |
0x305108 0x3051f00 |
||
|
SCALAR 0x351f00 |
5 |
||
|
$$a=3; |
0x305108 0x3051f00 |
||
|
SCALAR 0X351f00 |
5 |
||
|
print "$$a $b\n 3 3 |
J |
Все ссылки по определению оцениваются как t rue, поэтому, если ваша функция возвращает ссылку, в случае ошибки можно вернуть undef и проверить возвращаемое значение следующим образом:
p_cit = cite($ibid)
or die "couldn't make a reference";
380 Глава 11 • Ссылки и записи
|
Initial state: $$а=3, |
0x305108 |
0x3051f00 |
||
|
0x305108 |
||||
|
SCALAR 0x351f00 |
3 |
-* — (made by Perl) |
||
|
print "$$a $b\n 3 3 |
Рис. 11.3. Анонимные субъекты
Оператор undef может использоваться с любой переменной или функцией Perl для освобождения занимаемой ей памяти. Однако не следует полагать, что при вызове undef всегда освобождается память, вызываются деструкторы объектов и т. д. В действительности оператор всего лишь уменьшает счетчик ссылок на 1. Без аргумента undef дает неопределенное значение.
Записи
Ссылки традиционно применялись в Perl для обхода ограничения, согласно которому массивы и хэши могут содержать только скаляры. Ссылки являются скалярами, поэтому для создания массива массивов следует создать массив ссылок на массивы. Аналогично, хэши хэшей реализуются как хэши со ссылками на хэши; массивы хэшей — как массивы ссылок на хэши; хэши массивов — как хэши ссылок на массивы и т. д. "
Имея в своем распоряжении эти сложные структуры, можно воспользоваться ими для реализации записей. Запись представляет собой отдельную логическую единицу, состоящую из различных атрибутов. Например, запись, описывающая человека, может содержать имя, адрес и дату рождения. В С подобные вещи называются структурами (structs), а в Pascal — записями (RECORDs). В Perl для них не существует специального термина, поскольку эта концепция может быть реализована разными способами.
Наиболее распространенный подход в Perl заключается в том, чтобы интерпре тировать хэш как запись, где ключи хэша представляют собой имена полей записи, а ассоциированные величины — значения этих полей.
Например, запись «человек» может выглядеть так;
$Nat = { Name => Leonhard Euler ,
Address => 1729 Ramanujan Lane\nMathworld, PI 31416 , Birthday => 0x5bb5580,
Поскольку ссылка $NAT является скалярной величиной, ее можно сохранить в элементе хэша или массива с информацией о целой группе людей и далее использовать приемы сортировки, объединения хэшей, выбора случайных записей и т. д., рассмотренные в главах 4 и 5.
Атрибуты записи, в том числе и «человека» из нашего примера, всегда являются скалярами. Конечно, вместо строк можно использовать числа, но это банально. Настоящие возможности открываются в том случае, если атрибуты записи также представляют собой ссылки. Например, атрибут "Birthday" может храниться в виде анонимного массива, состоящего из трех элементов: день, месяц и год. Выражение $person->{"BIrthday"}->[0] выделяет из даты рождения поле «день». Дата также может быть представлена в виде хэша, для доступа к полям которого применяются выражения вида $person->{ Birthday }->{' day' }. После включения ссылок в коллекцию приемов перед вами откроются многие нетривиальные и полезные стратегии программирования.
На этом этапе мы концептуально выходим за пределы простых записей и переходим к созданию сложных структур, которые представляют запутанные отношения между хранящимися в них данных. Хотя они могут использоваться для реализации традиционных структур данных (например, связанных списков), рецепты второй части этой главы не связаны ни с какими конкретными структурами. В них описываются обобщенные приемы загрузки, печати, копирования и сохранения обобщенных структур данных. Завершающая программа этой главы демонстрирует работу с бинарными деревьями.
О Смотри также--------------------------------------------------------------------------------------------
perlref( I); perllol( I); perldsc{ 1).
11.1. Ссылки на массивы
Проблема
Требуется работать с массивом через ссылку.
Решение
Ссылка на массив создается следующим образом:
$aref = \@array
$anon_array = [1, 3, 5, 7, 9],
$anon_copy = [ @array ]
(s>$implicit_creation = (2, 4, 6, 8, 10),
Чтобы разыменовать ссылку на массив, поставьте перед ней символ @:
push(ia$anon_array, 11),
Или воспользуйтесь стрелкой с указанием индекса конкретного элемента в квадратных скобках:
$two = $implicit_creation->[0],
Для получения индекса последнего элемента массива по ссылке или определения количества элементов в массиве применяется следующая запись:
$last_idx = $#$aref, $num items = @$aref,
$last_idx = $#{ $aref }; $num_itens = scalar @{ $aref };
Комментарий
Рассмотрим примеры использования ссылок на массивы:
# Проверить, содержит ли Ssomeref ссылку на массив if (ref($someref) ne 'ARRAY') {
die "Expected an array reference, not $someref\n";
print "@{$array_ref}\n", # Вывести исходные данные border = sort @{ $array_ref }; # Отсортировать их
push @{ $array_ref }, $item; # Добавить в массив новый элемент
Если вы не можете выбрать между использованием ссылки на именованный массив и созданием нового массива, существует простое правило, которое в большинстве случаев оказывается верным. Получение ссылки на существующий массив используется либо для возврата ссылки за пределы области действия, либо при передаче массива функции по ссылке. Практически во всех остальных случаях используется [@аггау], что приводит к созданию ссылки на новый массив с копиями старых значений.
Автоматический подсчет ссылок в сочетании с оператором \ обладает большими возможностями:
sub array_ref { my @array; return \@array,
$aref1 = array_ref(); $aref2 = array_ref(),
При каждом вызове array_ref функция выделяет для @array новый блок памяти. Если бы мы не вернули ссылку на @аггау, то занимаемая массивом память была бы возвращена при выходе из блока, то есть при завершении подпрограммы. Однако ссылка на ©array продолжает существовать, поэтому Perl не освобождает память, и мы получаем ссылку на блок памяти, недоступный через таблицу символов. Такие блоки памяти называются анонимными, поскольку с ними не связано никакое имя.
К определенному элементу массива, на который указывает ссылка $aref, можно обратиться в форме $$aref[4], но $aref->[4] делает то же самое и обладает большей наглядностью.
print $array_ref->[$N]; # Обращение к N-му элементу (лучший вариант) print $$array_ref[$N]; # To же, но менее наглядно print ${$array_ref}[$N]; # То же, но непонятно и уродливо
Имея ссылку на массив, можно получить срез субъектного массива?
@$pie[3. 5]; # Срез массива, но читается плохо
@{$pie}[3..5]; # Срез массива, читается лучше С)
Срезы массивов, даже при обращении через ссылки, допускают присваивание. В следующей строке сначала происходит разыменование массива, после чего элементам среза присваиваются значения:
@{$pie}[3. 5] = ("blackberry", "blueberry", "pumpkin");
Срез массива полностью идентичен списку отдельных элементов. Поскольку ссылку на список получить нельзя, вам не удастся получить ссылку на срез массива:
Ssliceref = \@{$pie}[3..5]; # НЕВЕРНО1
Для перебора в массиве применяется цикл foreach или for:
foreach $item ( @{$array_ref} ) { # Данные в $item
for ($idx = 0; $idx <= $#{ $array_ref }; $idx++) {
# Данные в $array_ref->[$idx] }
> Смотри также---------------------------------------------------------------------------------------------
perlref{\) nperlhl(i); рецепты 2.14; 4.5.
11.2. Создание хэшей массивов
Проблема
С каждым ключом хэша может быть ассоциирована лишь одна скалярная величина, однако вам хочется использовать один ключ для хранения и извлечения нескольких величин. Иначе говоря, вы хотите, чтобы ассоциированное значение представляло собой список.
Решение
Сохраните в элементе хэша ссылку на массив. Используйте push для присоединения новых элементов:
push(@{ $hash{"KEYNAME'} }, "new value');
Затем при выводе хэша разыменуйте значение как ссылку на массив:
foreach Sstring (keys %hash) {
print "$stnng: @{$hash{$string}}\n",
Комментарий
В хэше могут храниться только скалярные величины. Впрочем, ссылки и являются скалярными величинами. Они помогают решить проблему сохранения не-
Присвоение ключу нескольких значений осуществляется следующим образом:
$hash{ a key } = [ 3, 4, 5 ] # Анонимный массив
Ключ с ассоциированным массивом используется так:
©values = @{ $hash{ a key } }
Для присоединения новых значений к массиву, ассоциированному с конкретным ключом, используется функция push:
push @>{ $hash{ a key } } $value
Классическое применение этой структуры данных — инвертирование хэша, в котором одно значение ассоциируется с несколькими ключами. В хэше, полученном после инвертирования, один ключ ассоциирован с несколькими значениями. Эта проблема рассматривается в рецепте 5.8.
Учтите, что запись вида:
Residents = @{ $phone2name{$number} },
при действующей директиве use st net вызовет исключение, поскольку вы пытаетесь разыменовать неопределенную ссылку без автоматического создания. Приходится использовать другую формулировку:
©residents = exists( $phone2name{$number} ) 7 (s>{ $phone2name{$number} } О >
t> Смотри также--------------------------------------------------------------------------------------------
Раздел «Hashes of Arrays» perldsc(l); рецепт 5.8; пример «Хэш с автоматическим дополнением» из рецепта 13.15.
11.3. Получение ссылок на хэши
Проблема
Требуется работать с хэшем по ссылке. Например, ссылка может передаваться функции или входить во внешнюю структуру данных.
Решение
Получение ссылки на хэш:
$href = \%hash,
$anon_hash = { key1 => valuel key2 => value2 }
$anon_hash_copy = { %hash }
Разыменование ссылки на хэш:
%hash = %$href,
Svalue = $href->{$key}
(as]ice = @$href{$key1 $key2 $key3}, # Обратите внимание стрелки нет1
@keys = keys %$hash,
Проверка того, является ли переменная ссылкой на хэш:
if (ref($someref) ne HASH ) {
die Expected a hash reference, not $someref\n
Комментарий
Следующий пример выводит все юпочи и значения двух заранее определенных хэшей:
foreach $href ( \%ENV, \%INC ) { # ИЛИ for $href ( \(%ENV %INC) ) { foreach $key ( keys %$href ) {
print $key => $href->{$key}\n ,
Операции со срезами хэшсй по ссылке выполняются так же, как со срезами массивов. Например:
lvalues = @$hash_ref{ key1 , key2 , кеуЗ },
for $val ((§)$hash_ref{ key1 key2 , кеуЗ }) {
$val +=7 # Прибавить 7 к каждому значению в срезе хэша
> Смотри также
Глава 5 «Хэши»; perlref(l), рецепт 11.9.
11.4. Получение ссылок на функции
Проблема
Требуется создать ссылку для вызова подпрограммы. Такая задача возникает при создании обработчиков сигналов, косвенно-вызываемых функций Тк и указателей на хэши функций.
Решение
Получение ссылки на функцию:
$cref = \&func, $cref = sub { },
Вызов функции по ссылке:
^returned = $cref->(@arguments), ^returned = &$cref(^arguments).
Комментарий
Чтобы получить ссылку на функцию, достаточно снабдить ее имя префиксом \&. Кроме того, формулировка sub {} позволяет создавать анонимные функции. Ссылка на анонимную функцию может быть сохранена так же, как и любая другая.
В Perl 5.004 появилась постфиксная запись для разыменования ссылок на функции. Чтобы вызвать функцию по ссылке, раньше приходилось писать &$f uncname (@ARGS), где Sfuncname — имя функции. Возможность сохранить имя функции в переменной осталась и сейчас:
Sfuncname = "thefunc"; &$funcname();
однако подобное решение нежелательно по нескольким причинам. Во-первых, в нем используются символические, а не настоящие (жесткие) ссылки, поэтому при действующей директиве use strict 'refs' оно отпадает. Символические ссылки обычно не рекомендуются, поскольку они не могут обращаться к лексическим, а только к глобальным переменным, и для них не ведется подсчет ссылок.
Во-вторых, оно не содержит данных о пакете, поэтому выполнение фрагмента в другом пакете может привести к вызову неверной функции. Наконец, если функция была в какой-то момент переопределена (хотя это происходит нечасто), символическая ссылка будет обращаться к текущему определению функции, а жесткая ссылка сохранит старое определение.
Вместо того чтобы сохранять имя функции в переменной, создайте ссылку на нее с помощью оператора \. Именно так следует сохранять функцию в переменной или передавать ее другой функции. Ссылки на именованные функции можно комбинировать со ссылками на анонимные функции:
my %commands = (
"happy" => \&]оу,
"sad" => \&sullen,
"done" => sub { die "See ya1" },
"mad" => \&angry,
)
print "How are you' "; chomp($strmg = <STDIN>); if ($commands{$stnng}) {
$commands{$string}->(); } else {
print "No such command: $strmg\n"; }
Если вы создаете анонимную функцию, которая ссылается на лексическую (ту) переменную из вмещающей области действия, схема подсчета ссылок гарантирует, что память лексической переменной не будет освобождена при наличии ссылок на нее:
sub counterjnaker {
my $start = 0;
return sub { # Замыкание
return $start++; # Лексическая переменная
# из вмещающей области действия
Scounter = counter_maker();
for ($i =0; $i < 5; $i ++) { print &$counter, "\n";
Даже несмотря на то что функция countermaker завершилась, а переменная $start вышла из области действия, Perl не освобождает ее, поскольку анонимная подпрограмма (на которую ссылается $counter) все еще содержит ссылку на $start. Если повторно вызвать counter_maker, функция вернет ссылку на другую анонимную подпрограмму, использующую другое значение $start:
$counter1 = counter_maker(); $counter2 = counter_maker();
for ($i =0; $i < 5; $i ++) { print &$counter1, "\n",
print &$counter1,
01
2
3
&$counter2, "\n",
5 0
Замыкания часто используются в косвенно-вызываемых функциях (callbacks). В графических интерфейсах и вообще в программировании, основанном на событиях, определенные фрагменты кода связываются с событиями нажатий клавиш, щелчков мышью, отображения окон и т. д. Этот код вызывается много позже, возможно, из совсем другой области действия. Переменные, используемые в замыкании, должны быть доступными к моменту вызова. Для нормальной работы они должны быть лексическими, а не глобальными.Замыкания также используются в генераторах функций, то есть в функциях, которые создают и возвращают другие функции. Функция counter_maker является генератором. Приведем еще один простой пример:
sub timestamp {
my $start_time = time();
return sub { return time() - $start_time }; }
$early = timestampO; sleep 20;
Slater = timestampO; sleep 10;
printf "It's been %d seconds since early.\n", $early->(); printf "It s been %d seconds since later.\n", $later->(); It's been 30 seconds since early. It's been 10 seconds since later.
> Смотри также---------------------------------------------------------------------------------------------
Описание замыканий в perlref(l); рецепты 10.11; 11.4.
11.5. Получение ссылок на скаляры
Проблема
Требуется создать ссылку на скалярную величину и работать с ней.
Решение
Для создания ссылки на скалярную величину воспользуйтесь оператором \:
$scalar_ref = \$scalar; # Получение ссылки на именованный скаляр
Чтобы создать ссылку на анонимную скалярную величину (то есть скаляр, не являющийся переменной), присвойте нужное значение через разыменование неопределенной переменной:
undef $anon_scalar_ref; $$anon_scalar_ref = 15;
Ссылка на скалярную константу создается следующим образом:
$anon_scalar_ref = \15;
Разыменование выполняется конструкцией ${...}:
print ${ $scalar_ref }; # Разыменовать
${ $scalar_ref } .= "string"; # Изменить значение субъекта
Комментарий
Если вам понадобилось создать много новых анонимных скаляров, воспользуйтесь функцией, возвращающей ссылку на лексическую переменную вне области действия, как объяснялось во введении:
sub new_anon_scalar {
my $temp;
return \$temp; }
Perl почти никогда не выполняет косвенного разыменования. Исключение составляют ссылки на файловые манипуляторы, программные ссылки на sort и ссылочный аргумент функции bless. Из-за этого для разыменования скалярной переменной следует снабдить ее префиксом $, чтобы получить все ее содержимое:
$sref = new_anon_scalar();
$$sref = 3;
print "Three = $$sref\n";
11.6. Создание массивов ссылок на скаляры 389
@array_of_srefs = ( new_anon_scalar(), new_anon_scalar() );
${ $array[0] } = 6.02е23;
${ $array[1] } = "avocado";
print "уэаггау contains: ", join(", ", map { $$_ } @array ), "\n";
Обратите внимание на фигурные скобки вокруг $аггау[0] и $аггау[1]. Если бы мы попытались ограничиться простым $$аггау[0], то в процессе разыменования получили бы $аггау->[0]. Переменная $аггау интерпретировалась бы как ссылка на массив, поэтому в результате был бы возвращен элемент с нулевым индексом.
Приведем другие примеры, в которых фигурные скобки необязательны:
$var = 'uptime'; й $var содержит текст
$vref = \$var; # $vref "указывает на" $var
if ($$vref =~ /load/) {} # Косвенное обращение к $var
chomp $$vref; й Косвенное изменение $var
Как упоминалось во введении, для определения типа субъекта по ссылке применяется встроенная функция ref. При вызове ref для ссылки на скаляр возвращается строка "SCALAR":
# Проверить, содержит ли Ssomeref ссылку на скаляр if (ref(Ssomeref) ne 'SCALAR') {
die "Expected a scalar reference, not $someref\n";
О Смотри также--------------------------------------------------------------------------------------------
perlref(l).
11.6. Создание массивов ссылок на скаляры
Проблема
Требуется создать массив ссылок на скаляры. Такая задача часто возникает при передаче функциям переменных по ссылке, чтобы функция могла изменить их значения.
Решение
Чтобы создать массив, либо снабдите префиксом \ каждый скаляр в списке:
(9>array_of_scalar_refs = ( \$а, \$Ь );
либо просто поставьте \ перед всем списком, используя свойство дистрибутивности оператора \:
@array_of_scalar_refs = \( $а, $Ь );
Чтобы получить или задать значение элемента списка, воспользуйтесь конструкцией ${...}:
${ $array_of_scalar_refs[1] } = 12; # $b = 12
Комментарий
В следующих примерах предполагается, что @аггау — простой массив, содержащий ссылки на скаляры (не путайте массив ссылок со ссылкой на массив). При косвенных обращениях к данным необходимы фигурные скобки.
©array = (\$a, \$b, \$c, \$d); # Ссылки на все скаляры
@аггау = \( $а, $b, $c, $d); # To же самое!
${ $аггау[2] } += 9; # $с = 12
$< $аггау[ $#аггау ] } *= 5; # $d = 20
${ $array[-1] } •= 5; # То же; $d = 100
$tmp = $array[-1]; # Использование временной переменной
$$tmp *= 5; #'$d = 500
Две формы присваивания @аггау эквивалентны — оператор \ обладает свойством дистрибутивности. Следовательно, \ перед списком (но не массивом!) эквивалентно применению \ к каждому элементу списка. Следующий фрагмент изменяет значения переменных, ссылки на которые хранятся в массиве.
А вот как работать с массивом без явного индексирования.
use Math::Trig qw(pi); # Загрузить константу pi
foreach $sref (@array) { # Подготовиться к изменению $а,$b,$c, $d
($$sref *•= 3) •= (4/3 * pi); # Заменить объемом сферы
}
В этом фрагменте используется формула вычисления объема сферы: V - 4/Злр3.
Переменная цикла $sref перебирает все ссылки ©array, а в $$sref заносятся сами числа, то есть исходные переменные $а, $Ь, $с и $d. Изменение $$sref в цикле приводит к изменению этих переменных. Сначала мы возводим $$sref в куб, а затем умножаем полученный результат на 4/Зя. При этом используется то обстоятельство, что присваивание в Perl возвращает левостороннее выражение. Это позволяет сцеплять операторы присваивания, как это делается с операторами •¦= и *=.
Вообще говоря, анонимные скаляры обычно бесполезны — ведь скалярная величина занимает столько же места, что и ссылка на нее. По этой причине не предусмотрены и специальные конструкции для их создания. Скалярные ссылки существуют только для поддержки синонимов, которые могут быть реализованы и другими способами.
> Смотри также--------------------------------------------------------------------------------------------
Раздел «Assignment Operators» perlop(l).
11.7. Применение замыканий вместо объектов
Проблема
Вы хотите работать с записями, обладающими определенным состоянием, поведением и идентичностью, но вам не хочется изучать для этого объектно-ориентированное программирование.
Решение
Напишите функцию, которая возвращает (по ссылке) хэш ссылок на фрагменты кода. Все эти фрагменты представляют собой замыкания, созданные в общей области действия, поэтому при выполнении они будут совместно использовать одни и те же закрытые переменные.
Комментарий
Поскольку замыкание представляет собой совокупность кода и данных, одна из реализаций позволяет имитировать поведение объекта.
Следующий пример создает и возвращает хэш анонимных функций. Функция mkcounter получает начальное значение счетчика и возвращает ссылку, позволяющую косвенно оперировать им.
|
$d = |
mkcounter(20); |
|
|
$с2 = |
mkcounter(77); |
|
|
pnntf |
"next d: |
%d\n", |
|
printf |
"next c2: |
%d\n", |
|
printf |
"next d: |
%d\n", |
|
printf |
"last d. |
%d\n", |
|
printf |
"old c2: |
%d\n", |
$c2->{NEXT}->(); # 78
$c1->{NEXT}->(); U 22
$d->{PREV}->(); # 21
$c2->{RESET}->(); # 77
Каждая ссылка на хэш, $с1 и $с2, отдельно хранит информацию о своем состоянии. Реализация выглядит так:
|
sub mkcounter { |
|||||
|
my |
Scount = |
shift; |
|||
|
ray |
$start = |
Scount; |
|||
|
my |
Sbundle = |
{ |
|||
|
"NEXT" |
=> |
sub { |
return ++$count |
} |
|
|
"PREV" |
=> |
sub { |
return --Scount |
} |
|
|
"GET" |
=> |
sub { |
return Scount |
} |
|
|
"SET" |
=> |
sub { |
Scount = shift |
} |
|
|
"BUMP" |
=> |
sub { |
Scount += shift |
} |
|
|
"RESET" |
=> |
sub { |
Scount = Sstart |
} |
$bundle->{"LAST"} = $bundle->{"PREV"}; return $bundle; }
Поскольку лексические переменные, используемые замыканиями в ссылке на хэш $bundle, используются функцией, они не освобождаются. При следующем вызове mkcounter замыкания получают другой набор привязок переменных для того же кода. Никто не сможет обратиться к этим двум переменным за пределами замыканий, поэтому полная инкапсуляция гарантирована.
В результате присваивания, расположенного непосредственно перед return, значения "prev" и "last" будут ссылаться на одно и то же замыкание. Если вы разбираетесь в объектно-ориентированном программировании, можете считать их двумя разными сообщениями, реализованными с применением одного метода.
Возвращаемая нами совокупность не является полноценным объектом, поскольку не поддерживает наследования и полиморфизма (пока). Однако она несом-
> Смотри также--------------------------------------------------------------------------------------------
Замыкания рассматриваются вperlref(l). Также см. главу 13, рецепты 10.11; 11.4.
11.8. Создание ссылок на методы
Проблема
Требуется сохранить ссылку на метод.
Решение
Создайте замыкание, обеспечивающее вызов нужного метода для объекта.
Комментарий
Ссылка на метод — это нечто большее, чем простой указатель на функцию. Вам также придется определить, для какого объекта вызывается метод, поскольку исходные данные для работы метода содержатся в объекте. Оптимальным решением будет использование замыкания. Если переменная $obj имеет лексическую область действия, воспользуйтесь следующим фрагментом:
$mref = sub { $ob]->meth(@_) };
# Позднее...
$mref->("args", "go", "here");
Даже когда переменная $obj выходит из области действия, она остается в замыкании, хранящемся в $mref. Позднее при косвенном вызове метода будет использован правильный объект.
Учтите, что формулировка:
$sref = \$obj->meth;
работает не так, как можно предположить. Сначала она вызывает метод объекта, а затем дает ссылку либо на возвращаемое значение, либо на последнее из возвращаемых значений, если метод возвращает список.
Метод сап из базового класса UNIVERSAL выглядит заманчиво, но вряд ли делает именно то, что вы хотите:
$cref = $obj->can("meth");
Он дает ссылку на код соответствующего метода (если он будет найден), не несущую информации об объекте. В сущности, вы получаете обычный указатель на функцию. Информация об объекте теряется. Из-за этого и понадобилось замыкание, запоминающее как состояние объекта, так и вызываемый метод.
> Смотри также —---------------------------------------------------------------------------------------
Описание методов во введении к главе 13; рецепты 11.7; 13.7.
11.9. Конструирование записей
Проблема
Требуется создать тип данных для хранения атрибутов (запись).
Решение
Воспользуйтесь ссылкой на анонимный хэш.
Комментарий
Предположим, вам захотелось создать тип данных, содержащий различные атрибуты — аналог структур С или записей Pascal. Проще всего сделать это с помощью анонимного хэша. Следующий пример демонстрирует процесс инициализации и применения записи, содержащей информацию о работнике фирмы:
|
$record = |
{ |
||
|
NAME |
=> |
'Jason", |
|
|
EMPNO |
=> |
132, |
|
|
TITLE |
=> |
"deputy peon", |
|
|
AGE |
=> |
23, |
|
|
SALARY |
=> |
37_000, |
|
|
PALS |
=> |
[ "Norbert", "Rhys' , |
"Phineas"], |
|
printf "I |
am 1 |
is, and my pals are %s |
An", |
|
$record->{NAME}, |
|||
|
]oin(" |
, @{$record->{PALS}}); |
# Сохранить запись
$byname{ $record->{NAME} } = $record;
# Позднее искать по имени
if ($rp = $byname{"Aron"}) { # false, если отсутствует missing
printf "Aron is employee %d \n", $rp-><EMPNO};
# Дать Джейсону нового друга
push @{$byname{"Jason"}->{PALS}}, "Theodore";
printf "Jason now has %d pals\n", scalar @{$byname{"Jason"}->{PALS}};
В результате %byname превращается в хэш хэшей, поскольку хранящиеся в нем значения представляют собой ссылки на хэши. Поиск работника но имени с применением такой структуры оказывается простой задачей. Если значение найдено в хэше, мы сохраняем ссылку на запись во временной переменной $гр, с помощью которой далее можно получить любое нужное поле.
Для операций с %byname можно использовать стандартные средства работы с хэшами. Например, итератор each организует перебор элементов в произвольном порядке:
Глава 11 • Ссылки и записи
# Перебор всех записейwhile (($name, $record) = each %bynane) {
printf "%s is employee number %d\n", $name, $record->{EMPNO}, }
А как насчет поиска работников по номеру? Достаточно построить другую структуру данных — массив хэшей ^employees. Если работники нумеруются непоследовательно (скажем, после 1 следует номер 159997), выбор массива окажется неудачным. Вместо этого следует воспользоваться хэшем, в котором номер работника ассоциируется с записью. Для последовательной нумерации подойдет и массив:
# Сохранить запись
$employees[ $record->{EMPNO} ] = Srecord,
# Поиск по номеру
if ($rp = $employee[132]) {
printf 'employee number 132 is %s\n , $rp->{NAME}, >
При работе с подобными структурами данных обновление записи в одном месте обновляет ее везде. Например, следующая команда повышает жалование Джейсо-на на 3,5%:
$byname{'Jason¦}->{SALARY} *= 1 035,
Внесенные изменения отражаются во всех представлениях этих записей. Помните о том, что $byname{ 'Jason '} и $employees[ 132] ссылаются на одну и ту же запись, поскольку хранящиеся в них ссылки относятся к одному анонимному хэшу.
Как отобрать все записи, удовлетворяющие некоторому критерию? Для этого и была создана функция g rep. Например, в следующем фрагменте отбираются два подмножества записей — работников, чья должность содержит слово "peon", и тех, чей возраст равен 27 годам.
(Speons = grep { $_->{TITLE} =~ /peon/i } ©employees,
(atsevens = grep { $_->{AGE} == 27 } ^employees;
Каждый элемент @peons и @tsevens представляет собой ссылку на запись, поэтому они, как и ©employees, являются массивами хэшей.
Вывод записей в определенном порядке (например, по возрасту) выполняется так:
# Перебрать все записи
foreach $rp (sort { $a->{AGE> <=> $b->{AGE} } values %byname) {
printf '%s is age %d.\n", $rp->{NAME>, $rp->{AGE};
# или со срезом хэша через ссылку
printf "%s is employee number %d.\n", @$rp{'NAME', 'EMPNO'}; >
Вместо того чтобы тратить время на сортировку по возрасту, можно просто создать для этих записей другое представление, @byage. Каждый элемент массива (например, $byage[27]) является массивом всех записей с данным возрастом. Фактически мы получаем массив массивов хэшей. Он строится так:
# Используем @byage, массив массивов записей push @{ $byage[ $record->{AGE> ] >, Srecord;
Далее отбор осуществляется следующим образом:
for ($age = 0; $age <= $#byage; $age++) { next unless $byage[$age]; print "Age $age-foreach $rp (@{$byage[$age]}) {
print $rp->{NAME}, ' ", } print "\n",
}
Аналогичное решение заключается в применении map, что позволяет избежать цикла foreach:
for ($age = 0, $age <= $#byage; $age++) { next unless $byage[$age]; printf "Age %d: %s\n", Sage,
', map {$_->{NAME}} @{$byage[$age]}),
> Смотри также--------------------------------------------------------------------------------------------
Рецепты 4.13; 11.3.
11.10. Чтение и сохранение записей в текстовых файлах
Проблема
Требуется прочитать или сохранить хэш записи в текстовом файле.
Решение
Воспользуйтесь простым форматом, при котором каждое поле занимает отдельную строку вида:
ИмяПоля: Значение и разделяйте записи пустыми строками.
Комментарий
Если у вас имеется массив записей, которые должны сохраняться в текстовом файле и читаться из него, воспользуйтесь простым форматом, основанным на заголовках почтовых сообщений. Из-за простоты формата ключи не могут быть двоеточиями и переводами строк, а значения — переводами строк. Следующий фрагмент записывает данные в файл:
foreach Srecord (@Array_of_Records) { for $key (sort keys %$record) {
print \n'; }
Прочитать записи из файла тоже несложно:
$/ = "', # Режим чтения абзацев
while (<>) {
my ©fields = { split /"([":]+) \s*/m >,
shift ©fields; # Удалить начальное пустое поле
push-(@Array_of_Records, { ©fields }); >
Функция split работает с $_, своим вторым аргументом по умолчанию, в котором находится прочитанный абзац. Шаблон ищет начало строки (не просто начало записи благодаря /ш), за которым следует один или более символов, не являющихся двоеточиями, затем двоеточие и необязательный пропуск. Если шаблон split содержит скобки, они возвращаются вместе со значениями. Возвращаемые значения заносятся в @f lleds в порядке «ключ/значение»; пустое поле в начале убирается. Фигурные скобки в вызове push создают ссылку на новый анонимный хэш, куда копируется содержимое ©fields. Поскольку в массиве сохранился порядок «ключ/значение», мы получаем правильно упорядоченное содержимое хэша.
Все происходящее сводится к операциям чтения и записи простого текстового файла, поэтому вы можете воспользоваться другими рецептами. Рецепт 7.11 поможет правильно организовать параллельный доступ. В рецепте 1.13 рассказано о сохранении в ключах и значениях двоеточий и переводов строк, а в рецепте 11.3 — о сохранении более сложных структур.
Если вы готовы пожертвовать элегантностью простого текстового файла в пользу быстрой базы данных с произвольным доступом, воспользуйтесь DBM-фай-лом (см. рецепт 11.14).
> Смотри также---------------------------------------------------------------------------------------------
Описание функции split вperlfunc(l)-;рецепты 11.9, 11.13—11.14.
11.11. Вывод структур данных
Проблема
Требуется вывести содержимое структуры данных.
Решение
Если важна наглядность вывода, напишите нестандартную процедуру вывода. В отладчике Perl воспользуйтесь командой х:
0B<1> $reference = [ { 'foo' => "bar" }, 3, sub { print "hello, world\n } ], DB<2> x Sreference 0 ARRAY(0x1d033c) 0 HASH(0x7b39O)
'foo' = 'bar'> 1 3
2 C0DE(0x21e3e4) - & in ???>
В программе воспользуйтесь функцией Dumper модуля Data::Dumper от CPAN:
use Data..Dumper;
print Dumper($reference),
Комментарий
Иногда для вывода структур данных в определенном формате пишутся специальные функции, но это часто оказывается перебором. В отладчике Perl существуют команды х и X, обеспечивающие симпатичный вывод. Команда х полезнее, поскольку она работает с глобальными и лексическими переменными, а X — только с глобальными. Передайте х ссылку на выводимую структуру данных.
D<1> х \@INC
О ARRAY(0x807d0a8)
О '/home/tchrist/perllib'
1 '/usr/lib/perl5/i686-linux/5.00403' 2 7usr/lib/perl5'
3 7usr/lib/perl5/site_perl/i686-linux' 4 '/usr/lib/perl5/site_perl' 5 '.'
Эти команды используют библиотеку dumpvar.pl. Рассмотрим пример:
{ package mam, require 'dumpvar.pl' }
•dumpvar = \&mairr dumpvar if _ _PACKAGE_ _ ne mam ;
dumpvar('main', "INC"); # Выводит и @INC, и %INC
Библиотека dumpvar.pl не является модулем, но мы хотим использовать ее как модуль и поэтому заставляем импортировать функцию dumpvar. Первые две строки форсируют импортирование функции mam: :dumpvar из пакета mam в текущий пакет, предполагая, что эти функции отличаются. Выходные данные будут выглядеть так:
§INC = (
0 7home/tchrist/perllib/i686-linux'
1 '/home/tchrist/perllib'
2 7usr/lib/perl5/i686-linux/5.00404'
3 '/usr/lib/perl5'
4 '/usr/lib/perl5/site_perl/i686-linux'
5 7usr/lib/perl5/site_perl'
6 '.'
)
XINC = (
'dumpvar.pl' = '/usr/lib/perl5/i686-linux/5.00404/dumpvar.pl' 'strict, pm' = 7usr/Ub/perl5/i686-linux/5.00404/strict.pm'
use Data::Dumper; print Dumper(\@INC); $VAR1 = [
'/home/tchrist/perllib', 7usr/lib/perl5/i686-linux/5.00403', 7usr/lib/perl5',
7usr/lib/perl5/site_perl/i686-linux', '/us r/lib/pe rl5/site_pe rl',
Datar.Dumper поддерживает разнообразные форматы вывода. За подробностями обращайтесь к документации.
> Смотри также--------------------------------------------------------------------------------------------
Документация по модулю Data::Dumper с CPAN; раздел «The Perl Debugger» perldebug(l).
11.12. Копирование структуры данных
Проблема
Требуется скопировать сложную структуру данных.
Решение
Воспользуйтесь функцией dclone модуля Storable от CPAN:
use Storable,
$r2 = dclone($r1),
Комментарий
Существуют два типа копирования, которые иногда путают. Поверхностное копирование (surface copy) ограничивается копированием ссылок без создания копий данных, на которые они ссылаются:
©original = ( \@а, \@Ь, \@с ); ©surface = ©original;
Глубокое копирование (deep copy) создает абсолютно новую структуру без перекрывающихся ссылок. Следующий фрагмент копирует ссылки на один уровень вглубь:
©deep = map { [ @$_ ] } ©original;
Если переменные §а, @Ь и @с сами содержат ссылки, вызов тар не решит всех проблем. Написание специального кода для глубокого копирования структур — дело трудоемкое и быстро надоедающее.
Модуль Storable, доступный на CPAN, содержит функцию dclone, которая обеспечивает рекурсивное копирование своего аргумента:
use Storable qw(dclone); $г2 = dclone($r1);
Функция работает только со ссылками или приписанными к конкретному пакету (blessed) объектами типа SCALAR, ARRAY и HASH; ссылки на CODE, GLOB и 10 и другие экзотические типы не поддерживаются. Функция saf eFreeze модуля FreezeThaw обеспечивает такую возможность для одного адресного пространства посредством использования кэша ссылок, который при некоторых обстоятельствах вмешивается в процесс сборки мусора и работу деструкторов объектов.
Поскольку dclone принимает и возвращает ссылки, при копировании хэша ссылок в нее приходится включать дополнительные символы:
%newhash = %{ dclone(\%oldhash) };
> Смотри также---------------------------------------------------------------------------------------------
Документация по модулям Storable, Data::Dumper и FreezeThaw с CPAN.
11.13. Сохранение структур данных на диске
Проблема
Требуется сохранить большую, сложную структуру данных на диске, чтобы ее не пришлось заново строить при каждом запуске программы.
Решение
Воспользуйтесь функциями store и retrieve модуля Storable с CPAN:
use Storable; store(\%hash, "filename");
# later on ..
$href = retneve("filename"), # По ссылке
%hash = %{ retrieve("filename") }; # Прямо в хэш
Комментарий
Модуль Storable использует функции С и двоичный формат для обхода внутренних структур данных Perl и описания данных. По сравнению со строковой реализацией сохранения записей в Perl такой вариант работает эффективнее, однако он менее надежен.
Функции store и retrieve предполагают, что в передаваемых двоичных данных используется порядок байтов, стандартный для данного компьютера. Это означает, что созданные этими функциями файлы нельзя передавать между различными архитектурами. Функция nstore делает то же, что и store, но сохраняет дан-
use Storable qw(nstore), nstore(\%hash, filename ), # Позднее $href = retneve( filename )
Независимо от того, какая функция сохраняла данные — store или nstore, для их восстановления в памяти используется одна и та же функция retrieve. О переносимости должен заботиться создатель данных, а не их потребитель. Если создатель изменит свое решение, ему достаточно изменить программу всего в одном месте. Тем самым обеспечивается последовательный интерфейс со стороны потребителя, который ничего не знает об этих изменениях.
Функции store и nstore не блокируют файлы, с которыми они работают. Если вас беспокоят проблемы параллельного доступа, откройте файл самостоятельно, заблокируйте его (см. рецепт 7.11) и воспользуйтесь функцией storefd или более медленной, но независимой от платформы версией, nstore_fd.
Следующий фрагмент сохраняет хэш в файле с установкой блокировки При открытии файла не используется флаг O_TRUNC, поскольку до стирания содержимого нам приходится ждать получения блокировки.
use Storable qw(nstore_fd),
use Fcntl qw( DEFAULT flock)
sysopen(DF, /tmp/datafile , O_RDWR|O_CREAT 0666)
or die can t open /tmp/datafile S1 , flock(DF LOCK_EX) or die can t lock /tmp/datafile $i nstore_fd(\%hash, *DF)
or die can t store hash\n truncate(OF, tell(DF)) close(DF),
Другой фрагмент восстанавливает хэш из файла, также с применением блокировки:
use Storable,
use Fcntl qw( DEFAULT flock),
open(DF, < /tmp/datafile ) or die can t open /tmp/datafile $' ,
flock(DF, LOCK_SH) or die can t lock /tmp/datafile $' ,
$href = retrieve(*DF),
close(DF),
Внимательное применение этой стратегии позволяет эффективно передавать большие объекты данных между процессами, поскольку файловый манипулятор канала или сокета представляет собой байтовый поток, похожий на обычный файл.
В отличие от связей с различными реализациями DBM, модуль Storable не ограничивается одними хэшами (или массивами, как DB_File). На диске могут сохраняться произвольные структуры данных. Вся структура должна читаться или записываться полностью.
0 Смотри также---------------------------------------------------------------------------------------------
Рецепт 11.14.
11.14. Устойчивые структуры данных
Проблема
Существует сложная структура данных, которую требуется сделать устойчивой (persistent)1.
Решение
Воспользуйтесь модулем MLDBM и либо DB_File (предпочтительно), либо GDBM_File:
use MLDBM qw(DB_File), use Fcntl,
tie(%hash MLDBM , testfile db , O_CREAT|O_RDWR 0666) or die can t open tie to testfile db $' ,
# Операции с %hash
untie %hash,
Комментарий
Конечно, построение хэша из 100 000 элементов займет немало времени. Сохранение его на диске (вручную или с помощью Storable) также потребует немалых расходов памяти и вычислительных ресурсов.
Модули DBM решают эту проблему посредством связывания хэшей с файлами баз данных на диске. Вместо того чтобы читать всю структуру сразу, они извлекают данные лишь при необходимости. Для пользователя все выглядит так, словно состояние хэша сохраняется между вызовами программы
К сожалению, значения устойчивого хэша должны представлять собой простые строки. Вам не удастся легко использовать базу данных для хранения хэша хэшей, хэша массивов и т. д. — только хэши строк.
Однако модуль MLDBM с CPAN позволяет сохранять ссылки в базе данных. Преобразование ссылок в строки для внешнего хранения осуществляется с помощью Data::Dumper:
use MLDBM qw(DB_File) use Fcntl,
tie(%hash MLDBM testfile db , O_CREAT|O_RDWR, 0666) or die can t open tie to testfile db $' ,
Теперь %hash может использоваться для выборки или сохранения сложных записей на диске. Единственный недостаток заключается в том, что к ссылкам нельзя обращаться напрямую. Приходится извлекать ссылку из базы, работать с ней, а затем снова сохранять в базе.
# Не будет работать1
$hash{ some key }[4] = fred ,
$aref = $hash{"some key"}; $aref->[4] = "frecf; $hash{"sorae key") = $aref;
> Смотри также------------------------------------------------------------------------
Документация по модулю MLDBM с CPAN; рецепты 14.1; 14.7; 14.11.
11.15. Программа: бинарные деревья
Встроенные типы данных Perl представляют собой мощные, динамические структуры. В большинстве программ этих стандартных возможностей оказывается вполне достаточно. Для выполнения простого поиска почти всегда следует использовать простые хэши. Как выразился Ларри, «Весь фокус в том, чтобы использовать сильные, а не слабые стороны Perl».
Однако хэши не обладают внутренним упорядочиванием элементов. Чтобы перебрать элементы хэша в определенном порядке, необходимо сначала извлечь ключи, а затем отсортировать их. При многократном выполнении это может отразиться на быстродействии программы, что, однако, вряд ли оправдывает затраты времени на разработку хитроумного алгоритма.
Древовидные структуры обеспечивают упорядоченный перебор. Как реализовать дерево на Perl? Для начала загляните в свой любимый учебник по структурам данных. Воспользуйтесь анонимным хэшем для представления каждого узла дерева и переведите алгоритмы, изложенные в книге, на Perl. Обычно это задача оказывается проще, чем кажется.
Программа в примере 11.1 демонстрирует простую реализацию бинарного дерева, построенную на базе анонимных хэшей. Каждый узел состоит из трех полей: левый потомок, правый потомок и значение. Важнейшее свойство упорядоченных бинарных деревьев заключается в том, что значение левого потомка всегда меньше, чем значение текущего узла, а значение правого потомка всегда больше.
Основная программа выполняет три операции. Сначала она создает дерево с 20 случайными узлами, затем выводит три варианта обхода узлов дерева и, наконец, запрашивает у пользователя ключ и сообщает, присутствует ли этот ключ в дереве.
Функция insert использует механизм неявной передачи скаляров по ссылке для инициализации пустого дерева при вставке пустого узла. Присваивание $_[0] созданного узла приводит к изменению значения на вызывающей стороне.
Хотя такая структура данных занимает гораздо больше памяти, чем простой хэш, и обычный перебор элементов в ней происходит медленнее, упорядоченные перемещения выполняются быстрее.
Исходный текст программы приведен в примере 11.1.
Пример 11.1. bintree
#!/usr/bin/perl -w
# bintree - пример работы с бинарным деревом
use strict;
my($root, $n);
# Сгенерировать 20 случайных узлов
while ($п++ < 20) { insert($root, int(rand(1000))# Вывести узлы дерева в трех разных порядках
|
print "Pre order: print "In order: print "Post order: |
# Запрашивать до получения EOF
for (print 'Search'' "; <>; print "Search'' ") {chomp;
my Sfound = search($root, $_);
if (Sfound) { print "Found $_ at Sfound, $found->{VALUE}\n" }
else { print "No $_ in tree\n" }
exit; #########################################
# Функция вставляет передаваемое значение в правильную позицию
# передаваемого дерева. Если дерево не передается,
# для @_ используется механизм косвенной передачи по ссылке,
# что приводит к созданию дерева на вызывающей стороне,
sub insert {
my($tree, Svalue) = (s>_; unless (Stree) {
Stree = {}, tf Создать новый узел
Stree->{VALUE} = Svalue;
$tree->{LEFT} = undef;
$tree->{RIGHT} = undef;
$_[0] = $tree; # $_[0] - ссылочный параметр!
return;
if ($tree->{VALUE} > Svalue) { insert($tree->{LEFT}, Svalue) }
elsif ($tree->{VALUE} < Svalue) { msert($tree->{RIGHT}, Svalue) }
else { warn "dup insert of $value\n" }
# XXX: узлы не должны повторяться
# Рекурсия по левому потомку,
# вывод текущего значения
# и рекурсия по правому потомку,
sub m_order {
my($tree) = @>_; return unless $tree; in_order($tree->{LEFT}); print $tree->{VAI_UE}, " "; m_order($tree->{RIGHT>);
продолжение ¦&
404 Глава 11 • Ссылки и записи Пример 11.1 (продолжение)
# Вывод текущего значения,# рекурсия по левому потомку
# и рекурсия по правому потомку
sub pre_order {
my($tгее) = @_, return unless $tree, print $tree->{VALUE}, ' ' , pre_order($tree->{LEFT}), pre_order($tree->{RIGHT}),
# Рекурсия по левому потомку,
# рекурсия по правому потомку
# и вывод текущего значения,
sub post_order {
my($tree) = @_, return unless $tree, post_order($tree->{LEFT}), post_order($tree->{RIGHT}), print $tree->{VALUE},
# Функция определяет, присутствует ли передаваемое значение в дереве
# Если значение присутствует, функция возвращает соответствующий узел
# Поиск ускоряется за счет ограничения перебора нужной ветвью
sub search {
my($tree, Svalue) = @_,
return unless $tree,
if ($tree->{VALUE} == $value) {
return $tree, } search($tree->{ (Svalue < $tree->{VALUE}) ? 'LEFT' RIGHT'}, $value)
Пакеты, библиотеки
и модули м есе обладатели библиотек, Аурелиаи сознавал свою вину за то, что он недостаточно хорошо знал ее содержимое.
Хорхе Луис Борхес, «Теологи»
Введение
Представьте, что у вас есть две программы, каждая из которых хорошо работает сама по себе. Возникает идея — создать третью программу, объединяющую лучшие свойства первых двух. Вы копируете обе программы в новый файл и начинаете перемещать фрагменты. Выясняется, что в программах встречаются переменные и функции с одинаковыми именами, которые невозможно объединить. Например, каждая программа может содержать функцию mit или глобальную переменную $count. При объединении эти компоненты вступают в конфликт.
Проблема решается с помощью пакетов. Пакеты используются в Perl для разделения глобального пространства имен. Они образуют основу как для традиционных модулей, так и для объектно-ориентированных классов. Подобно тому, как каталог содержит файлы, пакет содержит идентификаторы. Каждый глобальный идентификатор (переменная, функция, манипулятор файла или каталога, формат) состоит из двух частей: имени пакета и собственно идентификатора. Эти две части разделяются символами : .. Например, переменная $CGI. ,needs_binmode представляет собой глобальную переменную с именем $needs_binmode, принадлежащую пакету CGI (до выхода версии 5.000 для этой цели использовался апостроф — например, $CGI'needs_bin_mode). Переменная $Names: :startup — это переменная $startup пакета Names, a $Dates:: startup — переменная Sstartup пакета Dates. Идентификатор Sstartup без имени пакета означает глобальную переменную Sstartup текущего пакета (при условии, что в данный момент не видна лексическая переменная Sstartup; о лексических переменных рассказано в главе 10 «Подпрограммы»). При указании неполного имени (то есть имени переменной без пакета) лексические переменные переопределяют глобальные. Лексическая переменная существует в области действия; глобальная — на уровне пакета. Если вам нужна глобальная переменная, укажите ее полное имя.
package Alpha; $name = "first";
package Onega; $name = "last";
package mam;
print "Alpha is $Alpha::name, Omega is $Omega:;name.\n";
Alpha is first, Omega is last.
В отличие от пользовательских идентификаторов, встроенные переменные со специальными именами (например, $_ и $.) и идентификаторы STDIN, STDOUT, STDERR, ARGV, ARGVOUT, ENV, ING и SIG без указания имени пакета считаются принадлежащими к пакету main. Благодаря этому STDIN, @ARGV, %ENV и $_ всегда означают одно и то же независимо от текущего пакета; например, @ARGV всегда относится к @main: : ARGV, даже если вы измените пакет по умолчанию командой package. Уточненное имя ©ElseWhere: : ARGV относится к нестандартному массиву @ARGV и не обладает специальным значением. Не забудьте локализовать переменную $_, если вы используете ее в своем модуле.
Модули
Многократное использование кода в Perl осуществляется с помощью модулей. Модуль представляет собой файл, содержащий набор взаимосвязанных функций, которые используются другими программами и библиотечными модулями. У каждого модуля имеется внешний интерфейс — набор переменных и функций, предназначенных для использования за его пределами. Внутри модуля интерфейс определяется инициализацией некоторых пакетных переменных, с которыми работает стандартный модуль Exporter. За пределами модуля доступ к интерфейсу организуется посредством импортирования имен, что является побочным эффектом команды use. Внешний интерфейс модуля Perl объединяет все, что документировано для всеобщего применения. К недокументированному интерфейсу относится все, что не предназначено для широкой публики. Говоря о модулях в этой главе и о традиционных модулях вообще, мы имеем в виду модули, использующие Exporter.
Команды require и use подключают модуль к вашей программе, хотя и облада ют несколько разной семантикой. Команда require загружает модуль во время выполнения с проверкой, позволяющей избежать повторной загрузки модуля.
Команда use работает аналогично, но с двумя дополнительными свойствами: загрузкой модуля на стадии компиляции и автоматическим импортированием.
Модули, включаемые командой use, обрабатываются на стадии компиляции, а обработка require происходит во время выполнения. Это существенно, поскольку при отсутствии необходимого модуля программа даже не запустится — use не пройдет компиляцию сценария. Другое преимущество use перед require заключается в том, что компилятор получает доступ к прототипам функций в подпрограммах модуля. Прототипы принимаются во внимание только компилятором, но не интерпретатором (впрочем, как говорилось выше, мы рекомендуем пользоваться прототипами только для замены встроенных команд, у которых они имеются).
Обработка команды use на стадии компиляции позволяет передавать указания компилятору. Директива (pragma) представляет собой специальный модуль, влияющий на процесс компиляции Perl-кода. Имена директив всегда записываются в нижнем регистре, поэтому при написании обычного модуля следует выбирать имена, начинающиеся с большой буквы. К числу директив, поддерживаемых Perl 5.004, принадлежат autouse, constant, diagnostics, integer, lib, locale, overload, sigtrap, strict, subs и vars. Каждой директиве соответствует отдельная страница руководства.
Другое отличие use и require заключается в том, что use выполняет неявное импортирование пакета включаемого модуля. Импортирование функции или переменной из одного пакета в другой создает некое подобие синонима — иначе говоря, появляются два имени, обозначающих одно и то же. Можно провести аналогию с созданием ссылки на файл, находящийся в другом каталоге, командой In / somedir/somefile. После подключения уже не придется вводить полное имя для того, чтобы обратиться к файлу. Аналогично, импортированное имя не приходится уточнять именем пакета (или заранее объявлять с помощью use vars или use subs). Импортированные переменные можно использовать так, словно они являются частью вашего пакета. После импортирования $English: :OUTPUT_AUTOFLUSH в текущий пакет на нее можно ссылаться в виде $OUTPUT_AUTOFLUSH.
Модули Perl должны иметь расширение .рт. Например, модуль FileHandle хранится в файле FileHandle.рт. Полный путь к файлу зависит от включаемых путей, хранящихся в глобальном массиве @INC. В рецепте 12.7 показано, как работать с этим массивом.
Если имя модуля содержит одну или несколько последовательностей : ;, они преобразуются в разделитель каталогов вашей системы. Следовательно, модуль File::Find в большинстве файловых систем будет храниться в файле File/Find.pm. Например:
require "FileHandle pm"; # Загрузка во время выполнения
require FileHandle; # Предполагается ".pm";
# то же, что и выше
use FileHandle; # Загрузка во время компиляции
require "Cards/Poker, pm"; # Загрузка во время выполнения
require Cards::Poker; # Предполагается ".pm"; ч
# то же, что и выше
use Cards::Poker; # Загрузка во время компиляции
Процесс экспортирования демонстрируется ниже на примере гипотетического модуля Cards::Poker. Программа хранится в файле Poker.pm в каталоге Cards, то есть Cards/ Poker.рт (о том, где должен находиться каталог Cards, рассказано в рецепте 12.7). Приведем содержимое этого файла с пронумерованными для удобства строками:
1 package Cards :Poker,
2 use Exporter,
3 @ISA = ('Exporter'),
4 ©EXPORT = qw(&shuffle ig>card_deck),
5 @card_deck = (), # Инициализировать глобальные
# переменные пакета
6 sub shuffle { } # Определение
U заполняется позднее
7 1 # Не забудьте1
8 строке 1 объявляется пакет, в который модуль поместит свои глобальные
переменные и функции. Обычно модуль начинается с переключения на конкрет
ный пакет, что позволяет ему хранить глобальные переменные и функции так,
чтобы они не конфликтовали с переменными и функциями других программ. Имя
пакета должно быть записано точно так же, как и при загрузке модуля соответству
ющей командой use.
Не пишите package Poker только потому, что модуль хранится в файле Poker.pml Используйте package Cards:: Poker, поскольку в пользовательской программе будет стоять команда use Cards: ' Poker. Эту распространенную ошибку трудно обнаружить. Если между командами package и use нет точного соответствия, проблемы возникнут лишь при попытке вызвать импортированную функцию или обратиться к импортированной переменной — те будут загадочным образом отсутствовать.
Строка 2 загружает модуль Exporter, управляющий внешним интерфейсом модуля (см. ниже). Строка 3 инициализирует специальный, существующий на уровне пакета массив @ISA строкой "Exporter'. Когда в программе пользователя встречается команда use Cards: .Poker, Perl неявно вызывает специальный метод, Cards' :Poker->import(). В пакете нет метода import, но это нормально — такой метод есть в пакете Exporter, и вы наследуете его благодаря присваиванию @ISA (ISA = «is а», то есть «является»). Perl обращается к массиву ©ISA пакета при обращении к неопределенному методу. Наследование рассматривается в главе 13 «Классы, объекты и связи». Пока не обращайте на него внимания, но не забывайте вставлять код строк 2 и 3 в каждый новый модуль.
Строка 4 заносит список ('&shuffle', '@card_deck') в специальный, существующий на уровне пакета массив ©EXPORT. При импортировании модуля для переменных и функций, перечисленных в этом массиве, создаются синонимы в вызывающем пакете. Благодаря этому после импортирования вам не придется вызывать функцию в виде Poker: :Deck: :shuffle(23) — хватит простого shuffle(23). Этого не произойдет при загрузке Cards::Poker командой require Cards::Poker; импортирование выполняется только для use.
Строки 5 и 6 готовят глобальные переменные и функции пакета к экспортированию (конечно, вы предоставите более конкретные инициализации и определе-
ния, чем в нашем примере). Добавьте другие переменные и функции, включая и те, которые не были включены в внешний интерфейс посредством ©EXPORT. Об использовании модуля Exporter рассказано в рецепте 12.1.
Наконец, строка 7 определяет общее возвращаемое значение модуля. В нашем случае это просто 1. Если носледнее вычисляемое выражение модуля не дает истинного значения, инициируется исключение. Обработка исключений рассматривается в рецепте 12.2. Подойдет любое истинное выражение, будь то 6.02е23 или "Because tchrist and gnat told us to put this here"; однако 1 — каноническая истинная величина, используемая почти во всех модулях.
Пакеты обеспечивают группировку и организацию глобальных идентификаторов. Они не имеют ничего общего с ограничением доступа. Код, откомпилированный в пакете Church, может свободно просматривать и изменять переменные пакета State. Пакетные переменные всегда являются глобальными и общедоступными. Но это вполне нормально, поскольку модуль представляет собой больше, чем простой пакет; он также является файлом, а файлы обладают собственной областью действия. Следовательно, если вам нужно ограничить доступ, используйте лексические переменные вместо глобальных. Эта тема рассматривается в рецепте 12.4.
Другие типы библиотечных файлов
Библиотека представляет собой набор неформально взаимосвязанных функций, используемых другими программами. Библиотеки не обладают жесткой семантикой модулей Perl. Их можно узнать по расширению файла .pi — например, syslog.pl и chat2.pl.
Библиотека Perl (а в сущности, любой файл, содержащий код Perl) может загружаться командой do ' file, pi' или require ' f il. pi'. Второй вариант лучше, поскольку в отличие от do require выполняет неявную проверку ошибок. Команда инициирует исключение, если файл не будет найден в пути @INC, не компилируется или не возвращает истинного значения при выполнении инициализирующего кода (последняя строка с 1, о которой говорилось выше). Другое преимущество require заключается в том, что команда следит за загруженными файлами с помощью глобального хэша % IN С. Если %INC сообщает, что файл уже был загружен, он не загружается повторно.
Библиотеки хорошо работают в программах, однако в ситуациях, когда одна библиотека использует другую, могут возникнуть проблемы. Соответственно, простые библиотеки Perl в значительной степени устарели и были заменены более современными модулями. Однако некоторые программы продолжают пользоваться библиотеками, обычно загружая их командой require вместо do.
В Perl встречаются и другие расширения файлов. Расширение .ph используется для заголовочных файлов С, преобразованных в библиотеки Perl утилитой h2ph (см. рецепт 12.14). Расширение .xs соответствует исходному файлу С (возможно, созданному утилитой h2xs), скомпилированному утилитой xsubpp и компилятором С в машинный код. Процесс создания смешанных модулей рассматривается в рецепте 12.15.
До настоящего времени мы рассматривали лишь традиционные модули, которые экспортируют свой интерфейс, предоставляя вызывающей стороне прямой доступ к некоторым подпрограммам и переменным. К этой категории относится
Пользуйтесь готовыми решениями
CPAN (Comprehensive Perl Archive Network) представляет собой гигантское хранилище практически всех ресурсов, относящихся к Perl, — исходные тексты, документацию, версии для альтернативных платформ и, что самое главное, модули. Перед.тем как браться за новый модуль, загляните на CPAN и поищите там готовое решение. Даже если его не существует, может найтись что-нибудь похожее, полезное в вашей работе.
На CPAN можно обратиться по адресу http://www.perl.com/CPAN/CPAN.html (или ftp://www.perl.com/pub/perl/CPAN/CPAN.html). В этом файле кратко описан каждый модуль, входящий в CPAN. Поскольку файл редактируется вручную, в нем могут отсутствовать описания последних модулей. Необходимую информацию можно получить по адресу CF'AN/RECENT'или CPAN/RECENT.html.
Каталог модулей находится по адресу CPAN/modules. В нем содержатся индексы всех зарегистрированных модулей, а также имеются три удобных подкаталога: byjnodule (сортировка по модулям), by_author (сортировка по авторам) и byjoategory (сортировка по категориям). В каждом подкаталоге перечислены одни и те же модули, но подкаталог by_category, вероятно, наиболее удобен. Находящиеся в нем подкаталоги соответствуют конкретным прикладным областям, среди которых — интерфейсы операционной системы, сетевые взаимодействия, модемы и межпроцессные коммуникации, интерфейсы баз данных, пользовательские интерфейсы, интерфейсы к другим языкам программирования, аутентификация, безопасность и шифрование, World Wide Web, HTML, HTTP, CGI и MIME, графика, операции с растровыми изображениями, построение графиков — и это лишь малая часть.
> Смотри также---------------------------------------------------------------------------------------------
Разделы «Packages» и «Modules» Bperlmod(l).
12.1. Определение интерфейса модуля
Проблема
Требуется определить внешний интерфейс модуля с помощью стандартного модуля Exporter.
Решение
Включите в файл модуля (например, YourModule.pm) приведенный ниже фрагмент. Многоточия заполняются в соответствии с инструкциями, приведенными в разделе «Комментарий».
package YourModule;
use strict;
use vars qw(@ISA ©EXPORT ©EXPORTJ)K %EXPORT_TAGS $VERSION);
use Exporter;
SVERSION =1.00; # Или выше
©ISA = qw(Exporter);
©EXPORT = qw(...); # Автоматически экспортируемые имена
й (набор :DEFAULT)
@EXP0RT_OK = qw(...); й Имена, экспортируемые по запросу
%EXPORT_TAGS = ( # Определение имен для наборов
TAG1 => [...],
TAG2 => [...],
#####й##йй######й###й##й й Ваш программный код #################йй#####
1; й Так должна выглядеть последняя строка
Чтобы воспользоваться модулем YourModule в другом файле, выберите один из следующих вариантов:
use YourModule; # Импортировать в пакет имена по умолчанию
use YourModule qw(..,); # Импортировать в пакет перечисленные имена
use YourModule (); й Не импортировать никаких имен
use YourModule qw(:TAG1); й Импортировать набор имен
Комментарий
Внешний интерфейс модуля определяется с помощью стандартного модуля Exporter. Хотя в пакете можно определить собственный метод import, почти никто этого не делает.
Когда в программе встречается команда use YourModule, в действительности выполняется команда require "YourModule. pm", за которой вызывается метод YourModule->import(). Это происходит во время компиляции. Метод import, унаследованный из пакета Exporter, ищет в вашем пакете глобальные переменные, управляющие его работой. Поскольку они должны быть пакетными, мы используем директиву use vars, чтобы избежать проблем с use strict. Это следующие переменные.
$VERSION
При загрузке модуля можно указать минимальный допустимый номер версии. Если версия окажется ниже, use инициирует исключение.
use YourModule 1.86 # Если $VERSION < 1.86, происходит исключение
$EXPORT
Массив содержит список функций и переменных, экспортируемых в пространство имен вызывающей стороны, чтобы в дальнейшем к ним можно было
(SEXPORT = qw(&F1 &F2 @List)
(SEXPORT = qw( F1 F2 @List) # To же
После выполнения простой команды use YourModule вы сможете вызывать функцию &F1 в виде F1 () вместо YourModule F1 () и обращаться к массиву @List вместо ©YourModule List. Амперсанд (&) перед спецификацией экспортированной функции необязателен.
Чтобы загрузить модуль во время компиляции, но при этом запретить экспортирование каких-либо имен, воспользуйтесь специальной формой с пустым списком use Exporter^).
@EXPORT_OK
Массив содержит имена, которые могут импортироваться по конкретному запросу. Если массив заполнен следующим образом:
@EXP0RT_0K = qw(0p_Func %Table), то пользователь сможет загрузить модуль командой:
use YourModule qw(0p_Func %Table F1)
и импортировать только функцию Op_Func, хэш %ТаЫе и функцию F1. Функция F1 присутствует в массиве ©EXPORT. Обратите внимание: команда не выполняет автоматического импортирования F2 или @List, хотя эти имена присутствуют в ©EXPORT. Чтобы получить все содержимое ©EXPORT и плюс к тому все дополнительное содержимое @EXPORT_OK, воспользуйтесь специальным тегом DEFAULT:
use YourModule qw( DEFAULT %Table)
%EXPORT_TAGS
Хэш используется большими модулями (типа CGI или POSIX) для высокоуровневой группировки взаимосвязанных импортируемых имен Его значения представляют собой ссылки на массивы символических имен, каждое из которых должно присутствовать либо в ©EXPORT, либо в @EXPORT_OK. Приведем пример инициализации:
%EXPORT_TAGS = (
Functions => [ qw(F1 F2 Op_Func) ]
Variables => [ qw(@List %Table) ], )
Импортируемое имя с начальным двоеточием означает импортирование группы имен. Например, команда:
use YourModule qw( Functions %Table) импортирует все имена из
@{ SYourModule EXPORT_TAGS{Functions} }, то есть функции F1, F2 и Op_Func, а затем — хэш %ТаЫе.
Хотя тег DEFAULT не указывается в %EXPORT_TAGS, он обозначает все содержимое ©EXPORT.
Все эти переменные не обязательно определять в каждом модуле. Ограничьтесь лишь теми, которые будут использоваться.
> Смотри также---------------------------------------------------------------------------------------------
Документация по стандартному модулю Exporter, рецепты 12.7; 12.18
12.2. Обработка ошибок require и use
Проблема
Загружаемый модуль может отсутствовать в системе. Обычно это приводит к фатальной ошибке. Вы хотите обнаружить и перехватить эту ошибку.
Решение
Поместите require или use в eval, a eval — в блок BEGIN.
tt He импортировать BEGIN {
unless (eval require $mod ) { warn couldn t load $mod $@>
# Импортировать в текущий пакет BEGIN {
unless (eval use $mod ) { warn couldn t load $mod
Комментарий
Попытка загрузки отсутствующего или неполного модуля обычно должна приводить к аварийному завершению программы. Однако в некоторых ситуациях программа должна продолжить работу — например, попытаться загрузить другой модуль. Как и при других исключениях, для изолирования ошибок компиляции применяется конструкция eval.
Использовать eval { БЛОК } нежелательно, поскольку в этом случае будут перехватываться только исключения времени выполнения, a use относится к событиям времени компиляции. Вместо этого следует использовать конструкцию eval СТРОКА , что позволит перехватывать и ошибки компиляции. Помните: вызов require для простого слова' имеет несколько иной смысл, чем вызов requi re
Если вы хотите последовательно попытаться загрузить несколько модулей и остановиться на первом работающем, поступите так:
BEGIN {
my($found, @DBs, $mod);
$found = 0;
@DBs = qw(Giant: :Eeme Giant: :Meame Mouse: :Mynie Мое);
for $mod (@>DBs) {
if (eval "require $mod") <
$mod->import(); # При необходимости
$found = 1;
last;
die "None of @DBs loaded" unless Sfound; }
Мы включаем eval в блок BEGIN, чтобы гарантировать загрузку модуля во время компиляции, а не во время выполнения.
> Смотри также-------------------------------------------------------------------------
Рецепт 10.12; рецепт 12.3. Функции eval, die, use и require описаны в perl-func(l).
12.3. Отложенное использование модуля
Проблема
Необходимо организовать загрузку модуля на определенной стадии работы программы или вообще отказаться от его загрузки при некоторых обстоятельствах.
Решение
Разбейте use на отдельные компоненты require и import, либо воспользуйтесь директивой use autouse.
Комментарий
Если программа проверяет свои аргументы и завершает работу с информационным сообщением или ошибкой, загружать неиспользуемые модули бессмысленно. Это лишь вызывает задержки и раздражает пользователей. Но как говорилось во введении, команды use обрабатываются во время компиляции, а не во время выполнения.
Наиболее эффективная стратегия состоит в проверке аргументов внутри блока BEGIN до загрузки модулей. Следующая программа перед загрузкой необходимых модулей проверяет, что она была вызвана ровно с двумя аргументами, каждый из которых является целым числом:
BEGIN {
unless (@ARGV == 2 && (2 == grep {/"\d+$/> @ARGV)) die "usage: $0 num1 num2\n";
use Some::Module; use More::Modules;
Похожая ситуация возникает в программах, которые при разных запусках могут использовать разные наборы модулей. Например, программа factors из главы 2 «Числа» загружает библиотеку вычислений с повышенной точностью лишь при вызове с флагом -Ь. Команда use в данном случае бессмысленна, поскольку она обрабатывается во время компиляции, задолго до проверки условия if. По этой причине мы используем команду require:
if ($opt_b) {
require Math::BigInt; >
Math::BigInt является не традиционным, а объектно-ориентированным модулем, поэтому импортирование не требуется. Если у вас имеется список импортируемых объектов, укажите его в конструкции qw() так, как это было бы сделано для use. Например, вместо:
use Fcntl qw(O_EXCL O_CREAT O_RDWR); можно использовать следующую запись:
require Fcntl;
Fcntl->import(qw(0_EXCL O_CREAT 0_RDWR));
Откладывая импортирование до времени выполнения, мы сознательно идем на то, что оставшаяся часть программы не узнает об изменениях импортированной семантики, которые были бы видны компилятору при использовании use. В частности, не будут своевременно видны прототипы функций и переопределения встроенных функций.
Возникает идея — инкапсулировать отложенную загрузку в подпрограмме. Следующее, простое на первый взгляд решение не работает:
sub loadjnodule {
require $_[0]; «НЕВЕРНО
import $_[0]; «НЕВЕРНО }
Понять причину неудачи непросто. Представьте себе вызов require с аргументом "Math: : BigFloat". Если это простое слово, ;: преобразуется в разделитель каталогов операционной системы, а в конец добавляется расширение .рт. Но простая переменная интерпретируется как литерал — имя файла. Дело усугубляется тем, что Perl не имеет встроенной функции import. Существует лишь метод класса import, который мы пытаемся применить с сомнительным косвенным объектным синтаксисом. Как и в случае с косвенным применением файловых манипуляторов, косвенный объект можно использовать лишь для простой ска-
loadjnoduleC Fcntl1, qw(0_EXCL O_CREAT 0_RDWR));
sub load_module {
eval ' require $_[0]";
die if $@,
$_[0]->import((8>_[1 . $#_]); }
Но и он в общем случае не идеален. Функция должна импортировать имена не в свой пакет, а в пакет вызвавшей стороны. В принципе эта проблема решается, но процедура становится все сложнее и сложнее.
Удобное альтернативное решение — применение директивы autouse. Она появилась в Perl 5.004. Эта новая директива экономит время для редко загружаемых функций, откладывая их загрузку до момента фактического использования:
use autouse Fcntl => qw( O_EXCL() O.CREAT() O_RDWR() );
Круглые скобки после O_EXCL, O_CREAT и O_RDWR нужны для autouse, но не для use или import. Директива autouse принимает не только имена функций, ио также позволяет передать прототип функции. В соответствии с прототипами константы Fcntl вызываются без аргументов, поэтому их можно использовать в программе как простые слова без возни с use strict.
Также помните, что проверка use strict осуществляется во время компиляции. Если модуль Fcntl подключается командой use, прототипы модуля Fcntl будут откомпилированы и мы сможем использовать копстанты без круглых скобок. Если использована команда require или вызов use заключен в eval, как это делалось выше, компилятор не сможет прочитать прототипы, поэтому константы Fcntl не будут использоваться без скобок.
За сведениями об особенностях директивы autouse обращайтесь к электронной документации.
t> Смотри также--------------------------------------------------------------------------------------------
Рецепт 12.2; документация по стандартному модулю Exporter (описание метода import); документация по стандартной директиве use autouse.
12.4. Ограничение доступа к переменным модуля
Проблема
Требуется сделать переменную или функцию закрытой (то есть разрешить ее использование только в границах пакета).
Решение
Общего решения не существует. Однако можно ограничить доступ на уровне файла, в котором находится модуль, — обычно этого достаточно.
Комментарий
Помните, что пакет всего лишь определяет способ группировки переменных и функции и потому не поддерживает ограничения доступа. Все содержимое пакета по определению является глобальным и доступным отовсюду. Пакеты лишь группируют, ничего не скрывая.
Ограничение доступа возможно только с применением лексических переменных. Предположим, модуль реализован в виде файла Module.pm, а все его глобальные имена принадлежат пакету Module. Поскольку файл по определению образует самостоятельную область действия, а лексические переменные ограничиваются ею, создание лексической переменной с файловой областью действия фактически эквивалентно переменной, ограниченной данным модулем.
Однако переключение пакетов внутри области действия может привести к тому, что лексические переменные этой области остаются видны в любом месте области. Дело в том, что команда package всего лишь устанавливает новый префикс для глобальных идентификаторов.
package Alpha; my $aa = 10; $х = "azure";
package Beta; my $bb = 20; $x = "blue";
package main;
print "$aa, $bb, $x, $Alpha::x, $Beta::x\n";
10, 20, , azure, blue
На это ли вы рассчитывали? Две лексические переменные, $аа и $bb, остаются в области действия, поскольку они не вышли за границы текущего блока, файла или eval. Считайте, что глобальные и лексические переменные существуют в раз-.ных изменениях, никак не связанных друг с другом. Пакетные команды не имеют ничего общего с лексическими переменными. После установки текущего префикса первая глобальная переменная $х в действительности представляет собой $Alpha:: х, а вторая — $Beta:: х, поскольку промежуточная команда package изменила префикс по умолчанию. Доступ к пакетным идентификаторам при указании полного имени может осуществляться откуда угодно, как это делается в команде print.
Итак, пакеты не позволяют ограничивать доступ — зато на это способны модули, поскольку они находятся в файлах, а файл всегда обладает собственной областью действия. Приведенный ниже простой модуль находится в файле Flipper.pm и экспортирует две функции, f lip_words и f lip_boundary. Первая функция переставляет слова строки в обратном порядке, а вторая изменяет определение границы слова.
require Exporter;
use vars qw(@ISA ©EXPORT SVERSION);
@ISA = qw(Exporter);
@EXP0RT = qw(flip_words flip_boundary);
$VERSION =1.0;
my SSeparatrix = ' '; # По умолчанию пробел; предшествует функциям
sub flip_boundary {
my $prev_sep = SSeparatrix;
if (@_) { SSeparatrix = $_[0] }
return $prev_sep; > sub flip_words {
my $lme = $_[0];
my @words = split(SSeparatrix, Sline);
return ]oin(SSeparatrix, reverse @words); } 1;
Модуль задает значения трех пакетных переменных, необходимых для работы Exporter, а также инициализирует лексическую переменную SSeparatrix уровня файла. Как говорилось выше, эта переменная ограничивается границами файла, а не пакета. Весь код той же области действия, расположенный после ее объявления, прекрасно видит SSeparatrix. Хотя глобальные переменные не экспортировались, к ним можно обращаться по полному имени — например, $Flipper: : VERSION.
Лексические переменные, существующие в некоторой области действия, нельзя прочитать или изменить вне этой области, которая в данном случае соответствует всему файлу после объявления переменной. На лексические переменные нельзя ссылаться по полному имени или экспортировать их; экспортирование возможно лишь для глобальных переменных. Если кому-либо за пределами модуля потребуется просмотреть или изменить лексические переменные файла, они должны обратиться с запросом к модулю. Именно здесь в игру вступает функция f lip_boundary, обеспечивающая косвенный доступ к закрытым компонентам модуля.
Работа приведенного выше модуля ничуть не изменилась бы, будь SSeparatrix пакетной глобальной переменной, а не файловой лексической. Теоретически к ней можно было бы обратиться снаружи так, что модулю об этом ничего не было известно. С другой стороны, не стоит увлекаться чрезмерными ограничениями и щедро уснащать модули лексическими переменными с файловой областью действия. У вас уже имеется пространство имен (в нашем примере — Flipper), в котором можно сохранить все необходимые идентификаторы. Собственно, для этого оно и предназначено. Хороший стиль программирования на Perl почти всегда избегает полностью уточненных идентификаторов.
Если уж речь зашла о стиле, регистр символов в идентификаторах модуля Flipper выбирался не случайно. В соответствии с руководством по стилю программирования на Perl, символами верхнего регистра записываются идентификато-
ры, имеющие специальное значение для Perl. Имена функций и локальных переменных записываются в нижнем регистре. Устойчивые переменные модуля (файловые лексические или пакетные глобальные) начинаются с символа верхнего регистра. Если идентификатор состоит из нескольких слов, то для удобства чтения эти слова разделяются символами подчеркивания. Пожалуйста, не разделяйте слова символами верхнего регистра без подчеркиваний — в конце концов, вряд ли вам захотелось бы читать эту книгу без пробелов.
!> Смотри также--------------------------------------------------------------------------------------------
perlstyle(l); рецепты 10.2—10.3. Лексические переменные с файловой областью действия рассматриваются в perlmod(l).
12.5. Определение пакета вызывающей стороны
Проблема
Требуется узнать текущий или вызывающий пакет.
Решение
Текущий пакет определяется так:
$this_pack = __ PACKAGE__ ;
Пакет вызывающей стороны определяется так:
$that_pack = caller();
Комментарий
Метапеременная______ PACKAGE возвращает пакет, в котором был откомпилирован
текущий код. Значение не интерполируется в строках, заключенных в кавычки:
print "I am in package __PACKAGE__\n"; # НЕВЕРНО!
I am in package __ PACKAGE
Необходимость узнать пакет вызывающей стороны чаще возникает в старом коде, которому в качестве входных данных была передана строка для eval, файловый манипулятор, формат или имя манипулятора каталога. Рассмотрим гипотетическую функцию runit:
package Alpha; runit('$line = <TEMP>');
package Beta; sub runit {
my $codestr = shift;
eval Scodestr;
die if $@;
package Beta; sub runit {
my Scodestr = shift;
my Shispack = caller;
eval "package Shispack; $codestr";
die if $<s>; }
Новое решение не только работает с лексическими переменными, но и обладает дополнительным преимуществом — синтаксис кода проверяется во время компиляции, а это существенный плюс.
При передаче файлового манипулятора стоит воспользоваться более переносимым решением — функцией Symbol:: qualify. Она получает имя и пакет, для которого оно уточняется. Если имя нуждается в уточнении, оно исправляется, а в противном случае остается без изменений. Однако это решение заметно уступает по эффективности прототипу *.
Следующий пример читает и возвращает п строк из файлового манипулятора. Перед тем как работать с манипулятором, функция qualify уточняет его.
open (FH, "< /etc/termcap")
or die "can't open /etc/termcap• $!"; ($a, $b, $c) = nreadlme(3, 'FH');
use Symbol ();
use Carp;
sub nreadlme {
my ($count, $handle) = §_;
my(@retlist,$line);
croak "count must be > 0" unless $count > 0;
$handle = Symbol::qualify($handle, (caller())[0]);
croak "need open filehandle" unless defined fileno($handle),
push(@retlist, $line) while defined($line = <$handle>) && $count--; return ©retlist; }
Если при вызове функции nreadline файловый манипулятор всегда передается в виде тип-глоба *FH, ссылки на глоб \*FH или с помощью объектов FileHandle или 10:: Handle, уточнение не потребуется. Оно необходимо лишь на случай передачи минимального "FH".
1> Смотри также-------------------------------------------------------------------------------------------
Документация по стандартному модулю Symbol; рецепт 12.12. Специальные
метапеременные FILE__ ,__ LINE__ и__ PACKAGE_ описаны в perldata{ 1).
12.6. Автоматизированное выполнение завершающего кода
Проблема
Требуется создать для модуля начальный и завершающий код, вызываемый автоматически без вмешательства пользователя.
Решение
Начальный код реализуется просто — разместите нужные команды вне определений подпрограмм в файле модуля. Завершающий код помещается в блок END модуля.
Комментарий
В некоторых языках программист должен вызвать инициализирующий код модуля, прежде чем вызывать какие-либо его функции. Аналогично, при завершении программы от программиста может потребоваться вызов завершающего кода, выполняющего деинициализацию модуля.
В Perl дело обстоит иначе. Инициализирующий код модуля образуют команды, не входящие ни в одну подпрограмму модуля. Этот код выполняется непосредственно при загрузке модуля. Пользователю никогда не приходится следить за вызовом начального кода, поскольку это происходит автоматически.
Для чего нужен автоматический вызов завершающего кода? Все зависит от модуля. Допустим, вам захотелось записать информацию о завершении в системный журнал, приказать серверу базы данных актуализировать все незаконченные операции, обновить состояние экрана или вернуть терминал в исходное состояние.
Предположим, модуль должен регистрировать начало и завершение своей работы в журнале. Вставьте следующий фрагмент в блок END, чтобы он выполнялся при завершении программы:
$Logfile = "Amp/mylog" unless defined SLogfile; open(LF, "»$Logfile")
or die "can't append to SLogfile: $!";
select(((select(LF), $|=1))[0]); # Отменить буферизацию LF logmsgC'startup");
sub logmsg {
my $now = scalar gmtime;
print LF "$0 $$ $now: @_\n"
or die "write to SLogfile failed: $!"; >
END {
logmsg("shutdown"); close(LF)
or die "close SLogfile failed: $!";
Блоки END не отличаются от других функций завершения — trap 0 в командном интерпретаторе, atexit в языке С или глобальные деструкторы в объектно-ориентированных языках. Порядок выполнения END противоположен порядку загрузки модулей; иначе говоря, первым выполняется блок END последнего загруженного модуля. Завершающий код вызывается независимо от причины завершения — нормального достижения конца основной программы, непосредственного вызова функции exit или необработанного исключения (например, die или ошибки деления на ноль).
Однако с неперехваченными сигналами дело обстоит иначе. При завершении по сигналу блоки завершения не вызываются. Проблема решается следующей директивой:
use sigtrap qw(die normal-signals error-signals)
END также не вызывается в случае, если процесс вызывает функцию exec, поскольку процесс остается тем же самым, изменяется лишь программа. Все стандартные атрибуты (идентификатор процесса и его родителя, идентификаторы пользователя и группы, маска доступа, текущий каталог, переменные окружения, ограничения ресурсов и накопленная статистика), открытые файловые дескрипторы (однако см. описание переменной $~F в perlvar(l)) сохраняются. Другой подход привел бы к лишним вызовам блоков завершения в программах с ручной обработкой fork и exec. Это было бы нежелательно.
О Смотри также--------------------------------------------------------------------------------------------
Стандартная директива use sigtrap описана вperlmod(i), а переменная $"F — в perldata(i). Функции fork и exec рассматриваются вperlmod(l).
12.7. Ведение собственного каталога модулей
Проблема
Вы не хотите включать собственные модули в стандартную библиотеку расширений системного уровня.
Решение
Возможно несколько вариантов: воспользоваться параметром командной строки Perl -I; присвоить значение переменной окружения PERL5LIB; применить директиву use lib (возможно, в сочетании с модулем FindBin).
Комментарий
Массив @INC содержит список каталогов, которые просматриваются при каждой компиляции кода из другого файла, библиотеки или модуля командой do, require или use. Содержимое массива легко вывести из командной строки:
% perl -e 'for (@INC) { printf %d %s\rf , $1++, $_ Г
0 /usr/local/perl/lib/i686-linux/5.004
1 /usr/local/perl/lib
2 /usr/local/perl/lib/site_perl/i686-linux
3 /usr/local/perl/lib/site_perl
4 .
Первые два элемента (0 и 1) массива @INC содержат обычные платформенно-за-висимый и платформенно-независимый каталоги, с которыми работают все стандартные библиотеки, модули и директивы. Этих каталогов два, поскольку некоторые модули содержат данные или форматирование, имеющие смысл лишь для конкретной архитектуры. Например, модуль Config содержит информацию, относящуюся лишь к некоторым архитектурам, поэтому он находится в 0 элементе массива. Здесь же хранятся модули, содержащие откомпилированные компоненты на С (например, Socket.so). Однако большинство модулей находится в элементе 1 (независимый от платформы каталог).
Следующая пара, элементы 2 и 3, по своим функциям аналогична элементам О и 1, но относится к конкретной системе. Допустим, у вас имеется модуль, который не поставлялся с Perl, — например, модуль, загруженный с CPAN или написанный вами. Когда вы (или, что более вероятно, ваш системный администратор) устанавливаете этот модуль, его компоненты попадают в один из этих каталогов. Эти каталоги следует использовать для любых модулей, удобный доступ к которым должен быть в вашей системе.
Последний стандартный элемент, " " (текущий рабочий каталог), используется только в процессе разработки и тестирования программ. Если модули находятся в каталоге, куда вы перешли последней командой chdir, все хорошо. Если в любом другом месте — ничего не получится.
Иногда ни один из каталогов, указанных в @INC, не подходит. Допустим, у вас имеются личные модули или ваша рабочая группа использует свой набор модулей, относящихся только к данному проекту. В этом случае необходимо дополнить поиск по стандартному содержимому @INC.
В первом варианте решения используется флаг командной строки -1список_ка-талогов. После флага указывается список из одного или нескольких каталогов, разделенных двоеточиями1. Список вставляется в начало массива @INC. Этот вариант удобен для простых командных строк и потому может использоваться на уровне отдельных команд (например, при вызове простой однострочной программы из сценария командного интерпретатора).
Подобную методику не следует использовать в строках #!. Во-первых, редактировать каждую программу в системе скучно. Во-вторых, в некоторых старых
Нередко самое удачное решение заключается в использовании переменной окружения PERL5LIB, значение которой обычно задается в стартовом сценарии интерпретатора. Если системный администратор задаст переменную в стартовом файле системного уровня, результаты будут доступны для всех пользователей. Предположим, ваши модули хранятся в каталоге -/perllib. Включите одну из следующих строк в стартовый файл командного интерпретатора (в зависимости от того, каким интерпретатором вы пользуетесь):
# Синтаксис для sh, bash, ksh и zsh
$ export PERL5LIB=$H0ME/perllib
# Синтаксис для csh или tcsh
% setenv PERL5LIB "/perllib
Возможно, самое удобное решение с точки зрения пользователя — включение директивы use lib в начало сценария. При этом пользователям программы вообще не придется выполнять специальных действий для ее запуска. Допустим, у нас имеется гипотетический проект Spectre, программы которого используют собственный набор библиотек. Такие программы могут начинаться с команды:
use lib "/projects/spectre/lib",
Что делать, если точный путь к библиотеке неизвестен? Ведь проект может устанавливаться в произвольный каталог. Конечно, можно написать детально проработанную процедуру установки с динамическим обновлением сценария, но даже в этом случае путь будет жестко фиксироваться на стадии установки. Если позднее файлы переместятся в другой каталог, библиотеки не будут найдены.
Модуль FindBin легко решает эту проблему. Он пытается вычислить полный путь к каталогу выполняемого сценария и присваивает его важной пакетной переменной $Вт. Обычно он применяется для поиска модулей в одном каталоге с программой или в каталоге lib того же уровня.
Рассмотрим пример для первого случая. Допустим, у вас имеется программа /wherever/spectre/myprog, которая ищет свои модули в каталоге /wherever/spectrem, однако вы не хотите жестко фиксировать этот путь:
use FindBin;
use lib $FmdBin: :Bin;
Второй случай — если ваша программа находится в каталоге /wherever/spectre/ bin/myprog, но ее модули должны находиться в каталоге /wherever/spectre/lib:
use FindBin qw($Bin); use lib "$Bm/. /lib";
> Смотри также---------------------------------------------------------------------------------------------
Документация по стандартной директиве use lib и стандартному модулю FindBin. Переменная окружения PERL5LIB описана врег1(1). Переменные окружения рассматриваются в руководстве по синтаксису командного интерпретатора.
12.8. Подготовка модуля к распространению
Проблема
Вы хотите подготовить модуль в стандартном формате распространения, чтобы им можно было легко поделиться с другом. Или, что еще лучше, вы собираетесь загрузить модуль на CPAN и сделать его общедоступным.
Решение
Начните со стандартной утилиты Perl h2xs. Предположим, вы хотите создать модуль Planets или Astronomy::Orbits. Введите следующие команды:
% h2xs -XA -n Planets
% h2xs -XA -n Astronomy Orbits
Эти команды создают подкаталоги ./Planets/ и ./Astronomy/Orbits/ соответственно. В каталогах находятся все компоненты, необходимые для начала работы. Флаг -п задает имя создаваемого модуля, -X запрещает создание компонентов XS (внешних подпрограмм), а -А означает, что модуль не будет использовать AutoLoader.
Комментарий
Написать модуль несложно, если знать, как это делается. Написание «правильного» модуля похоже на заполнение юридического контракта — перед вами множество мест для инициалов, подписей и дат, и все нужно заполнить правильно. Если вы что-нибудь пропустите, контракт не имеет законной силы. Вместо того чтобы нанимать специалиста, можно воспользоваться утилитой h2xs. Она создает «скелет» файла модуля с заполненными данными об авторских правах, а также другие файлы, необходимые для правильной установки и документирования модуля, для включения его в CPAN или распространения среди друзей.
Название утилиты h2xs может сбить с толку, поскольку XS представляет собой интерфейс внешних подпрограмм Perl для компоновки с С или C++. Однако утилита h2xs также в высшей степени удобна для подготовки распространяемых модулей, даже если они и не используют интерфейс XS.
Давайте рассмотрим один из модулей, созданных утилитой h2xs. Поскольку модуль будет называться Astronomy::Orbits, вместо команды use Orbits пользователь должен вводить use Astronomy: Orbits. Следовательно, нам потребуется
package Astronomy Orbits,
Команда определяет пакет (префикс по умолчанию) для всех глобальных идентификаторов (переменных, функций, файловых манипуляторов и т. д.) данного файла. Следовательно, переменная @ISA в действительности является глобальной переменной ©Astronomy Orbits ISA.
Как было сказано во введении, использовать команду package Orbits только потому, что она находится в файле Orbits.pm, будет ошибкой. Команда package в модуле должна точно совпадать с формулировкой use или require; это означает присутствие префикса каталога, а также совпадение регистра символов. Более того, необходим промежуточный каталог Astronomy. Утилита h2xs позаботится обо всем, включая правило установки в Make-файле. Если вы готовите модуль вручную, помните об этом (см. рецепт 12.1).
Если вы собираетесь использовать автоматическую загрузку (см. рецепт 12.10), уберите флаг -А из вызова h2xs. В результате будет создан фрагмент вида:
require Exporter,
require Autoloader,
@ISA = qw(Exporter Autoloader)
Если ваш модуль использует и Perl и С (см. рецепт 12.14), уберите флаг -X из вызова h2xs. Сгенерированный фрагмент выглядит так:
require Exporter,
require DynaLoader,
@ISA = qw(Exporter DynaLoader),
Далее перечисляются переменные модуля Exporter (см. рецепт 12.1). Если вы пишете объектно-ориентированный модуль (см. главу 13), вероятно, вам вообще не придется использовать Exporter.
Подготовка завершена. Переходите к написанию кода своего модуля. Когда модуль будет готов к распространению, преобразуйте модуль в tar-архив для удобства распространения. Для этого используется команда make dist в командном интерпретаторе (имя программы make может зависеть от системы).
%make dist
Команда создает файл с именем вида Astronomy-Orbits- 1.03.tar.Z. Чтобы зарегистрироваться в качестве разработчика CPAN, обратитесь по адресу http://www.perl.com/CPAN/modules/04pause.html.
> Смотри также---------------------------------------------------------------------------------------------
h2xs(i); документация по стандартным модулям Exporter, Auto Loader, Auto-Spht и ExtUtils::MakeMaker. По адресу http://www.perl.com/CPANможно найти ближайший зеркальный узел и рекомендации, касающиеся предоставления модулей.
12.9. Ускорение загрузки модуля с помощью SelfLoader
Проблема
Вам хочется быстро загрузить очень большой модуль.
Решение
Воспользуйтесь модулем SelfLoader:
require Exporter,
require SelfLoader,
@ISA = qw(Exporter SelfLoader)
# "
# Прочие инициализации и объявления
ft
__DATA__
sub abc { }
sub def { }
Комментарий
При загрузке модуля командой require или use необходимо прочитать содержимое всего файла модуля и откомпилировать его (во внутренние деревья лексического анализа, не в байт-код или машинный код). Для очень больших модулей эта раздражающая задержка совершенно не нужна, если вам нужны всего несколько функций из конкретного файла.
Модуль SelfLoader решает эту проблему, откладывая компиляцию каждой под
программы до ее фактического вызова. Использовать SelfLoader несложно: до
статочно расположить подпрограммы вашего модуля под маркером DATA , что
бы они были проигнорированы компилятором, обратиться к SelfLoader с помощью
require и включить SelfLoader в массив @ISA модуля. Вот и все, что от вас требует
ся. При загрузке модуля SelfLoader создает заглушки для функций, перечислен
ных в секции__ DATA___________________________________ . При первом вызове функции заглушка компилирует насто
ящую функцию и вызывает ее.
В модулях, использующих SelfLoader (или AutoLoader — см. рецепт 12.10), дей
ствует одно важное ограничение. Функции, загружаемые SelfLoader или AutoLoader,
не имеют доступа к лексическим переменным файла, в чьем блоке___ DATA они на
ходятся, поскольку они компилируются функцией eval в импортированном бло
ке AUTOLOAD. Следовательно, динамически сгенерированные функции компи
лируются в области действия AUTOLOAD модуля SelfLoader или AutoLoader.
Как скажется применение SelfLoader на быстродействии программы — положительно или отрицательно? Ответ на этот вопрос зависит от количества функций в модуле, от их размера и от того, вызываются ли они на протяжении всего жизненного цикла программы или нет.
Модуль SelfLoader не следует применять на стадии разработки и тестирова
ния модулей. Достаточно закомментировать строку___ DATA , и функции станут
видны во время компиляции.
Документация по стандартному модулю SelfLoader; рецепт 12.10.
12.10. Ускорение загрузки модуля с помощью AutoLoader
Проблема
Вы хотите воспользоваться модулем AutoLoader.
Решение
Простейшее решение — воспользоваться утилитой h2xs для создания каталога и всех необходимых файлов. Предположим, у вас имеется каталог -/perllib, содержащий ваши личные библиотечные модули.
% h2xs -Xn Sample
% cd Sample
% perl Makefile.PL LIB=7perllib
% (edit Sample.pm)
% make install
Комментарий
Модуль AutoLoader, как и SelfLoader, предназначен для ускорения работы про
граммы. Он также генерирует функции-заглушки, которые заменяются настоя
щими функциями при первом вызове. Но вместо того чтобы искать все функции
в одном файле под маркером DATA__, AutoLoader ищет определение каждой функ
ции в отдельном файле. Например, если модуль Sample.pm содержит две функ
ции, f оо и ba г, то AutoLoader будет искать их в файлах Sample/auto/foo.al и Sample/
auto/bar.al соответственно. Модули, загружающие функции с помощью AutoLoader,
работают быстрее тех, что используют SelfLoader, но за это приходится расплачи
ваться созданием дополнительных файлов, местом на диске и повышенной слож
ностью.
Процесс подготовки выглядит сложно. Вероятно, сделать это вручную дей
ствительно непросто. К счастью, h2xs оказывает громадную помощь. Помимо со
здания каталога с шаблонами Sample.pm и других необходимых файлов, утилита
также генерирует Make-файл, который использует модуль AutoSplit для разделе
ния функций модуля по маленьким файлам, по одной функции на файл. Прави
ло make install устанавливает их так, чтобы они находились автоматически. Все,
что от вас нужно, — разместить функции модуля после строки__ END (вместо стро
ки _ DATA______________________________________ в SelfLoader), которая, как вы убедитесь, генерируется автоматически.
Как и в случае с SelfLoader, разработку и тестирование модуля лучше осуще
ствлять без AutoLoader. Достаточно закомментировать строку__ END , пока модуль
не придет к окончательному виду.
При работе с AutoLoader действуют те же ограничения видимости файловых лексических переменных, что и для SelfLoader, поэтому использование файловых
лексических переменных для хранения закрытой информации состояния не подойдет. Если вопрос хранения состояния становится настолько важным и труднореализуемым, подумайте о том, чтобы написать объектный модуль вместо традиционного.
> Смотри также---------------------------------------------------------------------------------------------
Документация по стандартному модулю SelfLoader; /z2xs(l); рецепт 12.9.
12.11. Переопределение встроенных функций
Проблема
Вы хотите заменить стандартную функцию собственной версией.
Решение
Импортируйте нужную функцию из другого модуля в свое пространство имен.
Комментарий
Многие (хотя и не все) встроенные функции Perl могут переопределяться. К этому шагу следует относиться серьезно, но в принципе это возможно. Например, необходимость в переопределении может возникнуть при работе на платформе, которая не поддерживает эмулируемой функции. Также переопределение используется для создания интерфейсных оболочек для встроенных функций.
Не все зарезервированные слова одинаковы. Те, что возвращают отрицательное число в функции С keyword() файла token.c исходной поставки Perl, могут переопределяться. В версии 5.004 не допускалось переопределение следующих ключевых слов: chop, defined, delete, do, dump, each, else, elsif, eval, exists, for, foreach, format, glob, goto, grep, if, keys, last, local, m, map, my, next, no, package, pop, pos, print, printf, prototype, push, q, qq, qw, qx, redo, return, s, scalar, shift, sort, splice, split, study, sub, tie, tied, tr, undef, unless, unshift, untie, until, use, while и у.
Стандартный модуль Perl Cwd переопределяет функцию chdir. Также переопределение встречается во многих модулях с функциями, возвращающими списки: File::stat, Net::hostent, Net::netent, Net::protoent, Net::servent, Time::gmtime, Time::localtime, Time::tm, User::grent и User::pwent. Эти модули содержат переопределения встроенных функций (например, stat или getpwnam), которые возвращают объект с возможностью доступа по имени — например, getpwnam( "daemon" )->di r. Для этого они переопределяют исходные, списковые версии этих функций.
Переопределение осуществляется импортированием функции из другого пакета. Импортирование действует только в импортирующем пакете, а не во всех возможных пакетах. Простого переобъявления недостаточно, функцию необходимо импортировать. Это защищает от случайного переопределения встроенных функций.
Предположим, вы решили заменить встроенную функцию time, которая возвращает целое количество секунд, другой, возвращающей вещественное число. Для
package FineTime;
use strict;
require Exporter;
use vars qw(@ISA @EXPORT_OK);
@ISA = qw(Exporter);
@EXPORT_OK = qw(time);
sub time() { }
Затем пользователь, желающий использовать усовершенствованную версию time, пишет что-то вроде:
use FineTime qw(time);
$start = time();
1 while print time() - $start, "\n";
Предполагается, что в вашей системе есть функция, соответствующая приведенной выше спецификации. Некоторые решения, которые могут работать в вашей системе, рассматриваются в рецепте 12.14.
Переопределение методов и операторов рассматривается в главе 13.
О Смотри также--------------------------------------------------------------------------------------------
Раздел «Overriding Built-in Functions» perlsub(l).
12.12. Вывод сообщений об ошибках и предупреждений по аналогии со встроенными функциями
Проблема
Ваш модуль генерирует ошибки и предупреждения, однако при использовании warn или die пользователь видит имя вашего файла и номер строки. Вы хотите, чтобы функции модуля вели себя по аналогии со встроенными функциями и сообщали об ошибках с точки зрения пользовательского, а не вашего кода.
Решение
Соответствующие функции присутствуют в стандартном модуле Carp. Вместо warn используйте функцию carp, а вместо die — функцию croak (для коротких сообщений) или confess (для длинных сообщений).
Комментарий
Некоторые функции модуля, как и встроенные функции, могут генерировать предупреждения или ошибки. Предположим, вы вызвали функцию sqrt с отри-
дательным аргументом (и не воспользовались модулем Math::Complex) — возникает исключение с выводом сообщения вида "Can't take sqrt of -3 at /tmp/ negroot line 17", где/tmp/negroot — имя вашей программы. Но если вы напишете собственную функцию с использованием die:
sub even_only {
my $n = shift;
die "$n is not even" if $n & 1; # Один из способов проверки
#.... }
то в сообщении вместо пользовательского файла, из которого вызывалась ваша функция, будет указан файл, в котором была откомпилирована функция even_only. На помощь приходит модуль Carp. Вместо die мы используем функцию croak:
use Carp;
sub even_only {
my $n = shift;
croak "$ n is not even" if $n % 2; Другой способ
П.... }
Если вы хотите просто вывести сообщение с номером строки пользовательской программы, где произошла ошибка, вызовите carp вместо warn (в отличие от warn и die, завершающий перевод строки в сообщениях carp и croak не имеет особой интерпретации). Например:
use Carp; sub even_only { my $n = shift;
if ($n & 1) { # Проверка нечетности carp "$n is not even, continuing"; ++$n; }
П. . . . }
Многие встроенные функции выводят предупреждения лишь при использовании ключа командной строки -w. Переменная $"W сообщает о его состоянии. Например, предупреждения можно выдавать лишь при наличии запроса от пользою вателя:
carp "$n is not even, continuing" if $"W;
Наконец, в модуле Carp существует третья функция — confess. Она работает аналогично croak за исключением того, что при аварийном завершении выводится полная информация о состоянии стека, вызовах функций и значениях аргументов.
> Смотри также---------------------------------------------------------------------------------------------
Описание функций warn и die вperlmod(l); описание метапеременных_ WARN
и__ DIE_ в разделе «Global Special Arrays» perlvar{\.) и в рецепте 16.15; доку
ментация по стандартному модулю Carp; рецепт 19.2.
Проблема
Требуется сослаться на переменную или функцию в пакете, имена которых неизвестны до момента выполнения программы, однако синтаксис Spackname: :$varname недопустим.
Решение
Воспользуйтесь символическими ссылками:
{
по strict 'refs';
$val = ${ Spackname , "::" . $varname >;
@vals = ig>{ Spackname . "::" . Saryname };
&{ Spackname . "::" . Sfuncname }("args");
(Spackname . "::" . Sfuncname) -> ("args"); }
Комментарий
Объявление пакета имеет смысл во время компиляции. Если имя пакета или переменной неизвестно до времени выполнения, придется прибегнуть к символическим ссылкам и организовать прямые обращения к таблице символов пакета. Включите в блок директиву no strict ' refs' и постройте строку с полным именем интересующей вас переменной или функции. Затем разыменуйте полученную строку так, словно она является нормальной ссылкой Perl.
До выхода Perl версии 5 программистам в подобных случаях приходилось использовать eval:
eval "package Spackname; \$'$val = \$$varname"; # Задать $mai-n'val die if $@;
Как видите, такой подход затрудняет построение строки. Кроме того, такой код работает относительно медленно. Впрочем, вам никогда не придется делать это лишь для того, чтобы косвенно обращаться к переменным по именам. Символические ссылки обеспечивают необходимый компромисс.
Функция eval также используется для определения функций во время выполнения программы. Предположим, вы хотите иметь возможность вычислять двоичные и десятичные логарифмы:
printf "Iog2 of 100 is %.2f\n", 1од2(100); printf "1од10 of 100 is %.2f\n", Iog10(100);
В Perl существует функция log для вычисления натуральных логарифмов. Давайте посмотрим, как использовать eval для построения функций во время выполнения программы. Мы создадим функции с именами от 1од2 до 1од999:
Spackname = 'main'; for ($i = 2; Si < 1000; $i++) { SlogN = log($i);
По крайней мере в данном случае это не нужно. Следующий фрагмент делает то же самое, но вместо того, чтобы компилировать новую функцию 998 раз, мы откомпилируем ее всего единожды в виде замыкания. Затем мы воспользуемся символическим разыменованием в таблице символов и присвоим одну и ту же ссылку на функцию по многим именам:
$packname = 'main';
for ($i =2; $i < 1000; $i++) {
my $logN = log($i);
no strict ' refs';
*{"${packname}::log$i"} = sub { log(shift) / $logN }; }
Присваивая ссылку тип-глобу, вы всего лишь создаете синоним для некоторого имени. На этом принципе построена работа Exporter. Первая строка следующего фрагмента вручную экспортирует имя функции Colors::blue в текущий пакет. Вторая строка назначает функцию main::blue синонимом функции Colors::azure.
*blue = \&Colors::blue; •main::blue = \&Colors::azure;
Принимая во внимание гибкость присваиваний тип-глобов и символических ссылок, полноценные конструкции eval "СТРОКА" почти всегда оказываются излишеством, последней надеждой отчаявшегося программиста. Ничего худшего себе и представить нельзя — разве что если бы они были недоступны.
О Смотри также--------------------------------------------------------------------------------------------
Раздел «Symbolic References» perlsub(l); рецепт 11.4
12.14. Применение h2ph для преобразования заголовочных файлов С
Проблема
Полученный от кого-то код выдает устрашающее сообщение об ошибке:
Can't locate sys/syscall.ph in §INC (did you run h2ph?) (•INC contains: /usr/lib/perl5/i686-linux/5.00404 /usr/lib/perl5 /usr/lib/perl5/site_perl/ie86-linux /usr/lib/perl5/site_perl .) at some_program line 7.
Вы хотите понять, что это значит и как справиться с ошибкой.
Решение
Попросите системного администратора выполнить следующую команду с правами привилегированного пользователя:
Однако многие заголовочные файлы включают другие заголовочные файлы; иными словами, придется преобразовать Их все:
% cd /usr/include; h2ph *.h */*.h
Если вы получите сообщение о слишком большом количестве файлов или если некоторые файлы в подкаталогах не будут найдены, попробуйте другую команду:
% cd /usr/include; find . -name '*.h' -print | xargs h2ph
Комментарий
Файлы с расширением .ph создаются утилитой h2ph, которая преобразует директивы препроцессора С из ftinclude-файлов в Perl. Это делается для того, чтобы программа на Perl могла работать с теми же константами, что и программа на С. Утилита h2xs обычно оказывается более удачным решением, поскольку вместо кода Perl, имитирующего код С, она предоставляет откомпилированный код С. Однако работа с h2xs требует намного большего опыта программирования (по крайней мере, в том, что касается С), чем h2ph.
Если процесс преобразования h2ph работает, все прекрасно. Если нет — что ж, вам не повезло. Усложнение системных архитектур и заголовочных файлов приводит к более частым отказам h2ph. Если повезет, необходимые константы уже будут присутствовать в модулях Fcntl, Socket или POSIX. В частности, модуль POSIX реализует константы из sys/file.h, sys/ermoh и sys/wait.h. Кроме того, он обеспечивает выполнение нестандартных операций с терминалом (см. рецепт 15.8).
Так что же можно сделать с файлом .ph? Рассмотрим несколько примеров. В первом примере непереносимая функция syscall используется для вызова системной функции gettimeofday. Перед вами реализация модуля FineTime, описанного в рецепте 12.11.
# Файл FineTime.pm package main; require 'sys/syscall.ph'; die "No SYS_gettimeofday in sys/syscall.ph" unless defined &SYS_gettimeofday;
package FineTime;
use strict; require Exporter; use vars qw(@ISA @EXPORT_OK); @ISA = qw(Exporter); @EXPORT_OK = qw(time);
sub time() {
my $tv = pack("LL", ()); # presize buffer to two longs syscall(&main::SYS_gettimeofday, $tv, undef) >= 0 or die "gettimeofday: $!";
12.14. Применение h2ph для преобразования заголовочных файлов С 435
my($seconds, $microseconds) = unpack("LL", $tv); return $seconds + ($microseconds / 1_000_000);1;
Если вам приходится вызывать require для старых файлов .pi или .ph, сделайте это из главного пакета (package main в приведенном выше коде). Эти старые библиотеки всегда помещают свои символические имена в текущий пакет, a main служит «местом встречи». Чтобы использовать имя, уточните его, как мы поступили с main:: SYS_gettimeofday.
Файл sys/ioctl.ph, если вам удастся построить его в своей системе, открывает доступ к функциям ввода/вывода вашей системы через функции ioctl. К их числу принадлежит функция TIOCSTI из примера 12.1. Сокращение TIOCSTI означает «управление терминальным вводом/выводом, имитация терминального ввода» (terminal I/O control, simulate terminal input). В системах, где эта функция реализована, она вставляет один символ в поток устройства, чтобы при следующем чтении из устройства со стороны любого процесса был получен вставленный символ.
Пример 12.1. jam
#!/usr/bin/perl -w
U jam - вставка символов в STDIN
require 'sys/ioctl.ph';
die "no TIOCSTI" unless defined &TIOCSTI;
sub jam {
local $SIG<TT0U} = "IGNORE"; # "Остановка для вывода на терминал"
local «TTY; п Создать локальный манипулятор
open(TTY, "+</dev/tty") or die "no tty: $'";
for (split(//, $_[0])) <
ioctl(TTY, &TI0CSTI, $_) or die "bad TIOCSTI: $!";
}
close(TTY); > jam("@ARGV\n");
Поскольку преобразование sys/ioctl. h может вызвать некоторые сложности, вероятно, для получения кода TIOCSTI вам придется запустить следующую программу на С:
% cat > tio.c «EOF && ее tio.c && a.out
«include <sys/ioctl.h>
main() { printf("%#08x\n", TIOCSTI); }
EOF
0x005412
Функция ioctl также часто применяется для определения размеров текущего окна в строках/столбцах и даже в пикселях. Исходный текст программы приведен в примере 12.2.
436 Глава 12 • Пакеты, библиотеки и модули Пример 12.2. winsz
#!/usr/bin/perl# winsz - определение размеров окна в символах и пикселях
require 'sys/ioctl.ph';
die "no TIOCGWINSZ " unless defined &TIOCGWINSZ;
open(TTY, "+</dev/tty") or die "No tty: $!";
unless (ioctl(TTY, &TIOCGWINSZ, $winsize='')) {
die sprintf "$0: ioctl TIOCGWINSZ (%08x: $')\n", &TIOCGWINSZ; }
($row, $col, $xpixel, $ypixel) = unpack('S4', Swinsize); print '(row,col) = ($row,$col)";
print " (xpixel,ypixel) = ($xpixel,$ypixel)" if Sxpixel || Sypixel; print "\n",
Как видите, для экспериментов с файлами .ph, распаковкой двоичных данных и вызовами syscall и ioctl необходимо хорошо знать прикладной интерфейс С, обычно скрываемый Perl. Единственное, что требует такого же уровня знаний С — это интерфейс XS. Одни считают, что программисты должны бороться с искушением и за версту обходить подобные непереносимые решения. По мнению других, жесткие требования, поставленные перед рядовым программистом, оправдывают самые отчаянные меры.
К счастью, все большее распространение получают менее хрупкие механизмы. Для большинства этих функций появились модули CPAN. Теоретически они работают надежнее, чем обращения к файлам .ph.
> Смотри также---------------------------------------------------------------------------------------------
Описание функций syscall и ioctl вperlmod(l); инструкции по работе с h2ph в файле INSTALL исходной поставки Perl; h2ph{\); рецепт 12.15.
12.15. Применение h2xs для создания модулей с кодом С
Проблема
Вам хотелось бы работать с функциями С из Perl.
Решение
Воспользуйтесь утилитой h2xs для построения необходимых файлов шаблонов, заполните их соответствующим образом и введите:
% perl 'Makefile.PL % make
Комментарий
При написании модуля Perl необязательно ограничиваться одним Perl. Как и для любого другого модуля, выберите имя и вызовите для него утилиту h2xs. Мы со-
здадим функцию FineTime::time с той же семантикой, что и в предыдущем рецепте, но на этот раз реализуем ее на С.
Сначала выполните следующую команду:
% h2xs -en FineTime
Если бы у нас был файл .h с объявлениями прототипов функций, его можно было бы включить, но поскольку мы пишем модуль с нуля, используется флаг -с — тем самым мы отказываемся от построения кода, преобразующего директивы #def ine. Флаг -п требует создать для модуля каталог FineTime/, в котором будут находиться следующие файлы:
Файл Список файлов в поставке
Makefile.PL Мета-таке-файл
FineTime.pm Компоненты Perl
FineTime.xs Будущие компоненты С
test.pl_________ Тестовая программа______
Перед тем как вводить команду make, необходимо сгенерировать make-файл для текущей системной конфигурации с помощью шаблона Makefile.PL. Вот как это делается:
% perl Makefile.PL
Если код XS вызывает библиотечный код, отсутствующий в нормальном наборе библиотек Perl, сначала добавьте в Makefile.pl новую строку. Например, если мы хотим подключить библиотеку librpm.a из каталога /usr/redhat/lib, то нам надо изменить строку Makefile. PL:
'LIBS' =>["], # e.g , '-lm
и привести ее к виду:
'LIBS' => ['-L/usr/redhat/lib -lrpm1],
Наконец, отредактируйте файлы FineTime.pm и FineTime.xs. В первом случае большая часть работы уже сделана за нас. Нам остается создать список экспортируемых функций. На этот раз мы помещаем его в @EXPORT_OK, чтобы нужные функции запрашивались пользователем по имени. Файл FineTime.pm выглядит так:
package FineTime;
use strict;
use vars qw($VERSION @ISA @EXPORT_OK),
require Exporter;
require OynaLoader;
@ISA = qw(Exporter DynaLoader);
@EXPORT_OK = qw(time);
SVERSION = '0.01';
bootstrap FineTime $VERSION;
1;
Кроме хороших познаний в С, вы также должны разбираться в интерфейсе C-Perl, который называется XS (eXternal Subroutine). Подробности и нюансы XS выходят за рамки этой книги. Автоматически сгенерированный файл FineTimejcs содержит заголовочные файлы, специфические для Perl, а также объявление MODULE. Мы добавили несколько дополнительных файлов и переписали код новой функции time. На С пока не похоже, но после завершения работы xsubpp все придет в норму.
Использованный нами файл FineTimejcs выглядит так:
#include <unistd.h> Sinclude <sys/time.h> «include "EXTERN.h" «include "perl.h" «include "XSUB.h"
MODULE = FineTime PACKAGE = FineTime
double time() CODE:
struct timeval tv; gettimeofday(&tv,0);
RETVAL = tv.tv_sec + ((double) tv.tv_usec) / 1000000; OUTPUT: RETVAL
Определение функции с именем, присутствующем в стандартной библиотеке С, не вызовет проблем при компиляции — это не настоящее имя, а лишь псевдоним, используемый Perl. Компоновщик С увидит функцию с именем XS_FineTime_ time, поэтому конфликта не будет.
При выполнении команды make install происходит следующее (с небольшими исправлениями):
% make install
mkdir ./blib/lib/auto/FineTime
cp FineTime.pm ./blib/lib/FineTime.pm
/usr/local/bin/perl -I/usr/lib/perl5/i686-linux/5.00403 -I/usr/lib/perl5
/usr/lib/perl5/ExtUtils/xsubpp -typemap
/usr/lib/perl5/ExtUtils/typemap FineTime.xs FineTime.tc && mv FineTime.tc FineTime.ccc -c -Dbool=char -DHAS_BOOL
-02-DVERSI0N=\"0.01\" -DXS_VERSI0N=\"0.01\" -fpic
-I/usr/lib/perl5/i686-linux/5.00403/CORE FineTime.cRunning Mkbootstrap for FineTime () chmod 644 FineTime.bs LD_RUN_PATH="" cc -o blib/arch/auto/FineTime/FineTime. so
-shared -L/usr/local/lib FineTime.о chmod 755 blib/arch/auto/FineTime/FineTime.so
ср FineTime.bs ./blib/arch/auto/FineTime/FineTime.bs
chmod 644 blib/arch/auto/FineTime/FineTime.bs
Installing /home/tchrist/perllib/i686-linux/./auto/FineTime/FineTime.so
Installing /home/tchrist/perllib/ieee-linux/./auto/FineTime/FineTime.bs
Installing /home/tchrist/perllib/./FineTime.pm
Writing /home/tchrist/perllib/i686-linux/auto/FineTine/.packlist
Appending installation info to /home/tchrist/perllib/i686-linux/perllocal.pod
Когда все будет готово, в интерпретаторе вводится следующая команда:
% perl -I Vperllib -MFineTime=time -le '1 while print time()' | head
888177070.090978
888177070.09132
888177070.091389
888177070.091453
888177070.091515
888177070.091577
888177070.091639
888177070.0917
888177070.091763
888177070.091864
> Смотри также---------------------------------------------------------------------------------------------
Документация по стандартному модулю ExtUtils::MakeMaker; h2ph(\) hxsu-bpp(l). Вызовы функций С из Perl описаны в perlxstut(l) и perlxs(l), а вызовы функций Perl из С — в perlembed(l). Внутренний API Perl рассматривается в perlcall(Y) nperlguts(l). По адресу http://www.perl.com/CPAN/authors/Dean _ Roehrich/ находится подробное руководство по XS с рекомендациями по организации интерфейса с C++.
12.16. Документирование модуля в формате pod
Проблема
Вы хотите документировать свой модуль, но не знаете, какой формат следует использовать.
Решение
Включите документацию в файл модуля в формате pod.
Комментарий
Сокращение pod означает «plain old documentation», то есть «простая документация». Документация в формате pod включается в программу с применением очень простого формата разметки. Как известно, программисты сначала пишут программу, а документацию... не пишут вообще. Формат pod был разработан для максимальной простоты документирования, чтобы с этой задачей справился даже лентяй. Иногда это даже помогает.
Вместе с Perl поставляется несколько программ-трансляторов, которые фильтруют документацию в формате pod и преобразуют ее в другой формат вывода. Утилита pod2man преобразует pod в формат troff, используемый в программе man или в системах верстки и печати. Утилита pod2html создает Web-страницы, работающие в системах, не принадлежащих к семейству UNIX. Утилита pod2text преобразует pod в простой ASCII-текст. Другие трансляторы (pod2ipf, pod2fm, pod2text, pod2latex и pod2ps) могут входить в поставку Perl или распространяются через CPAN
Многие книги пишутся в коммерческих текстовых редакторах с ограниченными сценарными возможностями... но только не эта! Она была написана в формате pod в простых текстовых редакторах (Том использовал ы, а Нат — emacs). На стадии технической правки книга была преобразована в формат troff специальным транслятором pod2ora, написанным Ларри. Окончательный вариант книги был получен преобразованием pod-файлов в формат FrameMaker.
Хотя в perlpod{ 1) приведено общее описание pod, вероятно, этот формат удобнее изучать на примере готовых модулей Если вы начали создавать собственные модули с помощью утилиты h2xs, то у вас уже имеются образцы. Утилита Makefile знает, как преобразовать их в формат man и установить страницы руководства так, чтобы их могли прочитать другие. Кроме того, программа perldoc может транслировать документацию pod с помощью pod2text.
Абзацы с отступами остаются без изменений. Другие абзацы переформатируются для размещения на странице. В pod используются лишь два вида служебной разметки: абзацы, начинающиеся со знака = и одного или нескольких слов, и внутренние последовательности в виде буквы, за которой следует текст в угловых скобках. Теги абзацев определяют заголовки, перечисляемые элементы списков и служебные символы, предназначенные для конкретного транслятора Последовательности в угловых скобках в основном используются для изменения начертания (например, выбора полужирного, курсивного или моноширинного шрифта). Приведем пример директивы =head2 в сочетании с изменениями шрифта:
=head2 Discussion
If we had a dot-h file with function prototype declarations, we could include that, but since we re writing this one from scratch, we 11 use the -c flag to omit building code to translate any Sdefine symbols The -n flag says to create a module directory named FmeTime/, which will have the following files
Последовательность =for определяет код для выходных файлов конкретного формата. Например, в этой книге, главным образом написанной в формате pod, присутствуют вызовы стандартных средств troff: eqn, tbl и pic. Ниже показан пример внутреннего вызова eqn, который обрабатывается лишь трансляторами, производящими данные в формате troff:
=for troff
EQ log sub n (x) = { {log sub e (x)} over {log sub e (n)} }
EN
Формат pod также позволяет создавать многострочные комментарии. В языке С комментарий /* */ может включать несколько строк текста — вам не придется ставить отдельный маркер в каждой строке. Поскольку Perl игнорирует директивы pod, этим можно воспользоваться для блочного комментирования. Весь фокус заключается в том, чтобы найти директиву, игнорируемую трансляторами pod. Например, можно воспользоваться тегом for later или for nobody:
=for later
next if 1 ?"$?,
s/( {73}) */$1<SNIP>/,
= cut back to perl или парой =begin и =end: =begin comment
if ('open(FILE, $file)) { unless ($opt_q) {
warn $me $file $'\n
$Errors++, } next FILE,
$total = 0, $matches = 0,
=end comment
> Смотри также---------------------------------------------------------------------------------------------
Раздел «POD: Enbedded Documentation» вperlsyn(l);perlpod(l),pod2man(l), pod2html{ 1) и pod2text( 1).
12.7. Построение и установка модуля CPAN
Проблема
Требуется установить файл модуля, загруженный с CPAN или взятый с компакт-диска.
Введите в интерпретаторе следующие команды (на примере установки модуля Some::Module версии 4.54):
% gunzip Some-Module-4 54 tar gz
% tar xf Some-Module-4 54
% cd Some-Module-4 54
% perl Makefile PL
% make
% make test
% make install
Комментарий
Модули Perl, как и большинство программ в Сети, распространяются в архивах tar, сжатых программой GNU zip1. Если tar выдает предупреждение об ошибках контрольных сумм каталогов ( Directory checksum errors"), значит, вы испортили двоичный файл, приняв его в текстовом формате.
Вероятно, для установки модуля в системные каталоги необходимо стать привилегированным пользователем с соответствующими правами доступа. Стандартные модули обычно устанавливаются в каталог /usr/lib/perl5, а прочие — в каталог /usr/lib/perl5/site_perl.
Рассмотрим процесс установки модуля MD5:
% gunzip MD5-1 7 tar gz
% tar xf MD5-1 7 tar
% cd MD5-1 7
% perj Makefile PL
Checking if your kit is complete...
Looks good
Writing Makefile for MD5
% make
mkdir ./blib
mkdir ./blib/lib
cp MD5.pm ./blib/lib/MD5.pm
AutoSplitting MD5 (./blib/lib/auto/MD5)
/usr/bin/perl -I/usr/local/lib/perl5/i386
cp MD5.bs ./blib/arch/auto/MD5/MD5.bs
chmod 644 ./blib/arch/auto/MD5/HD5.bsmkdir ./ЬИЬ/тапЗ
Manifying ./blib/man3/MD5.3
% make test
PERL_DL_NONLAZY=1 /usr/bin/perl -I./blib/arch -I./blib/lib
-I/usr/local/lib/perl5/i386-freebsd/5.00404 -I/usr/local/lib/perl5 test.pi
1..14 ок 1 ок 2
ок 13
ок 14
% sudo make install
Password:
Installing /usr/local/lib/perl5/site_perl/i386-freebsd/./auto/MD5/
HD5.so Installing /usr/local/lib/perl5/site_perl/i386-freebsd/./auto/MD5/
MD5.bs
Installing /usr/local/lib/perl5/site_perl/./auto/MD5/autosplit.ix
Installing /usr/local/lib/perl5/site_perl/./MD5. pm Installing /usr/local/lib/perl5/man/man3/./MD5.3
Writing /usr/local/lib/perl5/site_perl/i386-freebsd/auto/MD5/.packlist
Appending installation info to /usr/local/lib/perl5/i386-freebsd/ 5.00404/perllocal.pod
Если ваш системный администратор где-то пропадает или у него нет времени на установку, не огорчайтесь. Используя Perl для построения .make-файла по шаблону Makefile.PL, можно выбрать альтернативный каталог для установки.
# Если вы хотите установить модули в свой каталог
% perl Makefile PL LIB=~/lib
# Если у вас имеется полная поставка
% perl Makefile PL PREFIX="/perl5-pnvate
> Смотри также---------------------------------------------------------------------------------------------
Документация по стандартному модулю ExtUtils::MakeMaker. Файл INSTALL в исходной поставке Perl содержит сведения о построении двоичного файла perl со статической компоновкой.
12.18. Пример: шаблон модуля
Ниже приведен «скелет» модуля. Если вы собираетесь написать собственный модуль, попробуйте скопировать и отредактировать его.
package Some::Module, # Должен находиться в Some/Module pm use strict;
require Exporter;
use vars qw($VERSION @ISA ©EXPORT @EXPORT_OK %EXP0RT_TA6S);
# Установка версии для последующей проверки $VERSION = 0.01;
@EXP0RT = qw(&fund &func2 &func4);
%EXPORT_TAGS = ( ); # например: TAG => [ qw!namel name2! ],
# Здесь находятся экспортируемые глобальные переменные,
# а также функции с необязательным экспортированием
@EXPORT_OK = qw($Var1 %Hashit &func3);
use vars qw($Var1 %Hashit);
# Здесь находятся неэкспортируемые глобальные имена пакета
use vars qw(@more $stuff);
# Инициализировать глобальные переменные пакета,
# начиная с экспортируемых
$Vari = '¦;
%Hashit = ();
# Затем все остальные (к которым можно обращаться
# в виде $Some::Module::stuff)
Sstuff = '';
@more = ();
# Все лексические переменные с файловой областью действия
# должны быть созданы раньше функций, которые их используют.
# Лексические переменные, доступ к которым
й ограничивается данным файлом.
my $priv_var = ' '; ту %secret_hash = ();
# Закрытая функция, оформленная в виде замыкания
# и вызываемая через &$priv_func.
my $priv_func = sub {
# Содержимое функции.
# Все ваши функции, экспортируемые и нет;
# не забудьте вставить что-нибудь в заглушки {>
sub fund {....} # без прототипа
sub func2() {....} # прототип - void
sub func3($$) {....} # прототип - 2 скаляра
# Функция не экспортируется автоматически, но может вызываться!
sub func4(\%) {....} # прототип - 1 ссылка на хэш
END { > # Завершающий код модуля (глобальный деструктор)
1;
Perl распространяется вместе с множеством модулей. Еще больше модулей можно найти в CPAN. Следующая программа выводит имена, версии и описания всех модулей, установленных в вашей системе. Она использует стандартные модули (например, File::Find) и реализует некоторые приемы, описанные в этой главе. Программа запускается следующей командой:
% pmdesc
Она выводит список модулей с описаниями:
FileHandle (2.00) - supply object methods for filehandles I0::Flle (1.06021) - supply object methods for filehandles I0::Select (1.10) - 00 interface to the select system call 10::Socket (1.1603) - Object interface to socket communications
С флагом -v программа pmdesc выводит имена каталогов, в которых находятся файлы:
% pmdesc -v
<«Modules from /usr/lib/perl5/i686-linux/5.00404>»
FileHandle (2.00) - supply object methods for filehandles
Флаг -w предупреждает о том, что модуль не включает документации в формате pod, а флаг -s сортирует список модулей в каждом каталоге. Исходный текст программы приведен в примере 12.3.
Пример 12.3. pmdesc
#!/usr/bin/perl -w
№ pmdesc - вывод описаний файлов pm
# tchrist@perl.com
use strict;
use File::Find qw(find); use Getopt::Std qw(getopts); use Carp;
use vars (
q!$opt_v!, # Вывод отладочной информации
q!$opt_w!, # Предупреждения об отсутствующих
# описаниях модулей
q!$opt_a!, # Вывод относительных путей
q!$opt_s!, # Сортировка данных по каждому каталогу
);
продолжение ё>
$1 = 1;
getopts('wvas') or die "bad usage";
@ARGV = @INC unless @ARGV;
# Глобальные переменные. Я бы предпочел обойтись без этого.
use vars (
q!$Start_Dir!, # Каталог верхнего уровня, для которого
# вызывалась функция find
q!%Future>, # Другие каталоги верхнего уровня,
# для которых find вызывается позднее
);
my $Module;
# Установить фильтр для сортировки списка модулей,
# если был указан соответствующий флаг,
if ($opt_s) {
if (open(ME, "4")) { $/ = ¦'; while (<ME>) { chomp;
print join("\n", sort split /W), "\n"; } exit;
MAIN: {
my %visited; my ($dev,$ino);
@Future{@ARGV} = (1) x @ARGV;
foreach $Start_Dir (@ARGV) { delete $Future{$Start_Dir};
print "\n«Modules from $Start_Dir»\n\n" if $opt_v;
next unless ($dev,$ino) = stat($Start_Oir);
next if $visited{$dev,$ino}++;
next unless $opt_a || $Start_Dir =" m!"/!;
find(\&wanted, $Start_Dir); } exit;
local $_ = $File::Find::name;
if (index($_, $Start_Dir . '/') == 0) {
substr($_, 0, 1+length($Start_Dir)) = ";
s { /
s { \.p(m|od)$
return $_;
# Решить, нужен ли нам данный модуль sub wanted {
if ( $Future{$File::Find::name} ) {
warn "\t(Skipping $File::Find::name, qui venit in future)\n"
if 0 and $opt_v; $File::Find::prune = 1; return; }
return unless /\.pra$/ && -f; $Module = &modname; # skip obnoxious modules if (SModule =' /~CPAN(\Z|::)/) {
warn("$Module -- skipping because it misbehaves\n"); return;
my $file = $_;
unless (open(P0D, "< $file")) { warn "\tcannot open $file: $!
в if $opt_w; return 0;
$: = " -:";
|
local |
$/ = ' ¦; |
|
local |
$_; |
|
while |
(<P00>) { |
|
if (/=head\d\s+NAME/) { |
|
|
|
chomp($_ = <POD>); |
|
s/\n/ /g; |
|
|
Bwrite; |
|
|
my $v; |
if (defined ($v = getversion($Module))) print "$Module ($v) ";
} else {
print "$Module ";
}
print "- $_\n"; • return 1;
warn "\t(MISSING DESC FOR $File::Find::name)\n" if $opt_w;
return 0;
# Загрузить модуль и вывести его номер версии,
# перенаправляя ошибки в /dev/null
sub getversion {
my $mod = shift;
my $vers = '$"X -m$mod -e 'print \$${mod}: .'VERSION' 2>/dev/null' $vers =~ s/"\s*(.*?)\s*$/$1/; # Удалить лишние пропуски return ($vers || undef);
format = SModule,
Классы, объекты и связи
v:-
По всему миру я призываю массы на борьбу с классами. Уильям Гладстон, речь в Ливерпуле, 28 июня 1886 г.
Введение
Наряду со ссылками и модулями в Perl версии 5.000 появились объекты. Как обычно, Perl не заставляет всех использовать единственно правильный стиль, а поддерживает несколько разных стилей. Благодаря этому люди решают свои задачи так, как им нравится.
При написании программ необязательно пользоваться объектами, в отличие от языка Java, где программы представляют собой экземпляры объектов. Однако при желании можно написать Perl-программу, в которой используется практически весь арсенал приемов объектно-ориентированного программирования. В Perl поддерживаются классы и объекты, одиночное и множественное наследование, методы экземпляров и методы классов, переопределение методов, конструкторы и деструкторы, перегрузка операторов, методы-посредники с автозагрузкой, делегирование, иерархия объектов и два уровня сборки мусора.
Вы можете выбрать ровно столько объектно-ориентированных принципов, сколько захочется. Связи (ties) являются единственной частью Perl, где объектно-ориентированный подход обязателен. Но даже здесь об этом должен знать лишь программист, занимающийся реализацией модуля; случайный пользователь остается в блаженном неведении относительно внутренних механизмов. Связи, рассматриваемые в рецепте 13.14, позволяют организовать прозрачный перехват обращений к переменной. Например, с помощью связей можно создать хэш с возможностью поиска по ключу или по значению.
Под капотом
Если спросить десятерых программистов, что такое «объектная ориентация», вы получите десять разных ответов. Люди рассуждают об «абстракции» и «инкапсуляции», пытаются выделить основные черты объектно-ориентированных языков
Мы будем использовать терминологию из документации Perl и страницы руководства perlobj(l). Объект представляет собой переменную, принадлежащую к некоторому классу. Методами называются функции, ассоциируемые с классом или объектом. В Perl класс представляет собо^ пакет — а обычно и модуль. Объект является ссылкой на что-то, что было приведено (blessed) к классу. Приведение ассоциирует субъект с классом. Для этого используется функция bless, вызываемая с одним или двумя аргументами. Первым аргументом является ссылка на приводимый объект, а необязательным вторым аргументом — пакет, к которому осуществляется приведение.
$object = {>, # Ссылка на хэш
bless($object, "Data.:Encoder"); # Привести Sobject к классу
# Data.'Encoder
bless($object); # Привести Sobject к текущему пакету
Имя класса соответствует имени пакета (Data::Encoder в приведенном выше примере). Поскольку классы являются модулями (обычно), код класса Data::Encoder находится в файле Data/Encoder.pm. Структура каталогов, как и для традиционных модулей, существует исключительно для удобства; она никак не связана с наследованием, ограничением доступа к переменным или чем-нибудь еще. Однако в отличие от традиционных модулей, объектные модули очень редко используют Exporter. Вся работа должна вестись только через вызовы методов, но не через импортированные функции или переменные.
После приведения объекта вызов функции ref для ссылки на него возвращает имя класса вместо фундаментального типа субъекта:
$ob] = [3,5];
print ref($obj), " ", $obj->[1], "\n";
bless($obj, "Human: Cannibal");
print ref($obj), " ", $ob]->[1], "\n";
ARRAY 5
Human::Cannibal 5
Как видите, приведенную ссылку все еще можно разыменовать. Чаще всего объекты реализуются с помощью приведенных ссылок на хэши. Вы можете использовать любые типы ссылок, но ссылки на хэш обеспечивают максимальную гибкость. Они позволяют создавать в объекте поля данных с произвольными именами:
$obj->{Stomach} = "Empty"; # Прямое обращение к данным объекта $ob]->{NAME} = "Thag";
# Символы верхнего регистра в имени поля
# помогают выделить его (необязательно)
Хотя Perl позволяет любому коду за пределами класса напрямую обращаться к данным объекта, это считается нежелательным. Согласно общепринятому мне-
Введение 451
нию, работа с данными должна вестись только с использованием методов, предназначенных для этой цели. У разработчика класса появляется возможность изменить его реализацию без модификации всего кода приложений, использующих данный класс.
Методы
Для вызова методов используется оператор, оператор ->. В следующем примере мы вызываем метод encode() объекта $object с аргументом "data" и сохраняем возвращаемое значение в переменной Sencoded:
Sencoded = $object->encode("data');
Перед нами метод объекта, поскольку мы вызываем метод конкретного объекта. Также существуют методы классов, то есть методы, вызываемые по имени класса:
Sencoded = Data::Encoder->encode("data");
При вызове метода вызывается функция соответствующего класса с неявной передачей в качестве аргумента либо ссылки (для метода объекта), либо строки (для метода класса). В рецепте 13.17 показано, как вызывать методы с именами, определяемыми во время выполнения.
В большинстве классов существуют специальные методы, возвращающие новые объекты — конструкторы. В отличие от некоторых объектно-ориентированных языков, конструкторы Perl не имеют специальных имен. В сущности, конструктор можно назвать, как вам захочется. Программисты C++ обожают присваивать своим конструкторам в Perl имя new. Мы рекомендуем выбирать имя конструктора так, чтобы оно имело смысл в контексте решаемой задачи. Например, конструкторы расширения Тк в Perl называются по именам создаваемых ими элементов (widgets). Менее распространенный подход заключается в экспортировании функции, имя которой совпадает с именем класса; см. пример в разделе «Пример. Перегруженный класс StrNum» в рецепте 13.14.
Типичный конструктор выглядит следующим образом:
sub new {
my Sclass = shift,
my $self = {}; # Выделить новый хэш для объекта
bless($self, Sclass),
return $self; }
Вызов конструктора выглядит так:
Sobject = Class->new();
Если дело обходится без наследования или иных выкрутасов, это фактически эквивалентно
Sobject = Class::new("Class"),
Первым аргументом функции new() является имя класса, к которому приводится новая ссылка. Конструктор должен передать эту строку bless() в качестве второго аргумента.
Деструктором называется функция, которая выполняется при уничтожении субъекта, соответствующего данному объекту, в процессе сборки мусора. В отличие от конструкторов имена деструкторов жестко фиксируются. Методу-деструктору должно быть присвоено имя DESTROY. Этот метод, если он существует, вызывается для всех объектов непосредственно перед освобождением памяти. Наличие деструктора (см. рецепт 13.2) необязательно.
Некоторые языки на уровне синтаксиса позволяют компилятору ограничить доступ к методам класса. В Perl такой возможности нет — программа может вызывать любые методы объекта. Автор класса должен четко документировать открытые методы (те, которые можно использовать). Пользователям класса следует избегать недокументированных (то есть неявно закрытых) методов.
Perl не различает методы, вызываемые для класса (методы классов), и методы, вызываемые для объекта (методы экземпляров). Если вы хотите, чтобы некоторый метод вызывался только как метод класса, поступите следующим образом:
sub class_only_method { my $class = shift, die "class method called on object" if ref $class;
# Дополнительный код
>
Чтобы метод вызывался только как метод экземпляра, воспользуйтесь следующим кодом:
sub instance_only_method { my $self = shift; die "instance method called on class' unless ref $self;
# Дополнительный код
)
Если в вашей программе вызывается неопределенный метод объекта, Perl не будет жаловаться на стадии компиляции; вместо этого произойдет исключение во время выполнения. Аналогично, компилятор не перехватывает ситуации, при которой методу, который должен вызываться для простых чисел, передается комплексный аргумент. Метод представляет собой обычный вызов функции, пакет которой определяется во время выполнения. Методы, как и все косвенные функции, не имеют проверки прототипа — проверка выполняется на стадии компиляции. Даже если бы вызовы методов учитывали наличие прототипа, в Perl компилятор не сможет автоматически установить точный тип или интервал аргумента функции. Прототипы Perl предназначены для форсирования контекста аргумента функции, а не для проверки интервала. Странности прототипов Perl описаны в рецепте 10.11.
Чтобы предотвратить инициирование исключений для неопределенных методов, можно использовать механизм AUTOLOAD для перехвата вызовов несуществующих методов. Данная возможность рассматривается в рецепте 13.11.
Введение 453
Наследование
Отношения наследования определяют иерархию классов. При вызове метода, не определенного в классе, поиск метода с указанным именем осуществляется в иерархии. Используется первый найденный метод. Наследование позволяет строить классы «на фундаменте» других классов, чтобы код не приходилось переписывать заново. Классы являются одной из форм многократного использования кода и потому способствуют развитию Лени — главной добродетели программиста.
В некоторых языках существует специальный синтаксис наследования. В Perl каждый класс (пакет) может занести список своих суперклассов, то есть родителей в иерархии, в глобальную (не лексическую!) пакетную переменную @ISA. Этот список просматривается во время выполнения программы, при вызове метода, не определенного в классе объекта. Если первый пакет, указанный в @ISA, не содержит искомого метода, но имеет собственный массив @ISA, то Perl перед продолжением поиска рекурсивно просматривает @ISA этого пакета.
Если поиск унаследованного метода заканчивается неудачей, проверка выполняется заново, но на этот раз ищется метод с именем AUTOLOAD. Поиск метода $ob->meth(), где объект $ob принадлежит классу Р, происходит в следующей последовательности:
• P.:meth
• Любой метод S: :meth() в пакетах S из @P::ISA, рекурсивно.
• UNIVERSAL::meth
• Подпрограмма Р:: AUTOLOAD.
• Любой метод S:: AUTOLOAD() в пакетах S из @P::ISА, рекурсивно.
• Подпрограмма UNIVERSAL: AUTOLOAD.
В большинстве классов массив @ISA состоит из одного элемента — такая ситуация называется одиночным наследованием. Если массив @ISA содержит несколько элементов, говорят, что класс реализует множественное наследование. Вокруг достоинств и недостатков множественного наследования идут постоянные споры, но Perl поддерживает эту возможность.
В рецепте 13.9 рассматриваются основы наследования и базовые принципы построения классов, обеспечивающие удобство субклассирования. В рецепте 13.10 мы покажем, как субкласс переопределяет методы своих суперкласов.
Perl не поддерживает наследования данных. Класс может напрямую обращаться к данным другого класса, но делать этого не следует. Это не соответствует принципам инкапсуляции и нарушает абстракцию. Если вы последуете рекомендациям из рецептов 13.10 и 13.12, это ограничение не вызовет особых проблем.
Косвенный вызов методов
Косвенный вызов методов:
$lector = new Human::Cannibal; feed $lector "Zak"; move $lector "New York";
представляет собой альтернативный вариант синтаксиса для:
454 Глава 13 • Классы, объекты и связи
Slector = Human::Cannibal->new(); $object->feed("Zak"); $object->move("New York");Косвенный вызов методов привлекателен для англоязычных программистов и хорошо знаком программирующим на C++ (где подобным образом используется new). He поддавайтесь соблазну. Косвенный вызов обладает двумя существенными недостатками. Во-первых, он должен подчиняться тем же ненадежным правилам, что и позиция файлового манипулятора в print и printf:
printf STDERR "stuff here\n";
Эта позиция, если она заполняется, должна содержать простое слово, блок или имя скалярной переменной; скалярные выражения недопустимы. Это приводит к невероятно запутанным проблемам, как в двух следующих строках:
move $obj-><FIELD}; # Вероятно, ошибка
move $ary[$i]; # Вероятно, ошибка
Как ни странно, эти команды интерпретируются следующим образом:
$obj->move->{FIELD}; # Сюрприз!
$ary->move->[$i]; # Сюрприз!
вместо ожидаемого:
$obj->{FIELD}->move(); # Ничего подобного
$ary[$i]->move; . # Ничего подобного
Вторая проблема заключается в том, что во время компиляции Perl приходится гадать, что такое name и move — функции или методы. Обычно Perl угадывает правильно, но в случае ошибки функция будет откомпилирована как метод, и наоборот. Это может привести к появлению невероятно хитрых ошибок, которые очень трудно обнаружить. Формулировке -> э^и раздражающие неоднозначности не присущи, поэтому мы рекомендуем пользоваться только ею.
Некоторые замечания по объектной терминологии
В объектно-ориентированном мире одни и те же концепции часто описываются разными словами. Если вы программировали на другом объектно-ориентированном языке, возможно, вам захочется узнать, как знакомые термины и концепции представлены в Perl.
Например, объекты часто называются экземплярами (instances) классов, а методы этих объектов — методами экземпляров. Поля данных, относящиеся к каждому объекту, часто называются данными экземпляров или атрибутами объектов, а поля данных, общие для всех членов класса, — данными класса, атрибутами класса или статическими переменными класса.
Кроме того, термины базовый класс и суперкласс описывают одно и то же понятие (родитель или другой предок в иерархии наследования), тогда как термины производный класс и субкласс описывают противоположное отношение (непосредственный или отдаленный потомок в иерархии наследования).
Введение 455
Программисты на C++ привыкли использовать статические методы, виртуальные методы и методы экземпляров, но Perl поддерживает только методы классов и методы объектов. В действительности в Perl существует только общее понятие «метод». Принадлежность метода к классу или объекту определяется исключительно контекстом использования. Метод класса (со строковым аргументом) можно вызвать для объекта (с аргументом-ссылкой), но вряд ли это приведет к разумному результату.
Программисты C++ привыкли к глобальным (то есть существующим на уровне класса) конструкторам и деструкторам. В Perl они идентичны соответственно инициализирующему коду модуля и блоку END{}.
С позиций C++ все методы Perl являются виртуальными. По этой причине их аргументы никогда не проверяются на соответствие прототипам функции, как это можно сделать для встроенных и пользовательских функций. Прототипы проверяются компилятором во время компиляции. Функция, вызванная методом, определяется лишь во время выполнения.
Философское отступление
В своих объектно- ориентированных аспектах Perl предоставляет полную свободу выбора: возможность делать одни и те же вещи несколькими способами (приведение позволяет создать объект из данных любого типа), возможности модификации классов, написанных другими (добавление функций в их пакеты), а также полная возможность превратить отладку программы в сущий ад — если вам этого сильно захочется.
В менее гибких языках программирования обычно устанавливаются более жесткие ограничения. Многие языки с фанатичным упорством отстаивают закрытость данных, проверку типов на, стадии компиляции, сложные сигнатуры функций и другие возможности. Все э.ти возможности отсутствуют в объектах Perl, поскольку они вообще не поддерживаются Perl. Помните об этом, если объектно-ориентированные аспекты Perl покажутся вам странными. Все странности происходят лишь от того, что вы привыкли к философии других языков. Объектно-ориентированная сторона Perl абсолютно разумна — если мыслить категориями Perl. Для любой задачи, которую нельзя решить на Perl по аналогии с Java или C++, найдется прекрасно работающее решение в идеологии Perl. Программист-параноик даже сможет обеспечить полную закрытость: Bperltoot(l) рассказано о том, как с помощью приведения замыканий получить объекты, по степени закрытости не уступающие объектам C++ (и даже превосходящие их).
Объекты Perl не плохи; просто они другие.
> Смотри также---------------------------------------------------------------------------------------------
В литературе по объектно-ориентированному программированию Perl упоминается очень редко. Изучение объектно-ориентированных аспектов языка лучше всего начать с документации Perl — особенно с учебника по объектам perltoot(l). За справочной информацией обращайтесь кperlobj(l). Вероятно, этот документ понадобится вам при чтении руководстваperlbot(l), полного объектно-ориентированных фокусов.
456 Глава 13 • Классы, объекты и связи
13.1. Конструирование объектаПроблема
Необходимо предоставить пользователю возможность создания новых объектов,
Решение
Создайте конструктор. В Perl метод-конструктор не только инициализирует объект, но и предварительно выделяет память для него — как правило, с использованием анонимного хэша. Конструкторы C++, напротив, вызываются после выделения памяти. В объектно-ориентированном мире конструкторы C++ было бы правильнее назвать инициализаторами.
Канонический конструктор объекта в Perl выглядит так:
sub new {
my $class = shift;
my $self = {};
bless($self, $class);
return $self; }
Данный фрагмент эквивалентен следующей строке:
sub new { bless( { >, shift ) }
Комментарий
Любой метод, который выделяет память для объекта и инициализирует его, фактически является конструктором. Главное, о чем следует помнить, — ссылка становится объектом лишь после того, как для нее будет вызвана функция bless. Простейший, хотя и не особенно полезный конструктор выглядит так:
sub new { bless({ >) >
Давайте включим в него инициализацию объекта:
sub new {
my $self = { }; # Выделить анонимный хэш
bless($self);
# Инициализировать два атрибута/поля/переменных экземпляра
$self->{START} = time();
$self-><AGE} = 0;
return $self; >
Такой конструктор не очень полезен, поскольку в нем используется одноаргу-ментная форма bless, которая всегда приводит объект в текущий пакет. Это означает, что полезное наследование от него становится невозможным; сконструированные объекты всегда будут приводиться к классу, в котором была откомпилирована функция new. При наследовании этот класс не обязательно совпадет с тем, для которого вызывался данный метод.
Проблема решается просто: достаточно организовать в конструкторе обработку первого аргумента. Для метода класса он представляет собой имя пакета. Передайте имя класса функции bless в качестве второго аргумента:
sub new {
my Iclassname = shift; tt Какой класс мы конструируем'
my $self = {>; # Выделить память
bless($obref, $classname); tt Привести к нужному типу
$self->{START} = time(); # Инициализировать поля данных
$self->{AGE} = 0;
return $obref; # И вернуть
>
Теперь конструктор будет правильно наследоваться производными классами.
Выделение памяти и приведение можно отделить от инициализации данных экземпляра. В простых классах это не нужно, однако такое разделение упрощает наследование; см. рецепт 13.10.
sub new {
my Sclassname = shift; # Какой класс мы конструируем9
my $self = {}; # Выделить память
bless($self, $classname); # Привести к нужному типу
$self->_init(@_); # Вызвать _imt
# с остальными аргументами
return $self,
# "Закрытый" метод для инициализации полей. Он всегда присваивает START tt текущее время, a AGE - 0. При вызове с аргументами _imt tt интерпретирует их как пары ключ/значение и инициализирует ими объект, sub _imt {
my $self = shift;
$self->{START} = time();
$self->{AGE} = 0;
if «3>J {
my %extra = @_;
<s>$self{keys %extra} = values Stextra;
£> Смотри также
perltoot{\) иperlobj(l); рецепты 13.6; 13.9-13.10.
13.2. Уничтожение объекта
Проблема
Некоторый фрагмент кода должен выполняться в случае, если надобность в объекте отпадает. Например, объект может использоваться в интерфейсе с внешним миром или содержать циклические структуры данных — в этих случаях он
Решение
Создайте метод с именем DESTROY. Он будет вызываться в том случае, когда на объект не остается ни одной ссылки или при завершении программы (в зависимости от того, что произойдет раньше). Освобождать память не нужно; лишь выполните все завершающие действия, которые имеют смысл для данного класса.
sub DESTROY {
my $self = shift,
pnntf("$self dying at %s\n", scalar localtime),
Комментарий
У каждой истории есть начало и конец. История объекта начинается с выполнения конструктора, который явно вызывается при создании объекта. Жизненный цикл объекта завершается в деструкторе — методе, который неявно вызовется при уходе объекта из жизни. Весь завершающий код, относящийся к объекту, помещается в деструктор, который должен называться DESTROY.
Почему деструктору нельзя присвоить произвольное имя, как это делается для конструктора? Потому что конструктор явно вызывается по имени, а деструктор — нет. Уничтожение объекта выполняется автоматически через систему сборки мусора Perl, реализация которой в настоящее время основана на системе подсчета ссылок. Чтобы знать, какой метод должен вызываться при уничтожении объекта, Perl требует присвоить деструктору имя DESTROY. Если несколько объектов одновременно выходят из области действия, Perl не гарантирует вызова их деструкторов в определенном порядке.
Почему имя DESTROY пишется в верхнем регистре? В Perl это обозначение говорит о том, что данная функция вызывается автоматически. К числу других автоматически вызываемых функций принадлежат BEGIN, END, AUTOLOAD и все методы связанных объектов (см. рецепт 13.15) — например, STORE и FETCH.
Пользователь не должен беспокоиться о том, когда будет вызван конструктор. Просто это произойдет в нужный момент. В языках, не поддерживающих сборку мусора, программисту приходится явно вызывать деструктор для очистки памяти и сброса состояния — и надеяться на то, что он не ошибся в выборе момента. Беднягу можно только пожалеть.
Благодаря автоматизированному управлению памятью в Perl деструкторы объектов используются редко. Но даже в случаях, когда они нужны, явный вызов деструктора — вещь не только излишняя, но и попросту опасная. Деструктор будет вызван системой времени исполнения в тот момент, когда объект перестанет использоваться. В большинстве классов деструкторы не нужны, поскольку Perl сам решает основные проблемы — такие, как освобождение памяти.
Система сборки мусора не поможет лишь в одной ситуации — при наличии циклических ссылок в структуре данных:
$self-><WHATEVER} = $self,
13.3. Работа с данными экземпляра 459
В этом случае циклическую ссылку приходится удалять вручную, чтобы при работе программы не возникали утечки памяти. Такой вариант чреват ошибками, но это лучшее, что мы можем сделать. Впрочем, в рецепте 13.13 представлено элегантное решение этой проблемы. Однако вы можете быть уверены, что при завершении программы будут вызваны деструкторы всех ее объектов. При завершении работы интерпретатора выполняется тотальная сборка мусора. Даже недоступные или циклические объекты не переживут последней чистки. Следовательно, можно быть уверенным в том, что объект когда-нибудь будет уничтожен должны образом, даже если выход из программы никогда не происходит. Если Perl работает внутри другого приложения, вторая форма сборки мусора встречается чаще (при каждом завершении интерпретатора).
Метод DESTROY не вызывается при завершении программы, вызванной функцией exec.
> Смотри также--------------------------------------------------------------------------------------------
perltoot(l) иperlobj(l); рецепты 13.10; 13.13.
13.3. Работа с данными экземпляра
Проблема
Для работы с каждым атрибутом данных объекта (иногда называемым переменной экземпляра или свойством) необходим специальный метод доступа. Как написать функцию для работы с данными экземпляра?
Решение
Напишите пару методов для чтения и присваивания соответствующего ключа в хэше объекта:
sub get_name {
my $self = shift; return $self->{NAME>,
sub set_name {
my $self = shift,
$self->{NAME} = shift, }
Или воспользуйтесь одним методом, который решает ту или иную задачу в зависимости от того, был ли передан аргумент при вызове:
sub name {
my $self = shift;
if (@_) { $self->{NAME> = shift }
return $self->{NAME},
460 Глава 13 • Классы, объекты и связи
Иногда при установке нового значения полезно вернуть старое:sub age {
my $self = shift;
my $prev = $self->{AGE>;
if (@_) { $self->{AGE} = shift >
return $prev; }
tt Пример одновременного чтения и записи атрибута $obj->age( 1 + $obj->age );
Комментарий
Работа методов зависит от того, как вы организуете открытый интерфейс к объекту. Нормальный класс не любит, чтобы окружающие копались у него во внутренностях. Для каждого атрибута данных должен существовать метод, обеспечивающий его чтение или обновление. Если пользователь пишет фрагмент вида:
$him = Person->new(); $him->{NAME} = "Sylvester"; $him->{AGE} = 23;
он нарушает интерфейс объекта и напрашивается на неприятности.
Для номинально закрытых атрибутов вы просто не создаете методы, позволяющие обращаться к ним.
Интерфейс на базе функций позволяет изменить внутреннее представление, не рискуя нарушить работу программ. Он позволяет выполнять любые проверки диапазона, а также выполнять необходимое форматирование или преобразование данных.
Продемонстрируем сказанное на примере улучшенной версии метода name:
use Carp; sub name {
my $self = shift;
return $self->{NAME} unless <g>_;
local $_ = shift;
croak "too many arguments" if @_;
if ($~W) {
/["\s\w'-]/ && carp "funny characters in name";
/\d/ && carp "numbers in name";
/\S+(\s+\S+)+/ || carp "prefer multiword name";
/\S/ II carp "name is blank";
}
s/(\w+)/\u\L$1/g; # Начинать с символа верхнего регистра $self->{NAME} = $_; }
Если пользователи (или даже другие классы посредством наследования) обращаются к полю "NAME" напрямую, вы уже не сможете добавить подобный код. Настаивая на косвенном обращении ко всем атрибутам данных через функции, вы оставляете за собой свободу выбора.
Программисты, которым приходилось работать с объектами C++, привыкли к тому, что к атрибутам объекта можно обращаться из методов в виде простых переменных. Модуль Alias с CPAN обеспечивает эту и многие другие возможности — например, создание открытых методов, которые могут вызываться объектом, но недоступны для кода за его пределами.
Рассмотрим пример создания класса Person с применением модуля Alias. Обновление «магических» переменных экземпляра автоматически обновляет поля данных в хэше. Удобно, правда?
package Person;
# То же, что и раньше... sub new {
my $that = shift;
ray $class = ref($that) || $that;
my $self = {
NAME => undef, AGE => undef, PEERS => [],
bless($self, $class); return $self;
use Alias qw(attr);
use vars qw($NAME $AGE $PEERS);
sub name {
my $self = attr shift;
if (@_) { $NAME = shift; }
return $NAME;
sub age {
my $self = attr shift; if (@J { SAGE = shift; } return SAGE;
sub peers {
my $self = attr shift; if (@_) { ©PEERS = @_; } return @PEERS;
sub exclaim {
my $self = attr shift;
return sprintf "Hi, I'm %s, age %d, working with %s" SNAME, SAGE, join(", ", ©PEERS);
462 Глава 13 • Классы, объекты и связи
sub happy_birthday {my $self = attr shift;
return ++SAGE; }
Директива use va rs понадобилась из-за того, что Alias играет с пакетными глобальными переменными, имена которых совпадают с именами полей. Чтобы использовать глобальные переменные при действующей директиве use strict, необходимо заранее объявить их. Эти переменные локализуются в блоке, содержащем вызов attr(), словно они объявлены с ключевым словом local. Таким образом, они остаются глобальными пакетными переменными с временными значениями.
> Смотри также------------------------------------------------------------------------
perltoot(l), perlobj(l) nperlbot(l); документация по модулю Alias с CPAN; рецепты 13.11-13.12.
13.4. Управление данными класса
Проблема
Вам нужен метод, который вызывается для класса в целом, а не для отдельного объекта. Например, он может обрабатывать глобальный атрибут данных, общий для всех экземпляров класса.
Решение
Первым аргументом метода класса является не ссылка, как в методах объектов, а строка, содержащая имя класса. Методы классов работают с данными пакета, а не данными объекта, как показывает приведенный ниже метод population:
package Person;
$Body_Count = 0;
sub population { return $Body_Count >
sub new { # Конструктор
$Body_Count++; return bless({}, shift);
sub DESTROY { --SBodyCount } # Деструктор
# Позднее пользователь может написать: package main;
for (1..10) { push ^people, Person->new }
printf "There are %d people alive.\n", Person->population();
There are 10 people alive.
Комментарий
Обычно каждый объект обладает определенным состоянием, полная информация о котором хранится в самом объекте. Значение атрибута данных одного объекта никак не связано со значением этого атрибута в другом экземпляре того же класса. Например, присваивание атрибуту gender объекта her никак не влияет на атрибут gender объекта him, поскольку это разные объекты с разным состоянием:
$him = Person->new(); $him->gender("male");
* $her = Person->new(); $her->gender("female");
Представьте атрибут, общий для всего класса — изменение атрибута для одного экземпляра приводит к его изменению для остальных экземпляров. Подобно тому, как имена глобальных переменных часто записываются с большой буквы, некоторые программисты предпочитают записывать имя символами верхнего регистра, если метод работает с данными класса, а не с данными экземпляра. Рассмотрим пример использования метода класса с именем Max_Bounds:
FixedArray->Max_Bounds(100); # Устанавливается для всего класса
Salpha = FixedArray->new();
printf "Bound on alpha is %d\n", $alpha->Max_Bounds();
100
$beta = FixedArray->new();
$beta->Max_Bounds(50); # Также устанавливается для всего класса
printf "Bound on alpha is %d\n", $alpha->Max_Bounds();
SO
Реализация выглядит просто:
package FixedArray; SBounds =7; # default sub new { bless( {}, shift ) } sub Max_Bounds {
my $proto = shift;
SBounds = shift if @_; # Разрешить обновления
return SBounds; >
Чтобы фактически сделать атрибут доступным только для чтения, просто удалите команды обновления:
sub Max_Bounds { SBounds }
Настоящий параноик сделает SBounds лексической переменной, которая ограничена областью действия файла, содержащего класс. В этом случае никто не сможет обратиться к данным класса через SFixedArray: : Bounds. Работать с данными придется через интерфейсные методы.
Следующий совет поможет вам строить расширяемые классы: храните данные объекта в пространстве имен объекта (в хэше), а данные класса — в пространстве имен класса (пакетные переменные или лексические переменные с файловой об-
sub new {
my $class = shift; my $self = bless({>, $class); $self->{Max_Bounds_ref} = \$Bounds; return $self,
> Смотри также---------------------------------------------------------------------------------------------
perltoot(l), perlobj(l) иperlbot(l); рецепт 13.3; пример использования метода places в разделе «Пример. Перегруженный класс FixNum» в рецепте 13.14.
13.5. Использование класса как структуры
Проблема
Вы привыкли работать со структурированными типами данных — более сложными, чем массивы и хэши Perl (например, структуры С и записи Pascal). Вы слышали о том, что классы Perl не уступают им по возможностям, но не хотите изучать объектно-ориентированное программирование.
Решение
Воспользуйтесь стандартным модулем Class::Struct для объявления С-подобных структур:
use Class::Struct, # Загрузить модуль построения структур
struct Person => { й Создать определение класса "Person"
name =>'$', # Имя - скаляр
age =>'$', # Возраст - тоже скаляр
peers => '@', # Но сведения о друзьях - массив (ссылка)
>:
my $p = Person->new(); # Выделить память для пустой структуры Person
$p->name("Jason Smythe"), # Задать имя
$p->age(13); # Задать возраст
$p->peers( ["Wilbur", "Ralph", "Fred' ] ); # Задать друзей
# Или так:
?->peers} = ("Wilbur", "Ralph", "Fred");
# Выбрать различные значения, включая нулевого друга pnntf "At age %d, %s's first friend is %s.\n", $p->age, $p->name, $p->peers(0);
Комментарий
Функция Class: : St met: st ruct автоматически создает классы, дублирующие структуры. Она создает класс с именем, передаваемым в первом аргументе, и генерирует для него конструктор new и методы доступа к полям.
В определении структуры ключи соответствуют именам полей, а значения — типам данных. Существуют три основных значения типа: ' $' для скаляров,' @' для массивов и '%' для хэшей. Каждый метод доступа может вызываться без аргументов (выборка текущего значения) или с аргументами (присваивание значения). Для полей с типом «массив» или «хэш» вызов метода без аргументов возвращает ссылку на весь массив или хэш, вызов с одним аргументом получает значение по указанному индексу1, а вызов с двумя аргументами задает значение для указанного индекса.
Однако тип может быть именем другой структуры (или любого класса), имеющей конструктор new.
use Class:'Struct,
struct Person => {name => '$', age => '$'};
struct Family => {head => 'Person , address => '$ , members => '©'},
$folks = Family->new(); $dad = $folks->head, $dad->name("John"); $dad->age(34);
pnntf( '%s's age is %d\n", $folks->head->name, $folks->head->age),
Чтобы организовать дополнительную проверку параметров, напишите собственные версии методов доступа, переопределяющие версии по умолчанию. Предположим, вы хотите убедиться, что значение возраста состоит из одних цифр и не превышает нормальной продолжительности человеческой жизни. Функция Может выглядеть так:
sub Person::age { use Carp,
my ($self, $age) = @_;
if (@_ > 2) { confess "too many arguments" } elsif (@_ == 1) { return $struct->{'age'} } elsif (@_ == 2) {
carp "age '$age' isn't numeric" if $age '~ /"\d+/;
carp "age '$age' is unreasonable" if $age > 150;
$self->{'age'} = $age,
Если предупреждения должны выводиться лишь при наличии флага -w в командной строке, проверьте переменную $"W:
466 Глава 13 • Классы, объекты и связи
If ($"W) {carp "age '$age' isn't numeric" if Sage !' /"\d+/;
carp "age '$age' is unreasonable" if $age > 150;
}
Если при наличии флага -w выводится предупреждение, а без него функция должна инициировать исключение, воспользуйтесь следующим фрагментом. Пусть стрелка вас не смущает; это косвенный вызов функции, а не вызов метода.
my $gripe = $"W ? \&carp : \&croak;
$gripe->("age '$age' isn't numeric") if $age !* /~\d+/l
$gripe->("age $age' is unreasonable") if Sage > 150;
Как и большинство классов, наш класс реализован в виде хэша. Это упрощает отладку и сопровождение кода. Представьте себе возможность вывода структуры в отладчике. Однако модуль Class::Struct также поддерживает реализацию на базе массива, для этого достаточно перечислить поля в квадратных скобках вместо фигурных:
struct Family => [head => 'Person', address => '$', members => '©'];
Существуют эмпирические данные, свидетельствующие о том, что выбор массива вместо хэша снижает расходы памяти от 10 до 50 % и примерно на 33 % ускоряет доступ. За это приходится расплачиваться менее содержательной отладочной информацией и трудностями при написании переопределяющих функций (таких, как приведенная выше функция Person::age). Обычно представление объекта в виде массива усложняет наследование. В данном случае это не так, поскольку С-по-добные структуры обеспечивают намного более понятную реализацию агрегирования.
Директива use fields в Perl версии 5. 005 повышает скорость за счет дополнительных затрат памяти и обеспечивает проверку имен полей на стадии компиляции.
Если все поля принадлежат к одному типу, то запись вида:
struct Card => {
name => '$',
color => '$',
cost => '$',
type => '$',
release => '$',
text => '$',
};
упрощается с помощью функции map:
struct Card => map {$_=>'$' } qw(name color cost type release text);
А если вы программируете на С и предпочитаете указывать тип поля перед его именем, а не наоборот, просто измените их порядок:
struct hostent => { reverse qw{ $ name
@ aliases $ addrtype $ length @ addr_list И;
Вы даже можете создавать синонимы в стиле «define (впрочем, такая возможность выглядит сомнительно), позволяющие обращаться к одному полю по нескольким именам. В С можно написать:
«define h_type h_addrtype #defme h_addr h_addr_list[O]
В Perl можно попробовать следующий вариант:
# Сделать (hostent object)->type()
# эквивалентным (hostent object)->addrtype()
•hostent::type = \&hostent::addrtype;
# Сделать (hostenv object)->addr()
# эквивалентным (hostenv object)->addr_list(0)
sub hostent::addr { shift->addr_list(O,@_) }
Как видите, вы можете добавлять методы в класс (или функции в пакет) простым объявлением функции в нужном пространстве имен. Для этого необязательно находиться в файле с определением класса, создавать субкласс или делать что-то хитроумное и запутанное. Однако вариант с субклассированием все же смотрится намного лучше:
package Extra::hostent;
use Net::hostent;
@ISA = qw(hostent);
sub addr { shift->addr_list(O,@_) }
1;
Это решение взято из стандартного класса Net::hostent. Обратитесь к исходным текстам этого модуля, это весьма вдохновляющее чтение. Впрочем, авторы не несут ответственности за возможные последствия вашего вдохновения.
> Смотри также---------------------------------------------------------------------------------------------
perltoot(l), perlobj(l) и perlbot(l); документация по стандартному модулю Class::Struct; исходный текст стандартного модуля Net::hostent; документация по модулю Alias с CPAN; рецепт 13.3.
13.6. Клонирование объектов
Проблема
Вы хотите написать конструктор, который может вызываться для существующего объекта.
Начните свой конструктор примерно так:
my $proto = shift;
ту $class = ref($proto) || $proto;
ту $parent = ref($proto) && $proto;
Переменная $class содержит класс, к которому выполняется приведение, а переменная Sparent либо равна false, либо ссылается на клонируемый объект.
Комментарий
Иногда требуется создать объект, тип которого совпадает с типом другого, существующего объекта. Вариант:
$оЫ = SomeClass->new();
8 Далее
$ob2 = (ref $ob1)->new();
выглядит не очень понятно. Вместо этого хотелось бы иметь конструктор, который может вызываться для класса или существующего объекта. В качестве метода класса он возвращает новый объект, инициализированный по умолчанию. В качестве метода экземпляра он возвращает новый объект, инициализированный данными объекта, для которого он был вызван:
$оЫ = Widget->new(); $оЬ2 = $ot>1->new();
Следующая версия new учитывает эти соображения:
sub new {
my Sproto = shift;
my $class = ref($proto) || $proto;
my Sparent = ref($proto) && $proto;
my $self;
# Проверить, переопределяется ли new из @ISA
if (@ISA && $proto->SUPER::can('new') <
$self = $proto->SUPER::new(@_); } else {
$self = {};
bless ($self, $proto); } bless($self, $class);
$self->{PARENT} = $parent;
$self->{START} = time(); # Инициализировать поля данных $self->{AGE} = 0; return $self; }
Инициализация не сводится к простому копированию данных из объекта-прототипа. Если вы пишете класс связанного списка или бинарного дерева, при вы-
зове в качестве метода экземпляра ваш конструктор может вернуть новый объект, включенный в дерево или список.
[> Смотри также-------------------------------------------------------------------------------------------
perlobj(l); рецепты 13.1; 13.9; 13.13.
13.7. Косвенный вызов методов
Проблема
Требуется вызвать метод по имени, которое станет известно лишь во время выполнения программы.
Решение
Сохраните имя метода в строковом виде в скалярной переменной и укажите имя переменной там, где обычно указывается имя метода — справа от оператора ->:
$methname = "flicker";
$obj->$methname(10); # Вызывает $ob->flicker(10);
# Три метода объекта вызываются по именам foreach $m ( qw(start run stop) ) { $obj->$m();
Комментарий
Имя метода не всегда известно на стадии компиляции. Как известно, получить адрес метода нельзя, но можно сохранить его имя. Если имя хранится в скалярной переменной $meth, то для объекта $crystal этот метод вызывается так:
$crystal->$meth().
©methods = qw(name rank serno);
%his_info = map { $_ => $ob->$_() } ©methods;
# Эквивалентно:
%his_info = (
'name' => $ob->name(),
'rank' => $ob->rank(),
'serno' => $ob->serno(),
);
Если вам никак не обойтись без получения адреса метода, попробуйте переосмыслить свой алгоритм. Например, вместо неправильной записи \$ob->method(), при которой \ применяется к возвращаемому значению или значениям метода, поступите следующим образом:
my $fnref = sub { $ob->method(@_) };
470 Глава 13 • Классы, объекты и связи
Когда придет время косвенного вызова этого метода, напишите:$fnref->(10, "fred"); и это даст правильный вызов метода:
$obj->method(10, "fred");
Такое решение работает даже в том случае, если $ob находится вне области действия и потому является предпочтительным.
Ссылку на код, возвращаемую методом сап() класса UNIVERSAL, вероятно, не следует использовать для косвенного вызова методов. Нельзя быть уверенным в том, что она будет соответствовать правильному методу для объекта произвольного класса.
Например, следующий фрагмент крайне сомнителен:
$ob]->can('method_name')->($obj_target, ©arguments) if $obj_target->isa( ref $obj );
Ссылка, возвращаемая can, может и не соответствовать правильному методу для $ob]2. Вероятно, разумнее ограничиться проверкой метода сап() в логическом условии.
> Смотри также---------------------------------------------------------------------------------------------
perlobj(l); рецепт 11.8.
13.8. Определение принадлежности субкласса
Проблема
Требуется узнать, является ли объект экземпляром некоторого класса или одного из его субклассов. Например, надо выяснить, можно ли вызвать для объекта некоторый метод.
Решение
Воспользуйтесь методами специального класса UNIVERSAL:
$obj->isa("HTTP::Message"); # Как метод объекта
HTTP1 ¦Response->isa("HTTP::Message"); # Как метод класса
if ($obj->can("method_name")) { } n Проверка метода
Комментарий
Для нас было бы очень удобно, чтобы все объекты в конечном счете происходили от общего базового класса. Тогда их можно было бы наделить общими методами, не дополняя по отдельности каждый массив @ISA. В действительности такая возможность существует. Хотя вы этого не видите, но Perl считает,
что в конце @ISA находится один дополнительный элемент — пакет с именем UNIVERSAL.
В версии 5.003 класс UNIVERSAL не содержал ни одного стандартного метода, но вы могли занести в него все, что считали нужным. Однако в версии 5.004 UNIVERSAL уже содержит несколько методов. Они встроены непосредственно в двоичный файл Perl и потому на их загрузку не расходуется дополнительное время. К числу стандартных методов относятся isa, can и VERSION. Метод isa сообщает, «является ли» (is а) объект или класс чем-то другим, избавляя вас от необходимости самостоятельно просматривать иерархию:
$has_io = $fd->isa("IO.:Handle"); $itza_handle = 10 Socket»isa("IO 'Handle'),
Также существует мнение, что обычно лучше попробовать вызвать метод. Считается, что явные проверки типов вроде показанной выше слишком ограничивают свободу действий.
Метод сап вызывается для объекта или класса и сообщает, соответствует ли его строковый аргумент допустимому имени метода для данного класса. Он возвращает ссылку на функцию данного метода:
$his_pnnt_method = $ob]->can('as_string'),
Наконец, метод VERSION проверяет, содержит ли класс (или класс объекта) пакетную глобальную переменную $VERSION с достаточно высоким значением:
Some_Module->VERSI0N(3.0); $his_vers = $obj->VERSION();
Тем не менее нам обычно не приходится вызывать VERSION самим. Вспомните: имена функций, записанные в верхнем регистре, означают, что функция вызывается Perl автоматически. В нашем случае это происходит, когда в программе встречается строка вида:
use Some_Module 3 0;
Если вам захочется включить проверку версии в класс Person, описанный выше, добавьте в файл Person.pm следующий фрагмент:
use vars qw($VERSION); $VERSION = '1.01';
Затем в пользовательской программе ставится команда use Person 1.01; —это позволяет проверить версию и убедиться в том, что она равна указанной или превышает ее. Помните, что версия не обязана точно совпадать с указанной, а должна быть не меньше ее. Впрочем, в настоящее время параллельная установка нескольких версий одного модуля не поддерживается.
> Смотри также---------------------------------------------------------------------------------------------
Документация по стандартному модулю UNIVERSAL. Ключевое слово use описа
но в perlfunc{\). , ,
Проблема
Вы не уверены в том, правильно ли вы спроектировали свой класс и может ли он использоваться в наследовании.
Решение
Воспользуйтесь «проверкой пустого субкласса».
Комментарий
Допустим, вы реализовали класс Person с конструктором new и методами age и name. Тривиальная реализация выглядит так:
package Person; sub new {
my $class = shift;
my $self = { },
return bless $self, Sclass, } sub name {
my $self = shift;
$self->{NAME} = shift if @>_;
return $self->{NAME>; } sub age {
my $self = shift,
$self->{AGE} = shift if §_,
return $self->{AGE}; }
Пример использования класса может выглядеть так:
use Person,
my $dude = Person->new();
$dude->name("Jason");
$dude->age(23),
printf '%s is age %d \n', $dude->name, $dude->age;
Теперь рассмотрим другой класс с именем Employee:
package Employee; use Person, @ISA = ('Person"); 1;
Ничего особенно интересного. Класс всего лишь загружает класс Person и заявляет, что все необходимые методы Employee наследует от Person. Поскольку Employee не имеет собственных методов, он получит от Person все методы.
Мы хотим, чтобы поведение класса Person полностью воспроизводилось в Employee.
Создание подобных пустых классов называется «проверкой пустого субкласса»; иначе говоря, мы создаем производный класс, который не делает ничего, кроме наследования от базового. Если базовый класс спроектирован нормально, то производный класс в точности воспроизведет его поведение. Это означает, что при простой замене имени класса все остальное будет работать:
use Employee;
my $empl = Employee->new();
$empl->name("Jason");
$empl->age(23);
printf "%s is age %d.\n", $empl->name, $empl->age;
Под «нормальным проектированием» имеется в виду использование только двухаргументной формы bless, отказ от прямого доступа к данным класса и отсутствие экспортирования. В определенной выше функции Person:: new() мы проявили необходимую осторожность; в конструкторе используются некоторые пакетные данные, но ссылка на них хранится в самом объекте. Другие методы обращаются к пакетным данным через эту ссылку, поэтому проблем быть не должно.
Но почему мы сказали «функции PersomwewQ» — разве это не метод? Дело в том, что метод представляет собой функцию, первый аргумент которой определяет имя класса (пакет) или объект (приведенную ссылку). Person;: new — это функция, которая в конечном счете вызывается методами Person->new и Employee->new. Хотя вызов метода очень похож на вызов функции, они все же отличаются. Если вы начнете путать функции с методами, то очень скоро у вас не останется ничего, кроме неработающих программ. Во-первых, функции отличаются от методов фактическими конвенциями вызова — метод вызывается с дополнительным аргументом. Во-вторых, вызовы функций не поддерживают наследования, а методы — поддерживают.
Если вы привыкнете к вызовам вида:
Вызов метода Вызов функции
Employee->new() Person::new("Employee")
Shim = Person::new(); «НЕВЕРНО
в программе возникнет нетривиальная проблема, поскольку функция не получит ожидаемого аргумента "Person" и не сможет привести его к переданному классу. Еще хуже, если вам захочется вызвать функцию Employee:: new(). Такой функции не существует! Это всего лишь вызов унаследованного метода. Мораль: не вызывайте функции там, где нужно вызывать методы.
> Смотри также---------------------------------------------------------------------------------------------
perltoot(i),perlobj(l) иperlbot(l); рецепты 13.1; 13.10.
Проблема
Конструктор переопределяет конструктор суперкласса. Вы хотите вызвать конструктор суперкласса из своего конструктора.
Решение
Используйте специальный класс, SUPER:
sub meth {
my $self = shift;
$self->SUPER::meth(); >
Комментарий
В таких языках, как C++, где конструкторы не выделяют память, а ограничиваются инициализацией объекта, конструкторы базовых классов вызываются автоматически. В таких языках, как Java и Perl, приходится вызывать их самостоятельно.
Для вызова методов конкретного класса используется формулировка $self-> SUPER: :meth(). Она представляет собой расширение обычной записи с началом поиска в определенном базовом классе и допустима только в переопределенных методах. Сравните несколько вариантов:
$self->meth(); # Вызвать первый найденный meth
$self->Where::meth(); # Начать поиск с пакета "Where"
$self->SUPER::meth(); # Вызвать переопределенную версию
Вероятно, простым пользователям класса; следует ограничиться первым вариантом. Второй вариант возможен, но не рекомендуется. Последний вариант может вызываться только в переопределенном методе..
Переопределяющий конструктор должен вызвать конструктор своего класса SUPER, в котором выполняется выделение памяти и приведение объекта, и ограничиться инициализацией полей данных. В данном случае код выделения памяти желательно отделять от кода инициализации объекта. Пусть имя начинается с символа подчеркивания — условного обозначения номинально закрытого метода, аналога таблички «Руками не трогать».
sub new {
my $classname = shift; # Какой класс мы конструируем?
my $self = $classname->SUPER:;new(@_);
$self->_init(@_);
return $self; # Вернуть
sub _inxt { ,,
my $self = shift; $self->{START} = time(); # Инициализировать поля данных
13.11. Генерация методов доступа с помощью AUTOLOAD 475
$self->{AGE> =0; ,
$self->{EXTRA} = { @_ }1 # Прочее
И SUPER: :new и _init вызываются со всеми остальными аргументами, что позволяет передавать другие инициализаторы полей:
Sobj = Widget->new( haircolor => red, freckles => 121 );
Стоит ли сохранять пользовательские параметры в отдельном хэше — решайте сами.
Обратите внимание: SUPER работает только для первого переопределенного метода. Если в массиве @ISA перечислено несколько классов, будет обработан только первый. Ручной перебор @ISA возможен, но, вероятно, не оправдывает затраченных усилий.
my $self = bless {}, Sclass; for my Sclass (@ISA) <
my $meth = Sclass . "::_init";
$self->$meth(@_) if $class->can("_init");
В этом ненадежном фрагменте предполагается, что все суперклассы инициализируют свои объекты не в конструкторе, а в _init. Кроме того, предполагается, что объект реализуется через ссылку на хэш.
> Смотри также---------------------------------------------------------------------------------------------
Класс SUPER рассматривается Bperltoot(l) nperlobj(l).
13.11. Генерация методов доступа с помощью AUTOLOAD
Проблема
Для работы с полями данных объекта нужны методы доступа, а вам не хочется писать повторяющийся код.
Решение
Воспользуйтесь механизмом AUTOLOAD для автоматического построения методов доступа — это позволит обойтись без самостоятельного написания методов при добавлении новых полей данных.
Комментарий
Механизм AUTOLOAD перехватывает вызовы неопределенных методов. Чтобы ограничиться обращениями к полям данных, мы сохраним список допустимых полей в хэше. Метод AUTOLOAD будет проверять, присутствует ли в хэше запрашиваемое поле.
use strict;
use Carp;
use vars qw($AUTOLOAD %ok_field);
# Проверка четырех атрибутов
for my $attr ( qw(name age peers parent) ) { $ok_field{$attr}++; }
sub AUTOLOAD {
my $self = shift;
my $attr = $AUTOL0AD;
$attr =" s/.*:://;
return unless $attr =' /["A-Z]/; # Пропустить DESTROY и другие
# методы, имена которых
# записаны в верхнем регистре
croak "invalid attribute method: ->$attr()" unless $ok_field{$attr}; $self->{uc $attr} = shift if @_;
return $self->{uc $attr}; } sub new {
my Sproto = shift;
my $class = ref($proto) || Sproto;
my $parent = ref($proto) && Sproto;
my $self = {};
bless($self, $class);
$self->parent($parent);
return $self; } 1;
Класс содержит конструктор new и четыре метода атрибутов: name, age, peers и parent. Модуль используется следующим образом:
use Person;
my ($dad, $kid);
$dad = Person->new;
$dad->name("Jason");
$dad->age(23);
$kid = $dad->new;
$kid->name("Rachel");
$kid->age(2);
printf "Kid's parent is %s\n", $kid->parent->name;
Jason
В иерархиях наследования это решение вызывает некоторые затруднения. Предположим, вам понадобился класс Employee, который содержит все атрибуты данных класса Person и еще два атрибута (например, salary и boss). Класс Employee не может определять методы своих атрибутов с помощью унаследованного варианта Person:: AUTOLOAD — следовательно, каждому классу нужна собственная функция AUTOLOAD. Она проверяет атрибуты данного класса, но вместо вызова croak при отсутствии атрибута вызывает переопределенную версию суперкласса.
С учетом этого AUTOLOAD может выглядеть так:
sub AUTOLOAD {
my $self = shift;
my $attr = SAUTOLOAD;
$attr =¦ s/. *:://;
return if $attr eq 'DESTROY';
if ($ok_field{$attr}) {
$self->{uc $attr> = shift if @_;
return $self->{uc $attr}; } else {
my Ssuperior = "SUPER::$attr",
$self->$superior(@_);
Если атрибут отсутствует в списке, мы передаем его суперклассу, надеясь, что он справится с его обработкой. Однако такой вариант AUTOLOAD наследовать нельзя; каждый класс должен иметь собственную версию, поскольку работа с данными осуществляется напрямую, а не через объект.
Еще худшая ситуация возникает, если класс А наследует от классов В и С, каждый из которых определяет собственную версию AUTOLOAD — в этом случае при вызове неопределенного метода А будет вызвана функция AUTOLOAD лишь одного из двух родительских классов.
С этими ограничениями можно было бы справиться, но всевозможные заплатки, исправления и обходные пути вскоре начинают громоздиться друг на друге. Для сложных ситуаций существуют более удачные решения.
> Смотри также---------------------------------------------------------------------------------------------
Рецепты 10.15; 13.12. Пример использования AUTOLOAD приведен в perltoot(l).
13.12. Решение проблемы наследования данных
Проблема
Вы хотите унаследовать от существующего класса и дополнить его несколькими новыми методами, но не знаете, какие поля данных используются родительским классом. Как безопасно дополнить хэш объекта новым пространством имен и не повредить данные предков?
Решение
Снабдите каждое имя поля префиксом, состоящим из имени класса и разделителя, — например, одного или двух подчеркиваний.
В недрах стандартной объектно-ориентированной стратегии Perl спрятана одна неприятная проблема: знание точного представления класса нарушает иллюзию абстракции. Субкласс должен находиться в чрезвычайно близких отношениях со своими базовыми классами.
Давайте сделаем вид, что все мы входим в одну счастливую объектно-ориентированную семью и объекты всегда реализуются с помощью хэшей — мы попросту игнорируем классы, в чьих представлениях используются массивы, и наследуем лишь от классов на основе модели хэша (как показано в perlbot(\), эта проблема решается с помощью агрегирования и делегирования). Но даже с таким предположением наследующий класс не может с абсолютной уверенностью работать с ключами хэша. Даже если мы согласимся ограничиваться методами доступа для работы с атрибутами, значения которых задавались не нами, как узнать, что устанавливаемый нами ключ не используется родительским классом? Представьте себе, что в вашем классе используется поле count, но поле с таким же именем встречается в одном из пра-пра-правнуков. Имя _count (подчеркивание обозначает номинальную закрытость) не поможет, поскольку потомки могут сделать то же самое.
Одно из возможных решений — использовать для атрибутов префиксы, совпадающие с именем пакета. Следовательно, если вы хотите создать поле age в классе Employee, для обеспечения безопасности можно воспользоваться Employee_age. Метод доступа может выглядеть так:
sub Employee'.age {
my $self = shift;
$self->{Employee_age} = shift if @_;
return $self->{Employee_age}; }
Модуль Class::Spirit, описанный в рецепте 13.5, предоставляет еще более радикальное решение. Представьте себе один файл:
package Person,
use Class Attributes; # Объясняется ниже
mkattr qw(name age peers parent),
и другой файл:
package Employee, @ISA = qw(Person); use Class, attributes; mkattr qw(salary age boss);
Вы обратили внимание на общий атрибут age? Если эти атрибуты должны быть логически раздельными, то мы не сможем использовать $self->{age} даже для текущего объекта внутри модуля! Проблема решается следующей реализацией функции Class::Attributes::mkattr:
package Class;'.Attributes; i
use strict, use Carp,
use Exporter (); use vars qw(@ISA ©EXPORT); @ISA = qw(Exporter); ©EXPORT = qw(mkattr); sub mkattr {
my Shispack = caller(); for my $attr (@_) {
my($field, $method); $method = "${hispack}::$attr"; ($field = $method) =" s/:/_/g; no strict 'refs'; *$method = sub { my $self = shift;
confess "too many arguments" if @_ > 1; $self->{$field> = shift if @_; return $self->{$field};
1;
В этом случае $self->{Person_age} и $self->{Employee_age} остаются раздельными. Единственная странность заключается в том, что $obj-> age даст лишь первый из двух атрибутов. В принципе атрибуты можно было бы различать с помощью формулировок $obj ->Person:: age и $obj ->Employee;: age, но грамотно написанный код Perl не должен ссылаться на конкретный пакет с помощью ; :, за исключением крайних случаев. Если это оказывается неизбежным, вероятно, ваша библиотека спроектирована не лучшим образом.
Если вам не нравится подобная запись, то внутри класса Person достаточно использовать age($self), и вы всегда получите age класса Person, тогда как в классе Employee age($self) дает версию age класса Employee. Это объясняется тем, что мы вызываем функцию, а не метода.
> Смотри также---------------------------------------------------------------------------------------------
Документация по директивам use fields и use base для Perl версии 5.005; рецепт 10.14.
13.13. Использование циклических структур данных
Проблема
Имеется структура данных, построенная на циклических ссылках. Система сборки мусора Perl, использующая подсчет ссылок, не заметит, когда данная структура перестает использоваться. Вы хотите предотвратить утечки памяти в программе.
Создайте не-циклический объект-контейнер, содержащий указатель на структуру данных с циклическими ссылками. Определите для объекта-контейнера метод DESTROY, который вручную уничтожает циклические ссылки.
Комментарий
Многие интересные структуры данных содержат ссылки на самих себя. Например, это может происходить в простейшем коде:
$node->{NEXT} = $node;
Как только в вашей программе встречается такая команда, возникает цикличность, которая скрывает структуру данных от системы сборки мусора Perl с подсчетом ссылок. В итоге деструкторы будут вызваны при выходе из программы, но иногда ждать долго не хочется.
Связанный список также обладает циклической структурой: каждый узел содержит указатель на следующий узел, указатель на предыдущий узел и значение текущего узла. Если реализовать его на Perl с применением ссылок, появится циклический набор ссылок, которые также не будут автоматически уничтожаться с исчезновением внешних ссылок на узлы.
Проблема не решается и созданием узлов, представляющих собой экземпляры специального класса Ring. На самом деле мы хотим, чтобы данная структура уничтожалась Perl по общим правилам — а это произойдет в том случае, если объект реализуется в виде структуры, содержащей ссылку на цикл. В следующем примере ссылка хранится в поле DUMMY":
package Ring;
# Вернуть пустую циклическую структуру sub new {
my $class = shift;
my $node = { };
$node->{NEXT} = $node->{PREV} = $node;
my $self = { DUMMY => $node, COUNT => 0 };
bless $self, $classr
return $self; }
Цикличностью обладают узлы кольца, но не сам возвращаемый объект-кольцо. Следовательно, следующий фрагмент не вызовет утечек памяти:
use Ring;
$COUNT = 1000; for (1 .. 20) {
my $r = Ring->new();
for ($1 =0, $i < $COUNT; $i++) { $r->insert($i) } }
Даже если мы создадим двадцать колец по тысяче узлов, то перед созданием нового кольца старое будет уничтожено. Пользователю класса не придется бес-
покоиться об освобождении памяти в большей степени, чем для простых строк. Иначе говоря, все происходит автоматически, как и должно происходить.
Однако при реализации класса необходимо написать деструктор, который вручную уничтожает узлы:
# При уничтожении Ring уничтожить содержащуюся в нем кольцевую структуру sub DESTROY {
my $nng = shift; my $node;
for ( $node = $rmg->{DUMMY}->{NEXT}; $node '= $nng->{DUMMY}; $node = $node->{NEXT} ) {
$nng->delete_node($node); > $node->{PREV} = $node->{NEXT> = undef;
# Удалить узел из циклической структуры
sub delete_node {
my ($ring, $node) = @_; $node->{PREV}->{NEXT} = $node->{NEXT}; $node->{NEXT}->{PREV> = $node->{PREV}; -$nng->{C0UNT}; >
Ниже приведено еще несколько методов, которые следовало бы включить в класс. Обратите внимание на то, что вся реальная работа выполняется с помощью циклических ссылок, скрытых внутри объекта:
# $node = $nng->search( $value ) : найти $value в структуре $nng
sub search {
my ($ring, $value) = @>_;
my $node = $ring->{DUMMY}->{NEXT},
while ($node < = $nng->{0UMMY} && $node->{VALUE} != lvalue) {
$node = $node-><NEXT}; > return $node;
(t $rmg->msert( $value ) : вставить lvalue в структуру $nng sub msert_value {
my ($nng, lvalue) = @_;
my $node = { VALUE => lvalue };
|node->{NEXT} = |ring->{DUMMY}->{NEXT};
$nng->{DUMMY}->{NEXT}->{PREV} = Inode;
$nng->{DUMMY}->{NEXT} = Inode;
|node->{PREV} = |nng->{DUMMY};
++|ring->{COUNT};
482 Глава 13 • Классы, объекты и связи
# $ring->delete_value( $value ) : удалить узел по значению sub delete_value {my ($ring, lvalue) = @_;
my $node = $ring->search($value);
return if $node == $ring->{DUMMY};
$ring->delete_node($node);
1;
> Смотри также---------------------------------------------------------------------------------------------
Раздел «Garbage Collection» perlobj(l).
13.14. Перегрузка операторов
Проблема
Вы хотите использовать знакомые операторы (например, == или +) с объектами написанного вами класса или определить интерполированное значение для вывода объектов.
Решение
Воспользуйтесь директивой use overload. Ниже приведены два самых распространенных и часто перегружаемых оператора:
use overload ('<=>' => \&threeway_compare); sub threeway_compare {
my ($s1, $s2) = @_;
uc($s1->{NAME>) cmp uc($s2->{NAME});
use overload ( ..... => \&stringify );
sub stringify {
my $self = shift;
return sprintf "%s (%05d)",
ucfirst(lc($self->{NAME})), $self->{IONUM};
Комментарий
При работе со встроенными типами используются некоторые операторы (например, оператор + выполняет сложение, а . — конкатенацию строк). Директива use overload позволяет перегрузить эти операторы так, чтобы для ваших собственных объектов они делали что-то особенное.
Директиве передается список пар «оператор/функция»:
package TimeNumber;
use overload '+' => \&my_plus,
13.14. Перегрузка операторов 483
'-' => \&my_minus, ¦*¦ => \&my_star, V => \&my_slash;
Теперь эти операторы можно использовать с объектами класса TimeNumber, и при этом будут вызываться указанные функции. Функции могут делать все, что вам захочется.
Приведем простой пример перегрузки + для работы с объектом, содержащим количество часов, минут и секунд. Предполагается, что оба операнда принадлежат к классу, имеющему метод new, который может вызываться в качестве метода объекта, и что структура состоит из перечисленных ниже имен:
sub my_plus {
my($left, $right) = @_;
my $answer = $left»new();
$answer->{SECONDS} = $left->{SECONDS} + $right->{SECONDS};
$answer->{MINUTES} = $left»{MINUTES} + $right->{MINUTES};
$answer->{HOURS} = $left->{HOURS} + $right->{HOURS>;
if ($answer->{SECONDS> >= 60) { $answer->{SECONDS> %= 60; $answer->{MINUTES} ++;
if ($answer->{MINUTES> >= 60) { $answer->{MINUTES} %= 60; $answer->{H0URS} ++;
return $answer;
Числовые операторы рекомендуется перегружать лишь в том случае, если объекты соответствуют какой-то числовой конструкции — например, комплексным числам или числам с повышенной точностью, векторам или матрицам. В противном случае программа становится слишком сложной, а пользователи делают неверные предположения относительно работы операторов. Представьте себе класс, который моделирует страну. Если вы создадите оператор для сложения двух стран, то почему нельзя заняться вычитанием? Как видите, перегрузка операторов для нечисловых математических объектов быстро приводит к абсурду.
Объекты (а в сущности, и любые ссылки) можно сравнивать с помощью == и eq, но в этом случае вы узнаете лишь о совпадении их адресов (при этом == работает примерно в 10 раз быстрее, чем eq). Поскольку объект является всего лишь высокоуровневым представлением обычного машинного адреса, во многих ситуациях требуется определить собственный критерий того, что следует понимать под равенством двух объектов.
Даже для нечисловых классов особенно часто перегружаются два оператора: сравнения и строковой интерполяции. Допускается перегрузка как оператора <=>, так и стр, хотя преобладает второй вариант. После того как для объекта будет
Оператор строковой интерполяции обозначается странным именем "" (две кавычки). Он вызывается каждый раз, когда происходит строковое преобразование — например, внутри кавычек или апострофов или при вызове функции print.
Прочитайте документацию по директиве overload, прилагаемую к Perl. Перегрузка операторов Perl откроет перед вами некоторые нетривиальные возможности — например, методы строковых и числовых преобразований, автоматическая генерация отсутствующих методов и изменение порядка операндов при необходимости (например, в выражении 5 + $а, где $а является объектом).
Пример. Перегруженный класс StrNum
Ниже приведен класс StrNum, в котором числовые операторы используются для работы со строками. Да, мы действительно собираемся сделать то, против чего настраивали вас, то есть применить числовые операторы к нечисловым объектам, однако программисты по опыту работы в других языках всегда ожидают, что + и == будут работать со строками. Это всего лишь несложный пример, демонстрирующий перегрузку операторов. Подобное решение почти наверняка не будет использоваться в коммерческой версии программы из-за проблем, связанных с быстродействием. Кроме того, перед вами один из редких случаев использования конструктора, имя которого совпадает с именем класса, — наверняка это порадует программистов со знанием C++ и Python.
#!/usr/bm/perl
# show_strnum - пример перегрузки операторов
use StrNum;
$х = StrNum("Red"); $y = StrNum("Black');
$z = $х + $у; $r = $z • 3;
print "values are $x, $y, $z, and $r\n";
print "$x is ", $x < $y ? "LT" ; "GE", " $y\n";
values are Red, Black, RedBlack, and 0 Red Is GE Black
Исходный текст класса приведен в примере 13.1. Пример 13.1. StrNum
package StrNum;
use Exporter ();
@ISA = 'Exporter';
@EXPORT = qw(StrNum); # Необычно
use overload (
¦<=>' => \&spaceship, 'cmp' => \&spaceship,
..... => \&stringify,
'ЬооГ => \&boolify,
'0+' => \&numify,
'+' => \&concat,
'*' => \&repeat,
# Конструктор sub StrNum($) {
my ($value) = @_;
return bless \$value;
sub stnngify { $< $_[0] } }
sub numify { ${ $_[0] > >
sub boolify { ${ $_[0] > }
# H.' -J.<r> _ -
Ss1 $s2 $ir -*^., = ¦_ ¦eturn StrNum $mveriea 9 ($s2 $s1) . ($s1 . $s2);
# Использует stnngify sub repeat {
my ($s1, $s2, $inverted) = @_;
return StrNum $inverted ' ($s2 x $s1) : ($s1 x $s2);
1;
Пример. Перегруженный класс FixNum
В этом классе перегрузка оператора позволяет управлять количеством десятичных позиций при выводе. При этом во всех операциях используется полная точность. Метод places() вызывается для класса или конкретного объекта и задает количество выводимых позиций справа от десятичной точки.
#!/usr/bin/perl
# demo_fixnum - show operator overloading
use FixNum;
FixNum->places(5); $x = FixNum->new(40);
486 Глава 13 • Классы, объекты и связи
$у = FixNum->new(12);print "sum of $x and $y is ", $x + $y, "\n"; print "product of $x and $y is ", $x * $y, "\n";
$2 = $x / $y;
printf "$z has %d places\n", $z->places;
$z->places(2) unless $z->places;
print "div of $x by $y is $z\n";
print "square of that is ", $z • $z, "\n";
sum of STRFixNum: 40 and STRFixNum: 12 is STRFixNum: 52 product of STRFixNum: 40 and STRFixNum: 12 is STRFixNum: 480 STRFixNum: 3 has 0 places
div of STRFixNum: 40 by STRFixNum: 12 is STRFixNum: 3.33 square of that is STRFixNum: 11.11
Исходный текст класса приведен в примере 13.2. Из математических операций в нем перегружаются только операторы сложения, умножения и деления. Также перегружен оператор <=>, обеспечивающий выполнение всех сравнений, оператор строковой интерполяции и оператор числового преобразования. Оператор строковой интерполяции выглядит необычно, но это было сделано для удобства отладки.
Пример. 13.2 FixNum
package FixNum; use strict; my $PLAGES = 0;
sub new {
my Sproto = shift;
my $class = ref(Sproto) || Sproto;
my Sparent = ref(Sproto) && Sproto;
my $v = shift; my Sself = {
VALUE => $v,
PLACES => undef,
};
if (Sparent && defined $parent->{PLACES}) {
$self->{PLACES} = $parent->{PLACES}; } elsif ($v =" /(\.\d*)/) {
$self->{PLACES> = length($1) - 1; } else {
$self->{PLACES} = 0; } return bless Sself, Sclass;
13.14. Перегрузка операторов 487
sub places {
my $proto = shift;
my $self = ref($proto) && $proto;
my $type = ref($proto) || $proto;
if (@J (
ray Splaces = shift;
($self ? $self->{PLACES} ; $PLACES) = $places; }
return $self ? $self->{PLACES} : SPLACES; }
sub _max { $_[0] > $_[1] f $_[0] : $_[1] >
|
use overload '+' |
=> |
\&add, |
|
=> |
\&multiply, |
|
|
V |
=> |
\÷, |
|
<=>¦ |
=> |
\&spaceship, |
|
=> |
\&as_string, |
|
|
•o+- |
=> |
\&as_number; |
my ($this, $that, Sflipped) = @_;
my Sresult = $this->new( $this->{VALUE> + $that->{VALUE} ); $result->places( _max($this->{PLACES>, $that->{PLACES> )); return Sresult;
sub multiply {
my ($this, $that, Sflipped) = @_;
my Sresult = $this->new( $this->{VALUE> * $that->{VALUE> ); $result->places( _max($this->{PLACES}, $that->{PLACES} )); return Sresult;
sub divide {
my ($this, $that, Sflipped) = @_;
my Sresult = $this->new( $this->{VALUE} / $that->{VALUE> ); $result->places( _max($this->{PLACES>, $that->{PLACES> )); return Sresult;
sub as_string {
my Sself = shift;
return sprintf("STR%s: %..f", ref(Sself),
defined($self->{PLACES}) ? $self->{PLACES} : SPLACES, $self->{VALUE});
продолжение
488 Глава 13 • Классы, объекты и связи Пример 13.2 (продолжение)
sub as_number {my $self = shift, return $self->{VALUE},
sub spaceship {
my ($this, $that, Sflipped) = @_, $this->{VALUE) <=> $that->{VALUE},
1,
I> Смотри также--------------------------------------------------------------------------------------------
Документация по стандартной директиве use overload, а также модулям Math::BigInt и Math::Complex.
13.15. Создание «магических» переменных функцией tie
Проблема
Требуется организовать специальную обработку переменной или манипулятора.
Решение
Воспользуйтесь функций tie, чтобы создать объектные связи для обычной переменной.
Комментарий
Каждый, кому приходилось работать с DBM-файлами в Perl, уже использовал связанные объекты. Возможно, самый идеальный вариант работы с объектами — тот, при котором пользователь их вообще не замечает. Функция tie связывает переменную или манипулятор с классом, после чего все обращения к связанной переменной или манипулятору перехватываются специальными методами.
Наиболее важными являются следующие методы tie: FETCH (перехват чтения), STORE (перехват записи) и конструктор, которым является один из методов TIESCALAR, TIEARRAY, TIEHASH или TIEHANDLE.
Выполняемый код
SomeClass->TIESCALAR()
$р = $ob]->FETCH()
$ob]->ST0RE(10)___
Откуда берется объект $ob]? Вызов tie приводит к вызову конструктора TIESCALAR соответствующего класса. Perl прячет возвращенный объект и тайком использует его при последующих обращениях.
Ниже приведен простой пример класса, реализующего кольцевую структуру данных. При каждом чтении переменной выводится следующее значение из кольца, а при записи в кольцо заносится новое значение.
й'/usr/bm/perl
# demo_valuering - демонстрация связывания
use ValueRing,
tie $color, ValueRing , qw(red blue),
print $color $color $color $color $color $color\n ,
red blue red blue red blue
$color = green ,
print $color $color $color $color $color $color\n ,
green red blue green red blue
Простая реализация класса ValueRing приведена в примере 13.3. Пример 13.3. ValueRing
package ValueRing,
И Конструктор для связывания скаляров sub TIESCALAR {
my ($class, ©values) = @_,
bless \@values, $class,
return \@values,
# Перехватывает чтение sub FETCH {
my $self = shift,
push(@$self, shift(@$self)),
return $self->[-1],
# Перехватывает запись
sub STORE {
my ($self, lvalue) = @_, unshift @$self, Svalue, return Svalue,
1,
Вероятно, такой пример кажется надуманным, но он показывает, как легко создать связь произвольной сложности. Для пользователя $color остается старой доброй переменной, а не объектом. Все волшебство спрятано под связью. При связывании скалярной переменной совсем не обязательно использовать скалярную ссылку; мы использовали ссылку на массив, но вы можете выбрать любой другой вариант. Обычно при связывании любых переменных используется ссылка на хэш, поскольку она обеспечивает наиболее гибкое представление объекта.
490 Глава 13 • Классы, объекты и связи
Для массивов и хэшей возможны и более сложные операции. Связывание манипуляторов появилось лишь в версии 5.004, а до появления версии 5.005 возможности применения связанных массивов были несколько ограничены, но связывание хэшей всегда поддерживалось на высоком уровне. Поскольку полноценная поддержка связанных хэшей требует реализации множества методов объекта, многие пользователи предпочитали наследовать от стандартного модуля Tie::Hash, в котором существуют соответствующие методы по умолчанию.Ниже приведены некоторые интересные примеры связывания.
Пример связывания. Запрет $_
Этот любопытный связываемый класс подавляет использование неявной переменной $_. Вместо того чтобы подключать его командой use, что приведет к косвенному вызову метода import() класса, воспользуйтесь командой по для вызова редко используемого метода unimport(). Пользователь включает в программу следующую команду:
no Underscore;
После этого любые попытки использования нелокализованной глобальной переменной $_ приводят к инициированию исключения.
Рассмотрим применение модуля на небольшом тестовом примере:
#!/usr/bin/perl
# nounder_demo - запрет использования $_ в программе
no Underscore;
@tests = (
"Assignment" => sub { $_ = "Bad" },
"Reading" => sub { priat },
"Matching" => sub { $x = /badness/ },
"Chop" => sub < chop },
"Filetest" => sub { -x },
"Nesting" => sub { for (1..3) { print } },
while ( ($name, $code) = splice(@tests, 0, 2) ) {
print "Testing $name: ";
eval { &$code >;
print $@ ? "detected" : "missed!";
print "\n"; }
Результат выглядит так:
Testing Assignment: detected
Testing Reading: detected
Testing Matching: detected
Testing Chop: detected
Testing Filetest: detected
Testing Nesting: 123missed!
В последнем случае обращение к переменной не было перехвачено, поскольку она была локализована в цикле for.
13.15. Создание «магических» переменных функцией tie 491
Исходный текст модуля Underscore приведен в примере 13.4. Обратите внимание, каким маленьким он получился. Функция tie вызывается модулем в инициализирующем коде.
Пример 13.4. Underscore
package Underscore;
use Carp;
sub TIESCALAR {
my $class = shift;
my $dummy;
return bless \$dummy => $class; >
sub FETCH { croak "Read access to \$_ forbidden" > sub STORE { croak "Write access to \$_ forbidden" } sub unimport { tie($_, __PACKAGE__) } sub import { untie $_ > tie($_, __PACKAGE__) unless tied $_; 1;
Чередование вызовов use и по для этого класса в программе не принесет никакой пользы, поскольку они обрабатываются во время компиляции, а не во время выполнения. Чтобы снова воспользоваться переменной $_, локализуйте ее.
Пример связывания. Хэш с автоматическим дополнением
Следующий класс создает хэш, который автоматически накапливает повторяющиеся ключи в массиве вместо их замены.
ft!/usr/bin/perl
« appendhash_demo - хэш с автоматическим дополнением
use Tie::AppendHash;
tie %tab, 'Tie::AppendHash';
$tab{beer} = "guinness"; $tab{food} = "potatoes"; $tab{food} = "peas";
while (my($k, $v) = each %tab) {
print "$k => [@$v]\n"; >
Результат выглядит так:
food -> [potatoes peas] beer => [guinness]
Простоты ради мы воспользовались шаблоном модуля для связывания хэша, входящим в стандартную поставку (см. пример 13.5). Для этого мы загружаем модуль Tie::Hash и затем наследуем от класса Tie::StdHash (да, это действительно разные имена — файл Tie/Hash.pm содержит классы Tie::Hash и Tie::StdHash, несколько отличающиеся друг от друга).
package Tie::AppendHash;
use strict;
use Tie::Hash;
use Carp;
use vars qw(@ISA);
§ISA = qw(Tie::StdHash);
sub STORE {
my ($self, $key, lvalue) = @_;
push @{$self->{key}), $value; > 1;
Пример связывания. Хэш без учета регистра символов
Ниже приведен другой, более хитроумный пример связываемого хэша. На этот раз хэш автоматически преобразует ключи к нижнему регистру.
#!/usr/bin/perl
# folded_demo - хэш с автоматическим преобразованием регистра
use Tie::Folded;
tie %tab, 'Tie::Folded';
$tab{VILLAIN> = "big "; $tab{herOine} = "red riding hood"; $tab{villain> = "bad wolf";
while ( my($k, $v) = each %tab ) {
print "$k is $v\n"; }
Результат демонстрационной программы выглядит так:
heroine is red riding hood villain is big bad wolf
Поскольку на этот раз перехватывается большее количество обращений, класс из примера 13.6 получился более сложным, чем в примере 13.5.
Пример 13.6. Tie::Folded
package Tie::Folded;
use strict;
use Tie::Hash;
use vars qw(@ISA);
@ISA = qw(Tie::StdHash);
sub STORE {
my ($self, $key, $value) = @_;
return $self->{lc $key} = Svalue;
} sub FETCH <
my (Sself, $key) = @_;
13.15. Создание «магических» переменных функцией tie 493
return $self->{lc $key>;
>
sub EXISTS {
my ($self, $key) = @_;
return exists $self->{lc $key}; > sub DEFINED <
my ($self, $key) = @_;
return defined $self->{lc $key}; > 1;
Пример. Хэш с возможностью поиска по ключу и по значению
Следующий хэш позволяет искать элементы как по ключу, так и по значению. Для этого метод STORE заносит в хэш не только значение по ключу, но и обратную пару — ключ по значению.
Если сохраняемое значение представляет собой ссылку, возникают затруднения, поскольку обычно ссылка не может использоваться в качестве ключа хэша. Проблема решается классом Tie::RefHash, входящим в стандартную поставку. Мы унаследуем от него.
|
#!/usr/bin/perl |
-w |
|
# revhash_demo - |
хэш с возможностью поиска по ключу *или» по значению |
|
use strict; |
|
|
use Tie::RevHash |
; |
|
my %tab; |
|
|
tie %tab, 'Tie:: |
RevHash'; |
|
%tab = qw{ |
|
|
Red |
Rojo |
|
Blue |
Azul |
|
Green i. |
Verde |
|
I, $tab{EVIL} = [ " |
No way!", "Way!!" ]; |
print ref($k) ? "[@$k]" : $k, " => ",
ref($v) ? "[e$v]" : $v, An"; >
При запуске программа revhash_demo выдает следующий результат:
[No way! Way!!] = EVIL> EVIL => [No way! Way!!] Blue => Azul Green => Verde Rojo => Red Red => Rojo Azul => Blue Verde => Green
Исходный текст модуля приведен в примере 13.7. Оцените размеры!
494 Глава 13 • Классы, объекты и связи Пример 13.7. TiexRevHash
package Tie::RevHash; use Tie::RefHash; use vars qw(@ISA); @ISA = qw(Tie::RefHash); sub STORE {my ($self, $key, $value) = @_;
$self->SUPER::STORE($key, $value);
$self->SUPER::STORE($value, $key);
sub DELETE {
my ($self, $key) = @_;
my $value = $self->SUPER::FETCH($key);
$self->SUPER::DELETE($key);
$self->SUPER::DELETE($value);
1;
Пример связывания. Манипулятор с подсчетом обращений
Пример связывания для файлового манипулятора выглядит так:
use Counter;
tie *CH, 'Counter';
while (<CH>) {
print "Got $_\n"; }
При запуске эта программа выводит Got 1, Got 2 и так далее — пока вы не прервете ее, не перезафузите компьютер или не наступит конец света (все зависит от того, что случится раньше). Простейшая реализация приведена в примере 13.8.
Пример 13.8. Counter
package Counter; sub TIEHANDLE {
my $class = shift;
my $start = shift;
return bless \$start => $class; > sub READLINE {
my $self = shift;
return ++$$self; } 1;
Пример связывания. Дублирование вывода по нескольким манипуляторам
Напоследок мы рассмотрим пример связанного манипулятора, который обладает tee-подобными возможностями — он объединяет STDOUT и STDERR:
13.15. Создание «магических» переменных функцией tie 495
use Tie::Tee;
tie -TEE, Tie::Tee\ *STDOUT, -STDERR;
print TEE "This line goes both places.\n"
Или более подробно:
#!/usr/bin/perl tt demo_tietee use Tie::Tee; use Symbol;
©handles = (*STD0UT); for $i ( 1 .. 10 ){
push(@handles, $handle = gensymO);
open($handle, ">/tmp/teetest.$i");
tie «TEE, 'Tie::Tee', ©handles;
print TEE "This lines goes many places.\n";
Содержимое файла Tie/Tee.pm показано в примере 13.9.
Пример 13.9. Tie::Tee
package Tie::Tee;
sub TIEHANDLE <
my $class = shift; my Shandies = [@_];
bless Shandies, $class; return Shandies;
sub PRINT {
my $href = shift;
my Shandle;
my Ssuccess = 0;
foreach Shandle (@$href) { Ssuccess += print Shandle
return Ssuccess == @$href;
1;
> Смотри также----------------------------------------------
Функция tie описана в perlfunc(l) иperltie(l).
 |
Базы данных тт-i
Все, чего я прошу, — это информация. Чарльз Диккенс, -«Дэвид Копперфильд»
Введение
Базы данных встречаются везде, где происходит обработка данных. На простейшем уровне базой данных можно считать любой файл, а на самом сложном — дорогую и сложную реляционную базу данных, обрабатывающую тысячи транзакций в секунду. Между этими полюсами расположены бесчисленные механизмы ускоренного доступа к более или менее структурированным данным. Perl поддерживает работу с базами данных на любом из этих уровней.
На заре компьютерной эпохи люди заметили, что базы данных на основе плоских файлов плохо подходят для работы с большими объемами информации. Плоские файлы улучшались посредством введения записей фиксированной длины или индексирования, однако обновление требовало все больших затрат, и некогда простые приложения увязали в болоте ввода/вывода.
Умные программисты почесали в затылках и разработали более удачное решение. Поскольку хеш, находящийся в памяти, обеспечивает более удобный доступ к данным по сравнению с массивом, хеш на диске также упростит работу с данными по сравнению с «массивообразным» текстовым файлом. За ускорение доступа приходится расплачиваться объемом, но дисковое пространство в наши дни стоит дешево (во всяком случае, так принято считать).
Библиотека DBM предоставляет в распоряжение программистов простую и удобную базу данных. С хешами, ассоциированными с DBM-файлами, можно выполнять те же операции, что и с хешами в памяти. В сущности, именно так построена вся работа с базами данных DBM в Perl. Вы вызываете dbmopen с именем хеша и именем файла, содержащего базу данных. Затем при любом обращении к хешу Perl выполняет чтение или запись в базе данных DBM на диске.
Рецепт 14.1 демонстрирует процесс создания базы данных DBM, а также содержит рекомендации относительно ее эффективного использования. Хотя с файлами DBM допускаются все операции, разрешенные для простых хешей, возникают
проблемы быстродействия, неактуальные для хешей в памяти. Рецепты 14.2 и 14.4 разъясняют суть этих проблем и показывают, как справиться с ними. С файлами DBM также можно выполнять операции, недоступные для обычных хешей. Два примера таких операций рассматриваются в рецептах 14.6 и 14.7.
Разные реализации DBM обладают разными возможностями. Старая функция dbmopen позволяла использовать лишь ту библиотеку DBM, с которой был построен Perl. Если вы хотели использовать dbmopen для чтения базы данных одного типа и записи в другой тип — считайте, что вам не повезло. Положение было исправлено в Perl версии 5, где появилась возможность связать хеш с произвольным классом объекта — см. главу 13 «Классы, объекты и связи».
В следующей таблице перечислены некоторые доступные библиотеки DBM.
|
Особенности |
NDBM |
SDBM |
GDBM |
DB |
|
Программное обеспечение для связи |
Да |
Да |
Да |
Да |
|
поставляется с Perl |
||||
|
Исходные тексты поставляются с Perl |
Нет |
Да |
Нет |
Нет |
|
Возможность распространения |
Нет |
Да |
GPL1 |
Да |
|
исходных текстов |
||||
|
Доступность через FTP |
Нет |
Да |
Да |
Да |
|
Легкость построения |
- |
Да |
Да |
Нормально |
|
Частое применение в UNIX |
Да3 |
Нет |
Нет4 |
Нет4 |
|
Нормальное построение в UNIX |
- |
Да |
Да |
Да5 |
|
Нормальное построение в Windows |
- |
Да |
Да |
Да6 |
|
Размер кода |
7 |
Малый |
Большой |
Большой |
|
Использование диска |
9 |
Малое |
Большое |
Нормальное |
|
Скорость |
9 |
Низкая |
Нормальная |
Высокая |
|
Ограничение размера блока |
4Кб |
1Кб10 |
Нет |
Нет |
|
Произвольный порядок байтов |
Нет |
Нет |
Нет |
Да |
|
Порядок сортировки, определяемый |
Нет |
Нет |
Нет |
Да |
|
пользователем |
||||
|
Поиск по неполному ключу |
Нет |
Нет |
Нет |
Да |
За дополнительной информацией обращайтесь на www gnu.org.
2 См. библиотечный метод DB_File. Требует символических ссылок.
3 На некоторых компьютерах может входить в библиотеку совместимости с BSD.
4 Кроме бесплатных версий UNIX - Linux, FreeBSD, OpenBSD и NetBSD.
5 При наличии ANSI-компилятора С.
6 До выхода единой версии 5.005 существовало несколько разных версий Perl для Windows-систем,
включая стандартный порт, построенный по обычной поставке Perl, и ряд специализированных пор
тов. DB, как и большинство модулей CPAN, строится только в стандартной версии.
7 Зависит от поставщика.
8 Уменьшается при компиляции для одного метода доступа.
9 Зависит от поставщика.
10 По умолчанию, но может переопределяться (с потерей совместимости для старых файлов).
