PERL: БИБЛИОТЕКА ПРОГРАММИСТА

         

Строки

..И открыл легкомысленно уста свои, и безрассудно расточает слова.

Книга Иова, 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}



|| $ENV{LOGNAME}

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



Функция ord возвращает числа от 0 до 255. Этот диапазон соответствует типу данных unsigned char языка С.

О Смотри также--------------------------------------------------------------------------------------------

Описание функций 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 st net    ref s', потому что она запрещает символическое разы­менование.

Приведем пример:

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"



$big = "Vmittle";                   #   'bo peep' -> "BO PEEP"

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).



1.10. Интерполяция функций и выражений в строках

Проблема

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

Решение

Выражение можно разбить на отдельные фрагменты и произвести конкатенацию:

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. с



EVER_ON_AND_ON

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 символов. Перед



списком строк функции wrap передаются два аргумента: один определяет отступ первой строки абзаца, а второй — отступы всех последующих строк

Пример 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) — в этом случае вы вообще избегаете взаимодействия с интерпретатором.



$string = q(Mom said,   "Don't do that."), Sstnng =~ s/([

Две обратные косые черты в секции заменителя были использованы потому, что эта секция интерпретируется по правилам для строк в кавычках. Следовательно, чтобы получить одну обратную косую черту, приходится писать две. Приведем аналогичный пример для 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. Конечно, такой индекс не будет уникальным.



use Text::Soundex; use  User::pweht;

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

Программа из примера 1. 4 представляет собой фильтр, который заменяет все встречающиеся в тексте слова из первого столбца соответствующими элементами второго столбца.

При вызове без файловых аргументов программа выполняет функции просто­го фильтра. Если в командной строке передаются имена файлов, то в них помеща­ются результаты, а прежние версии сохраняются в файлах с расширениями *.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




Небольшое предупреждение: программа работает быстро, но не в тех случаях, когда количество замен измеряется сотнями. Чем больше секция DATA, тем боль­ше времени потребуется. Несколько десятков замен не вызовут существенного за­медления. Более того, для малого количества замен эта версия работает быстрее следующей. Но если запустить программу с несколькими сотнями замен, она нач­нет заметно отставать.

В примере 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.






В частности, нам хотелось бы иметь возможность обращаться с полноценными запросами к выводу программы или файлу журнала. Допустим, вы спрашиваете у ps: «Покажи мне все непривилегированные процессы размером больше 10Кб» или «Какие команды работают на псевдоконсолях?»

Программа 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

PPID PRI  NI  SIZE  RSS WCHAN    STA TTY TIME COMMAND

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*";

продолжение ¦&



Пример 1.6 (продолжение)

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
47
_ END FLAGS

100

140

100100 100140

I  I  I

STA TTY TIME COMMAND

UID О О 101
PID 1 187 428
PPID PRI
N1  SIZE   RSS WCHAN
0 1 1
О  0   760  432 do.select  S  ?  0:02 init О  0   784  452 do_select  S  ?  0: 02 syslogd О  0  1436  944 do.exit    S   1 0:00 /bin/ login

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
0  0  2964 2360 idetape_rea S  p2 0:06 trn 0  0  1412  926 setup_frame T  p3 0:00 ssh -C www
О 26560 26554 101 19058  9562
0  0  1076  572 setup_frame T  p2 0:00 less 0  0  1396  900 setup_frame T  p1 0:02 nvi / tmp/a В программе psgrep объединены многие приемы, представленные в книге. Об удалении начальных и конечных пропусков рассказано в рецепте 1.14. Преобра­зование позиций разреза в формат unpack для извлечения полей с фиксированным положением рассматривается в рецепте 1.1. Поиску регулярных выражений в строках посвящена вся глава 6. Многострочный текст, передаваемый die, представляет собой встроенный до­кумент (см. рецепты 1.10 и 1.11). Присваивание ©fields{©fieldnames} заносит сра­зу несколько величин в хэш %f ields. Хэши рассматриваются в рецептах 4.7 и 5.10. Входные данные программы-примера, расположенные под_ END       , описаны в рецепте 7.6. На стадии разработки для тестирования использовались «консерви­рованные» данные, полученные через файловый манипулятор DATA. Когда програм­ма заработала, мы перевели ее на получение данных из присоединенной команды ps, однако исходные данные были оставлены для будущего переноса на другие плат­формы и сопровождения. Конвейерный запуск других программ рассматривает-

ся в главе 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. Чтобы перенести ее в другую систему, посмотрите, в каких столб-



цах начинаются заголовки. Такой подход не ограничивается спецификой ps или системы UNIX. Это общая методика фильтрации входных записей с использова­нием выражений Perl, которая легко адаптируется для другой структуры записи. Поля могут быть выстроены в столбцы, разделены запятыми или заключены в скобки.

После небольшого изменения в функциях отбора программа даже подойдет для работы с пользовательской базой данных. Если у вас имеется массив записей (см. рецепт 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.






А если трудностей с целыми числами окажется недостаточно, числа с плаваю­щей запятой преподнесут целый букет новых проблем. Во внутреннем представ­лении дробные числа хранятся в формате с плавающей запятой. Они представ­ляют вещественные числа лишь приближенно, с ограниченной точностью. Для представления бесконечного множества вещественных чисел используется конеч­ное пространство, обычно состоящее из 64 бит или около того. Потеря точности неизбежна.

Числа, прочитанные из файла или встретившиеся в программе в виде литера­лов, преобразуются из десятичного представления (например, 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);



my $str = shift,

$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 и более, и вниз в противном случае.



$а = 0.255

$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

> Смотри также----

Описание функций sprintf и int в perlfunc(l); описание функций floor и ceil в документации по стандартному модулю POSIX. Методика использо­вания sprintf для округления представлена в рецепте 2.2.

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



2.5. Действия с последовательностями целых чисел

Проблема

Требуется выполнить некоторую операцию со всеми целыми между 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.



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;



return %dist;

# 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;



my Sradians = deg2rad($degrees), my $result= sin($radians),

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



В модуле Math:: Complex для вычисления логарифмов по произвольному осно­ванию существует функция logn(), поэтому вы можете написать:

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 недоступна или вы не хотите привлекать ее для столь тривиальной задачи, матрицы всегда можно перемножить вручную:



# mmult() и другие процедуры определены выше

$х = [

[ 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 "It took %d hour%s\n", $time, $time == 1 ? "" : "s";

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-разрядные) числа означают огромные интервалы.





В скалярном контексте localtime и gmtime возвращают дату и время, отформа­тированные в виде ASCII-строки:

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.



3.2. Преобразование полного времени в секунды с начала эпохи

Проблема

Требуется преобразовать дату/время, выраженные отдельными значениями дня, ме­сяца, юда и т. д. в количество секунд с начала эпохи.



Решение

Воспользуйтесь функцией 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.



3.7. Анализ даты и времени в строках

Проблема

Спецификация даты или времени читается в произвольном формате, однако ее требуется преобразовать в отдельные компоненты (год, месяц и т. д.).

Решение

Если дата уже представлена в виде числа пли имеет жесткий, легко анализируе­мый формат, воспользуйтесь регулярным выражением (и, возможно, хэшем, свя­зывающим названия месяцев с номерами) для извлечения отдельных значений дня, месяца и года. Затем преобразуйте их в секунды с начала эпохи с помощью функций 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-бодного терминала:



while (о) {

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'),



print "I have ", @array, " marbles \n'; print "I have @array marbles\n", I have redyellowgreen marbles. I have red yellow green marbles.

На самом деле вам нужна строка "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',



^people = qw(Crosby Stills Nash Young), what_about_that_array(),

Результат:

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),      й      .  предупредить о нарушении



Возможны и более сложные варианты. Команда last прерывает цикл, next пере­ходит к следующему элементу, a redo возвращается к первой команде внутри блока. Фактически вы говорите: «Нет смысла продолжать, это не то, что мне нужно» (next), «Я нашел то, что искал, и проверять остальные элементы незачем» (last) или «Я тут кое-что изменил, так что проверки и вычисления лучше выполнить заново» (redo).



Переменная, которой последовательно присваиваются все элементы списка, называется переменной цикла или итератором. Если итератор не указан, исполь­зуется глобальная переменная $_. Она используется по умолчанию во многих строковых, списковых и файловых функциях 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, не отсортирован в алфавитном или числовом порядке и не сохраняет поря­док вставки.






Ниже показано, как обрабатывать данные по мере ввода. Мы используем who' для получения сведений о текущем списке пользователей, а перед обновлением хэша извлекаем из каждой строки имя пользователя:

#  Построить список зарегистрированных пользователей с удалением дубликатов
%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 ),



splice(©members,   -2,   2,    А ,     Banana print    @members\n  ,

Результат выглядит так:

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 ,





Если нас интересует лишь значение индекса, можно сократить программу — достаточно вспомнить, что при неудачном поиске $i будет содержать недопусти­мый индекс. В основном экономится объем кода, а не время выполнения, посколь­ку затраты на присваивание невелики по сравнению с затратами на проверку элементов списка. Однако проверка условия if ($i < ©ARRAY) выглядит не­сколько туманно по сравнению с очевндной проверкой defined из приведенного выше решения.

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, читайте ее снизу вверх:



©strings: в конце указываются сортируемые данные. В данном случае это мас­сив, но как вы вскоре убедитесь, это может быть вызов подпрограммы или даже команда в обратных апострофах. Подходит все, что возвращает список для после­дующей сортировки.

тар: нижний вызов тар строит временный список анонимных массивов. Спи­сок содержит пары из предварительно вычисленного поля (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.



4.17. Случайная перестановка элементов массива

Проблема

Требуется случайным образом переставить элементы массива. Наиболее оче­видное применение — тасование колоды в карточной игре, однако аналогичная задача возникает в любой ситуации, где элементы массива обрабатываются в произвольном порядке.

Решение

Каждый элемент массива меняется местом с другим, случайно выбранным эле­ментом:

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 •

- вывод

данных по

столбцам

use strict,

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




Соответственно, выполнение операции для всех возможных перестановок за­нимает много времени. Сложность факториальных алгоритмов превышает коли­чество частиц во Вселенной даже для относительно небольших входных значе­ний. Факториал 500 больше, чем десять в тысячной степени!

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) {

продолжение




Пример 4.4 (продолжение)

}

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 хэш является встроенным ти­пом данных. Благодаря применению хэшей многие сложные алгоритмы сводятся к простой выборке значений. Кроме того, хэши предоставляют быстрые и удоб­ные средства для построения индексов и таблиц просмотра. Если для простой скалярной переменной применяется идентификатор типа $, а для массива — @, то для хэшей используется идентификатор %.

Префикс % относится лишь к ссылкам на хэш в целом. Значение ключа пред­ставляет собой скалярную величину, поэтому для него используется символ $ (по



аналогии с тем, как для ссылок на отдельный элемент массива используется пре­фикс $). Следовательно, отношение «начальник Ната» должно записываться в виде $boss{"Nat"}.

В обычных массивах используются числовые индексы, но индексы хэшей все­гда являются строковыми. Ассоциированные значения могут быть произвольны­ми скалярными величинами, в том числе ссылками. Используя ссылки в качестве ассоциированных значений, можно создавать хэши для хранения не только строк и чисел, но и массивов, других хэшей или объектов (вернее, ссылок на массивы, хэшп или объекты).

Хэши могут инициализироваться с помощью списков, содержащих пары «ключ/ значение»:

%аде = ( "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}).






Во внутренних алгоритмах хэширования Perl перестановки строки попадают на одну и ту же позицию Если в ключах хэша многократно встречаются переста­новки одной строки (скажем, spare и craps ), быстродействие хэша заметно падает На практике это происходит редко

> Смотри также---------------------------------------------------------------------------------------------

Раздел «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 $_



Замена неправильной строки следующим вызовом exists позволяет пропускать нулевые и несуществующие файлы:

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  "In insertion order,   the foods are'\n"; foreach $food  (keys %food_color)   { print '     $food\n";

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.



5.8. Инвертирование хэша

Проблема

Хэш связывает ключ с ассоциированным значением. У вас имеется хэш и значе­ние, для которого требуется определить ключ.

Решение

Воспользуйтесь функцией 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 для построения списка ключей, а затем отсорти­руйте их в нужном порядке:



# %hash - сортируемый хэш

@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 $substanceref (\%food_color,   \%dnnk_color  )  { while (($k,   $v) = each %substanceref)  { $substance_color{$k}  = $v,

Если в объединяемых хэшах присутствуют одинаковые ключи, можно вставить код для обработки дубликатов:

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}



Результат values %includes представляет собой анонимный массив, посколь­ку один файл может включать (и часто включает) сразу несколько других фай­лов. Мы используем тар для построения большого списка всех включенных фай­лов и удаляем дубликаты с помощью хэша.



> Смотри также---------------------------------------------------------------------------------------------

Рецепт 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 через du. Это позволяет вызвать dutree любым из приведенных ниже способов, а может быть, и иначе — если ваша вер­сия du поддерживает другие параметры.

% 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  {

продолжение



Пример 5.3 (продолжение)

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), },
}                                                      продолжение



Пример 5.4 (продолжение)

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). Подобные механизмы поиска гарантируют возврат не самого длинного общего совпадения, а лишь самого длинного левого совпаде-



ния. Можно считать, что жадность Perl проявляется лишь слева направо, а не в глобальном контексте.



Но дело не обязательно обстоит именно так. В следующем примере использу­ется 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 точка совпадает с \п — в обычных условиях этого не происходит. Кроме того, при поиске игнорируется значение устаревшей переменной $*. Модификатор /т приводит к тому, что " и $ совпадают в позициях до и после   \п   соответственно Он полезен в режиме



поглощения файлов, о котором говорится во введении к главе 8 «Содержимое файлов» и рецепте 6.6.

При наличии модификатора /е правая часть выполняется как программный код, и затем полученное значение используется в качестве заменяющей строки. Например, подстановка 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   Чтобы



повысить точность идентификации слов в строке, можно указать то, что окружа­ет слово. Как правило, указываются метасимволы границ1, а не пропусков:

/\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

Задача поиска последнего совпадения также встречается довольно часто Про­стейшее решение — пропустить все начало строки Например, после / *\b(\w+)\s+ f ish\b/ переменная $1 будет содержать слово, предшествующее последнему экземп­ляру   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();

Переменная $in_header будет истинной, начиная с первой входной строки и заканчивая пустой строкой, отделяющей заголовок от основного текста, — на­пример, в почтовых сообщениях, новостях Usenet и даже в заголовках HTTP (те­оретически строки в заголовках HTTP должны завершаться комбинацией CR/ LF, но на практике серверы относятся к их формату весьма либерально). Пере­менная $in_body становится истинной в момент обнаружения первой пустой строки и до конца файла. Поскольку интервальные операторы не перепроверяют начальное условие, остальные пустые строки (например, между абзацами) игно­рируются.

Рассмотрим пример. Следующий фрагмент читает файлы с почтовыми сооб­щениями и выводит адреса, найденные в заголовках. Каждый адрес выводится один раз. Заголовок начинается строкой "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).



6.9. Работа с универсальными символами командных интерпретаторов

Проблема

Вы хотите, чтобы вместо регулярных выражений 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.



Применяя модификатор /о, автор сценария гарантирует, что значения интер­полируемых в шаблоне переменных остаются неизменными, а если они все же



изменятся, Perl будет использовать прежние значения. Получив такие гарантии, Perl интерполирует переменную и компилирует шаблон лишь при первом поис­ке. Но если интерполированная переменная изменится, Perl этого не заметит. Применение модификатора к изменяющимся переменным даст неверный ре­зультат.

Модификатор /о в шаблонах без интерполированных переменных не дает ни­какого выигрыша в скорости. Кроме того, он бесполезен в ситуации, когда у вас имеется неизвестное количество регулярных выражений и строка должна пооче­редно сравниваться со всеми шаблонами Не поможет он и тогда, когда интерпо­лируемая переменная является аргументом функции, поскольку при каждом вы­зове функции ей присваивается новое значение.

В примере 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,

}

Как видите, получается что-то вроде строковых констант, вычисляемых eval. В текст включен весь цикл вместе с поиском по шаблону, что ускоряет работу программы.

Самое неприятное в таком решении — то, что правильно записать все строки и служебные символы довольно трудно. Функция 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



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

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.



6.14. Поиск от последнего совпадения

Проблема

Требуется возобновить поиск с того места, где было найдено последнее совпаде­ние.

Такая возможность пригодится при многократном извлечении фрагментов дан­ных из стрЪки.

Решение

Воспользуйтесь комбинацией модификатора /д, метасимвола \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".





Предположим, шаблон содержит максимальный квантификатор. При поиске подстроки, которая может встречаться переменное число раз (например, 0 и бо­лее раз для * или 1 и более раз для +), механизм поиска всегда предпочитает «и более». Следовательно, шаблон /foo *bar/ совпадает от первого "foo" до последне­го "bar", а не до следующего bar", как можно ожидать. Чтобы при поиске пред­почтение отдавалось минимальным, а не максимальным совпадениям, поставьте после квантификатора вопросительный знак. Таким образом, *9, как и *, соответ­ствует 0 и более повторений, но при этом выбирается совпадение минимальной, а не максимальной длины.



#  Максимальный поиск                               •*

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.



Поскольку для первого о* ищется максимальное совпадение, х растет до мак­симума. Замена одного или нескольких квантификаторов * на *9, + или +? дает другие решения:

(( о    х 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, который не совпадает или содержит несколько логически связанных шаблонов. Такая задача нередко возникает в про­граммах, читающих шаблоны из конфигурационных файлов.



Проблема с OR решается просто благодаря символу альтернативного выбо­ра |. Однако AND и OR потребуют особого кодирования.



В случае с 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

5:19pm    6days    0.43s    0.43s -tcsh 7:58am    3days  23.44s    0.44s -tcsh 2:01pm 13:36m    0.30s    0.30s -tcsh

Посмотрим, как поставленная задача решается с помощью приведенной выше программы 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+$//;



next unless $_;

$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;

# Глобальные переменные

продолжение



Пример 6.14 (продолжение)

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  «EOF
usage: $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;

продолжение



Пример 6.14 (продолжение)

##############

&{$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 из предыдущего примера. Манипулятор — это сим­волическое имя, которое представляет файл в операциях чтения/записи. Файло-



вые манипуляторы не являются переменными. В их именах отсутствуют префик­сы $, @ или %, однако они наряду с функциями и переменными попадают в сим­вольную таблицу Perl. По этой причине не всегда удается сохранить файловый манипулятор в переменной или передать его функции. Приходится использовать префикс *, который является признаком тип-глоба — базовой единицы символь­ной таблицы Perl:

$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 и








syscall, возвращающих -1). Системное сообщение или код ошибки хранится в переменной $1 и часто используется в die или сообщениях warn.

Для чтения записей в 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. Права доступа задаются в восьмеричной системе и учитыва-



ют текущее значение маски доступа (задаваемой функцией umask) процесса. В мас­ке доступа сброшенные биты соответствуют запрещенным правам. Например, если маска равна 027 (группа не может записывать; прочие не могут читать, за­писывать или выполнять), то вызов sysopen с параметром 066 создает файл с пра­вами 0640 (0666&-027 = 0640).



Если у вас возникнут затруднения с масками доступа, воспользуйтесь про­ стым советом: передавайте значение 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 вместо того, чтобы стереть пре­жнее содержимое.



Самое простое решение — воспользоваться функцией sysopen, у которой режим и имя файла передаются в разных аргументах:

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.



Манипулятор LOG не несет полезной информации, поскольку вы не знаете, с каким файлом он был связан. Если файловый манипулятор косвенно передается через имя файла, предупреждения и сообщения об ошибках Perl становятся более содержательными:

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.



7.6. Хранение данных в тексте программы

Проблема

Некоторые данные должны распространяться вместе с программой и интерпрети­роваться как файл, но при этом они не должны находиться в отдельном файле.

Решение

Лексемы_ 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))  {





warn "Can't open $ARGV:  $!\n";

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.



7.8. Непосредственная модификация файла с применением временной копии

Проблема

Требуется обновить содержимое файла на месте. При этом допускается примене­ние временного файла.

Решение

Прочитайте данные из исходного файла, запишите изменения во временный файл и затем переименуйте временный файл в исходный:

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 $_;



Обратите внимание: функция rename работает лишь в пределах одного каталога, поэтому временный файл должен находиться в одном каталоге с модифицируемым.

Программист-перестраховщик непременно заблокирует файл на время обнов­ления.

£> Смотри также-------------------------------------------------------------------------------------------

Рецепты 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!





print;
}
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{\).



7.10. Непосредственная модификация файла без применения временного файла

Проблема

Требуется вставить, удалить или изменить одну или несколько строк файла. При этом вы не хотите (или не можете) создавать временный файл.



Решение

Откройте файл в режиме обновления ("+<"), прочитайте все его содержимое в массив строк, внесите необходимые изменения в массиве, после чего перезапи­шите файл и выполните усечение до текущей позиции.

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) {       # Проверить версию Perl

my $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, вы тем самым разрешаете командную буферизацию.



На ввод она не влияет (небуферизованный ввод рассматривается в рецептах 15.6 и 15.8). Если $ | присваивается false, будет использоваться стандартная буфериза­ция stdio. Отличия продемонстрированы в примере 7.6.

Пример 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;



Snfound = select($rout=$rm,   undef,   undef,   0); if (Snfound)  {

# На одном или нескольких манипуляторах имеются входные данные

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";



$flags  |= O_NONBLOCK; fcntl(HANDLE,   F_SETFL,   Sflags)

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). Если вам удастся что-нибудь прочитать, вы узнае­те, столько байтов ожидало чтения, а если не удастся — значит, и читать нечего.

> Смотри также---------------------------------------------------------------------------------------------

Рецепт 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"; }

либо локализовать тип-глоб и использовать файловый манипулятор напрямую:



sub accept_fh  {

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

Подход, при котором print и pnntf интерпретируются как вызовы методов объекта, не работает для оператора о, поскольку это настоящий оператор, а не вызов функции с аргументом без запятых. Если тип-глобы сохранены в структу­ре, как это было сделано выше, то для чтения записей можно воспользоваться встроенной функцией readlme, работающей аналогично <>:

$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 "<&", ">&" и "+<&" решают эту задачу соответственно для чтения, за­писи и обновления. Режимы со знаком равенства ("<&=", ">&=" и "+<&=") работа­ют с дескрипторами более экономно, при этом почти всегда делается именно то,






что нужно. Дело в том, что они используют лишь функцию f dopen уровня С без системной функции dup2.

Если у вас установлена версия 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).



Вы получаете один файловый дескриптор с двумя буферами, доступ к которым осу­ществляется через два манипулятора. Закрытие одного манипулятора закрыва­ет дескрипторы синонимов, но не манипуляторы — если вы попытаетесь вызвать print для манипулятора с закрытым синонимом, Perl не выдаст предупреждения "print on closed filehandle", даже если вызов print закончится неудачей. Ко­роче говоря, попытки работать с файлом через оба манипулятора тоже наверняка приведут к катастрофе. Такая методика используется только для открытия фай­лового дескриптора по известному числовому значению (см. рецепт 7.19).

> Смотри также---------------------------------------------------------------------------------------------

Страница руководства 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 на базе стандартной библиотеки ввода/вывода С.



Что нельзя сделать с неструктурированным файлом? Поскольку вставка и удаление байтов возможны лишь в конце файла, вы не сможете вставить или уда­лить записи, а также изменить их длину. Исключение составляет последняя за­пись, которая удаляется простым усечением файла до конца предыдущей записи. В остальных случаях приходится использовать временный файл или копию фай­ла в памяти. Если вам приходится часто заниматься этим, вместо обычных фай­лов лучше подойдет база данных (см. главу 14 «Базы данных»).

Самый распространенный тип файлов — текстовые файлы, а самый распро­страненный тип операций с ними — построчное чтение и запись. Для чтения строк используется оператор о (или его внутренняя реализация, 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";



Для каждого файлового манипулятора отслеживается текущая позиция в файле. Операции чтения/записи выполняются именно в этой позиции, если при открытии не был указан флаг O_APPEND (см рецепт 7.1). Чтобы узнать текущую позицию файлового манипулятора, воспользуйтесь функцией tell, а чтобы за­дать ее — функцией seek. Поскольку стандартная библиотека ввода/вывода стремится сохранить иллюзию того, что \п является разделителем строк, вы не сможете обеспечить переносимый вызов seek для смещений, вычисляемых посредством подсчета символов. Вместо этого seek следует вызывать только для смещений, возвращаемых tell:

$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)

Вы хотите обработать текст, игнорируя внутренние разрывы строк. В приведен­ном примере первая запись занимает две строки, вторая — три строки и т. д.



Алгоритм работает следующим образом. Цикл while читает строки, которые могут быть, а могут и не быть полными записями, — они могут заканчиваться сим­волом \ (и переводом строки). Оператор подстановки s/// пытается удалить \ в конце строки. Если подстановка заканчивается неудачей, значит, мы нашли стро­ку без \. В противном случае мы читаем следующую запись, приписываем ее к накапливаемой переменной $line и возвращаемся к началу цикла while с помощью redo. Затем выполняется команда chomp.

У файлов такого формата имеется одна распространенная проблема — невиди­мые пробелы между \ и концом строки. Менее строгий вариант подстановки вы­глядит так:

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» или



«Nino». Помните об этом при выборе шаблона. В двух последних примерах вам придется включить в программу директиву use locale и использовать метасим­вол \w в текущем локальном контексте.



> Смотри также---------------------------------------------------------------------------------------------

Описание функции 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 обеспечива-



ет вызов reverse в списковом контексте, что, в свою очередь, обеспечивает спис­ковый контекст для оператора <FILE>. В списковом контексте о возвращает спи­сок всех строк файла.

Показанные решения легко распространяются на чтение абзацев, достаточно изменить значение $/:

# Внешний блок обеспечивает существование временной локальной копии $/ {

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).



8.6. Выбор случайной строки из файла

Проблема

Требуется прочитать из файла случайную строку.

Решение

Воспользуйтесь функцией 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);



Классическое применение функции split — извлечение данных, разделенных пропусками:



©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", как при выводе на терминал.



Но при чтении строк в таких системах происходят еще более странные вещи. Файл содержит "bad news\cM\cJ" — строку, состоящую из 10 байт. При чтении ваша программа не получит ничего, кроме "bad news\n", где "\п" — виртуальный символ перевода строки, то есть "\cJ". Следовательно, от него можно избавить­ся одним вызовом chop или chomp. Однако при этом приходится обманывать бед­ную программу и внушать ей, что из файла было прочитано всего 9 байт. Если про­читать 10 таких строк, она будет полагать, что из файла было прочитано 90 байт, хотя в действительности смещение будет равно 100. Из-за этого для определения текущей позиции всегда следует использовать функцию tell. Простой подсчет прочитанных байтов не подходит.

Такое наследие старой файловой системы СР/М, в которой хранились лишь сведения о количестве блоков, но не о размере файлов, бесит программистов уже несколько десятилетий, и конца-края этому не видно. Ведь 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. $' ';



read(FH SBUFFER, $RECSIZE) == SRECSIZE

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)

продолжение ¦&



Пример 8.5 (продолжение)

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

ч

Вычисленная двоичная структура (в нашем примере — s x2 i A12 А2 х2 1 А8 А16 1 ) передается pack с пустым списком полей для определения размера за­писи. Не забудьте проверить код возврата read при чтении записи, чтобы убе­диться в том, что вы получили запрошенное количество байт.

Если записи представляют собой текстовые строки, используйте шаблон рас­паковки   а   или   А .

Записи фиксированной длины хороши тем, что n-я запись начинается в фай­ле со смещения SIZE*(n-1), где SIZE — размер одной записи. Пример приведен в программе с построением индекса из рецепта 8.8.

> Смотри также---------------------------------------------------------------------------------------------

Описание функций unpack, pack и read в perlfunc(l), рецепт 1.1.



8.16. Чтение конфигурационных файлов

Проблема

Вы хотите, чтобы пользователи вашей программы могли изменить ее поведение с помощью конфигурационного файла.



Решение

Организуйте обработку файла в тривиальном формате ПЕРЕМЕННАЯ=ЗНАЧЕНИЕ, созда­ вая для каждого параметра элемент хэша «ключ/значение»:

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, способным воздействовать на вы­зывающую сторону.



Если столь четкое разграничение видимости переменных нежелательно, вы можете заставить код конфигурационного файла выполняться в вашей лексичес­кой области действия. Имея под рукой программу cat или ее эквивалент, можно написать доморощенный аналог do:

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 Если другие имеют право записи



return 0 unless -d _;     it He-каталоги недостоверны

# но каталоги с битом запрета (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 — игнорировать прерывания,



-а — дописывать данные в конец выходных файлов,

-и — выполнять небуферизованный вывод,

-п — отменить копирование выходных данных в стандартный вывод.



Поскольку в программе используется «волшебная» функция open, вместо фай­лов можно передавать каналы:

% someprog  |  tctee f1  " | cat -n'   f2 "»f3"

В примере 8.8 приведена программа-ветеран, написанная на Perl почти 10 лет назад и работающая до сих пор. Если бы нам пришлось писать ее заново, вероят­но, мы бы использовали strict, предупреждения и модули с десятками тысяч строк. Но как известно, «лучшее — враг хорошего».

Пример 8.8. tctee

#'/usr/bin/perl

#  tctee - клон tee

#  Программа совместима с perl версии 3 и выше.

while ($ARGV[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, операционная система читает индексный узел /, находит в его блоках данных информацию o/usr, читает индексный узел /usr, находит в его блоках данных информацию о /usr/bin, читает индексный узел /usr/bin, находит в его блоках данных информацию о /usr/bin/vi, читает индексный узел /usr/bin/vi, после чего читает данные из блока данных.

Имена, хранящиеся в каталогах, не являются полными. Файл /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 и для откры­того файла, но дисковое пространство будет освобождено лишь после его закры­тия последним процессом.

Ссылки делятся на два типа. Тип, описанный выше (два элемента каталога, в которых указан один номер индексного узла), называется прямой (или жесткой)



ссылкой (hard link). Операционная система не может отличить первый элемент каталога, соответствующий файлу (созданный при создании файла), от всех по­следующих ссылок на него. Со ссылками другого типа — символическими ссылка­ми — дело обстоит совершенно иначе. Символические ссылки представляют со­бой файлы особого типа: в блоке данных хранится имя файла, на который указывает ссылка. Символические ссылки имеют особое значение mode, отличающее их от обычных файлов. При вызове open для символической ссылки операционная сис­тема открывает файл, имя которого указано в блоке данных.



Резюме

Имена файлов хранятся в каталогах отдельно от размера, атрибутов защиты и прочих метаданных, хранящихся в индексном узле.

Функция 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

$'

Sblksize = (stat IN)[11]  jj   16384,                    # Желательный размер блока?

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.



9.4. Распознавание двух имен одного файла

Проблема

Требуется узнать, соответствуют ли два имени файла из списка одному и тому же файлу на диске (благодаря жестким и символическим ссылкам два имени могут ссылаться на один файл). Такая информация поможет предотвратить модифи­кацию файла, с которым вы уже работаете.

Решение

Создайте хэш, кэшируемый по номеру устройства и индексного узла для уже встречавшихся файлов. В качестве значений хэша используются имена файлов:

%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";






closedir(BIN);

Мы проверяем $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);







То же самое можно сделать и с помощью модуля DirHandle-

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] }

#

Числовая сортировка

имен

#

Каталоги

_ ] }

#

Сформировать (имя,

путь)

й

Только числа

#

Все файлы

@dirs = map    { $_->[1] }

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 ,



Переменные $saved_size и $ saved_name используются для хранения имени и размера самого большого файла. Если мы находим файл, размер которого пре­вышает размер самого большого из просмотренного до настоящего момента, сохраненное имя и размер заменяются новыми значениями. После завершения работы find выводится имя и размер самого большого файла в весьма подроб­ном виде. Вероятно, более практичная программа ограничится выводом имени файла, его размера или и того и другого. На этот раз мы воспользовались име­нованной функцией вместо анонимной, поскольку она получилась относительно большой.

Программу нетрудно изменить так, чтобы она находила файл, который изме­нялся последним:

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, гарантирующую перебор всех внутренних файлов перед посещением самого каталога. Именно этот вариант поведения использован нами для удаления каталога вместе с содержимым.



У нас есть две функции, rmdir и unlink. Функция unlink удаляет только фай­лы, a rmdir — только пустые каталоги. Мы должны использовать 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

512 Fri May 29 10:42:41 1998

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) {

продолжение &



Пример 9.7 (продолжение)

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(),



$him = whowasiO,

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 undef,undef $uid)   =  stat($filename)

Также можно создать срез и включить в него лишь интересующие вас значения:

($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 в некоторых ситуациях возвращают строку



"О but true" (для удобства эта волшебная строка была изъята из бесчисленных предупреждений об ошибках преобразования флага -w). Появляется возмож­ность использовать конструкции следующего вида:

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.



10.13. Сохранение глобальных значений

Проблема

Требуется временно сохранить значение глобальной переменной.

Решение

Воспользуйтесь оператором 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 манипулирует значениями






глобальных, а не локальных переменных, директива use st net ни к чему хороше­му не приведет.

Оператор 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



Если значение, присваиваемое тип-глобу, представляет собой не ссылку, а дру­гой тип-глоб, то замена распространяется на все типы с данным именем. Полное присваивание тип-глоба относится к скалярным величинам, массивам, хэшам, функциям, файловым манипуляторам, манипуляторам каталогов и форматам. Следовательно, присваивание *Тор = «Bottom сделает переменную $Тор текуще­го пакета синонимом для $Bottom, @Тор — для @Bottom, %Тор — для %Bottom и &Тор — для &Bottom. Замена распространяется даже на соответствующие манипуляторы файлов и каталогов и форматы! Вероятно, это окажется лишним.



Присваивание тип-глобов в сочетании с замыканиями позволяет легко и удоб­ но дублировать функции. Представьте, что вам понадобилась функция для гене­рации 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'>

Функции кажутся независимыми, однако фактически код был откомпилиро­ван лишь один раз. Подобная методика экономит время компиляции и память. Для создания полноценного замыкания все переменные анонимной подпрограм­мы должны быть лексическими. Именно поэтому переменная цикла объявляется с ключевым словом ту.

Перед вами одна из немногочисленных ситуаций, в которых создание прото­типа для замыкания оправдано. Если вам захочется форсировать скалярный кон­текст для аргументов этих функций (вероятно, не лучшая идея), ее можно запи­сать в следующем виде:



.$name = sub ($) { '^FONT COLOR='$name'>$_[0]</F0NT>" };

Однако прототип проверяется во время компиляции, поэтому приведенное выше присваивание произойдет слишком поздно и никакой пользы не принесет. Следовательно, весь цикл с присваиваниями следует включить в 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.



Методика с присваиваниями тип-глобов из рецепта 10.14 быстрее и удобнее. Быстрее — поскольку вам не приходится запускать копию и заниматься подста­новками. Удобнее — поскольку вы сможете делать следующее:

{

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, поэтому используется вторая часть | |, в которой номера со­общений сравниваются в порядке их исходного следования.



Если функции sort передается список (0,1,2,3), после сортировки будет полу­чена некоторая перестановка — например, (2,1,3,0). Мы перебираем элемен­ты списка в цикле f о г и выводим каждое сообщение.

В примере 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.



Приведенный выше пример с $$sref можно переписать в виде:

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];






print  $a[4][23][53]; ARRAY(0x81e2494) print $a[4][23]; ARRAY(0x81e0748) print $a[4]; ARRAY(0x822cd40)

В следующей таблице перечислены способы создания ссылок для именован­
ных и анонимных скалярных величин, массивов, хэшей и функций. Анонимные
тип-глобы выглядят слишком страшно и практически никогда не используются.
Вместо них следует применять 10: :Handle->new().
Ссылка на                             Именованный субъект             Анонимный субъект

Скалярная величина

\$scalar

Массив

\@array

Хэш

\%hash

Функция

\&function

\do{my $anon}
{ СПИСОК }
{ СПИСОК }
_______________________________________________________________ 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{$key} помещает­ся ссылка на массив, содержащий значения $кеу. Все стандартные операции с хэшами (вставка, удаление, перебор и проверка существования) могут комбини­роваться с операциями массивов (push, splice и foreach).

Присвоение ключу нескольких значений осуществляется следующим об­разом:

$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,

0

1

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.






Каждый вызов timestamp генерирует и возвращает новую функцию. Функция timestamp создает лексическую переменную $start_time, которая содержит теку­щее время (в секундах с начала эпохи). При каждом вызове замыкания оно воз­вращает количество прошедших секунд, которое определяется вычитанием на­чального времени из текущего.

> Смотри также---------------------------------------------------------------------------------------------

Описание замыканий в 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

Комментарий

В следующих примерах предполагается, что @аггау — простой массив, содержа­щий ссылки на скаляры (не путайте массив ссылок со ссылкой на массив). При косвенных обращениях к данным необходимы фигурные скобки.






($а,  $b,   $c,   $d) = (1  ..  4);                    # Инициализировать

©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",

$d->{NEXT}->(); # 21

$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, а затем инициализировать и использовать его следующим образом:



#  Сохранить запись

$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  "$key  $record->{$key}\n'; }

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'



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

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:

pre_order($root); print "\n"; in_order($root); print "\n"; post_order($root); print "\n";

# Запрашивать до получения 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 является объявлением, обрабатываемым на стадии компиляции. Оно устанавливает префикс пакета по умолчанию для неполных глобальных идентификаторов, по аналогии с тем, как chdir устанавливает пре­фикс каталога по умолчанию для относительных путей. Влияние package распро­страняется до конца текущей области действия (блока в фигурных скобках, фай­ла или eval) или до ближайшей команды package в той же области действия (см. следующий фрагмент). Все программы выполняются в пакете mam, пока коман­дой package в них не будет выбран другой пакет.

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.

До настоящего времени мы рассматривали лишь традиционные модули, кото­рые экспортируют свой интерфейс, предоставляя вызывающей стороне прямой доступ к некоторым подпрограммам и переменным. К этой категории относится



большинство модулей. Но некоторые задачи — и некоторые программисты — свя­зываются с хитроумными модулями, содержащими объекты. Объектно-ориенти­рованный модуль редко использует механизм импортирования/экспортирования. Вместо этого он предоставляет объектно-ориентированный интерфейс с конструк­торами, деструкторами, методами, наследованием и перегрузкой операторов. Дан­ная тема рассматривается в главе 13.

Пользуйтесь готовыми решениями

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

Массив содержит список функций и переменных, экспортируемых в про­странство имен вызывающей стороны, чтобы в дальнейшем к ним можно было



обращаться без уточнения имени пакета. Обычно используется список в фор­ме qw():

(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





для переменной. Команда добавляет расширение .рт и преобразует : : в раздели­тель каталогов вашей операционной системы — в каноническом варианте / (как в URL), но в некоторых системах используются \, : и даже .  .

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

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. Первая функция пере­ставляет слова строки в обратном порядке, а вторая изменяет определение гра­ницы слова.



# Flipper, pm package Flipper; use strict;

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 $@;



Такой подход работает лишь в том случае, если переменная $Ппе является гло­бальной. Для лексических переменных он не годится. Обходное решение — сде­лать так, чтобы функция runit принимала ссылку на функцию:

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:  $!";



Первая часть кода, не входящая в объявления функций, выполняется во время загрузки модуля. Для этого от пользователя модуля не потребуется никаких спе­циальных действий. Впрочем, для кого-нибудь это может оказаться неприятным сюрпризом, поскольку при недоступности журнала die вызовет сбой при выпол­нении use или require.

Блоки 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. Этот вари­ант удобен для простых командных строк и потому может использоваться на уров­не отдельных команд (например, при вызове простой однострочной программы из сценария командного интерпретатора).

Подобную методику не следует использовать в строках #!. Во-первых, редак­тировать каждую программу в системе скучно. Во-вторых, в некоторых старых





операционных системах имеются ошибки, связанные с ограничением длины этой строки (обычно 32 символа, включая #! ). В этом случае очень длинный путь (на­пример, #/opt/languages/free/extrabits/perl) приведет к появлению таинствен­ной ошибки "Command not found". Perl пытается заново просканировать строку, но этот механизм недостаточно надежен и полагаться на него не стоит.



Нередко самое удачное решение заключается в использовании переменной ок­ружения 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. Следовательно, нам потребуется



дополнительный подкаталог Astronomy, в котором будет размещаться каталог Orbits. Приведем первую и, вероятно, самую важную строку Orbits.pm:

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, которая возвра­щает целое количество секунд, другой, возвращающей вещественное число. Для



этого можно создать модуль FineTime с необязательным экспортированием функ­ции 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.



12.13. Косвенные ссылки на пакеты

Проблема

Требуется сослаться на переменную или функцию в пакете, имена которых неизве­стны до момента выполнения программы, однако синтаксис 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);



eval  "sub ${packname}::log$i  {  log(shift) / $logN  }"; die if $@; >

По крайней мере в данном случае это не нужно. Следующий фрагмент делает то же самое, но вместо того, чтобы компилировать новую функцию 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 sys/syscall.h

Однако многие заголовочные файлы включают другие заголовочные файлы; иными словами, придется преобразовать Их все:

% 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;



Make автоматически преобразует файл FineTimexs в FineTime.c и общую биб­лиотеку, которая на большинстве платформ будет называться FineTvmejso. Преобра­зование выполняется утилитой xsubpp, описанной в ее собственной странице руко­водства nperlxstut(l). Xsubpp автоматически вызывается в процессе построения.

Кроме хороших познаний в С, вы также должны разбираться в интерфейсе 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 обнаруживает строку, начинаю­щуюся со знака = (там, где ожидается новая команда), он игнорирует весь текст до строки, начинающейся с =cut, после чего продолжает анализировать код. Это по­зволяет смешивать в программах или файлах модулей Perl код и документацию. Поскольку формат 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;



@ISA      = qw(Exporter);

@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;



12.19. Программа: поиск версий и описаний установленных модулей

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!,       # Сортировка данных по каждому каталогу
);

продолжение ё>



Пример 12.3 (продолжение)

$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;



# Вычислить имя модуля по файлу и каталогу sub modname {

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;

продолжение



Пример 12.3 (продолжение)

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() в качестве вто­рого аргумента.






В рецепте 13. 1 также рассматриваются функции, возвращающие приведенные ссылки. Конструкторы не обязаны быть методами класса. Также встречаются ме­тоды объектов, возвращающие новые объекты (см. рецепт 13.6).

Деструктором называется функция, которая выполняется при уничтожении субъекта, соответствующего данному объекту, в процессе сборки мусора. В отли­чие от конструкторов имена деструкторов жестко фиксируются. Методу-дест­руктору должно быть присвоено имя 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{\).                        ,         ,



13.9. Создание класса с поддержкой наследования

Проблема

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

Решение

Воспользуйтесь «проверкой пустого субкласса».

Комментарий

Допустим, вы реализовали класс 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 полностью воспроизводилось в Emp­loyee.

Создание подобных пустых классов называется «проверкой пустого субклас­са»; иначе говоря, мы создаем производный класс, который не делает ничего, кро­ме наследования от базового. Если базовый класс спроектирован нормально, то производный класс в точности воспроизведет его поведение. Это означает, что при простой замене имени класса все остальное будет работать:

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.



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 будет проверять, присутствует ли в хэше запрашиваемое поле.



package Person;

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). Поскольку объект является всего лишь высокоуровневым представлением обычного машинного адреса, во многих ситу­ациях требуется определить собственный критерий того, что следует понимать под равенством двух объектов.

Даже для нечисловых классов особенно часто перегружаются два оператора: сравнения и строковой интерполяции. Допускается перегрузка как оператора <=>, так и стр, хотя преобладает второй вариант. После того как для объекта будет



определен оператор <=>, вы также сможете использовать операторы ==, ! =, <, <=, > и >= для сравнения объектов. Если отношения порядка нежелательны, огра­ничьтесь перегрузкой ==. Аналогично, перегруженная версия стр используется в It, gt и других строковых сравнениях лишь при отсутствии их явной перегрузки.

Оператор строковой интерполяции обозначается странным именем "" (две ка­вычки). Он вызывается каждый раз, когда происходит строковое преобразова­ние — например, внутри кавычек или апострофов или при вызове функции 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

=>

\&divide,

<=>¦

=>

\&spaceship,

=>

\&as_string,

•o+-

=>

\&as_number;

sub add {

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.




Выполняемый код






¦$s = Ю

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, не­сколько отличающиеся друг от друга).



Пример 13.5. Tie::AppendHash

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!!" ];

while ( my($k, $v) = each %tab ) {

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

Нет

Нет

Произвольный порядок байтов

Нет

Нет

Нет

Да

Порядок сортировки, определяемый

Нет

Нет

Нет

Да

пользователем

Поиск по неполному ключу

Нет

Нет

Нет

Да

1   Применение кода с общей лицензией GPL в программах должно удовлетворять некоторым условиям.
За дополнительной информацией обращайтесь на 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    По умолчанию, но может переопределяться (с потерей совместимости для старых файлов).



NDBM присутствует в большинстве систем семейства BSD. GTDBM представ­ляет собой GNU-реализацию DBM. SDBM входит в поставку XII и в стандарт­ную поставку