Автор: Кристиансен Т. Торкингтон Н.
Теги: компьютерные технологии программирование языки программирования
ISBN: 5-94723-855-1
Год: 2004
Текст
Решения и примеры
для программистов Perl
Сборник рецептов
ДЛЯ ПРОФЕССИОНАЛОВ
O’REILLY®
ПИТЕР
Том Кристиансен
Натан Торкингтон
Perl Cookbook
Second Edition
Tom Christiansen and Nathan Torkington
O’REILLY®
Beijing • Cambridge • Farnham • Koln • Paris • Sebastopol • Taipei • Tokyo
Perl. Сборник рецептов
ДЛЯ ПРОФЕССИОНАЛОВ
2-е издание
Том Кристиансен, Натан Торкингтон
^ППТЕР
Москва • Санкт-Петербург Нижний Новгород Воронеж
Ростов-на-Дону • Екатеринбург Самара • Новосибирск
Киев • Харьков • Минск
2004
Т. Кристиансен, Н. Торкингтон
Perl. Сборник рецептов. Для профессионалов
2-е издание
Перевел с английского Е. Матвеев
Главный редактор
Заведующий редакцией
Руководитель проекта
Литературный редактор
Художник
Корректоры
Верстка
Е. Строганова
И. Корнеев
А. Крузенштерн
А. Пасечник
Н. Биржаков
С. Беляева, И. Смирнова
Р. Гришанов
ББК 32.973-018.1
УДК 681.3.06
Кристиансен Т., Торкингтон Н.
К82 Perl. Сборник рецептов. Для профессионалов. 2-е изд. — СПб.: Питер, 2004. —
928 с.: ил.
ISBN 5-94723-855-1
Обширный сборник задач, решений и практических примеров для всех программистов Perl.
Книга содержит сотни тщательно проанализированных «рецептов» по всем основным областям
программирования: обработка данных (строки, числа, даты, массивы и хэши), поиск по образцу и
замена текста; ссылки, структуры данных, объекты и классы; сигналы и исключения и т. д.
Второе издание книги было дополнено двумя новыми главами. Одна глава посвящена mod_perl,
интегрированному интерпретатору Perl веб-сервера Apache, а другая — обработке данных в фор-
мате XML. Многие старые рецепты в других главах были изменены или дополнены.
Книга рассчитана на программистов, обладающих опытом работы на Perl.
© 2003, 1998 O'Reilly & Associates, Inc.
© Перевод на русский язык, ЗАО Издательский дом «Питер», 2004
© Издание на русском языке, оформление, ЗАО Издательский дом «Питер», 2004
Права на издание получены по соглашению с O'Reilly.
Все права защищены. Никакая часть данной книги не может быть воспроизведена в какой бы то ни было
форме без письменного разрешения владельцев авторских прав.
Информация, содержащаяся в данной книге, получена из источников, рассматриваемых издательством как на-
дежные. Тем не менее, имея в виду возможные человеческие или технические ошибки, издательство не может
гарантировать абсолютную точность и полноту приводимых сведений и не несет ответственности за возмож-
ные ошибки, связанные с использованием книги.
ISBN 5-94723-855-1
ISBN 0-596-00313-7 (англ.)
ООО «Питер Принт». 196105, Санкт-Петербург, ул. Благодатная, д. 67в.
Лицензия ИД № 05784 от 07.09.01.
Налоговая льгота — общероссийский классификатор продукции ОК 005-93, том 2; 953005 — литература учебная.
Подписано в печать 17.04.04. Формат 70X100/16. Усл. п. л. 74,82. Тираж 3000 экз. Заказ № 2378.
Отпечатано с готовых диапозитивов в ФГУП «Печатный двор» им. А. М. Горького Министерства РФ
по делам печати, телерадиовещания и средств массовых коммуникаций.
197110, Санкт-Петербург, Чкаловский пр., 15.
Краткое содержание
Предисловие.....................................................18
Введение...........................................................20
Глава 1. Строки....................................................32
Глава 2. Числа.....................................................92
Глава 3. Время и дата...........................................123
Глава 4. Массивы................................................143
Глава 5. Хэши...................................................184
Глава 6. Поиск по шаблону.......................................213
Глава 7. Доступ к файлам .......................................273
Глава 8. Содержимое файлов......................................334
Глава 9. Каталоги ..............................................380
Глава 10. Процедуры..............................................407
Глава 11. Ссылки и записи........................................441
Глава 12. Пакеты, библиотеки и модули............................477
Глава 13. Классы, объекты и связи................................532
Глава 14. Базы данных ...........................................581
Глава 15. Интерактивность .......................................615
Глава 16. Управление процессами и межпроцессные взаимодействия . . . 653
Глава 17. Сокеты................................................703
Глава 18. Протоколы Интернета...................................749
Глава 19. Программирование CGI..................................785
Глава 20. Автоматизация в Веб...................................821
Глава 21. mod_perl .............................................856
Глава 22. XML...................................................889
Алфавитный указатель............................................922
Содержание
Предисловие..............................................................18
Введение.................................................................20
О чем рассказано в этой книге.........................................21
Что нового в этом издании ............................................23
Платформы.............................................................24
Условные обозначения, использованные в книге.........................25
Благодарности для первого издания....................................27
Благодарности для второго издания....................................30
От издательства......................................................31
Глава 1. Строки..........................................................32
1.0. Введение.........................................................32
1.1. Работа с подстроками.............................................38
1.2. Выбор значения по умолчанию......................................41
1.3. Перестановка значений без использования временных переменных.....44
1.4. Преобразование между символами и ASCII-кодами....................45
1.5. Использование именованных символов Юникода.......................47
1.6. Посимвольная обработка строк.....................................48
1.7. Обратная перестановка слов или символов..........................51
1.8. Интерпретация комбинированных символов Юникода
как одиночных символов................................................52
1.9. Приведение строк с комбинированными символами Юникода
к каноническому виду..................................................54
1.10. Интерпретация строки Юникода как последовательности октетов.....55
1.11. Расширение и сжатие символов табуляции..........................57
1.12. Расширение переменных во входных данных.........................58
1.13. Преобразование регистра.........................................60
1.14. Расстановка прописных букв в заголовках.........................62
1.15. Интерполяция функций и выражений в строках......................65
1.16. Отступы во встроенных документах................................67
1.17. Переформатирование абзацев......................................71
1.18. Экранирование символов..........................................73
1.19. Удаление пропусков в обоих концах строки........................75
1.20. Анализ данных, разделенных запятыми.............................77
Содержание
7
1.21. Константы.......................................................80
1.22. Сравнение слов с похожим звучанием..............................82
1.23. Программа: fixstyle.............................................84
1.24. Программа: psgrep...............................................87
Глава 2. Числа..........................................................92
2.0. Введение........................................................92
2.1. Проверка строк на соответствие числам...........................93
2.2. Округление чисел с плавающей запятой............................96
2.3. Сравнение вещественных чисел...................................100
2.4. Действия с последовательностями целых чисел....................101
2.5. Работа с числами в римской записи..............................103
2.6. Генератор случайных чисел......................................104
2.7. Получение повторяющихся серий случайных чисел .................105
2.8. Повышение фактора случайности..................................106
2.9. Получение случайных чисел с неравномерным распределением.......107
2.10. Выполнение тригонометрических вычислений в градусах............110
2.11. Тригонометрические функции.....................................111
2.12. Вычисление логарифмов..........................................112
2.13. Умножение матриц...............................................113
2.14. Операции с комплексными числами................................115
2.15. Преобразования двоичных, восьмеричных и шестнадцатеричных чисел . . . 116
2.16. Вывод запятых в числах.........................................118
2.17. Правильный вывод во множественном числе........................119
2.18. Программа: разложение на простые множители.....................121
Глава 3. Время и дата..................................................123
3.0. Введение.......................................................123
3.1. Определение текущей даты.......................................126
3.2. Преобразование полного времени в секунды с начала эпохи........127
3.3. Преобразование секунд с начала эпохи в полное время............128
3.4. Операции сложения и вычитания для дат..........................129
3.5. Вычисление разности между датами...............................130
3.6. Определение номера недели или дня недели/месяца/года...........132
3.7. Анализ даты и времени в строках................................133
3.8. Вывод даты.....................................................135
3.9. Таймеры высокого разрешения....................................136
3.10. Короткие задержки..............................................139
3.11. Программа: hopdelta............................................140
Глава 4. Массивы.......................................................143
4.0. Введение.......................................................143
4.1. Определение списка в программе.................................144
4.2. Вывод списков с запятыми.......................................146
4.3. Изменение размера массива......................................148
4.4. Реализация разреженного массива................................150
8
Содержание
4.5. Выполнение операции с каждым элементом списка..................152
4.6. Перебор массива по ссылке......................................155
4.7. Выборка уникальных элементов из списка.........................156
4.8. Поиск элементов одного массива, отсутствующих в другом массиве.158
4.9. Вычисление объединения, пересечения и разности уникальных списков . . 161
4.10. Присоединение массива..........................................163
4.11. Обращение массива..............................................164
4.12. Обработка нескольких элементов массива.........................165
4.13. Поиск первого элемента списка, удовлетворяющего некоторому критерию 167
4.14. Поиск всех элементов массива, удовлетворяющих определенному критерию 170
4.15. Числовая сортировка массива....................................171
4.16. Сортировка списка по вычисляемому полю.........................172
4.17. Реализация циклических списков.................................176
4.18. Случайная перестановка элементов массива.......................177
4.19. Программа: words...............................................178
4.20. Программа: permute.............................................180
Глава 5. Хэш и ........................................................184
5.0. Введение.......................................................184
5.1. Занесение элемента в хэш.......................................186
5.2. Проверка наличия ключа в хэше..................................187
5.3. Создание хэша с неизменяемыми ключами или значениями...........189
5.4. Удаление из хэша...............................................190
5.5. Перебор хэша...................................................191
5.6. Вывод содержимого хэша.........................................194
5.7. Перебор элементов хэша в порядке вставки.......................195
5.8. Хэши с несколькими ассоциированными значениями.................196
5.9. Инвертирование хэша............................................198
5.10. Сортировка хэша................................................200
5.11. Объединение хэшей..............................................201
5.12. Поиск общих или различающихся ключей в двух хэшах..............203
5.13. Хэширование ссылок.............................................204
5.14. Предварительное выделение памяти для хэша......................205
5.15. Поиск самых распространенных значений..........................206
5.16. Представление отношений между данными .........................206
5.17. Программа: dutree..............................................208
Глава 6. Поиск по шаблону..............................................213
6.0. Введение.......................................................213
6.1. Копирование с подстановкой ....................................219
6.2. Идентификация алфавитных символов..............................220
6.3. Поиск слов.....................................................222
6.4. Комментирование регулярных выражений...........................223
6.5. Поиск N-ro совпадения .........................................227
Содержание
9
6.6. Межстрочный поиск...............................................229
6.7. Чтение записей с разделением по шаблону.........................232
6.8. Извлечение строк из определенного интервала.....................233
6.9. Работа с метасимволами командных интерпретаторов................236
6.10. Ускорение интерполированного поиска............................238
6.11. Проверка правильности шаблона..................................240
6.12. Локальный контекст в регулярных выражениях.....................242
6.13. Неформальный поиск.............................................243
6.14. Поиск от последнего совпадения.................................244
6.15. Максимальный и минимальный поиск...............................246
6.16. Поиск повторяющихся слов.......................................249
6.17. Поиск вложенных конструкций....................................252
6.18. Логические операции AND, OR и NOT в одном шаблоне..............254
6.19. Проверка адресов электронной почты.............................259
6.20. Поиск сокращений...............................................260
6.21. Программа: urlify..............................................262
6.22. Программа: tcgrep..............................................263
6.23. Копилка регулярных выражений...................................270
Глава 7. Доступ к файлам...............................................273
7.0. Введение........................................................273
7.1. Открытие файла..................................................281
7.2. Открытие файлов с нестандартными именами........................285
7.3. Тильды в именах файлов..........................................287
7.4. Имена файлов в сообщениях об ошибках............................288
7.5. Сохранение файловых манипуляторов в переменных..................289
7.6. Написание процедуры, получающей файловые манипуляторы...........293
7.7. Кэширование открытых манипуляторов вывода ......................294
7.8. Одновременный вывод по нескольким манипуляторам.................295
7.9. Открытие и закрытие файловых дескрипторов.......................296
7.10. Копирование файловых манипуляторов.............................298
7.11. Создание временных файлов......................................299
7.12. Хранение данных в тексте программы.............................301
7.13. Сохранение нескольких файлов в области DATA....................302
7.14. Создание фильтра...............................................305
7.15. Непосредственная модификация файла с применением временной копии 309
7.16. Непосредственная модификация файла с помощью параметра -i......310
7.17. Непосредственная модификация файла без применения временного файла 312
7.18. Блокировка файла...............................................313
7.19. Очистка буфера.................................................316
7.20. Асинхронный ввод/вывод.........................................319
7.21. Определение количества читаемых байтов.........................320
7.22. Асинхронное чтение из нескольких манипуляторов.................322
10
Содержание
7.23. Асинхронное чтение полной строки................................324
7.24. Программа: netlock..............................................326
7.25. Программа: lockarea.............................................329
Глава 8. Содержимое файлов..............................................334
8.0. Введение........................................................334
8.1. Чтение строк с символами продолжения............................340
8.2. Подсчет строк (абзацев, записей) в файле........................341
8.3. Обработка каждого слова в файле.................................343
8.4. Чтение файла по строкам или абзацам в обратном направлении......344
8.5. Чтение из дополняемого файла....................................346
8.6. Выбор случайной строки из файла.................................348
8.7. Случайная перестановка строк....................................349
8.8. Чтение строки с конкретным номером..............................350
8.9. Обработка текстовых полей переменной длины......................352
8.10. Удаление последней строки файла.................................353
8.11. Обработка двоичных файлов ......................................354
8.12. Ввод/вывод с произвольным доступом..............................355
8.13. Обновление файла с произвольным доступом........................356
8.14. Чтение строки из двоичного файла................................357
8.15. Чтение записей фиксированной длины..............................359
8.16. Чтение конфигурационных файлов..................................360
8.17. Проверка достоверности файла....................................363
8.18. Интерпретация файла как массива.................................365
8.19. Назначение уровней ввода/вывода ................................367
8.20. Чтение и запись Юникода через файловый манипулятор..............368
8.21. Преобразование текстовых файлов Microsoft в Юникод..............370
8.22. Сравнение содержимого двух файлов...............................372
8.23. Интерпретация строки как файла..................................374
8.24. Программа: tailwtmp.............................................374
8.25. Программа: tctee................................................375
8.26. Программа: laston...............................................377
8.27. Программа: индексация файла.....................................378
Глава 9. Каталоги.......................................................380
9.0 . Введение......................................................380
9.1. Получение и установка атрибутов времени.........................385
9.2. Удаление файла..................................................387
9.3. Копирование или перемещение файла...............................388
9.4. Распознавание двух имен одного файла............................389
9.5. Обработка всех файлов каталога..................................390
9.6. Получение списка файлов по шаблону..............................392
9.7. Рекурсивная обработка всех файлов каталога......................393
9.8. Удаление каталога вместе с содержимым...........................396
9.9. Переименование файлов...........................................397
Содержание
11
9.10. Деление имени файла на компоненты..............................399
9.11. Работа с разрешениями доступа к файлам в символьном представлении . . 400
9.12. Программа: symirror............................................402
9.13. Программа: 1st.................................................403
Глава 10. Процедуры....................................................407
10.0 . Введение.....................................................407
10.1. Доступ к аргументам процедуры.................................408
10.2. Создание закрытых переменных в функциях.......................410
10.3. Создание устойчивых закрытых переменных.......................412
10.4. Определение имени текущей функции.............................414
10.5. Передача массивов и хэшей по ссылке...........................415
10.6. Определение контекста вызова..................................416
10.7. Передача именованных параметров ..............................417
10.8. Пропуск некоторых возвращаемых значений.......................418
10.9. Возврат нескольких массивов или хэшей.........................419
10.10. Возвращение признака неудачного вызова........................420
10.11. Прототипы функций.............................................421
10.12. Обработка исключений..........................................425
10.13. Сохранение глобальных значений................................427
10.14. Переопределение функции.......................................430
10.15. Перехват вызовов неопределенных функций с помощью AUTOLOAD .... 432
10.16. Вложенные процедуры...........................................433
10.17. Имитация команды switch.......................................434
10.18. Сортировка почты..............................................438
Глава 11. Ссылки и записи..............................................441
11.0. Введение......................................................441
11.1. Ссылки на массивы.............................................447
11.2. Создание хэшей массивов ......................................449
11.3. Получение ссылок на хэши......................................450
11.4. Получение ссылок на функции...................................451
11.5. Получение ссылок на скаляры...................................454
11.6. Создание массивов ссылок на скаляры...........................455
11.7. Применение замыканий вместо объектов..........................457
11.8. Создание ссылок на методы.....................................458
11.9. Конструирование записей.......................................459
11.10. Чтение и сохранение записей в текстовых файлах...............461
11.11. Вывод структур данных........................................462
11.12. Копирование структуры данных.................................464
11.13. Сохранение структур данных на диске..........................465
11.14. Устойчивые структуры данных..................................467
11.15. Циклические структуры данных и слабые ссылки.................468
11.16. Программа: Outlines..........................................472
11.17. Программа: бинарные деревья..................................474
12
Содержание
Глава 12. Пакеты, библиотеки и модули...................................477
12.0. Введение.......................................................477
12.1. Определение интерфейса модуля..................................482
12.2. Обработка ошибок require и use.................................485
12.3. Отложенное использование модуля................................486
12.4. Ограничение доступа к переменным модуля........................488
12.5. Ограничение доступа к функциям модуля..........................491
12.6. Определение пакета вызывающей стороны..........................492
12.7. Автоматизированное выполнение завершающего кода................494
12.8. Ведение собственного каталога модулей..........................496
12.9. Подготовка модуля к распространению............................499
12.10. Ускорение загрузки модуля с помощью SelfLoader.................501
12.11. Ускорение загрузки модуля с помощью Autoloader.................502
12.12. Переопределение встроенных функций.............................503
12.13. Переопределение встроенной функции во всех пакетах.............505
12.14. Вывод сообщений об ошибках и предупреждений по аналогии
со встроенными функциями..............................................507
12.15. Настройка предупреждений.......................................509
12.16. Косвенные ссылки на пакеты.....................................512
12.17. Применение h2ph для преобразования заголовочных файлов С.......514
12.18. Применение h2xs для создания модулей с кодом С.................517
12.19. Написание расширений на С с использованием Inline: :С..........520
12.20. Документирование модуля в формате pod..........................521
12.21. Построение и установка модуля CPAN.............................523
12.22. Пример: шаблон модуля..........................................526
12.23. Программа: поиск версий и описаний установленных модулей.......527
Глава 13. Классы, объекты и связи.......................................532
13.0. Введение.......................................................532
13.1. Конструирование объекта........................................540
13.2. Уничтожение объекта............................................542
13.3. Работа с данными экземпляра ...................................544
13.4. Управление данными класса......................................547
13.5. Использование класса как структуры.............................549
13.6. Клонирование объектов..........................................553
13.7. Копирующие конструкторы........................................554
13.8. Косвенный вызов методов........................................555
13.9. Определение принадлежности субкласса...........................557
13.10. Создание класса с поддержкой наследования......................559
13.11. Вызов переопределенных методов.................................561
13.12. Генерация методов доступа с помощью AUTOLOAD...................563
13.13. Использование циклических структур данных......................565
13.14. Перегрузка операторов.........................................568
13.15. Создание «магических» переменных функцией tie.................573
Содержание
13
Глава 14. Базы данных..................................................581
14.0. Введение......................................................581
14.1. Создание и использование DBM-файла............................584
14.2. Очистка DBM-файла.............................................586
14.3. Преобразование DBM-файлов ....................................586
14.4. Объединение DBM-файлов........................................588
14.5. Сортировка больших DBM-файлов.................................589
14.6. Хранение сложных структур данных в DBM-файлах.................590
14.7. Устойчивые данные.............................................592
14.8. Сохранение результатов запроса в Excel или в CSV..............594
14.9. Выполнение команд SQL с помощью DBI...........................595
14.10. Экранирование строк...........................................598
14.11. Обработка ошибок при операциях с базами данных...............599
14.12. Эффективное повторение запросов...............................600
14.13. Программное построение запросов...............................602
14.14. Определение количества записей, возвращаемых запросом.........604
14.15. Использование транзакций......................................605
14.16. Постраничный просмотр данных..................................606
14.17. Запросы к файлам CSV с использованием SQL.....................608
14.18. Работа с SQL без сервера БД...................................609
14.19. Программа: ggh — поиск в глобальном журнале Netscape..........611
Глава 15. Интерактивность..............................................615
15.0. Введение......................................................615
15.1. Лексический разбор аргументов.................................617
15.2. Проверка интерактивного режима................................619
15.3. Очистка экрана................................................621
15.4. Определение размера терминала или окна........................622
15.5. Изменение цвета текста........................................622
15.6. Чтение символа с клавиатуры...................................624
15.7. Предупреждающие сигналы.......................................625
15.8. Использование termios.........................................627
15.9. Проверка наличия входных данных...............................629
15.10. Ввод пароля...................................................629
15.11. Редактирование входных данных.................................630
15.12. Управление экраном............................................632
15.13. Управление другой программой с помощью Expect ................634
15.14. Создание меню с помощью Тк....................................636
15.15. Создание диалоговых окон с помощью Тк.........................639
15.16. Обработка событий масштабирования в Тк........................642
15.17. Удаление окна сеанса DOS в Perl/Tk для Windows................643
15.18. Построение диаграмм...........................................644
15.19. Создание миниатюр.............................................645
15.20. Включение текста в изображение................................646
14
Содержание
15.21. Программа: tcapdemo ...........................................647
15.22. Программа: tkshufflepod........................................649
15.23. Программа: graphbox............................................651
Глава 16. Управление процессами и межпроцессные взаимодействия . . 653
16.0. Введение.......................................................653
16.1. Получение вывода от программы..................................656
16.2. Запуск другой программы........................................658
16.3. Замена текущей программы.......................................660
16.4. Получение или передача данных другой программе.................661
16.5. Фильтрация выходных данных.....................................663
16.6. Предварительная обработка ввода................................665
16.7. Чтение содержимого STDERR......................................666
16.8. Управление потоками ввода и вывода другой программы............669
16.9. Управление потоками ввода, вывода и ошибок другой программы....670
16.10. Взаимодействие между родственными процессами...................673
16.11. Имитация файла на базе именованного канала.....................678
16.12. Совместное использование переменных в разных процессах.........681
16.13. Получение списка сигналов......................................683
16.14. Посылка сигнала................................................684
16.15. Установка обработчика сигнала..................................685
16.16. Временное переопределение обработчика сигнала..................687
16.17. Написание обработчика сигнала..................................688
16.18. Перехват Ctrl+C................................................690
16.19. Уничтожение процессов-зомби....................................691
16.20. Блокировка сигналов............................................694
16.21. Тайм-аут.......................................................695
16.22. Преобразование сигналов в фатальные ошибки.....................697
16.23. Программа: sigrand.............................................698
Глава 17. Сокеты........................................................703
17.0. Введение......................................................703
17.1. Написание клиента TCP.........................................705
17.2. Написание сервера TCP.........................................707
17.3. Передача данных через TCP.....................................709
17.4. Создание клиента UDP..........................................712
17.5. Создание сервера UDP..........................................715
17.6. Использование сокетов UNIX....................................717
17.7. Идентификация другого конца сокета............................718
17.8. Определение вашего имени и адреса.............................720
17.9. Закрытие сокета после разветвления............................721
17.10. Написание двусторонних клиентов...............................722
17.11. Разветвляющие серверы.........................................724
17.12. Серверы с предварительным ветвлением..........................725
Содержание
15
17.13. Серверы без ветвления..........................................728
17.14. Многопоточный сервер...........................................732
17.15. Написание многопоточного сервера с использованием РОЕ..........733
17.16. Написание многоканального сервера..............................735
17.17. Создание сервера-демона........................................737
17.18. Перезапуск сервера по требованию...............................739
17.19. Управление несколькими потоками ввода..........................740
17.20. Программа: backsniff...........................................744
17.21. Программа: fwdport.............................................744
Глава 18. Протоколы Интернета...........................................749
18.0. Введение.......................................................749
18.1. Простой поиск в DNS............................................751
18.2. Клиентские операции FTP .......................................754
18.3. Отправка почты.................................................757
18.4. Чтение и отправка новостей Usenet..............................760
18.5. Чтение почты на серверах POP3..................................762
18.6. Программная имитация сеанса telnet.............................765
18.7. Проверка удаленного компьютера.................................766
18.8. Обращение к серверу LDAP.......................................768
18.9. Отправка вложений по электронной почте.........................771
18.10. Извлечение вложений из сообщений...............................774
18.11. Написание сервера XML-RPC......................................776
18.12. Написание клиента XML-RPC......................................778
18.13. Написание сервера SOAP.........................................779
18.14. Написание клиента SOAP.........................................780
18.15. Программа: rfrm................................................781
18.16. Программы: ехрп и vrfy.........................................783
Глава 19. Программирование CGI .........................................785
19.0. Введение.......................................................785
19.1. Написание сценария CGI.........................................788
19.2. Перенаправление сообщений об ошибках...........................791
19.3. Исправление ошибки 500 Server Error............................792
19.4. Написание безопасных программ CGI..............................796
19.5. Выполнение команд без обращений к командному интерпретатору .... 799
19.6. Форматирование списков и таблиц средствами HTML................802
19.7. Перенаправление клиентского браузера...........................804
19.8. Отладка на уровне HTTP.........................................806
19.9. Работа с cookie................................................808
19.10. Создание устойчивых элементов..................................810
19.11. Создание многостраничного сценария CGI.........................812
19.12. Сохранение формы в файле или канале............................814
19.13. Программа: chemiserie..........................................816
16
Содержание
Глава 20. Автоматизация в Веб ..........................................821
20.0. Введение.......................................................821
20.1. Обращение по URL из сценария Perl..............................822
20.2. Автоматизация отправки формы...................................824
20.3. Извлечение URL.................................................826
20.4. Преобразование ASCII в HTML....................................828
20.5. Преобразование HTML в ASCII....................................829
20.6. Удаление тегов HTML............................................830
20.7. Поиск устаревших ссылок........................................833
20.8. Поиск недавно обновлявшихся ссылок.............................834
20.9. Создание шаблонов HTML.........................................835
20.10. Зеркальное копирование веб-страниц.............................838
20.11. Создание робота................................................839
20.12. Анализ файла журнала веб-сервера...............................840
20.13. Обработка серверных журналов...................................842
20.14. Работа с cookie................................................844
20.15. Загрузка страниц, защищенных паролем...........................845
20.16. Загрузка веб-страниц https://..................................846
20.17. Продолжение загрузки по команде HTTP GET.......................847
20.18. Разбор кода HTML...............................................848
20.19. Извлечение табличных данных....................................851
20.20. Программа: htmlsub.............................................853
20.21. Программа: hrefsub.............................................854
Глава 21. mod_perl .....................................................856
21.0. Введение.......................................................856
21.1. Аутентификация.................................................860
21.2. Установка cookie...............................................862
21.3. Получение значений cookie......................................863
21.4. Перенаправление браузера.......................................864
21.5. Чтение информации из заголовков................................865
21.6. Работа с параметрами форм......................................866
21.7. Получение отправленных файлов..................................867
21.8. Ускорение операций с базой данных..............................868
21.9. Настройка ведения журналов Apache..............................870
21.10. Прозрачное хранение данных в URL..............................871
21.11. Взаимодействие между mod_perl и PHP...........................873
21.12. Переход с CGI на mod_perl.....................................873
21.13. Передача информации между обработчиками.......................875
21.14. Повторная загрузка измененных модулей.........................876
21.15. Хронометраж приложений mod_perl...............................877
21.16. Построение шаблонов с использованием HTML: :Mason.............878
21.17. Построение шаблонов с использованием Template Toolkit.........882
Содержание
17
Глава 22. XML..........................................................889
22.0. Введение......................................................889
22.1. Разбор XML в структуры данных.................................897
22.2. Разбор кода XML в деревья DOM ................................899
22.3. Разбор кода XML в события SAX.................................902
22.4. Простые изменения в элементах и тексте........................905
22.5. Проверка действительности XML.................................907
22.6. Поиск элементов и текста в документе XML......................910
22.7. Обработка преобразований таблиц стилей XML....................912
22.8. Обработка больших файлов......................................915
22.9. Чтение и запись файлов RSS....................................916
22.10. Построение кода XML...........................................920
Алфавитный указатель...................................................922
Предисловие
Говорят, метафорами легко увлечься. Но некоторые метафоры настолько хоро-
ши, что в таком увлечении нет ничего плохого. Вероятно, к их числу относится
и метафора поваренной книги — по крайней мере, в данном случае. Меня сму-
щает лишь одно: представленная работа настолько монументальна, что все ска-
занное мной будет либо повторением, либо пустыми словами.
Впрочем, прежде меня это никогда не останавливало.
Вероятно, кулинария является самым скромным из всех искусств; но я всегда
считал скромность достоинством, а не недостатком. Великий художник, как и ве-
ликий повар, всегда работает с конкретными выразительными средствами. И чем
скромнее средства, тем скромнее должен быть художник, чтобы вывести их за
рамки обыденного. И еда, и язык программирования относятся к скромным
средствам; они состоят из внешне разрозненных ингредиентов. И все же в руках
мастера, наделенного творческим мышлением и дисциплиной, из самых обыден-
ных вещей — картошки, макарон и Perl — возникают произведения искусства,
которые не просто справляются со своей задачей, но и делают это так, что ваше
странствие по жизни становится чуть более приятным.
Кроме того, кулинария принадлежит к числу самых древних искусств. Некото-
рые современные художники полагают, что так называемое эфемерное искусство
изобрели совсем недавно, однако кулинария всегда была эфемерным искусством.
Мы пытаемся сохранить произведения искусства, продлить их существование,
но даже пища, захороненная вместе с фараонами, со временем приходит в негод-
ность. Итак, плоды нашего программирования на Perl тоже в чем-то эфемерны.
Этот аспект «кухни Perl» часто порицают. Если хотите — называйте его «про-
граммированием на скорую руку», но миллиардные обороты в кафе быстрого
обслуживания позволяют надеяться, что быстрая еда может быть качественной
(нам хотелось бы в это верить).
Простые вещи должны быть простыми, а сложные... возможными. На один
рецепт быстрых блюд приходится бесчисленное множество обычных рецептов.
Одна из прелестей жизни в Калифорнии заключается в том, что для меня доступ-
на практически любая национальная кухня. Но даже в границах одной культуры
у каждой задачи всегда найдется несколько решений. Как говорят в России —
«сколько поваров, столько и рецептов борща», и я этому верю. Рецепт моей
мамы даже обходится без свеклы! И это вполне нормально. Борщ становится не-
ким разделителем культур, а культурное разнообразие интересно, познаватель-
но, полезно и увлекательно.
Предисловие
19
Итак, Том и Нат в этой книге не всегда делают все так, как бы это сделал я.
Иногда они даже не могут прийти к единому решению — и это тоже сила, а не
слабость. Признаюсь, из этой книги я узнал кое-что новое. Более того, навер-
няка и сейчас я знаю далеко не все (и надеюсь, не узнаю в ближайшее время).
Мы часто говорим о культуре Perl так, словно она является чем-то единым, не-
поколебимым, хотя в действительности существует множество здоровых субкуль-
тур Perl, не говоря уже о всевозможных сочетаниях суб-субкультур, суперкуль-
тур и околокультур, наследующих друг от друга атрибуты и методы.
Итак, поваренная книга не готовит пищу за вас (она этого не умеет) и даже
не учит вас готовить (хотя и помогает в этом). Она лишь передает различные
культурные фрагменты, которые оказались полезными, и, возможно, отфильтро-
вывает другие «культуры», которые выросли в холодильнике по беспечности хо-
зяев. В свою очередь, вы поделитесь этими идеями с другими людьми, пропус-
тите их через собственный опыт и личные вкусы, ваше творческое мышление
и дисциплину. У вас появятся собственные рецепты, которые вы передадите
собственным детям. Не удивляйтесь, когда они придумают что-то свое и спро-
сят, что вы об этом думаете. Постарайтесь не корчить недовольную гримасу.
Рекомендую вам эти рецепты. Когда я читал их, у меня не было особых пово-
дов для недовольных гримас.
Ларри Уолл, июнь 1998 г.
Введение
Бизнесмены осторожно разглядывали докладчика, скепсис на лицах переходил
в заинтересованность и наоборот.
«Ваш рискованный план обещает выгоду, — заключил председатель. — Но он
очень дорог и основан на одних предположениях. Наши математики не подтвер-
ждают ваших цифр. Почему мы должны доверить вам свои деньги? Что вы знае-
те такого, чего не знаем мы?»
«Прежде всего, — ответил он, — я знаю, как вертикально поставить яйцо без
внешней опоры. А вы?» С этими словами докладчик залез в сумку и осторожно
вынул свежее куриное яйцо. Он передал яйцо финансовым магнатам, которые
передавали его из рук в руки, пытаясь справиться с несложной задачей. Все по-
пытки оказались тщетными. Раздавались отчаянные возгласы: «Это невозмож-
но! Никому не удастся поставить яйцо вертикально!»
Докладчик взял яйцо у рассерженных бизнесменов и поставил яйцо на дубо-
вый стол, прочно удерживая его в руках. После легкого, но уверенного нажатия
скорлупа слегка потрескалась. Когда докладчик убрал руку, яйцо осталось на
месте — слегка продавленное, но определенно устойчивое. «Что здесь невозмож-
ного?» — спросил он.
«Но это же обычный фокус, — закричали бизнесмены. — Такое может сде-
лать любой!»
«Ваша правда, — последовал ответ. — Но это относится ко всему. Пока вы не
знаете решения, задача кажется невозможной. А решение выглядит так просто,
что вы не понимаете, почему это раньше не приходило вам в голову. Так по-
звольте мне показать простое решение, чтобы другие могли легко пойти тем же
путем. Вы мне доверяете?»
Скептически настроенные капиталисты убедились, что предприниматель
действительно на что-то способен, и выделили деньги на его проект. Из ма-
ленького андалузского порта отправились в море «Нинья», «Пинта» и «Санта
Мария». Их вел предприниматель с надбитым яйцом и своими идеями — Христо-
фор Колумб.
За ним последовали многие.
Задачи программирования часто похожи на колумбово яйцо. Пока никто не
покажет решения, вы сидите и смотрите, как яйцо (то бишь программа) падает
снова и снова, ни на шаг не приближаясь к решению. Это особенно справедливо
для таких идиоматических языков, как Perl.
Эта книга не задумывалась как полный справочник по Perl, хотя мы опишем
некоторые недокументированные аспекты Perl. Любая поставка Perl содержит
О чем рассказано в этой книге
21
свыше 1000 страниц электронной документации. Если их не окажется под ру-
кой, обратитесь к системному администратору или к разделу документации на
сайте http://www.perl.сот.
Итак, эта книга — для тех, кто хочет лучше узнать Perl. Перед вами не спра-
вочник и не учебник, хотя книга окажется полезным дополнением к ним. Она
предназначена для людей, которые изучили основы языка и теперь пытаются
связать ингредиенты в готовую программу. На протяжении 22 глав и свыше 400
отдельных тем, которые можно назвать «рецептами», вы найдете тысячи реше-
ний для повседневных задач, с которыми сталкиваются как новички, так и опыт-
ные программисты.
Мы постарались сделать так, чтобы книга подходила и для последовательно-
го, и для произвольного доступа. Каждый рецепт вполне самостоятелен, но если
вам понадобится дополнительная информация, вы найдете в конце рецепта список
ссылок. Глава обычно начинается с простых, повседневных рецептов, а книга
начинается с простых глав. Рецепты, посвященные типам данных и операторам
Perl, особенно полезны для новичков. Постепенно мы перейдем к темам и реше-
ниям, рассчитанным на более опытных программистов. Но там и сям встречает-
ся материал, способный вдохновить даже настоящего знатока Perl.
Главы начинаются с краткого обзора. За Введением следует основная суть
главы, ее рецепты. В духе лозунга Perl — «Всегда существует несколько реше-
ний» — во многих рецептах продемонстрированы разные способы решения той
же самой или аналогичной задачи. Рецепты простираются от конкретных реше-
ний в стиле «коротко, но мило» до углубленных мини-учебников. Там, где при-
ведено несколько вариантов, мы часто объясняем преимущества и недостатки
каждого подхода.
Предполагается, что к этой книге (как и к обычным поваренным книгам) чи-
татель обращается более или менее произвольно. Если вы хотите научиться
что-то делать, заглядываете в нужный рецепт. Даже если конкретное решение не
подойдет к вашей задаче, оно, по крайней мере, даст представление о возможных
направлениях поисков.
Каждая глава завершается одной или несколькими законченными программа-
ми. Хотя некоторые рецепты уже содержат маленькие программы, эти приложе-
ния выделяют основную тему главы; кроме того, в них, как и в любой реальной
программе, используются приемы из других глав. Все эти программы полезны,
некоторые из них используются ежедневно. Некоторые программы даже помог-
ли нам в работе над книгой.
О чем рассказано в этой книге
Первая четверть книги, занимающая пять глав, посвящена базовым типам дан-
ных Perl. В главе 1 «Строки» рассматриваются такие вопросы, как работа с под-
строками, расширение вызовов функций в строках и разбор данных, разделенных
запятыми. Глава 2 «Числа» описывает некоторые странности представления
с плавающей запятой, разделение разрядов запятыми и процесс генерации псев-
дослучайных чисел. Глава 3 «Дата и время» демонстрирует преобразования
22
Введение
между числовыми и строковыми форматами даты и применение таймеров. В гла-
ве 4 «Массивы» рассматривается все, что относится к операциям со списками
и массивами, в том числе поиск уникальных элементов, эффективная сортиров-
ка и случайные перестановки элементов. Глава 5 «Хэши» завершает основы
языка и представляет самый полезный тип данных — ассоциативные массивы.
В ней показано, как обращаться с элементами хэша в порядке вставки, как от-
сортировать хэш по значению и как хранить несколько ассоциированных значе-
ний для одного ключа.
Рецепты главы 6 «Поиск по шаблону» описывают преобразование метасим-
волов командного интерпретатора в шаблоны, поиск букв и слов, многостроч-
ные совпадения, минимализм при поиске, а также поиск строк, которые близки
к искомым, но не совпадают с ними. Хотя глава и так получилась самой длин-
ной, она могла бы стать еще длиннее — в каждой главе вы найдете примеры ис-
пользования регулярных выражений. Это часть того, что придает Perl его непо-
вторимость.
Три следующие главы относятся к файловой системе. В главе 7 «Доступ к фай-
лам» показано, как открыть файл, заблокировать его для параллельной работы,
модифицировать его на месте и сохранить файловый манипулятор в переменной.
В главе 8 «Содержимое файлов» обсуждается проблема сохранения манипуля-
торов в переменных, операции с временными файлами, поиска конца увеличи-
вающегося файла, чтение конкретной строки файла, работа с альтернативными
кодировками типа Юникода, и двоичный ввод/вывод с произвольным доступом.
Наконец, в главе 9 «Каталоги» описаны приемы копирования, перемещения и уда-
ления файлов, изменения атрибутов времени файла и рекурсивной обработки
всех файлов каталога.
Основное внимание в главах 10-13 уделено тому, как сделать программы бо-
лее гибкими и функциональными. Глава 10 «Процедуры» содержит рецепты
для создания устойчивых локальных переменных, передачи параметров по ссылке,
косвенного вызова функций, имитации конструкции switch и обработки исклю-
чений. Глава И «Ссылки и записи» посвящена структурам данных; продемонст-
рированы основные операции со ссылками на данные и функции. Также в ней
показано, как создавать аналоги конструкции struct языка С, как сохранять и за-
гружать их из устойчивого хранилища. В главе 12 «Пакеты, библиотеки и моду-
ли» рассматривается деление программы на отдельные файлы; создание пере-
менных и функций, действующих только в границах данного модуля; замена
встроенных функций, перехват обращений к отсутствующим модулям и исполь-
зование утилит h2ph и h2xs для использования кода, написанного на С и C++.
Наконец, в главе 13 «Классы, объекты и связи» рассматриваются основные
принципы построения объектно-ориентированных модулей для создания поль-
зовательских типов, обладающих конструкторами, деструкторами и возможно-
стями наследования. В других рецептах показаны примеры использования цик-
лических структур данных, перегрузки операторов и связанных типов данных.
Две следующие главы посвящены интерфейсам: первая — интерфейсам к базам
данных, вторая — пользовательским интерфейсам. В главе 14 «Базы данных»
описана методика работы с файлами DBM, выборки и обновления баз данных
с применением SQL и модуля DBI. В главе 15 «Интерактивность» рассматрива-
Что нового в этом издании
23
ются такие темы, как очистка экрана, обработка параметров командной строки,
посимвольный ввод, перемещение курсора средствами termcap и curses, построе-
ние миниатюр и диаграмм.
Последняя четверть книги посвящена взаимодействию с другими программа-
ми и устройствами. В главе 16 «Управление процессами и межпроцессные взаи-
модействия» говорится о запуске других программ и получении их вывода, об
уничтожении процессов-зомби, именованных каналах, обработке сигналов и совме-
стному использованию переменных работающими процессами. Глава 17 «Сокеты»
показывает, как установить потоковое соединение или использовать дейтаграммы
при разработке низкоуровневых сетевых приложений «клиент/сервер». В главе 18
«Протоколы Интернета» рассматриваются протоколы высокого уровня — элек-
тронная почта, FTP, Usenet, XML-RPC и SOAP. Глава 19 «Программирование
CGI» содержит рецепты для обработки веб-форм, перехвата ошибок, повыше-
ния безопасности за счет отказа от обращений к командному интерпретатору,
использования cookies, обслуживания электронных магазинов и сохранения
форм в файлах или каналах. В главе 20 «Автоматизация в Веб» описана неин-
терактивная работа в Веб. Ее рецепты посвящены загрузке страниц по URL,
автоматизации отправки форм в сценариях, извлечении URL из веб-страниц,
удалению тегов HTML, поиску недавно обновлявшихся или устаревших ссылок
и разбору кода HTML. Глава 21 «mod_perl» посвящена mod_perl — интерпрета-
тору Perl, встроенному в Apache. В частности, в ней рассматривается получение
параметров форм, перенаправление, настройка журналов Apache, аутентифика-
ция и построение шаблонов с применением Mason и Template Toolkit. Наконец,
в главе 22 «XML» рассматривается вездесущий формат данных XML. Среди ее
рецептов вы найдете методику проверки XML, разбора XML по событиям и де-
ревьям, а также преобразования XML в другие форматы.
Что нового в этом издании
Книга, которую вы сейчас держите, почти на 200 страниц толще предыдущего
издания, выпущенного пять лет назад. Новый материал образует более 80 новых
рецептов, а свыше 100 рецептов существенно изменились по сравнению с первым
изданием. Также в книгу включены две новые главы: одна посвящена mod_perl,
Perl-интерфейсу к популярному веб-серверу Apache, а в другой рассматривает-
ся XML — стандарт обмена структурированными данными, который играет все
более важную роль.
Увеличение объема книги в первую очередь объясняется эволюцией Perl от
версии 5.004 (первое издание) до версии 5.8.1 во втором издании. Впрочем, из-
менений в базовом синтаксисе языка относительно немного. В частности, для
объявления глобальных переменных теперь появилось удобное ключевое слово
our вместо неудобной конструкции use vars, усовершенствованные формы open
устраняют неоднозначности в именах файлов, содержащих нестандартные сим-
волы, а в неопределенных скалярных переменных теперь автоматически созда-
ются анонимные файловые манипуляторы. Там, где применение новых возмож-
ностей было оправданно, мы внесли изменения в решения и примеры программ.
24
Введение
Некоторые важнейшие подсистемы Perl были полностью переработаны с целью
расширения возможностей, повышения надежности и переносимости. Некоторые
из них относительно автономны — как, например, подсистемы поддержки мно-
гопоточности (см. рецепт 17.4) или безопасных сигналов (см. рецепт 16.17). Их
применение обычно ограничивается областью системного программирования.
Самые масштабные изменения в Perl и в этой книге обусловлены интегриро-
ванной поддержкой Юникода. В наибольшей степени эти изменения отразились
на строках (теперь представляемых многобайтовыми символами) и вводе/выводе
(использующем стек уровней с поддержкой кодировок). По этой причине в главы 1
и 8 был включен новый вводный материал, который поможет вам ориентиро-
ваться во всех тонкостях кодировок. Большинство рецептов по этим конкрет-
ным темам собрано в этих двух главах, но столь принципиальные изменения не
могли не отразиться на многих других рецептах книги.
Другое направление развития Perl и книги — появление множества полезней-
ших, широко используемых модулей, вошедших в стандартную поставку Perl.
Ранее эти модули приходилось искать, загружать, настраивать, собирать, тести-
ровать и устанавливать отдельно. После их включения в стандартную поставку
все эти задачи решаются при установке Perl.
Некоторые новые базовые модули в действительности представляют собой
директивы, изменяющие среду компиляции или выполнения Perl; это показано
в рецептах 1.21, 12.3 и 12.15. Некоторые являются инструментами програм-
миста, упрощающими разработку и отладку программ; в частности, это относит-
ся к модулям в рецептах 11.11, 11.13, 11.15 и 22.2. Другие модули расширяют
возможности выполнения операций с базовыми типами данных, наподобие пока-
занных в рецептах 2.1, 4.13, 4.18, 5.3, 8.7 и 11.15. Наконец-то в комплект поставки
были включены и сетевые модули (см. главу 18). Вероятно, процесс интеграции
модулей еще будет продолжаться.
Платформы
Книга создавалась на основе Perl 5.8.1, что означает старшую версию 5, млад-
шую 8 и исправления уровня 1. Большинство программ и примеров было про-
тестировано в BSD, Linux и SunOS, но это не значит, что они будут работать
только в этих системах. Perl проектировался как язык, независимый от платфор-
мы. Если вы ограничиваетесь базовыми операциями с переменными, шаблонами,
подпрограммами и высокоуровневым вводом/выводом, ваша программа должна
одинаково работать везде, где работает Perl, — то есть практически везде. Первые
две трети книги посвящены именно такому общему программированию.
Изначально Perl задумывался как высокоуровневый кросс-платформенный
язык системного программирования. Хотя с того времени Perl вышел далеко за
пределы исходного предназначения, он продолжает широко использоваться в сис-
темном программировании в родных системах семейства Unix и на других плат-
формах. Большинство рецептов в главах 14-18 относится к классическому сис-
темному программированию. Для обеспечения максимальной переносимости
основное внимание уделялось открытым системам, соответствующим стандарту
Условные обозначения, использованные в книге
25
POSIX (Portable Operating System Interface) — к их числу принадлежат практи-
чески все разновидности Unix и множество других операционных систем. Боль-
шинство рецептов будет работать в любой POSIX-системе без каких-либо изме-
нений (или с минимальными изменениями).
Perl может использоваться для системного программирования даже в систе-
мах, не соответствующих стандарту POSIX. Для этого вам понадобятся спе-
циализированные модули для этих систем, однако в этой книге они не рассмат-
риваются. Это объясняется тем, что такие программы не переносимы, — и, честно
говоря, еще и тем, что в распоряжении авторов таких систем нет. Информация
о специализированных модулях приведена в документации, прилагаемой к вашей
версии Perl. Например, можно начать со страницы руководства perlport (1); в раз-
деле SEE ALSO приводятся ссылки на документацию для конкретных плат-
форм (например, рег1тасоз(Д) и perlvms(l)).
Не беспокойтесь — большинство рецептов, связанных с системным программи-
рованием, работает и в системах, не соответствующих стандарту POSIX (особен-
но рецепты, относящиеся к базам данных, сетевым средствам и работе в Веб).
Используемые в этих областях модули маскируют различия между платформами.
Исключение составляют в первую очередь немногочисленные рецепты и про-
граммы, основанные на многозадачных конструкциях, и в первую очередь — на
мощной функции fork, стандартной в семействе POSIX и редко встречающейся
в других системах. Впрочем, в Mac OS X теперь реализована прямая поддержка
fork, и даже в системах семейства Windows Perl теперь на удивление хорошо
эмулирует эту системную функцию.
Во многих операциях со структурированными файлами используется удобная
база данных /etc/passwd. При чтении текстовых файлов используется /etc/motd,
а там, где была нужна внешняя программа с выходными данными — who(l). Эти
файлы были выбраны лишь для демонстрации общих принципов, действующих
независимо от того, присутствуют эти файлы в вашей системе или нет.
Условные обозначения, использованные
в книге
Условные обозначения в программах
В книге приведено множество примеров, большинство из которых представляет
собой фрагменты кода. Некоторые примеры являются полноценными програм-
мами, их нетрудно узнать по начальной строке #!. Практически все нетривиаль-
ные программы начинаются так:
#!/usr/bin/perl -w
use strict:
или в более современном варианте:
#!/usr/bin/perl
use strict;
use warnings:
26
Введение
Однако некоторые примеры должны вводиться в приглашении командной
строки. Приглашение обозначается символом %:
% perl -е 'print "Hello, world.\" '
Hello, world.
Подобный стиль характерен для стандартных командных строк Unix. Правила
определения строк и универсальные символы в других системах могут быть други-
ми. Например, большинство стандартных командных интерпретаторов в MS-DOS
и VMS требует, чтобы для группировки аргументов с пробелами или универ-
сальными символами использовались кавычки вместо апострофов.
Шрифтовое выделение
В книге использованы следующие условные обозначения:
Курсив
Страницы руководства и новые термины (там, где они впервые встречаются
в тексте).
Моноширинный шрифт
Имена функций и методов, а также их аргументы. В примерах обозначает не-
посредственно вводимый текст, а в тексте книги — элементы программного кода.
Моноширинный полужирный шрифт
Выходные данные в примерах.
ВНИМАНИЕ--------------------------------------------------------------------
Предупреждение или предостережение.
Документация
Самая свежая и полная документация по Perl распространяется вместе с Perl.
В печатном виде эта объемистая антология займет свыше 1000 страниц и внесет
заметный вклад в глобальную вырубку лесов. К счастью, распечатывать ее не
нужно, поскольку вся документация представлена в удобном электронном виде
с возможностями поиска.
Говоря о «страницах руководства» в этой книге, мы имеем в виду набор элек-
тронных документов. Название чисто условное; для их чтения необязательно
использовать программу man, традиционную для UNIX. Также подойдет ко-
манда perl doc, распространяемая с Perl. Страницы руководства даже могут
устанавливаться в виде HTML-страниц, особенно в системах, не принадлежа-
щих к семейству Unix. Если вам известно местонахождение электронной до-
кументации, вы сможете искать в ней информацию с помощью утилиты grep1.
HTML-версия электронной документации также имеется в Веб по адресу http://
www.perl.com/CPAN/doc/manual.html/.
1 Если утилита grep отсутствует в вашей системе, воспользуйтесь программой tcgrep, при-
веденной в конце главы 6.
Благодарности для первого издания
27
Когда мы ссылаемся на документацию, не относящуюся к Perl (например,
«См. страницу руководства 0(2) вашей системы»), речь идет о странице kill
из раздела 2 руководства «Unix Programmer’s Manual» (системные функции).
Для систем, не входящих в семейство Unix, эта документация недоступна, но
в этом нет ничего страшного, поскольку вам все равно не удастся ею восполь-
зоваться. Если вам действительно понадобится документация по системной
или библиотечной функции, многие организации размещают свою документа-
цию в Веб, и простейший поиск вида crypt(3) manual в Google даст желаемые ре-
зультаты.
Благодарности для первого издания
Эта книга появилась на свет лишь благодаря множеству людей, компетентных
и некомпетентных, стоявших за спинами авторов. Во главе этого легиона стоит
наш редактор Линда Май (Linda Mui), с кнутом в одной руке и пряником в дру-
гой. Она была бесподобна.
Ларри Уолл как автор Perl был нашим судьей в высшей инстанции. Он сле-
дил за тем, чтобы мы не документировали то, что он собирался изменить, и по-
могал в выборе формулировок и стиля1. Если временами в этой книге вам по-
слышится голос Ларри, вероятно, вы не ошиблись.
Глория, жена Ларри, — литературный критик. Как ни поразительно, она
прочитала каждое слово в этой книге... и одобрила большинство из них. Вместе
с Шерон Хопкинс (Sharon Hopkins), поэтессой Perl по призванию, она помогла
справиться с нашей патологической склонностью к предложениям, которые
можно было бы умеренно описать как нечто среднее между невообразимо слож-
ным и безнадежно запутанными. В результате наши невразумительные высказы-
вания стали понятны даже тем, чьим родным языком не был ассемблер PDP-11
или средневековый испанский.
Трое самых усердных рецензентов, Марк-Джейсон Доминус (Mark-Jason
Dominus), Джон Оруэнт (Jon Orwant) и Эбигейл (Abigail), трудились вместе
с нами практически все время работы над книгой. Их суровые стандарты, ужа-
сающий интеллект и практический опыт программирования на Perl принесли
бесценную помощь. Дуг Эдвардс (Doug Edwards) педантично протестировал
каждый фрагмент кода в семи начальных главах книги и нашел неочевидные
частные случаи, о которых никто даже не подумал. В числе других ведущих
рецензентов были Энди Догерти (Andy Dougherty), Энди Орам (Andy Oram),
Брент Халси (Brent Halsey), Брайан Баас (Bryan Buus), Джайсл Aac (Gisle Aas),
Грэхем Барр (Graham Barr), Джефф Хемер (Jeff Haemer), Джеффри Фридл
Geffrey Friedl), Линкольн Стейн (Lincoln Stein), Марк Мильке (Mark Mielke),
Мартин Бреч (Martin Brech), Маттиас Неерахер (Matthias Neeracher), Майк Сток
(Mike Stok), Нат Патвардхан (Nate Patwardhan), Пол Грасси (Paul Grassie), Питер
1 А также вставлял сноски.
28
Введение
Приммер (Peter Prymmer), Рафаэль Манфреди (Raphael Manfredi) и Род Уитби
(Rod Whitby).
И это далеко не все. Многие бескорыстные личности поделились с нами
своими техническими познаниями. Некоторые из них прочитали целые главы
и составили формальные рецензии; другие давали содержательные ответы на
короткие технические вопросы там, где мы выходили за рамки своей компе-
тенции. Кое-кто даже присылал нам программы. Приведем лишь частичный
список тех, кто был нам полезен: Аарон Харш (Aaron Harsh), Али Райл (АН
Rayl), Аллигатор Декарт (Alligator Descartes), Эндрю Хьюм (Andrew Hume),
Эндрю Стребков (Andrew Strebkov), Энди Уордли (Andy Wardley), Эштон Мак-
Эндрюс (Ashton MacAndrews), Бен Герцфилд (Ben Gertzfield), Бенджамин
Хольцман (Benjamin Holzman), Брэд Хьюджес (Brad Hughes), Чейм Френкель
(Cheim Frenkel), Чарльз Бейли (Charles Bailey), Крис Нандор (Chris Nandor),
Клинтон Вонг (Clinton Wong), Дэн Клейн (Dan Klein), Дэн Сугальски (Dan
Sugalski), Дэниел Грисинджер (Daniel Grisinger), Деннис Тейлор (Dennis Taylor),
Дуг Мак-Ичерн (Doug MacEachern), Дуглас Дэвенпорт (Douglas Davenport),
Дрю Экхардт (Drew Eckhardt), Дилан Нортрап (Dylan Northrup), Эрик Эйзен-
харт (Eric Eisenhart), Грег Бэкон (Greg Bacon), Гурусами Сарати (Gurusamy
Sarathy), Генри Спенсер (Henry Spencer), Джейсон Стюарт (Jason Stewart),
Джоэл Нобл (Joel Noble), Джонатан Коэн (Jonathan Cohen), Джонатан Скотт
Дафф Qonatathan Scott Duff), Джош Пуринтон (Josh Purinton), Джулиан Андер-
сон Qulian Anderson), Кейт Уинстейн (Keith Winstein), Кен Лунд (Ken Lunde),
Кирби Хьюджес (Kirby Hughes), Ларри Рослер (Larry Rosler), Лес Петерс (Les
Peters), Марк Хесс (Mark Hess), Марк Джеймс (Mark James), Мартин Бреч
(Martin Brech), Мэри Кутски (Mary Koutski), Майкл Паркер (Michael Parker),
Ник Инг-Симмонс (Nick Ing-Simmons), Пол Маркесе (Paul Marquess), Питер
Коллинсон (Peter Collinson), Питер Озел (Peter Osel), Фил Бошамп (Phil
Beauchamp), Пирс Коули (Piers Cawley), Рэндал Шварц (Randal Schwartz), Рич
Рауэнзан (Rich Rauenzahn), Ричард Аллан (Richard Allan), Рокко Капуто (Rocco
Caputo), Родерик Шертлер (Roderick Schertler), Роланд Уокер (Roland Walker),
Ронан Уэйд (Ronan Waide), Стивен Лиди (Stephen Lidie), Стивен Owens (Stephen
Owens), Салливан Бек (Sullivan Beck), Тим Бунс (Tim Bunce), Тодд Миллер
(Todd Miller), Трой Денкингер (Troy Denkinger) и Вилли Гримм (Willy Grimm).
Нельзя не упомянуть и сам Perl, без которого эта книга никогда не была
бы написана. Мы написали на Perl множество мелких утилит, помогавших нам
в работе над книгой. Они преобразовывали наш текст из формата pod в формат
troff для отображения и проверки и в формат FrameMaker на стадии подготов-
ки к печати. Другая программа Perl проверяла синтаксис в каждом фрагменте
кода, встречающемся в книге. С помощью Tk-расширения Perl была написана
графическая утилита для перемещения между рецептами посредством пере-
таскивания мышью. Кроме того, мы также написали бесчисленное множество
мелких утилит для других целей. Назовем лишь некоторые из них — поиск блоки-
ровок RCS, поиск повторяющихся слов и некоторых разновидностей граммати-
ческих ошибок, управление почтовыми папками с сообщениями от рецензентов,
построение предметного указателя и содержания, поиск текста с пересечением
Благодарности для первого издания
29
границы строки или ограниченного определенным разделом и т. д. Некоторые
из этих утилит описаны в книге.
Том
Прежде всего, благодарю Ларри и Глорию за то, что они пожертвовали частью
своего отпуска в Европе для работы над книгой, а также моих друзей и семью —
Брайана, Шерон, Брента, Тодда и Дрю — за то, что они терпели меня в течение
двух последних лет и выдержали бесчисленные проверки ошибок.
Хочу поблагодарить Натана за то, что он выдержал свои еженедельные по-
ездки, мою пикантную вегетарианскую кухню, а также за то, что он упрямо ис-
следовал темы, которые я старался избегать.
Благодарю наших безвестных титанов, Денниса, Линуса, Кирка, Эрика и Рича,
которые тратили время на мои глупые вопросы об операционной системе и troff.
Они проделали громадную работу, без которой эта книга никогда бы не была на-
писана.
Также благодарю моих учителей, которые доблестно отправлялись в опасные
места типа Нью-Джерси и преподавали Perl. Благодарю Тима О’Рейли (Tim
O’Reilly) и Фрэнка Уиллисона (Frank Willison): во-первых — за то, что они под-
дались на уговоры и согласились опубликовать эту книгу, и во-вторых — за то,
что они ставили на первое место качество, а не скорость работы. Также благодарю
Линду, нашего ошеломляюще честного редактора, за то, что ей удалось совершить
невероятное — соблюсти сроки издания.
Благодарю свою мать, Мэри, за то, что она оторвалась от работы по восста-
новлению прерий и преподавания информатики и биологии и помогла нормаль-
но организовать мою деловую и домашнюю жизнь в течение времени, достаточ-
ного для написания этой книги.
Наконец, хочу поблагодарить Иоганна Себастьяна Баха, который был для
меня бесконечным источником поэзии и вдохновения, лекарством для ума и тела.
Отныне при виде этой книги я всегда буду вспоминать звуки музыки, навечно
запечатленные в моей памяти.
Нат
Без любви и терпения своей семьи я ничего не достиг бы в этой жизни. Спасибо
вам! От своих друзей — Жюля, Эми, Раджа, Майка, Кефа, Сая, Роберта, Эвана,
Понди, Марка и Энди — я узнал много нового. Я глубоко благодарен своим кол-
легам в Сети, от которых я получал ценные технические советы и где познако-
мился со своей женой (впрочем, относительно нее никаких советов мне не дава-
ли). Также благодарю свою фирму, Front Range Internet, за интересную работу,
с которой мне не хотелось бы уходить.
Том был великолепным соавтором. Без него эта книга была бы отврати-
тельной, тупой и короткой. Напоследок хочу поблагодарить Дженин. Мы бы-
ли женаты около года, когда я принял предложение насчет книги, и с тех
пор практически не виделись. Никто так не порадуется окончанию этой рабо-
ты, как она.
30
Введение
Благодарности для второго издания
Мы хотим поблагодарить многочисленных рецензентов, великодушно отдавав-
ших свое время и знания, чтобы наша книга выглядела лучше. Среди них были
как официальные рецензенты, усердно прокладывающие путь сквозь череду
бесчисленных предварительных версий и изменений, так и наши знакомые, ог-
раничивавшиеся рассмотрением небольших фрагментов, которые были им инте-
ресны или хорошо известны по работе. Благодаря им из книги исчезло множе-
ство ошибок. Вероятно, оставшиеся ошибки были внесены уже после того, как
они просмотрели книгу.
Назову лишь нескольких из этих бескорыстных людей: Адам Маккаби Трах-
тенберг (Adam Maccabee Trachtenberg), Рафаэль Гарсиа-Суарес (Rafael Garcia-
Suarez), Аск Бьерн Хансен (Ask Bjorn Hansen), Марк-Джейсон Доминус (Mark-
Jason Dominus, Абхиджит Менон-Сен (Abhijit Menon-Sen), Яакко Хитаниеми
0arkko Hietaniemi), Бенджамин Голдберг (Benjamin Goldberg), Аарон Страуп
Коуп (Aaron Straup Соре), Тони Стабблбайн (Tony Stubblebine), Майкл Родри-
гес (Michel Rodriguez), Ник Инг-Симмонс (Nick Ing-Simmons), Джеффри Янг
(Geoffrey Young), Дуглас Уилсон (Douglas Wilson), Пол Кульченко (Paul Kul-
chenko), Джеффри Фридл 0eff rey Friedl), Артур Бергман (Arthur Bergman),
Отриус Танг (Autrijus Tang), Мэтт Сарджент (Matt Sergeant), Стив Марвелл
(Steve Marvell), Дамиан Конуэй (Damian Conway), Шон M. Берк (Sean М. Burke),
Элен Эштон (Elaine Ashton), Стив Лиди (Steve Lidie), Кен Уильямс (Кеп
Williams), Роберт Спайер (Robert Spier), Крис Нандор (Chris Nandor), Брент
Халси (Brent Halsey), Мэтью Фри (Matthew Free), Рокко Капуто (Rocco Caputo),
Робин Берджон (Robin Berjon), Адам Турофф (Adam Turoff), Чип Тернер (Chip
Turner), Дэвид Склар (David Sklar), Майк Сьерра (Mike Sierra), Дэйв Ролски
(Dave Rolsky), Кип Хэмптон (Kip Hampton), Крис Федд (Chris Fedde), Грэхем
Барр (Graham Barr), Джон Оруэнт 0on Orwant), Рич Боуэн (Rich Bowen), Майк
Сток (Mike Stok), Тим Бунс (Tim Bunce), Роб Браун (Rob Brown), Дэн Брайан
(Dan Brian), Джисл Aac (Gisle Aas) и Эбигейл (Abigail).
Также хотим поблагодарить нашего терпеливого и настойчивого редактора
Линду Май. Ей так часто приходилось добиваться от нас «окончательной прав-
ки», что это могло превратиться во вредную привычку.
Том
Я благодарен Ларри Уоллу, стараниями которого мир программирования (и не
только) стал более совершенным. Спасибо Натану за документирование не-
документированного и нашему редактору Линде Май за неистощимое терпение,
с которым она опекает своих недисциплинированных подчиненных. Без этих
троих людей книга бы не существовала.
Хочу особо поблагодарить того, кто уже не сможет прочитать эти слова: глав-
ного редактора издательства O’Reilly и моего друга Фрэнка Уилсона (Frank
Wilson), покинувшего нас два года назад. Комментарии этого эрудированного
человека были настоящим сокровищем и ценились авторами дороже золота.
От издательства
31
За годы совместной работы Фрэнк постоянно вдохновлял и поощрял нас. Его
обаяние и добродушие, широта интересов и блестящее остроумие — когда утон-
ченное, когда шутливое, веселое, а чаще и то и другое — неизменно привлекали
к нему окружающих, и сейчас мне его очень не хватает. Благодарю тебя, Фрэнк,
где бы ты ни находился.
Нат
Генри Дэвид Торо писал: «То, что обычно называют дружбой, лишь немногим
более понятия чести у бродяг». Если это правда, я хочу поблагодарить двух
честных бродяг: Джона Оруэнта, руководившего моей работой в издательстве
«O’Reilly & Associates», и Линду Май, которая помогла мне сохранить эту работу.
Эта книга, как и первое издание, никогда не появилась бы на свет без энер-
гии Тома, его внимания к деталям и готовности взяться за самую тяжелую рабо-
ту. Спасибо тебе, Том, за то, что ты взял на себя хлопоты с Юникодом.
Напоследок хочу поблагодарить свою семью. На время работы над книгой
Дженин практически превратилась в мать-одиночку. Я слышал, как Уильям
печально сказал другу: «А мой папа все работает и работает — днем и ночью»,
а первое предложение из двух слов, произнесенное Рейли, — «Папа работает».
Спасибо вам всем!
От издательства
Ваши замечания, предложения, вопросы отправляйте по адресу электронной
почты comp@p1ter.com (издательство «Питер», компьютерная редакция).
Мы будем рады узнать ваше мнение!
На веб-сайте издательства http://www.p1ter.com вы найдете подробную инфор-
мацию о наших книгах.
Строки
«...И открыл легкомысленно уста свои,
и безрассудно расточает слова».
Книга Иова, 35:16
1.0. Введение
Многие языки программирования заставляют нас мыслить на неудобном низ-
ком уровне. Вам понадобилась строка, а язык хочет, чтобы вы работали с указа-
телями или байтами. Подобные мелочи лишь отвлекают программиста от основ-
ной задачи. Впрочем, не отчаивайтесь — Perl не относится к языкам низкого
уровня, и в нем удобно работать со строками.
Perl проектировался для обработки текста. На самом деле в Perl существует
такое количество текстовых операций, что их невозможно описать в одной гла-
ве. Рецепты обработки текста встречаются и в других главах. В частности, обра-
титесь к главе 6 «Поиск по шаблону» и главе 8 «Содержимое файлов» — в них
описаны интересные приемы, не рассмотренные в этой главе.
Основной единицей для работы с данными в Perl является скаляр (scalar),
то есть отдельное значение, хранящееся в отдельной (скалярной) переменной.
В скалярных переменных хранятся строки, числа и ссылки. Массивы и хэши
представляют собой соответственно списки или ассоциативные массивы скаля-
ров. Ссылки используются для косвенных обращений к другим величинам; они
отчасти похожи на указатели в языках низкого уровня. Числа обычно хранятся
в вещественном формате с двойной точностью. Строки в Perl могут иметь про-
извольную длину (ограниченную только объемом виртуальной памяти вашего
компьютера) и содержат произвольные данные — даже двоичные последователь-
ности с нулевыми байтами.
Строка Perl не является массивом символов или байтов. К отдельному сим-
волу нельзя обратиться по индексу, как к элементу массива, — для этого следует
воспользоваться функцией substr. Строки, как и все типы данных Perl, увеличи-
ваются и уменьшаются в размерах по мере необходимости. Неиспользуемые
данные уничтожаются системой сборки мусора Perl (обычно при выходе пе-
ременной из области видимости или после вычисления выражения, в которое
входит строка). Иначе говоря, об управлении памятью можно не беспокоиться —
об этом уже позаботились до вас.
1.0. Введение
33
Скалярная величина может быть определенной или неопределенной. Опре-
деленная величина содержит строку, число или ссылку. Единственным неопре-
деленным значением является undef, все остальные значения считаются опре-
деленными — даже 0 и пустая строка. Однако определенность не следует путать
с логической истиной; чтобы проверить, определена ли некоторая величина, сле-
дует воспользоваться функций defined. Логическая истина имеет особое значе-
ние, которое проверяется логическими операторами && и 11, а также в условии
блока while.
Две определенных строки считаются ложными: пустая строка ("") и строка
единичной длины, содержащая цифру «ноль» ("О")- Все остальные определен-
ные значения (такие, как "false", 15 или \$х) истинны. Возможно, вас несколько
удивит, что строковое значение "О" считается ложным, но это связано с тем, что
Perl выполняет преобразования между числами и строками по мере необходи-
мости. Значения 0., 0.00 и 0.0000000 являются числами и поэтому без кавычек
считаются ложными, поскольку число «ноль» в любом обличии ложно. Но эти
же три строковых значения ("0.", "0.00" и "0.0000000") становятся истинными,
когда они используются в программе в форме строковых литералов, заключен-
ных в кавычки, или читаются из командной строки, переменной окружения или
входного файла.
Обычно эти различия несущественны, поскольку при использовании значе-
ния в числовом контексте автоматически выполняется преобразование. Но если
значение еще не использовалось в числовом контексте, то проверка его истинно-
сти или ложности иногда приводит к неожиданному результату — логические
проверки никогда не вынуждают каких-либо преобразований. Прибавление О
к переменной заставляет Perl преобразовать строку в число:
print "Gimme a number: ":
0.00000
chomp($n = <STDIN>); # $n теперь содержит "0.00000":
print "The value $n is ". $n ? "TRUE" : "FALSE". "\n":
The value 0.00000 is TRUE
$n += 0:
print "The value $n is now ", $n ? "TRUE" : "FALSE". "\n";
The value 0 is now FALSE
В строковом контексте значение undef интерпретируется как пустая строка
(""). В числовом контексте undef интерпретируется как 0, а в ссылочном — как
нуль-ссылка. При этом во всех случаях оно считается ложным. Использование
неопределенной величины там, где Perl ожидает получить определенную, приво-
дит к выводу в STDERR предупреждения времени выполнения (если предупрежде-
ния не были запрещены). Простая проверка истинности или ложности не требу-
ет конкретного значения, поэтому предупреждение в этом случае не выдается.
Некоторые операции не выдают предупреждений при использовании перемен-
ных, содержащих неопределенные значения. К их числу относятся операторы
автоматического увеличения и уменьшения, ++ и а также сложение и конкате-
нация с присваиванием, += и . =.
34
Глава 1. Строки
В программах строки записываются в апострофах или в кавычках, в форме q//
или qq// или «встроенных документов» (here-documents). Независимо от выбран-
ной формы записи, строковые литералы делятся на интерполируемые и неин-
терполируемые. Под интерполяцией понимается замена ссылок на переменные
и специальных последовательностей символов. В большинстве случаев по умол-
чанию интерполяция выполняется — в частности, в шаблонах (/regex/) и при
выполнении команд ($х = ' cmd').
В некоторых ситуациях отдельные символы имеют особую интерпретацию.
С префиксом \ любой специальный символ становится обычным символом; дру-
гими словами, он превращается в простой литерал. Такое преобразование обыч-
но называется экранированием (escaping).
В каноническом варианте создания неинтерполируемых строковых литера-
лов строка заключается в апострофы. В таких строках распознаются всего три
специальных последовательности: ' завершает строку, \' вставляет в нее апост-
роф, а \\ — обратную косую черту:
Sstrlng = '\п': # Два символа. \ и п
Sstrlng = 'Jon \'Maddog\' Orwant': # Внутренние апострофы-литералы
В строках, заключенных в кавычки, возможна интерполяция имен перемен-
ных (но не вызовов функций — о том, как это делается, см. рецепт 1.15). В них
также поддерживаются различные служебные последовательности: "\п" (перевод
строки) "\033" (символ с восьмеричным кодом 33), "\cJ" — Ctrl+J, "\х1В" (символ
с шестнадцатеричным кодом 0x1 В) и т. д. Полный список приведен на странице
руководства perlop(\).
Sstrlng = "\п": # Символ перевода строки
Sstrlng = "Jon \"Maddog\" Orwant": # Внутренние кавычки
Если строка не содержит расширяемых служебных последовательностей или
переменных, вы можете использовать любую запись по своему усмотрению. Выби-
рая между 'this' и "this", некоторые программисты Perl предпочитают второй
вариант, чтобы строки лучше выделялись. К тому же кавычки предотвращают
даже малейшую вероятность того, что читатель программы спутает простой апост-
роф с обратным. Для Perl это несущественно, но чтение программы упрощается.
Операторы q// и qq// позволяют использовать произвольные ограничители
с интерполируемыми и неинтерполируемыми литералами; они являются ана-
логами строк, заключенных соответственно в апострофы и кавычки. Например,
для записи неинтерполируемой строки с внутренними апострофами проще вос-
пользоваться оператором q// вместо того, чтобы использовать экранированные
символы \':
Sstrlng = 'Jon VMaddogV Orwant': # Внутренние апострофы
Sstrlng = q/Jon 'Maddog' Orwant/: # To же самое, но более наглядно
В качестве разделителей могут использоваться одинаковые символы, как /
в приведенном примере, или любая из четырех комбинаций парных ограничите-
лей (различных типов скобок):
Sstrlng = q[Jon 'Maddog' Orwant]: # Внутренние апострофы
Sstrlng = q{Jon 'Maddog' Orwant}: # Внутренние апострофы
1.0. Введение
35
Sstrlng = q(Jon 'Maddog' Orwant); # Внутренние апострофы
Sstring = qOon 'Maddog' 0rwant>: # Внутренние апострофы
Концепция «встроенных документов» позаимствована из командных интер-
претаторов (shell) и предназначается для определения строк, содержащих боль-
шое количество текста. Текст может интерпретироваться по правилам для строк,
заключенных в апострофы или кавычки, и даже как перечень исполняемых ко-
манд — в зависимости от того, как задается завершающий идентификатор. В неин-
терполируемых встроенных документах не расширяются три основные служебные
последовательности, которые расширяются в литералах, заключенных в апост-
рофы. Например, следующий встроенный документ будет интерпретироваться
по правилам для строк, заключенных в кавычки:
$а = «"EOF":
This is a multiline here document
terminated by EOF on a line by itself
EOF
Обратите внимание: после завершающего ограничителя EOF точка с запятой не
ставится. Встроенные документы более подробно рассматриваются в рецепте 1.16.
Универсальная кодировка символов
С точки зрения компьютера любые данные (даже цепочки битов) представляют
собой последовательность отдельных чисел. Даже текстовая строка — всего
лишь последовательность числовых кодов, которые интерпретируются как сим-
волы браузерами, почтовыми программами, редакторами и системами печати.
В те времена, когда памяти было мало, а стоила она гораздо дороже, програм-
мисты вытворяли настоящие чудеса ради экономии памяти. На практике часто
применялись такие приемы, как упаковка шести символов в одно 32-разрядное
слово или трех символов — в одно 16-разрядное слово. Даже в наши дни длина
числовых кодов, используемых для обозначения отдельных символов, обычно не
превышает 7 или 8 бит (как в кодировках ASCII и Latinl соответственно).
Малое количество битов на символ приводит к тому, что количество представ-
ляемых символов также невелико. Как известно, палитра графического файла
с 8-разрядным цветом ограничивается всего 256 цветами. Аналогично, при хра-
нении символов в виде отдельных октетов (то есть байтов, состоящих из 8 бит)
документ может содержать не более 256 различных букв, знаков препинаний
и знаков.
Кодировка ASCII (American Standard Code for Information Interchange) не реша-
ла всех проблем за пределами Соединенных Штатов, поскольку в нее входили
лишь символы слегка усеченного американского диалекта английского языка.
Из-за этого многие страны разработали собственные, несовместимые 8-разряд-
ные кодировки на базе 7-разрядной кодировки ASCII. Появились конфликтные
схемы назначения символам числовых кодов из одного ограниченного интерва-
ла. Это означало, что в разных системах одно число могло обозначать разные
символы, а одному символу могли быть сопоставлены разные коды.
36
Глава 1. Строки
Одной из первых попыток решения этих и других проблем, обусловленных
национальной и языковой спецификой, стали локальные контексты (locales).
Они до сих пор неплохо справляются с задачами, не связанными с кодировкой
символов, — в частности, с настройкой региональных параметров (формата
денежных единиц, даты и времени) и даже с обработкой объединяющих после-
довательностей1. Но в области использования 8-разрядного пространства для
разных кодировок локальные контексты приносят гораздо меньше пользы.
Если потребуется создать документ, содержащий латинские и греческие сим-
волы, а также кириллицу, у вас возникнут большие проблемы, поскольку один
числовой код может представлять разные символы в каждой из этих кодировок.
Например, код 196 представляет символ А в кодировке ISO 8859-1 (Latin 1),
а в кодировке ISO 8859-7 этому коду соответствует греческая буква А. Получа-
ется, что программа, интерпретирующая код символа в ISO 8859-1, увидит один
символ, а в 8859-7 символ будет совершенно иным.
Различия в интерпретации затрудняют одновременное использование раз-
ных кодировок в одном документе. Впрочем, даже если вам как-то удастся со-
вместить их, лишь немногие программы смогут работать с полученным текстом.
Чтобы правильно идентифицировать символы, нужно знать, из какой системы
они были взяты, а это не позволяет легко переходить от одной системы к дру-
гой. Если же догадка окажется неверной, вместо осмысленного текста на экране
появится абракадабра (и то в лучшем случае).
Поддержка Юникода в Perl
На помощь программисту приходит Юникод.
Эта кодировка пытается объединить все наборы символов всего мира, вклю-
чая многочисленные неалфавитные знаки и даже вымышленные наборы симво-
лов. Юникод позволяет использовать в документе десятки тысяч (и даже боль-
ше) разных символов без всякой путаницы.
Все проблемы с А и А моментально исчезают. Первому символу, который
формально называется «латинской буквой А верхнего регистра с тремой», на-
значается код U+00C4 (рекомендуемая форма записи в Юникоде). Второму
символу, «греческая буква дельта верхнего регистра», теперь соответствует код
U+0394. Разным символам всегда соответствуют разные коды, что исключает
любые конфликты.
Поддержка Юникода в Perl появилась примерно с версии 5.6, но лишь с вер-
сии 5.8 она стала действительно надежной и пригодной для практического при-
менения. Тогда же в Perl появились уровни ввода/вывода и их поддержка при
программировании; такое совпадение вовсе не случайно. Эта тема более под-
робно обсуждается в главе 8.
Все строковые функции и операторы Perl, в том числе и используемые при
поиске по шаблону, теперь работают не с октетами, а с символами. Так, при вы-
1 Объединяющие последовательности (collating sequences) определяют комбинации симво-
лов, которые должны особым образом обрабатываться при сортировке и т. д. Например,
в немецком языке р считается символом, расположенным между «s» и «t», но сортируе-
мым как два <<s» подряд.
1.0. Введение
37
зове для строки функции 1 ength Perl возвращает размер строки в символах, а не
в байтах. При извлечении из строки первых трех символов функцией substr
длина результата может быть отлична от трех байт... а может быть равна трем
байтам. Вы этого не знаете, да это и не важно. К базовому низкоуровневому
представлению вообще не стоит слишком пристально приглядываться — если
вам приходится думать о нем, то, скорее всего, вы рассматриваете происходящее
со слишком близкого расстояния. Выбор представления не должен влиять на ра-
боту программиста — а если он все же влияет, это может означать, что реализа-
ция Perl еще не идеальна. Мы над этим работаем.
Поддержка символов с кодами, превышающими 256, означает, что аргумент
функции chr уже не ограничивается значением 256, а функция ord может возвра-
щать числа, большие этого значения. Например, по запросу chr(0x394) будет воз-
вращена греческая буква «дельта» верхнего регистра:
$char = chr(0x394):
$code = ord($char):
printf "char Is code £d, fc#04x\n", $char, $code, $code:
char A is code 916, 0x394
При проверке длины такой строки вы получите 1, потому что строка содер-
жит всего один символ. Обратите внимание: речь идет именно о символах, а не о
длине строки в байтах. Конечно, во внутреннем представлении такой большой
числовой код невозможно представить всего 8 битами. Но программист должен
работать с символами как с абстракциями, а не как с физическими октетами. Все
низкоуровневые детали такого рода лучше оставить Perl.
Не считайте символы и байты эквивалентными понятиями. Смешивая байты
с символами, вы впадаете в тот же грех, что и программисты С, легкомысленно
смешивающие целые числа с указателями. На некоторых платформах внутрен-
ние представления могут совпадать, но это всего лишь случайное совпадение,
а смешение абстрактных интерфейсов с физическими реализациями рано или
поздно ударит по самому программисту.
Существует несколько способов включения символов Юникода в литералы
Perl. Если ваш текстовый редактор позволяет вводить Юникод непосредственно
в программы Perl, то вы можете сообщить об этом при помощи директивы use
utf8. Другой способ основан на использовании служебных последовательностей
\х в интерполируемых строках Perl и задании шестнадцатеричного кода символа
(например, \хС4). Если код символа больше OxFF, то для его представления по-
требуется более двух шестнадцатеричных цифр, поэтому такие коды должны за-
ключаться в фигурные скобки:
print "\хС4 and \х{0394] look different\n":
char A and A look different
В рецепте 1.5 рассказано, как использовать названия символов для включения
в строковые литералы конструкций \N{/W£}. Например, символ А может задавать-
ся в виде \N{GREEK CAPITAL LETTER DELTA}, \N{greek:Delta} и даже просто \N{Delta}.
Чтобы работать с Юникодом в Perl, достаточно и этого, но для взаимодейст-
вия Perl с другими программами потребуется кое-что еще.
В старых однобайтовых кодировках (таких, как ASCII или ISO 8859-гг) при
выводе символа с числовым кодом NN выводился один байт с числовым значе-
38
Глава 1. Строки
нием NN. Конкретный вывод зависел от доступных шрифтов, от выбранного ло-
кального контекста и ряда других факторов. Но в Юникоде уже не существует
однозначного соответствия между логическими кодами символов (кодовыми
пунктами) и выводимыми физическими байтами. Теперь логические коды могут
представляться в любом из нескольких доступных выходных форматов.
Во внутренней работе Perl используется формат UTF-8, но для Юникода
существует много других форматов выходной кодировки; Perl может работать
и с этими форматами. Директива use encoding сообщает Perl, в какой кодировке
написан сам сценарий и какая кодировка должна использоваться для стандарт-
ных файловых манипуляторов. Директива use open задает выходную кодировку
по умолчанию для всех манипуляторов. Формат кодировки для конкретного
файлового манипулятора задается при помощи специальных аргументов функ-
ций open и binmode. Ключ командной строки -С задает кодировку для всех (или
только для стандартных) манипуляторов, а также для самих аргументов програм-
мы. Переменные окружения PERLIO, PERL_ENCODING и PERLJJNICODE сообщают Perl
дополнительную информацию, относящуюся к этой теме.
1.1. Работа с подстроками
Проблема
Требуется получить или модифицировать не целую строку, а лишь ее часть. На-
пример, вы прочитали запись с фиксированной структурой и теперь хотите из-
влечь из нее отдельные поля.
Решение
Функция substr предназначена для чтения и записи отдельных частей строки:
$value = substr($string. Soffset, Scount):
Svalue = substr($string, Soffset):
substr($string, Soffset, Scount) = Snewstring:
substr($string. Soffset, Scount, Snewstring): # Эквивалент предыдущей строки
substr($string, Soffset) =$newtail:
Функция unpack ограничивается доступом только для чтения, но при извлече-
нии нескольких подстрок работает быстрее:
# Получить 5-байтовую строку, пропустить 3 байта,
# затем извлечь две 8-байтовых строки, затем все остальное
# (Примечание: работает только с ASCII-данными, но не с Юникодом)
(Sleading, Ssl, Ss2, Strailing) =
unpack(”A5 x3 A8 A8 A*", Sdata):
# Деление на группы из пяти байт
stivers = unpack("A5" х (1ength(Sstring)/5), Sstring):
# Деление строки на однобайтовые символы
@chars = unpackCAl" х 1 ength(Sstring), Sstring):
1.1. Работа с подстроками
39
Комментарий
Строки Perl входят в число базовых типов данных; они не являются массива-
ми, содержащими элементы базовых типов. Это означает, что для работы с от-
дельными символами или подстроками вместо индексирования, как в других
языках программирования, в Perl применяются такие функции, как unpack
или substr.
Второй аргумент substr (смещение) определяет начало интересующей вас
подстроки; положительные значения отсчитываются от начала строки, а отрица-
тельные — с конца. Если смещение равно 0, подстрока начинается с начала. Тре-
тий аргумент определяет длину подстроки.
Sstring = "This is what you have";
# +012345678901234567890 Прямое индексирование (слева направо)
# 109876543210987654321- Обратное индексирование (слева направо)
0 соответствует 10, 20 и т. д.
Sfirst = substr(Sstring, 0, 1); # "T"
Sstart = substr($string, 5. 2): # "is"
Srest = substr($str1ng, 13): # "you have"
$last = substr($string, -1): # "e"
Send = substr($string, -4); # "have"
Spiece = substr($string, -8, 3); # "you"
Однако функция substr позволяет не только просматривать части строки,
но и изменять их. Дело в том, что substr относится к экзотической категории
левосторонних функций, то есть таких, которым при вызове можно присвоить
значение. К тому же семейству относятся функции vec, pos и keys (а при некото-
рой фантазии функции local, my и our также можно рассматривать как левосто-
ронние).
Sstring = "This is what you have";
print Sstring;
This is what you have
substr($string, 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
substr($string, -10) = # Удалить последние 10 символов
his wasn’
Применяя оператор =~ в сочетании с операторами s///, т// или tr///, можно
заставить их работать только с определенной частью строки:
# Проверка подстрок по шаблону
if (substr(Sstring, -10) =~ /pattern/) {
print "Pattern matches in last 10 characters\n";
}
# Подставить "at" вместо "is" в первых пяти символах строки
substr(Sstring. 0, 5) =~ s/is/at/g:
40
Глава 1. Строки
Более того, подстроки даже можно поменять местами, используя с каждой
стороны присваивания несколько вызовов substr:
# Поменять местами первый и последний символы строки
$а = "make a hat":
(substr($a,0,1). substr(Sa.-D) = (substr($a,-1), substr(Sa,0,1)):
print Sa:
take a ham
Хотя функция unpack не является левосторонней, она работает значительно
быстрее substr, особенно при одновременном извлечении нескольких величин.
Структура извлекаемой записи определяется специальной форматной строкой,
в которой символ "х" нижнего регистра с числом пропускает заданное количест-
во байт в прямом направлении, а символ "X" верхнего регистра — в обратном на-
правлении. Символ перемещается к заданному смещению в байтах внутри
записи. Если вы работаете со строковыми данными Юникода, будьте осторожны
при использовании этих трех спецификаторов: они работают только на уровне
байтов, а выполнять байтовые операции в многобайтовых кодировках в лучшем
случае рискованно.
# Извлечение подстроки функцией unpack
$а = "То be or not to be";
Sb = unpack("x6 A6", Sa): # Пропустить 6 символов, прочитать 6 символов
print $b:
or not
(Sb. Sc) = unpack("x6 A2 X5 A2", Sa); # Вперед 6, прочитать 2:
# назад 5, прочитать 2
print "$b\n$c\n";
or
be
Иногда строка «режется» на части в определенных позициях. Предположим,
вам захотелось установить позиции разделения перед символами 8, 14, 20, 26
и 30 — в каждом из перечисленных столбцов начинается новое поле. В принци-
пе форматная строка unpack вычисляется просто — "А7 А6 А6 А4 А*", но програм-
мист на Perl по природе ленив и не желает попусту напрягаться. Пусть за него
работает Perl. Воспользуйтесь приведенной ниже функцией cut2fmt:
sub cut2fmt {
my(@positions) =
my Stemplate = ”;
my Slastpos = 1:
foreach Splace(positions) {
Stemplate .= "A" . (Splace - Slastpos) . " ":
Slastpos = Splace:
}
Stemplate .= "A*":
return Stemplate:
}
Stmt = cut2fmt(8, 14, 20. 26, 30):
print "$fmt\n":
A7 A6 A6 A6 A4 A*
1.2. Выбор значения по умолчанию
41
Возможности функции unpack выходят далеко за пределы обычной обработки
текста. Она также может использоваться для преобразования между текстовыми
и двоичными данными.
В настоящем рецепте предполагается, что все символы представляются в 7- или
8-разрядной кодировке, иначе байтовые операции unpack не будут работать так,
как предполагается.
См. также
Описание функций unpack и substr в perlfunc{\.)\ процедура cut2fmt из рецепта 1.24.
Применение unpack для двоичных данных продемонстрировано в рецепте 8.24.
1.2. Выбор значения по умолчанию
Проблема
Требуется закрепить за скалярной переменной значение по умолчанию, но лишь
в том случае, если оно не было задано явно в программе. Довольно часто требу-
ется, чтобы стандартное значение переменной было жестко закодировано в про-
грамме, но его можно было переопределить из командной строки или перемен-
ной окружения.
Решение
Воспользуйтесь оператором 11 или 11 =, работающим как со строками, так и с чис-
лами:
# Использовать $Ь. если значение $Ь истинно, и $с в противном случае
$а = $Ь || $с:
# Присвоить $х значение $у. но лишь в том случае,
# если $х не является истиной
$х ||= $у;
Если переменная может принимать значения О, "О" и воспользуйтесь функ-
цией defined:
# Использовать $Ь, если значение $Ь определено, и $с в противном случае
$а = def1ned($b) ? $b : $с:
# "Новый" оператор "определено-или" из будущей версии Perl
use 5.9;
$а = $b // $с:
Комментарий
Главное отличие между этими двумя решениями (defined и | |) состоит, прежде
всего, в том, что именно проверяется — определенность или истинность. В мире
Perl три определенных значения являются ложными: О, "О" и Если ваша
42
Глава 1. Строки
переменная содержит одну из этих величин, но вы не хотите изменять ее, 11 не
подойдет — приходится выполнять неуклюжие проверки с defl ned. Часто бывает
удобно организовать программу так, чтобы принималась в расчет истинность
или ложность переменных, а не их определенность.
В отличие от других языков, где возвращаемые значения ограничиваются О
и 1, в Perl оператор 11 обладает более интересным свойством: он возвращает
первый (левый) операнд, если тот имеет истинное значение; в противном случае
возвращается второй операнд. Оператор && ведет себя аналогично (для второго
выражения), но этот факт используется реже. Для этих операторов несущест-
венно, что представляют собой их операнды — строки, числа или ссылки; подой-
дет любое скалярное значение. Они просто возвращают первый операнд, из-за
которого все выражение становится истинным или ложным. Возможно, это рас-
ходится с возвращаемым значением в смысле булевой алгебры, но такими опе-
раторами удобнее пользоваться.
Это позволяет установить значение по умолчанию для переменной, функции
или более длинного выражения в том случае, если первый операнд не подходит.
Ниже приведен пример использования 11, в котором $foo присваивается либо
$bar, либо, если значение $bar ложно, — строка "DEFAULT VALUE":
$foo = $bar || "DEFAULT VALUE"
В другом примере переменной $dir присваивается либо первый аргумент ко-
мандной строки программы, либо "/tmp", если аргумент не указан:
$diг = shlft(@ARGV) || "/tmp"
То же самое можно сделать и без изменения @ARGV:
$d1г = $ARGV[0] || "/tmp"
Если 0 является допустимым значением $ARGV[0], использовать 11 нельзя, по-
тому что вполне нормальное значение будет интерпретировано как ложное.
Приходится обращаться к тернарному оператору выбора:
$diг = def1ned($ARGV[0]) ? sh1ft(@ARGV) : "/tmp";
То же можно записать и иначе, со слегка измененной семантикой:
$dir = ©ARGV ? $ARGV[0] : "/tmp"
Мы проверяем количество элементов в @ARGV. В условии оператора выбора
(?:) @ARGV интерпретируется в скалярном контексте. Значение будет ложным лишь
при нулевом количестве элементов, в этом случае будет использоваться "/tmp".
В остальных ситуациях (то есть при заданных аргументах) переменной будет
присвоен первый аргумент командной строки.
Следующая строка увеличивает значение %count, при этом в качестве ключа
используется значение $shell, а если оно ложно — строка "/bin/sh":
$count{ $shel1 || "/bin/sh" }++;
В одном условии можно объединить несколько альтернативных вариантов,
как показывает следующий пример. Результат выражения определяется первым
операндом, имеющим истинное значение.
1.2. Выбор значения по умолчанию
43
# Определить имя пользователя в системе Unix
Suser = $ENV{USER}
|| $ENV{LOGNAME}
11 getloginO
|| (getwu1d($<))[0]
|| "Unknown uid number S<":
Оператор && работает аналогично; он возвращает свой первый операнд, если
этот операнд ложен. В противном случае возвращается второй операнд. Посколь-
ку ложные значения представляют интерес существенно реже, чем истинные,
это свойство используется не так часто. Некоторые возможные применения про-
демонстрированы в рецептах 13.12 и 14.19.
Оператор присваивания 11 = выглядит странно, но работает точно так же, как
и остальные операторы присваивания. Практически для всех бинарных операто-
ров Perl $VAR 0Р= VALUE означает SVAR = SVAR OP VALUE; например, $a += $b — то же,
что и $a = $a + $b. Следовательно, оператор 11= может использоваться для присваи-
вания переменной, значение которой интерпретируется как ложное. Поскольку
11 выполняет простую логическую проверку (истина или ложь), у него не быва-
ет проблем с неопределенными значениями, даже при включенном выводе пре-
дупреждений. В следующем примере 11= присваивает переменной Sstartlngjxnnt
строку "Greenwich", если значение переменной не было задано ранее. Предпола-
гается, что $starting_point не принимает значений 0 или "0", а если принимает —
то такие значения должны быть заменены.
Sstart1ng_po1nt ||= "Greenwich"
В операторах присваивания 11 нельзя заменять оператором or, поскольку or
имеет слишком низкий приоритет. Выражение $а = $b or $с эквивалентно ($а =
$b) or $с. В этом случае переменной $Ь всегда присваивается $а, а это совсем не
то, чего вы добивались.
Не пытайтесь распространить это любопытное применение 11 и 11 = со ска-
лярных величин на массивы и хэши. У вас ничего не выйдет, потому что левый
операнд интерпретируется в скалярном контексте. Вместо этого приходится
делать что-нибудь подобное:
@а = @b unless @а: # Копировать, если массив пуст
@а = @Ь ? @Ь : @с: # Присвоить @Ь. если он не пуст, иначе @с
Ожидается, что когда-нибудь в Perl будут поддерживаться новые операторы
//, //= и err. Возможно, это уже произойдет к тому моменту, когда вы будете
читать эту книгу. Новые операторы будут работать аналогично оператору 11,
но вместо истинности они будут проверять определенность переменных, поэто-
му следующие пары станут эквивалентными:
Sa = deflned(Sb) ? Sb : $с:
Sa = Sb // Sc:
$х = deflned(Sx) ? $х : $у:
$х //= Sy;
def1ned(read(FH, Sbuf, Scount) or die "read failed: $!":
readtFH, Sbuf, Scount) err die "read failed: S!":
44
Глава 1. Строки
Эти три оператора уже включены в Perl версии 5.9. Как и все версии с нечет-
ными номерами, версия 5.9 является экспериментальной, поэтому использовать
ее в среде реальной эксплуатации не рекомендуется. Видимо, операторы оста-
нутся в стабильной версии 5.10 и наверняка будут поддерживаться в версии 6,
дата выхода которой пока остается неопределенной.
См. также
Описание оператора 11 в perlop(l\ описание функций defined и exists в perlfunc(l).
1.3. Перестановка значений без использования
временных переменных
Проблема
Требуется поменять значения двух скалярных переменных, но вы не хотите ис-
пользовать временную переменную.
Решение
Воспользуйтесь присваиванием по списку:
($VAR1. SVAR2) = ($VAR2. $VAR1);
Комментарий
В большинстве языков программирования перестановка значений двух перемен-
ных требует промежуточного присваивания:
Stemp = $а;
$а = $Ь;
$b = Stemp;
В Perl дело обстоит иначе. Язык следит за обеими сторонами присваивания
и гарантирует, что ни одно значение не будет случайно стерто. Это позволяет
избавиться от временных переменных:
$а = "alpha";
$b = "omega";
($а, $Ь) = ($Ь. $а); # Первый становится последним - и наоборот
Подобным способом можно поменять местами сразу несколько переменных:
(Salpha, $beta. Sproduction) = qw(January March August);
# beta перемещается в alpha.
# production - в beta,
# alpha - в production
(Salpha, Sbeta, Sproduction) = (Sbeta, Sproduction. Salpha);
Значения переменных Salpha, $beta и Sproduction после завершения этого фраг-
мента будут равны соответственно "March", "August" и "January".
1.4. Преобразование между символами и ASCII-кодами
45
См. также
Раздел «List value constructors» perlop(V).
1.4. Преобразование между символами
и ASCII-кода ми
Проблема
Требуется вывести код, соответствующий некоторому символу в кодировке
ASCII, или наоборот — символ по ASCII-коду.
Решение
Воспользуйтесь функцией ord для преобразования символа в числовой код или
функцией ch г — для преобразования числового кода в символ:
Snum = ord(Schar):
Schar = chr(Snum);
Формат в функциях prlntf и sprlntf также преобразует число в символ:
$char = sprlntf("%c". Snum); # Медленнее, чем chr(Snum)
prlntf("Number Xd Is character %c\n", Snum, Snum);
Number 101 is character e
Шаблон С* используемый в функциях pack и unpack, позволяет быстро преоб-
разовать несколько 8-разрядных символов; для символов Юникода следует ис-
пользовать шаблон U*:
kbytes = unpackCC*". Sstring);
©string = packCC*", kbytes);
Sunlstr = pack("U4",0x24b6,0x24b7,0x24b8,0x24b9):
@unichars = unpacked*". Sunlstr);
Комментарий
В отличие от низкоуровневых, нетипизованных языков вроде ассемблера, Perl
не считает эквивалентными символы и числа; эквивалентными считаются строки
и числа. Это означает, что вы не можете произвольно присвоить вместо символа
его числовое представление или наоборот. Для преобразования между символами
и их числовыми значениями в Perl существуют функции chr и ord, взятые из Pascal:
Svalue = ord("e"); # Теперь 101
Scharacter = chr(101): # Теперь "e"
Символ в действительности представляется строкой единичной длины, по-
этому его можно просто вывести функцией print или с помощью формата $s
функций prlntf и sprlntf. Формат заставляет prlntf или sprlntf преобразовать
46
Глава 1. Строки
число в символ, однако он не позволяет вывести символ, который уже хранится
в символьном формате (то есть в виде строки).
printf("Number is character %c\n", 101, 101);
Функции pack, unpack, chr и ord работают быстрее, чем sprintf. Ниже приведе-
ны примеры практического применения pack и unpack:
@ascii_character_numbers = unpack("С*". "sample");
print "@ascii_character_numbers\n";
115 97 109 112 108 101
Sword = packC’C*", ascii_character_numbers):
Sword = packC’C*". 115, 97, 109, 112, 108. 101); # To же самое
print "Sword\n"
sample
А вот как превратить HAL в IBM:
Shal = "HAL":
@byte = unpackC'C*", Shal);
foreach Sval (@byte) {
$val++; # Увеличивает каждый ASCII-код на 1
}
Sibm = packC’C*", @byte);
print "Sibm\n"; # Выводит "IBM"
Для однобайтовых символьных данных (таких, как старая добрая кодировка
ASCII или любые наборы семейства ISO 8859) функция ord возвращает числа от
О до 255. Этот диапазон соответствует типу данных unsigned char языка С.
Однако Perl этим не ограничивается: в нем появилась интегрированная под-
держка универсальной кодировки Юникода. Если при вызове chr, sprintf "Яс"
или pack "U*" передаются значения, превышающие 255, то полученный результат
будет представлять собой строку Юникода.
Ниже приведен аналог предыдущего фрагмента в Юникоде:
@unicode_points = unpacked*", "fac\x{0327}ade");
print "@unicode_points\n";
102 97 99 807 97 100 101
Sword = packC'U*", @unicode_points);
print "$word\n";
facade
Если требуется лишь вывести коды символов, возможно, вам даже не придет-
ся использовать unpack. У функций Perl printf и sprintf существует модифика-
тор v, который работает следующим образом:
printf "£vd\n", "fac\x{0327}ade":
102.97.99.807.97.100.101
printf ’’£vx\n’’. "fac\x{0327}ade";
66.61.63.327.61.64.65
Функции выводят числовые коды всех символов строки (в терминологии
Юникода — «кодовые пункты»), разделенные точками.
1.5. Использование именованных символов Юникода
47
См. также
Описание функций chr, ord, prlntf, sprlntf, pack и unpack в perlfunc(\}.
1.5. Использование именованных
символов Юникода
Проблема
Требуется обозначать нестандартные символы в программе по именам, без воз-
ни с их числовыми кодами.
Решение
Включите в начало файла директиву use charnames, а затем свободно включайте
в строковые литералы служебные последовательности "\N{...}".
Комментарий
Директива use charnames позволяет использовать символические имена для сим-
волов Юникода. Имена представляют собой константы времени компиляции, для
обращения к которым используются служебные последовательности вида \N {...}.
Для директивы use charnames поддерживается ряд поддиректив. Поддиректива
: ful 1 открывает доступ ко всему интервалу имен символов, но вам придется за-
писывать их полностью и точно в таком виде, как они хранятся в базе данных
символов Юникода (в частности, имена должны записываться в верхнем реги-
стре). Поддиректива -.short позволяет использовать удобные сокращения. Им-
портируемое имя без префикса «:» воспринимается как имя алфавита, что дает
возможность использовать для указанного алфавита сокращенные имена симво-
лов с учетом регистра.
use charnames ’:ful1’:
print "\N{GREEK CAPITAL LETTER DELTA} Is called deltaAn";
A Is called delta.
use charnames ':short';
print "\N{greek:Delta} Is an upper-case deltaAn":
A Is an upper-case delta.
use charnames qw(cyri111c greek);
print "\N{S1gma} and \N{s1gma} are Greek sigmas An";
print "\N{Be} and \N{be} are Cyrillic besAn";
X and о are greek sigmas.
Б and 6 are Cyrillic bes.
48
Глава 1. Строки
Функции charnames:: viacode и charnames::vianame выполняют преобразования
между числовыми кодовыми пунктами и длинными именами. В документации
Юникода символ с кодовым пунктом ХХХХ обозначается как U+XXXX, поэтому
мы также воспользуемся этим обозначением при выводе данных в следующем
примере:
use charnames qw(:full):
for $code (0xC4. 0x394) {
prlntf "Character U404X (%s) Is named %s\n".
Scode. chr(Scode). charnames::v1acode(Scode):
}
Character U+00C4 (A) Is named LATIN CAPITAL LETTER A WITH DIAERESIS
Character U+0394 (A) is named GREEK CAPITAL LETTER DELTA
use charnames qw(:ful1):
Sname = "MUSIC SHARP SIGN":
Scode = charnames::v1aname(Sname):
prlntf "%s Is character IH04X (%s)\n".
Sname. $code, chr(Scode):
MUSIC SHARP SIGN Is character U+266F ( # )
Имя копии базы данных символов Юникода в Perl определяется так:
% perl -MConflg -le 'print "$Conf1g{pr1vl1b}/un1core/NamesL1st.txt"'
/usr/1ocal/11b/perl5/5.8.1/uni core/NamesLi st.txt
Из этого файла можно узнать доступные имена символов.
См. также
Chamames(3y, база данных символов Юникода по адресу http://www.un1code.org.
1.6. Посимвольная обработка строк
Проблема
Требуется последовательно обрабатывать строку по одному символу.
Решение
Воспользуйтесь функцией split с пустым шаблоном, чтобы разбить строку на от-
дельные символы, или функцией unpack, если вам нужны лишь коды символов:
@array = sp!1t(//, Sstring); # Список содержит отдельные символы
@array = unpackCU*", Sstring): # Список содержит кодовые пункты (числа)
Также можно последовательно выделять очередной символ в цикле:
while (/(.)/g) { # Символ . не совпадает с символом перевода строки
# Переменная $1 содержит символ. ord(Sl) - числовой код символа.
1.6. Посимвольная обработка строк
49
Комментарий
Как говорилось выше, базовой единицей текста в Perl является строка, а не сим-
вол. Необходимость посимвольной обработки строк возникает достаточно ред-
ко. Обычно такие задачи легче решаются с помощью высокоуровневых опера-
ций Perl (например, поиск по шаблону). Пример приведен в рецепте 7.14, где
для поиска аргументов командной строки используются подстановки.
Если вызвать split с шаблоном, который совпадает с пустой строкой, функ-
ция вернет список отдельных символов строки. При намеренном использовании
эта особенность оказывается удобной, однако с ней можно столкнуться и слу-
чайно. Например, /X*/ совпадает с любыми строками, включая пустую строку.
Не исключено, что вам встретятся и другие ненамеренные совпадения.
Следующий пример выводит символы строки "an apple a day", отсортирован-
ные по возрастанию:
%seen = О;
Sstring = "an apple a day":
foreach Schar (split //, Sstring) {
$seen{$char}++:
}
print "unique chars are: ", sort(keys %seen), "\n":
unique chars are: adelnpy
Решения с функциями spl it и unpack предоставляют массив символов, с кото-
рым можно выполнять дальнейшие операции. Если массив не нужен, восполь-
зуйтесь поиском по шаблону в цикле while с флагом /д, который извлекает по
одному символу из строки:
%seen = 0:
Sstring = "an apple a day":
while (Sstring =~ /(. )/g) {
Sseen{$1}++:
}
print "unique chars are: ", sort(keys %seen), "\n":
unique chars are: adelnpy
Как правило, посимвольная обработка строк не является оптимальным реше-
нием. Иногда вместо использования 1 ndex/substr или spl it/unpack проще восполь-
зоваться шаблоном. В следующем примере 32-разрядная контрольная сумма вы-
числяется вручную, но лучше поручить работу функции unpack — она сделает то
же самое намного эффективнее.
Следующий пример вычисляет контрольную сумму символов Sstring в цикле
foreach. Приведенный алгоритм не оптимален; просто мы используем традици-
онную и относительно легко вычисляемую сумму. Если вам потребуются более
совершенные средства вычисления контрольной суммы, воспользуйтесь стан-
дартным1 модулем Digest::MD5.
1 Модуль стал стандартным начиная с версии 5.8. Если вы используете более старую
версию, загрузите его из архива CPAN.
50
Глава 1. Строки
$sum = 0;
foreach $byteval (unpack("С*". Sstrlng)) {
$sum += $byteval;
}
print "sum Is $sum\n":
# Для строки "an apple a day" выводится сумма 1248
Следующий вариант делает то же самое, но намного быстрее:
$sum = unpack("£32C*", $str1ng);
Это позволяет эмулировать программу вычисления контрольной суммы SysV:
#!/usr/bln/perl
# sum - вычисление 1б-разрядной контрольной суммы всех входных файлов
$checksum = 0;
while (<>) { $checksum += ипраскС'ИбС*", $_) }
$checksum %= (2 ** 16) - 1;
print "$checksum\n":
Фактически это выглядит так:
% perl sum /etc/termcap
1510
Если у вас установлена GNU-версия sum, то для получения идентичного отве-
та для того же файла ее следует вызвать с параметром -sysv:
% sum -sysv /etc/termcap
1510 851 /etc/termcap
В примере 1.1 приведена еще одна крошечная программа, в которой так-
же реализована посимвольная обработка входных данных. Идея заключается
в том, чтобы вывод каждого символа сопровождался небольшой паузой — текст
отображается перед читателями в замедленном темпе, чтобы его было удобнее
читать.
Пример 1.1. slowcat
#!/usr/bln/perl
# slowcat -замедленный вывод
# использование: slowcat [-DELAY] [files...],
# где DELAY - задержка
$DELAY = ($ARGV[O] =~ /A-([.\d]+)/) ? (shift, $1) : 1:
$| = 1:
while (<>) {
for (sp!1t(//)) {
print;
select(undef.undef.undef, 0.005 * $DELAY);
}
}
См. также
Описание функций split и unpack вperlfunc(\)\ применение select для организа-
ции задержки объясняется в рецепте 3.10.
1.7. Обратная перестановка слов или символов
51
1.7. Обратная перестановка
слов или символов
Проблема
Требуется изменить порядок символов или слов в строке на противоположный.
Решение
Для перестановки байтов воспользуйтесь функцией reverse в скалярном контексте:
Srevchars = reverse(Sstring):
Для перестановки слов воспользуйтесь reverse в списковом контексте с функ-
циями split и join:
Srevwords = joint" ". reverse splitC ". Sstring);
Комментарий
У функции reverse существует два варианта применения. В скалярном контек-
сте функция объединяет аргументы и возвращает полученную строку в обрат-
ном порядке. В списковом контексте функция возвращает свои аргументы в об-
ратном порядке. Если функция reverse применяется для перестановки символов
в неочевидной ситуации, воспользуйтесь функцией scalar для форсированного
применения скалярного контекста.
Sgnirts = reverse(Sstring); # Перестановка символов Sstrlng
Ssdrow = reverse(@words); # Перестановка элементов @words
Sconfused = reverse(@words): # Перестановка букв в joint"", @words)
Рассмотрим пример обратной перестановки слов в строке. Вызов функции
split с шаблоном " " является особым случаем: он заставляет split использовать
в качестве разделителя смежные пропуски (whitespace) и отбрасывать началь-
ные пустые поля (по аналогии с awk). Обычно split отбрасывает только конеч-
ные пустые поля.
# Обратная перестановка слов
Sstring = 'Yoda said, "can you see this?"':
Oallwords = splitC ". Sstring):
Srevwords = joint" ". reverse ©allwords);
print Srevwords. "\n";
this?" see you "can said. Yoda
Временный массив @allwords можно убрать и сделать все в одной строке:
Srevwords = joint" ". reverse splitC ", Sstring);
Смежные пропуски в Sstring превращаются в один пробел в Srevwords. Чтобы
сохранить существующие пропуски, поступите так:
Srevwords = joint"", reverse split t/(\s+)/. Sstring));
52
Глава 1. Строки
С помощью функции reverse можно проверить, является ли слово палиндро-
мом (то есть читается ли одинаково в обоих направлениях):
Sword = "reviver":
$1s_palIndrome = (Sword eq reverse(Sword));
Программа для поиска длинных палиндромов в файле /usr/dlct/words запи-
сывается в одну строку:
% perl -nle 'print if $_ eq reverse && length >5' /usr/dlct/words
deedeed
degged
deified
denned
hall ah
kakkak
murdrum
redder
repaper
retter
revi ver
rotator
sooloos
tebbet
terret
tut-tut
См. также
Описание функций split, reverse и scalar в perlfunc(l); рецепт 1.8.
1.8. Интерпретация комбинированных
символов Юникода как одиночных символов
Проблема
Строка Юникода содержит комбинированные символы. Требуется интерпрети-
ровать каждую из комбинированных последовательностей как один логический
символ.
Решение
Обработайте строку, используя регулярное выражение с метасимволом \Х:
Sstring = "fac\x{0327}ade"; # fagade
Sstring =~ "fa.ade":
Sstring =~ "fa\Xade";
# Неудача
# Совпадение
@chars = sp!1t(//, Sstring); # 7 букв в @chars
# To же самое
@chars = Sstring =~ /(.)/g;
@chars = Sstring =~ /(\X)/g: # 6 "букв" в @chars
1.8. Интерпретация комбинированных символов Юникода как одиночных символов
53
Комментарий
В Юникоде базовые символы могут комбинироваться с одним или несколькими
символами нулевой ширины, следующими за ним (обычно это всевозможные ди-
акритические знаки: акценты, седили, тильды и т. д.). Главным образом для под-
держки старых символьных систем существуют два варианта записи символов.
Например, слово «facade» можно записать так, чтобы между двумя буквами
«а» находился один символ "\х{Е7}" из кодировки Latinl (ISO 8859-1). Возмож-
но, в кодировке UTF-8, используемой во внутренней работе Perl, эти два симво-
ла представляются двухбайтовой последовательностью, но эти два байта все
равно интерпретируются как отдельный символ.
Однако существует и другой способ записи. Символ U+00E7 может быть
представлен двумя кодовыми пунктами: обычной буквой «с», за которой следует
"\х{ 0327} . Кодовый пункт U+0327 соответствует комбинационному символу
нулевой ширины, который означает, что под предыдущим базовым символом
должен находиться седиль.
Иногда бывает нужно, чтобы Perl интерпретировал каждый комбинирован-
ный символ как один логический символ. Но поскольку комбинированный сим-
вол представлен несколькими кодовыми пунктами, символьные операции Perl
(включая функции substr и length, а также метасимволы регулярных выражений
/./и /[^abc]/) интерпретируют комбинационные символы нулевой ширины как
самостоятельные символы.
В регулярном выражении метасимвол \Х совпадает с последовательностью,
определяющей комбинированный символ Юникода. Он в точности эквивален-
тен конструкции (?:\РМ\рМ*), или в расширенной записи:
(?х: # Начало несохраняющей группы
\РМ # Один символ без свойства М (знак)
# (например, буква);
\рМ # один символ со свойством М (знак)
# (например, акцент),
* # который может повторяться любое количество раз
)
Без метасимвола \Х присутствие этих комбинаций в строке основательно запу-
тывает даже простейшие операции. Рассмотрим пример с обратной перестанов-
кой символов слова из предыдущего рецепта. В комбинированной записи слова
«аппёе» и «nino» представляются в Perl в виде "anneXxlSOlle" и "п1п\х{303}о".
for Sword ("anne\x{301}e", "n1n\x{303}o") {
printf "£s simple reversed to £s\n", Sword,
scalar reverse Sword;
printf '7s better reversed to £s\n". Sword,
joInC", reverse Sword =~ /\X/g):
}
Результат выглядит так:
аппёе simple reversed to eenna
аппёе better reversed to eenna
nino simple reversed to onin
nino better reversed to onin
54
Глава 1. Строки
В примитивных перестановках первой и третьей строки диакритический знак
перескочил с одного базового символа на другой. Дело в том, что комбинацион-
ный символ всегда следует за своим базовым символом, а мы переставили все
символы в строке. Захватывая всю последовательность из базового символа и всех
комбинационных символов, следующих за ним, мы избавляемся от этой пробле-
мы при последующей перестановке элементов списка.
См. также
Perlre{\.) и perluniintro(Vp рецепт 1.9.
1.9. Приведение строк с комбинированными
символами Юникода к каноническому виду
Проблема
Две строки одинаково выглядят при выводе, но при проверке равенства они
считаются различными, а иногда даже имеют разную длину. Как добиться того,
чтобы Perl считал эти строки одинаковыми?
Решение
Если хотя бы некоторые из сравниваемых строк содержат комбинированные
символы Юникода, то при сравнении следует использовать результаты обработ-
ки этих строк функцией NFDO модуля Unicode: formalize:
use Unicode::NormalIze:
$sl = "fa\x{E7}ade":
$s2 = "fac\x{0327}ade":
if (NFD($sl) eq NFD($s2)) { print "YupiXn" }
Комментарий
Одни и те же символы в некоторых случаях могут определяться разными спосо-
бами. Иногда это происходит при использовании старых кодировок — напри-
мер, букв с диакритическими знаками из кодировки Latin 1. Такие буквы зада-
ются либо непосредственно в виде отдельного символа (например, U+00E7,
строчная латинская буква «с» с седилем), либо косвенно, как сочетание базово-
го символа (U+0063, строчная латинская буква «с») с комбинационным симво-
лом (U+0327, седиль).
Возможен и другой вариант: если за базовым символом следуют два и более
знака, которые могут следовать в разном порядке. Допустим, вы хотите исполь-
зовать символ «с» с седилем и коронкой, чтобы на печати выводился символ с.
Такой символ может определяться несколькими способами:
Sstrlng = V231.780:
# Строчная латинская буква С с седилем
# Комбинационная коронка
1.10. Интерпретация строки Юникода как последовательности октетов
55
Sstring = v99.807.780:
# Строчная латинская буква С
# Комбинационная коронка
# Комбинационный седиль
Sstring = v99.780.807;
# Строчная латинская буква С
# Комбинационный седиль
# Комбинационная коронка
Функции нормализации приводят эти варианты к единому порядку. Суще-
ствует несколько таких функций, в том числе функция NFDO для выполнения
канонической декомпозиции и функция NFCO для выполнения канонической
декомпозиции с последующей канонической композицией. Какой бы из трех
вариантов не был избран для определения символа 9, NFD всегда возвращает
v99.807.780, a NFC - v321.780.
Иногда бывает удобнее использовать функции NFKDO и NFKCO, аналогичные
предыдущим функциям, но в отличие от них выполняющие совместимую деком-
позицию, после которой в случае NFKCO следует каноническая композиция. На-
пример, \х{FB00} определяет лигатуру ff. Формы NFD и NFC возвращают одну и ту
же строку "\x{F800}", но формы NFKD и NFKC возвращают строку из двух символов
”\х{66}\х{66}".
См. также
Раздел «Универсальная кодировка символов» в начале этой главы; документа-
ция Юникода; модуль Unicode: formalize; рецепт 8.20.
1.10. Интерпретация строки Юникода
как последовательности октетов
Проблема
Требуется интерпретировать строку Юникода в Perl как последовательность
октетов (например, для вычисления ее длины или в контексте ввода/вывода).
Решение
Директива use bytes заставляет все операции Perl в своей лексической области
видимости интерпретировать строку как группу октетов. Используйте ее при
вызове символьных функций Perl:
Sff = ”\x{F800}”: # Лигатура ff
Schars = length(Sff): # Длина равна одному символу
{
use bytes: # Принудительное использование байтовой семантики
Soctets = length(Sff); # Длина равна двум октетам
}
Schars = length(Sff); # Возврат к символьной семантике
56
Глава 1. Строки
Существует и другое решение: модуль Encode позволяет преобразовать строку
Юникода в строку октетов и наоборот. Используйте его в том случае, если код с
символьной семантикой не находится в лексической области видимости:
use Encode qw(encode_utf8);
sub somefunc:
$ff = "\x{F800}":
$ff_oct = encode_utf8($ff);
# Определяется в другом месте
# Лигатура ff
# Преобразование в октеты
$chars = somefunc($ff):
$octets = somefunc($ff_oct);
# Функция работает с символьной строкой
# Функция работает с цепочкой октетов
Комментарий
Как объяснялось во введении настоящей главы, Perl различает две разновидно-
сти строк: строки, состоящие из простых неинтерпретированных октетов, и стро-
ки, состоящие из символов Юникода, в которых представление UTF-8 может
потребовать более одного октета. С каждой конкретной строкой связывается
флаг, идентифицирующий ее как строку октетов или строку UTF-8. Строковые
функции Perl (такие, как length) и средства ввода/вывода проверяют состояние
флага и применяют символьную или октетную семантику в зависимости от ре-
зультата проверки.
Иногда приходится работать с байтами, а не с символами. Например, во мно-
гих протоколах существует заголовок Content-Length, определяющий размер тела
сообщения в октетах. Простое вычисление размера length не подходит — если
строка, для которой вызывается 1 ength, помечена как строка UTF-8, вы получите
размер в символах.
Директива use bytes заставляет все функции Perl в лексической области ви-
димости использовать в строковых операциях октетную семантику вместо сим-
вольной. Под влиянием этой директивы 1 ength всегда возвращает длину строки
в октетах, а функция read всегда возвращает количество прочитанных октетов.
Однако директива use bytes имеет лексическую видимость, поэтому она не
может использоваться для влияния на работу кода в другой области видимости
(например, функции, написанной кем-то другим).
В этом случае вам придется создать копию строки UTF-8, перекодирован-
ную в октеты. Конечно, в памяти обе строки будут содержать одну и ту же по-
следовательность байтов. Различие состоит только в том, что в октетной копии
строки сброшен флаг UTF-8. Функции, работающие с октетной копией, всегда
будут использовать объектную семантику независимо от того, в какой области
видимости они находятся.
Директива no bytes обеспечивает принудительное использование символьной
семантики, а функция decode_utf8 преобразует октетную строку в строку UTF-8.
Впрочем, на практике они применяются реже, потому что не каждая октетная
строка является действительной строкой UTF-8, тогда как все строки UTF-8
являются действительными октетными строками.
1.11. Расширение и сжатие символов табуляции
57
См. также
Документация по директиве use bytes; документация по стандартному модулю
Encode.
1.11. Расширение и сжатие
символов табуляции
Проблема
Требуется заменить символы табуляции в строке соответствующим количеством
пробелов или наоборот. Замена пробелов табуляцией сокращает объем файлов, со-
держащих много смежных пробелов. Преобразование символов табуляции в про-
белы может понадобиться при выводе на устройства, которые не воспринимают
символы табуляции или предполагают, что они находятся в других позициях.
Решение
Примените подстановку весьма странного вида:
while (Sstring =~ s/\t+/' ' х (length($&) * 8 - length(S') % 8)/е) {
# Выполнять пустой цикл до тех пор.
# пока выполняется условие подстановки
}
Также можно воспользоваться стандартным модулем Text::Tabs:
use Text::Tabs:
@expanded_lines = expand(@lines_with_tabs):
@tabulated_lines = unexpand(@lines_without_tabs):
Комментарий
Если позиции табуляции следуют через каждые N символов (где N обычно рав-
но 8), их несложно преобразовать в пробелы. В стандартном, «книжном» методе
не используется модуль Text::Tabs, однако разобраться в нем непросто. Кроме
того, в нем используется переменная $', одно упоминание которой замедляет
поиск по шаблону в программе. Причина объясняется в разделе «Специальные
переменные» главы 6. Следующий алгоритм заменяет каждый символ табуля-
ции во входных данных восемью пробелами:
while (<>) {
1 while s/\t+/' ' х (length($&) * 8 - length(S') % 8)/e:
print:
}
Чтобы обойтись без $ч, можно воспользоваться более сложным решением,
в котором части совпадения сохраняются в именованных переменных. Следую-
щий цикл заменяет один символ табуляции четырьмя пробелами вместо восьми:
1 while s/A(.*?)(\t+)/$l . ' ' х (length($2) * 4 - length($l) % 4)/e:
58
Глава 1. Строки
Другой прием основан на прямом использовании смещений из массивов @+ и
В следующем примере символ табуляции тоже расширяется до четырех пробелов:
1 while s/\t+/' ' х (($+[0] - * 4 - $-[0] % 4)/е:
Вы смотрите на все эти циклы 1 while и не можете понять, почему их нельзя
было записать в виде простой конструкции s///g? Потому что нам приходится
каждый раз заново пересчитывать длину от начала строки, а не от последнего
совпадения.
Конструкция 1 while УСЛОВИЕ эквивалентна while (УСЛОВИЕ) {}, но более ком-
пактна. Она появилась в те дни, когда первая конструкция работала в Perl не-
сравнимо быстрее второй. Хотя сейчас второй вариант почти не уступает по ско-
рости, удобный первый вариант вошел в привычку.
Стандартный модуль Text::Tabs содержит функции преобразований в обоих
направлениях и экспортирует переменную Stabstop, которая определяет число про-
белов на символ табуляции. Кроме того, применение модуля не приводит к сниже-
нию быстродействия, потому что вместо $& и $ч используются переменные $1 и $2:
use Text::Tabs;
Stabstop = 4;
while (<>) { print expand($_) }
Модуль Text: :Tabs также может применяться для «свертки» табуляции. В сле-
дующем примере используется стандартное значение Stabstop, равное 8:
use Text::Tabs:
while (<>) { print unexpand($_) }
См. также
Страница руководства модуля Text::Tabs; описание оператора s/// в perlre(l)
и perlop(l).
1.12. Расширение переменных
во входных данных
Проблема
Программа читает строку, внутри которой присутствует ссылка на переменную:
You owe Sdebt to me.
Требуется заменить имя переменной Sdebt в строке ее текущим значением.
Решение
Если все переменные являются глобальными, воспользуйтесь подстановкой с сим-
волическими ссылками:
Stext =~ s/\$(\w+)/${$l}/g;
1.12. Расширение переменных во входных данных
59
Но если среди переменных могут встречаться лексические (ту) переменные,
следует использовать /ее:
Stext =~ s/(\$\w+)/$l/gee:
Комментарий
Первый способ фактически сводится к следующему: мы ищем нечто похожее на
имя переменной, а затем интерполируем ее значение посредством символиче-
ского разыменования (dereferencing). Если $1 содержит строку somevar, то ${$1}
будет равно содержимому $somevar. Такой вариант не будет работать при дейст-
вующей директиве use strict 'refs', потому что она запрещает символическое
разыменование.
Приведем пример:
our (Srows Scols):
no strict 'refs': # для приведенного ниже ${$l}/g
my Stext:
(Srows, Scols) = (24, 80):
Stext = q(I am $ rows high and Scols long): # Как строка в апострофах!
Stext =~ s/\$(\w+)/${$l}/g;
print Stext:
I am 24 high and 80 long
Возможно, вам уже приходилось видеть, как модификатор подстановки /е
используется для вычисления заменяющего выражения, а не строки. Допустим,
вам потребовалось удвоить каждое целое число в строке:
Stext = "I am 17 years old":
Stext =~ s/(\d+)/2 * $l/eg:
Перед запуском программы, встречая /е при подстановке, Perl компилирует
код заменяющего выражения вместе с остальной программой задолго до факти-
ческой подстановки. При выполнении подстановки $1 заменяется найденной
строкой. В нашем примере будет вычислено следующее выражение:
2 * 17
Но если попытаться выполнить следующий фрагмент:
$text = 'I am SAGE years old': # Обратите внимание на апострофы!
Stext =~ s/(\$\w+)/$l/eg: # НЕВЕРНО
при условии, что Stext содержит имя переменной SAGE, Perl послушно заменит
$1 на SAGE и вычислит следующее выражение:
'SAGE'
В результате мы возвращаемся к исходной строке. Чтобы получить значение
переменной, необходимо снова вычислить результат. Для этого в строку добав-
ляется еще один модификатор /е:
Stext =~ s/(\$\w+)/$l/eeg: # Находит переменные шу()
60
Глава 1. Строки
Да, количество модификаторов /е может быть любым. Только первый моди-
фикатор компилируется вместе с программой и проверяется на правильность син-
таксиса. В результате он работает аналогично конструкции eval {BLOCK}, хотя и не
перехватывает исключений. Возможно, лучше провести аналогию с do {BLOCK}.
Остальные модификаторы /е ведут себя иначе и больше напоминают кон-
струкцию eval "STRING". Они не компилируются до выполнения программы.
Маленькое преимущество этой схемы заключается в том, что вам не придется
вставлять в блок директиву no strict 'refs'. Есть и другое, огромное преиму-
щество: этот механизм позволяет находить лексические переменные, созданные
с помощью ту — символические ссылки на это не способны.
В следующем примере модификатор /х разрешает пропуски и комментарии
в шаблоне подстановки, а модификатор /е вычисляет правостороннее выражение
на программном уровне. Модификатор /е позволяет лучше управлять обработ-
кой ошибок или других экстренных ситуаций:
# Расширить переменные в $text. Если переменная не определена.
# вставить сообщение об ошибке.
$text =~ s{
\$ # Найти знак доллара
(\w+) # Найти "слово" и сохранить его в $1
}{
no strict 'refs': # Для $$1
if (defined ${$1}) {
${$1}; # Расширять только глобальные переменные
} else {
"[NO VARIABLE: : # Сообщение об ошибке
}
}egx:
В незапамятные времена выражение $$1 в строках обозначало ${$}1, то есть
переменную $$, за которой следует 1. Такая интерпретация принималась для
удобства расширения переменной $$ как идентификатора процесса (PID) при
формировании имен временных файлов. Сейчас $$1 всегда обозначает ${$1},
то есть разыменование содержимого переменной $1. В приведенной программе
уточненная запись используется только для наглядности, поскольку программа
и так работает правильно.
См. также
Описание оператора s/// в perlre(i) nperlop(l); описание функции eval в perlfunc(i).
Похожее использование подстановок встречается в рецепте 20.9.
1.13. Преобразование регистра
Проблема
Строку с символами верхнего регистра необходимо преобразовать в нижний ре-
гистр или наоборот.
1.13. Преобразование регистра
61
Решение
Воспользуйтесь функциями 1с и ис или модификаторами \L и \U:
$b1g = uc(Slittle): # "bo peep" -> "BO PEEP"
Slittie = lc(Sbig): # "JOHN" -> "John"
Sbig = "\USlittle": # "bo peep" -> "BO PEEP"
Slittie = "\L$big": # "JOHN" -> "John"
Для замены отдельного символа используйте функции lefirst и ucfirst или
модификаторы \1 и \и:
Sbig = "\u$little":
Slittie = "\l$big":
# "bo" -> "Bo"
# "BoPeep" -> "boPeep"
Комментарий
Функции и модификаторы выглядят по-разному, но делают одно и то же. Допус-
кается изменение регистра как первого символа, так и целой строки. Вы даже
можете совместить оба решения и преобразовать первый символ к верхнему ре-
гистру (а точнее, сделать его заглавным — см. Комментарий), а все остальные
символы — к нижнему регистру.
Sbeast = "dromedary";
# Изменить регистр разных символов Sbeast
Scapit = ucfirst(Sbeast); # Dromedary
Scapit = "\u\L$beast": # (то же)
Scapall = uc(Sbeast): # DROMEDARY
Scapall = "\U$beast": # (то же)
Scaprest = lcfirst(uc($beast)): # dROMEDARY
Scaprest = "\l\U$beast": # (то же)
Как правило, модификаторы обеспечивают единый стиль применения реги-
стра в строке:
# Сделать первый символ каждого слова заглавным.
# а остальные символы привести к нижнему регистру
Stext = "tHIS is a loNG liNE":
Stext =~ s/(w+)/\u\L$l/g;
print Stext:
This Is A Long Line
Ими также можно пользоваться для сравнения строк без учета регистра:
if (uc($a) eq uc(Sb)) {
print "a and b are the same\n":
}
Программа randcap из примера 1.2 случайным образом преобразует в верхний
регистр примерно 20 процентов вводимых символов. Пользуясь ею, вы сможете
свободно общаться с 14-летними кРУтЫми ХаЦкЕРамИ:
Пример 1.2. randcap
# !/usr/bin/perl -р
# randcap: фильтр, который случайным образом
# преобразует к верхнему регистру 20^ символов
# Начиная с версии 5.4, вызов srandO необязателен.
продолжение &
62
Глава 1. Строки
Пример 1.2 (продолжение)
BEGIN { srand(time() х ($$ + ($$ « 15))) }
sub randcase { rand(lOO) < 20 ? ”\u$_[0]" : ”\1$_[0Г’ }
s/(\w)/randcase($l)/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, aND void; AnD 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.
В письменности некоторых языков различаются символы верхнего регистра
и заглавные (titlecase) символы. В таких случаях функция ucfi rst() (и ее аналог-
модификатор \и) преобразует символы в заглавные. Например, в венгерском
языке существует последовательность «dz». В верхнем регистре она записывается
в виде «DZ», в заглавном — «Dz », а в нижнем — «dz». Соответственно, в Юни-
коде для этих трех случаев предусмотрены три разных символа:
Кодовый пункт Запись
01F1 DZ
01F2 Dz
01F3 dz
Название
LATIN CAPITAL LETTER DZ
LATIN CAPITAL LETTER D WITH SMALL LETTER Z
LATIN SMALL LETTER DZ
Преобразования регистра конструкциями типа tr[a-z][A-Z] или чем-нибудь
в этом роде выглядят соблазнительно, однако поступать так не рекомендуется.
Такое решение ошибочно, поскольку из него выпадают все символы с умляутами,
седилями и прочими диакритическими элементами, встречающимися во многих
языках (в том числе и в английском). Впрочем, задача правильного отображения
регистра в символьных данных с диакритическими знаками вообще гораздо слож-
нее, чем кажется на первый взгляд. Простого решения не существует, но если все
данные хранятся в Юникоде, все не так плохо, потому что регистровые функции
Perl безупречно работают с Юникодом. За дополнительной информацией обращай-
тесь к разделу «Универсальная кодировка символов» во введении настоящей главы.
См. также
Описание функций uc, 1с, ucfirst и Icfirst в perlfunc(l)‘, описание модификато-
ров \L, \U, \1 и \и в разделе «Quote and Quote-like Operators» perlop(V).
1.14. Расстановка прописных
букв в заголовках
Проблема
Имеется строка с заголовком статьи, названием книги и т. д. Требуется правиль-
но расставить в ней прописные буквы.
1.14. Расстановка прописных букв в заголовках
63
Решение
Воспользуйтесь разновидностью функции tc():
INIT {
our Япосар:
for (qw(
a an the
and but or
as at but by for from in into of off on onto per to with
))
{
$nocap{$_}++:
}
}
sub tc {
local $_ = shift:
# Начать co строчной буквы, если слово присутствует в списке.
# иначе использовать заглавную букву.
s/(\pL[\pL']*)/$посар{$1} ? 1с($1) : ucfirst(lc($l))/ge:
s/x(\pL[\pL’]*) /\u\L$l/x: # Последнее слово всегда
# начинается с заглавной буквы
s/ (\pL[\pL']*)$/\u\L$l/x: # Последнее слово всегда
# начинается с заглавной буквы
# Часть в круглых скобках интерпретируется как полное название
s/\( (\pl_L\pL’]*) /(\u\L$l/x:
s/(\pL[\pL']*) \) /\u\L$l)/x:
# Первое слово после двоеточия или точки с запятой
# начинается с заглавной буквы
s/ ( [::] \s+ ) (\pL[\pL'l* ) /$l\u\L$2/x:
return $_:
Комментарий
Правила расстановки прописных букв в английских заголовках и названиях слож-
нее, чем может показаться на первый взгляд. Если бы они сводились к простой
замене первой буквы каждого слова, то задача решалась бы подстановкой вида
s/(\w+\S*\w*)/\u\L$l/g:
В большинстве стилевых руководств рекомендуется начинать с прописных
букв первое и последнее слово в названии, а также все остальные слова, кроме
артиклей, частицы «to» в инфинитиве, сочинительных союзов и предлогов.
Следующий пример демонстрирует отличительные особенности заглавных
символов (в нем используется функция tc() из приведенного Решения):
©data = (
"the enchantress of \x{01F3}ur mountain",
"meeting the enchantress of \x{01F3}ur mountain".
64
Глава1. Строки
"the lord of the rings: the fellowship of the ring",
);
$mask = "£-20s: £s\n":
sub tc_lame {
local $_ = shift:
s/(\w+\S*\w*)/\u\L$l/g;
return $_;
}
for $datum (@data) {
printf $mask, "ALL CAPITALS", uc($datum):
printf $mask, "no capitals", lc($datum):
printf $mask, "simple titlecase", tc_lame($datum):
printf $mask, "better titlecase", tc($datum):
print "\n":
}
ALL CAPITALS : THE ENCHANTRESS OF DZUR MOUNTAIN
no capitals : the enchantress of dzur mountain
simple titlecase : The Enchantress Of Dzur Mountain
better titlecase : The Enchantress of Dzur Mountain
ALL CAPITALS : MEETING THE ENCHANTRESS OF DZUR MOUNTAIN
no capitals : meeting the enchantress of dzur mountain
simple titlecase : Meeting The Enchantress Of Dzur Mountain
better titlecase : Meeting the Enchantress of Dzur Mountain
ALL CAPITALS : THE LORD OF THE RINGS: THE FELLOWSHIP OF THE RING
no capitals : the lord of the rings: the fellowship of the ring
simple titlecase : The Lord Of The Rings: The Fellowship Of The Ring
better titlecase : The Lord of the Rings: The Fellowship of the Ring
Также стоит учитывать, что некоторые стилевые руководства рекоменду-
ют начинать с прописных букв предлоги длиной более трех, четырех, а в от-
дельных случаях — пяти символов. Так, по правилам издательства «O’Reilly &
Associates» предлоги из четырех и менее символов записываются со строчной
буквы. Ниже приведен расширенный список предлогов; измените его так, как
сочтете нужным:
@all_prepositions = qw{
about above absent across after against along amid amidst
among amongst around as at athwart before behind below
beneath beside besides between betwixt beyond but by circa
down during ere except for from in into near of off on onto
out over past per since than through till to toward towards
under until unto up upon versus via with within without
}:
Но и такое решение не идеально, потому что оно не различает слова, относя-
щиеся к нескольким частям речи. Некоторые предлоги в этом списке не отлича-
ются от слов, которые всегда записываются с прописной буквы — подчинитель-
ные союзы, наречия и даже прилагательные. Например, «Down by the Riverside»,
но «Getting By on Just $30 a Day»; «А Ringing in My Ears», но «Bringing In the
Sheaves».
1.15. Интерполяция функций и выражений в строках
65
Еще одно обстоятельство, которое также следует учитывать, — возможное
применение \и и ucfirst без принудительного перевода строки в нижний ре-
гистр. В этом случае слова, уже записанные прописными буквами (например,
акронимы), не изменят своего написания. Вероятно, сокращения «FBI» и «LBJ»
не должны преобразовываться в «Fbi» и «Lbj».
См. также
Описание функций uc, 1с, ucfirst и Icfirst вperlfunc(\)\ описание модификато-
ров \L, \U, \1 и \и в разделе «Quote and Quote-like Operators» perlop(V).
1.15. Интерполяция функций
и выражений в строках
Проблема
Требуется интерполировать вызов функции или выражение, содержащиеся в стро-
ке. По сравнению с интерполяцией простых скалярных переменных это позво-
лит конструировать более сложные шаблоны.
Решение
Выражение можно разбить на отдельные фрагменты и произвести конкатенацию:
$answer = $varl . funcO. $var2: # Только для скалярных величин
Также можно воспользоваться несколько неочевидными расширениями @{[LIST
EXPR]} или ${\(SCALAR EXPR)}:
$answer = "STRING @{[ LIST EXPR ]} MORE STRING":
$answer = "STRING ${\( SCALAR EXPR )} MORE STRING";
Комментарий
В следующем фрагменте продемонстрированы оба варианта. В первой строке
выполняется конкатенация, а во второй — фокус с расширением:
$phrase = "I have " . ($n + 1) . " guanacos.":
$phrase = "I have ${\($n + 1)} guanacos.":
В первом варианте строка-результат строится посредством конкатенации более
мелких строк; таким образом мы добиваемся нужного результата без интерполяции.
Функция print фактически выполняет конкатенацию для всего списка аргументов,
и если вы собираетесь вызвать print $phrase, можно было бы просто написать:
print "I have ". $n + 1. " guanacos.\n":
Если интерполяция абсолютно неизбежна, придется воспользоваться вторым
вариантом, изобилующим знаками препинания. Только символы @, $ и \ имеют
66
Глава 1. Строки
особое значение в кавычках и в обратных апострофах. Как и в случаях ст//
и s///, синоним qx() не подчиняется правилам расширения для кавычек, если
в качестве ограничителя использованы апострофы! В выражении $home = qx'echo
home 1 s $HOME'; переменная $HOME будет взята из командного интерпретатора, а не
из Perl! Итак, единственный способ добиться расширения произвольных выра-
жений — расширить ${} или @{}, в чьих блоках присутствуют ссылки.
В примере
$phrase = "I have ${\( count_em() )} guanacos.":
вызов функции в круглых скобках выполняется не в скалярном, а в списковом
контексте. Следующая конструкция переопределяет контекст:
$phrase = "I have ${\( scalar count_em() )} guanacos.":
Однако вы можете сделать нечто большее, чем просто присвоить переменной
значение, полученное в результате интерполяции. Мы имеем дело с универсаль-
ным механизмом, который может использоваться с любыми строками, заключен-
ными в кавычки. Так, в следующем примере мы конструируем строку с интерпо-
лированным выражением и передаем результат функции:
some_func("What you want is @{[ split /:/, $rec ]} items"):
Интерполяция может выполняться и во встроенных документах:
die "Couldn’t send mail" unless sendjnail(«"EOTEXT". $target):
To: $naughty
From: Your Bank
Cc: @{ get_manager_list($naughty) }
Date: @{[ do { my $now = 'date': chomp $now; $now} ]} (today)
Dear $naughty.
Today, you bounced check number @{[ 500 + int rand(100) ]} to us.
Your account is now closed.
Sincerely,
the management
EOTEXT
Расширение строк в обратных апострофах (") оказывается особенно творче-
ской задачей, поскольку оно часто сопровождается появлением ложных симво-
лов перевода строки. Создавая блок в фигурных скобках за @ в разыменовании
анонимного массива ©{£]}, как это было сделано в последнем примере, вы може-
те создавать закрытые (private) переменные.
Все эти приемы работают, однако простое разделение задачи на несколько
этапов или хранение всех данных во временных переменных почти всегда ока-
зывается более понятным для читателя.
Модуль Interpolation из архива CPAN позволяет решить эту задачу с исполь-
зованием более приятного синтаксиса. Например, в следующем фрагменте вы-
числяется ключ и возвращается значение из хэша ЯЕ:
use Interpolation Е => ’eval’:
print "You bounced check number $E{500 + int rand(100)}\n":
1.16. Отступы во встроенных документах
67
В другом примере для хэша ^money вызывается указанная вами функция:
use Interpolation money => \¤cy_commify;
print "That will be $money{ 4 * $payment }. right now.\n":
Результат будет выглядеть примерно так:
That will be $3,232.421.04, right now.
См. также
perlref(l); модуль Interpolation из CP AN.
1.16. Отступы во встроенных документах
Проблема
При использовании механизма определения длинных строк (встроенных доку-
ментов) текст должен выравниваться вдоль левого поля; в программе это неудоб-
но. Требуется снабдить отступами текст документа в программе, но исключить
отступы из окончательного содержимого документа.
Решение
Воспользуйтесь оператором s/// для отсечения начальных пропусков:
# Все сразу
($var = « HERE_TARGET) =~ s/x\s+//gm;
далее следует
ваш текст
HERE_TARGET
# Или за два этапа
$var = « HERE_TARGET:
далее следует
ваш текст
HERE_TARGET
$var =~ s/x\s+//gm;
Комментарий
Подстановка получается весьма прямолинейной: она удаляет начальные про-
пуски из текста встроенного документа. Модификатор /ш разрешает совпадение
метасимвола х в начале каждой логической строки документа, а модификатор /д
заставляет механизм поиска повторять подстановку с максимальной частотой
(то есть для каждой строки встроенного документа).
($definition = «’FINIS') =~s/x\s+//gm:
The five variations of camel ids
are the familiar camel, his frieds
the llama and the alpaca, and the
68
Глава 1. Строки
rather less well-known guanaco
and vicuna.
FINIS
Учтите: во всех шаблонах этого рецепта используется метасимвол \s, обозна-
чающий один символ-пропуск, который также может обозначать символ перевода
строки. В результате из встроенного документа будут удалены все пустые строки.
Если вы не хотите этого, замените в шаблонах \s на [x\S\n].
В подстановке используется то обстоятельство, что результат присваивания
может использоваться в левой части =~. Появляется возможность сделать все
в одной строке, но она работает лишь при присваивании переменной. При непо-
средственном использовании встроенный документ интерпретируется как неиз-
меняемый объект, и вы не сможете модифицировать его. Более того, содержимое
встроенного документа нельзя изменить без предварительного сохранения его
в переменной.
Впрочем, для беспокойства нет причин. Существует простой обходной путь,
особенно удобный при частом выполнении этой операции. Достаточно написать
небольшую процедуру:
sub fix {
my $str1ng = shift;
$string =~ s/x\s+//gm;
return $string;
}
print fix(«"END");
Наш документ
END
# Если функция была объявлена заранее, скобки можно опустить:
print fix «"END";
Наш документ
END
Как и во всех встроенных документах, маркер конца документа (END в на-
шем примере) должен быть выровнен по левому полю. Если вы хотите снабдить
отступом и его, в документ придется добавить соответствующее количество
пропусков:
($quote = «' FINIS') =~s/x\s+//gm;
...we will have peace, when you and all you works have
peri shed--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
$quote =~ s/\s+--/\n--; # Перенести на отдельную строку
Если эта операция выполняется с документами, содержащими программный
код для eval или просто выводимый текст, массовое удаление всех начальных
пропусков нежелательно, поскольку оно уничтожит отступы в тексте. Конечно,
это безразлично для eval, но не для читателей.
1.16. Отступы во встроенных документах
69
Мы подходим к следующему усовершенствованию — специальным префик-
сам для строк, которые должны снабжаться отступами. Например, в следующем
примере каждая строка начинается с @@@ и нужного отступа:
if ($REMEMBER_THE_MAIN) {
$perl_main_C = dequote«' MAIN_INTERPRETER_LOOP';
@@@ int
@@@ runops 0 {
@@@ SAVEI32(runlevel);
@@@ runlevel++;
@@@ while ( op = (*op->op_ppaddr)() ) ;
@@@ TAINT_NOT;
@@@ 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 then? I cannot say.
--Bilbo in /usr/src/perl/pp_ctl.c
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 справляется co всеми описанными про-
блемами. При вызове ей в качестве аргумента передается встроенный документ.
Функция проверяет, начинается ли каждая строка с общей подстроки (префик-
са), и если это так — удаляет эту подстроку. В противном случае она берет на-
чальный пропуск из первой строки и удаляет его из всех последующих строк,
sub dequote {
local $_ = shift;
my ($white. $leader); # пропуск и префикс, общие для всех строк
if (/x\s*(?:([x\w\s]+)(\s*).*\n)(?:\s*\l\2?.*\n)+$/) {
($white. $leader) = ($2. quotemeta($l));
} else {
70
Глава 1. Строки
($white, $leader_ = (/x(\s+)/, '
}
s/x\s*?$leader(?:$white)?//gm;
return $_;
}
Если при виде подобных шаблонов у вас голова идет кругом, их всегда мож-
но разбить на несколько строк и добавить комментарии с помощью модифика-
тора /х:
if (m{ # начало строки
\s * # 0 и более символов-пропусков
(?: # начало первой несохраняющей группы
( # начать сохранение $1
[x\w\s] # один байт - не пробел и не символ слова
+ # 1 или более
) # закончить сохранение $1
( \s* ) # занести 0 и более пропусков в буфер $2
.* \n # искать до конца первой строки
) # конец первой группировки
(?: # начало второй несохраняющей группы
\s * # 0 и более символов-пропусков
\1 # строка, предназначенная для $1
\2 ? # то. что будет в $2, но дополнительно
.* \n # искать до конца строки
) + # повторить идею с группами 1 и более раз
$ # до конца строки
}x
) { ($white, Sleader) = ($2, quotemeta($l));
} else {
($white, $leader) = (/x(\s+)/. ”);
}
s{
х # начало каждой строки (из-за /т)
\s * # любое количество начальных пропусков
? # с минимальным совпадением
$leader # сохраненный префикс
(?: # начать несохраняющую группу
$white # то же количество
) ? # если после префикса следует конец строки
}{}xgm:
Ну что, разве не стало понятнее? Пожалуй, нет. Нет смысла уснащать про-
грамму банальными комментариями, которые просто дублируют код. Возможно,
перед вами один из таких случаев.
См. также
Раздел «Scalar Value Constructors» perldata(\y, описание оператора s/// в perlre(l)
и perlop(l).
1.17. Переформатирование абзацев
71
1.17. Переформатирование абзацев
Проблема
Длина текста не позволяет разместить его в одной строке. Требуется разделить
его на несколько строк без переноса слов. Например, сценарий проверки стиля
читает текстовый файл по одному абзацу и заменяет неудачные обороты более
точными. Замена оборота «применяет функциональные возможности» словом
«использует» приводит к изменению количества символов в строках, поэтому
перед выводом абзаца его придется переформатировать.
Решение
Воспользуйтесь стандартным модулем Text: :Wrap для расстановки разрывов строк
в нужных местах:
use Text::Wrap;
^output - wrap($leadtab, $nexttab, @para):
Можно воспользоваться более интеллектуальным модулем Text: :Autoformat
из CPAN:
use Text::Autoformat:
$formatted = autoformat $rawtext:
Комментарий
В модуле 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 electrons!"):
use Text::Wrap qw($columns &wrap):
Scolumns = 20:
print "0123456789" x 2. "\n":
print wrap(" ", " ", @input), "\n":
Результат выглядит так:
01234567890123456789
Folding and
72
Глава 1. Строки
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 Scolumns);
use Term:-.ReadKey qw(GetTerminalSize):
(Scolumns) = GetTerminalSizeO:
($/. $\) = (". "\n\n"): # Читать по абзацам, выводить два перевода строки
while (<>) { # Читать весь абзац
s/\s*\n\s*/ /д: # Заменить промежуточные переводы строк пробелами
print wrap('', $_): # и отформатировать
}
Модуль CPAN Text::Autoformat гораздо умнее. Прежде всего он пытается из-
бежать «висячих строк», то есть очень коротких завершающих строк. Но самое
замечательное, что он правильно переформатирует абзацы с множественными
уровнями цитирования. Пример из документации этого модуля показывает, как
простой вызов print autoformat($badparagraph) преобразует текст
In comp.lang.perl.misc you wrote:
: > <CN = Clooless Noobie> writes:
: > CN> PERL sux because:
: > CN> * It doesn't have a switch statement and you have to put $
: > CN>signs in front of everything
: > CN> * There are too many OR operators: having |, || and 'or'
: > CN>operators is confusing
: > CN> * VB rools. yeah!!!!!!!!!
1.18. Экранирование символов
73
: > CN> So anyway, how can I stop reloads on a web page?
: > CN> Email replies only, thanks - I don't read this newsgroup.
; >
; > Begone, sirrah! You are a pathetic, Bill-loving, microcephalic
: > script-infant.
: Sheesh, what's with this group - ask a question, get toasted! And how
: *dare* you accuse me of lanuphi1ia!
к следующему виду:
In comp.lang.perl.misc you wrote:
: > <CN = Clooless Noobie> writes:
: > CN> PERL sux because:
: > CN> * It doesn't have a switch statement and you
: > CN> have to put $ signs in front of everything
: > CN> * There are too many OR operators: having |, ||
: > CN> and 'or' operators is confusing
: > CN> * VB rools, yeah!!!!!!!!! So anyway, how can I
: > CN> stop reloads on a web page? Email replies
: > CN> only, thanks - I don't read this newsgroup.
: > Begone, sirrah! You are a pathetic, Bill-loving,
: > microcephalic script-infant.
: Sheesh, what's with this group - ask a question, get toasted!
: And how *dare* you accuse me of lanuphilia!
Эффектно, не правда ли?
В следующей мини-программе этот модуль используется для переформати-
рования каждого абзаца во входном потоке:
use Text::Autoformat:
$/ = " :
while (<>) {
print autoformat($_, {squeeze => 0, all => 1}), "\n":
}
См. также
Описание функций split и join вperlfunc(l), страница руководства стандартно-
го модуля Text: :Wrap; модуль Term: :ReadKey из CPAN и пример его использова-
ния в рецепте 15.6, а также модуль CPAN Text::Autoformat.
1.18. Экранирование символов
Проблема
Некоторые символы выводимой строки (апострофы, запятые и т. д.) требуется
экранировать, то есть преобразовать к специальному виду. Предположим, вы
конструируете форматную строку для sprintf и хотите заменить символы % по-
следовательностями %%.
74
Глава 1. Строки
Решение
Воспользуйтесь подстановкой, которая снабжает префиксом \ или удваивает
каждый преобразуемый символ:
# Обратная косая черта
Svar =- s/([CWZ./sn)/W$l/g:
# Удвоение
Svar =- s/(ECH4/?Z_ZS73)/$l$l/g:
Комментарий
В приведенных выше решениях $var — модифицируемая переменная, a CHARLIST —
список преобразуемых символов, который может включать комбинации типа \t
или \п. Если преобразуется всего один символ, можно обойтись без скобок:
Sstring =~ 3/%/%%/д;
Преобразования, выполняемые в следующем примере, позволяют подготовить
строку для передачи командному интерпретатору. На практике преобразование
символов ' и " еще не сделает произвольную строку полностью безопасной для
командного интерпретатора. Правильно собрать весь список символов так слож-
но, а риск так велик, что для запуска программ лучше воспользоваться списко-
выми формами system и ехес (см. рецепт 16.2) — в этом случае вы вообще избе-
гаете взаимодействия с интерпретатором.
Sstring = q(Mom said. "Don’t do that."):
Sstring =~ s/(L‘”J)/\\$l/g:
Две обратные косые черты в секции заменителя были использованы потому,
что эта секция интерпретируется по правилам для строк в кавычках. Следова-
тельно, чтобы получить одну обратную косую черту, приходится писать две.
Приведем аналогичный пример для VMS DCL, где дублируются все апострофы
и кавычки:
Sstring = q(Mom said. "Don't do that."):
Sstring =~ s/(['"])/$l$l/g:
С командными интерпретаторами Microsoft дело обстоит еще сложнее. В Win-
dows COMMAND. СОМ работает с кавычками, но не с апострофами; не имеет представ-
ления о применении обратных апострофов для запуска команд, а для превраще-
ния кавычек в литерал используется обратная косая черта. Впрочем, почти во
всех бесплатных и коммерческих Unix-подобных командных интерпретаторах
для Windows этот недостаток исправлен.
В регулярных выражениях поддерживаются символьные классы, поэтому
также можно определить интервал с помощью -, а затем инвертировать его мета-
символом \ Следующая команда экранирует все символы, не входящие в интер-
вал от А до Z:
Sstring =~ s/([AA-Z])/\\$l/g:
1.19. Удаление пропусков в обоих концах строки
75
Для преобразования всех неалфавитных символов следует воспользоваться
метасимволами \Q и \Е или функцией quotemeta. Например, следующие команды
эквивалентны:
Sstrlng = "this \Qis a test!\E":
Sstrlng = "this is\\ a\\ test!":
Sstrlng = "this " . quotemeta("Is a test!"):
См. также
Описание оператора s/// в perlre(l) и perlop(l); описание функции quotemeta
рассматривается в perlfunc(l). В рецепте 19.1 рассматривается экранирование
служебных символов в HTML, а в рецепте 19.5 говорится о том, как избежать
экранирования при передаче строк командному интерпретатору.
1.19. Удаление пропусков
в обоих концах строки
Проблема
В полученную строку могут входить начальные или конечные пропуски. Требу-
ется удалить их.
Решение
Воспользуйтесь парой подстановок:
Sstrlng =~ s/^\s+//;
Sstrlng =~ s/\s+$//:
Или напишите специальную функцию, которая возвращает нужное значение:
Sstrlng = trlm(Sstrlng):
@many = tr1m(@many):
sub trim {
my @out =
for (@out) {
s/^\s+//: // Удаление пропусков слева
s/\s+$//; // Удаление пропусков справа
}
return @out == 1
? SoutEOJ // Возвращается одна строка
: @out[0]; // Возвращается много строк
}
Комментарий
У этой проблемы имеются различные решения, однако в большинстве случаев
приведенный вариант является наиболее эффективным. Функция возвращает
76
Глава 1. Строки
новые версии переданных строк, из которых удалены начальные и конечные
пробелы. Функция работает как с отдельными строками, так и со списками.
Для удаления последнего символа из строки воспользуйтесь функцией chop.
Будьте внимательны и не перепутайте ее с похожей функцией chomp, которая
удаляет последнюю часть строки в том и только в том случае, если она содер-
жится в переменной $/ (по умолчанию — ”\п”). Чаще всего она применяется для
удаления завершающего символа перевода строки из введенного текста:
# Вывести полученный текст заключенным в ><
wh11e(<STDIN>) {
chomp;
print ">$_<\n";
}
Функцию можно усовершенствовать несколькими способами.
Прежде всего, что делать, если функции передано несколько строк, а контекст
возвращаемого значения требует одной скалярной величины? В том виде, в ко-
тором она приведена в Решении, функция поступает довольно глупо: она воз-
вращает скалярную величину, представляющую количество переданных строк.
Возможны и другие варианты, например, выдать предупреждение, или сгенери-
ровать исключение, или объединить список возвращаемых строк в одну строку.
Если лишние пропуски могут находиться не только с концов, но и в сере-
дине, функция также может заменять внутренние серии пропусков одиноч-
ными пробелами. Для этого в цикл помещается дополнительная завершающая
команда:
s/\s+/ /д: # Свертка внутренних пропусков
Строка вида " but\t\tnot here\n" превращается в "but not here". Три последо-
вательных подстановки
s/^\s+//;
s/\s+$//;
s/\s+/ /д:
эффективнее заменить командой
$_ = joInC ', splitC ’)):
Если функция вызывается вообще без аргументов, можно последовать при-
меру chop и chomp и по умолчанию использовать $_. После всех перечисленных
усовершенствований мы получаем следующую функцию:
# 1. Отсечение начальных и конечных пропусков
# 2. Свертка внутренних пропусков в одиночные пробелы
# 3. При отсутствии аргументов входные данные берутся из $_
# 4. При возвращении в скалярном контексте
# список объединяется в скаляр с промежуточными пробелами,
sub trim {
my @out = @_ ? @_ : $_;
$_ = JoInC ’. splitC ’)) for @out;
return wantarray ? @out : "@out";
1.20. Анализ данных, разделенных запятыми
77
См. также
Описание оператора s/// в perlre(\) иperlop(i)\ описание функций chop и chomp
в perlfunc(l). Начальные пропуски удаляются в функции getnum из рецепта 2.1.
1.20. Анализ данных, разделенных
запятыми
Проблема
Имеется файл данных, поля которого разделены запятыми. Требуется прочитать
данные из файла. Однако в полях могут присутствовать свои запятые (нахо-
дящиеся внутри строк или экранированные). Во многих электронных таблицах
и СУБД списки полей, разделенных запятыми, поддерживаются в качестве стан-
дартного формата для импорта/экспорта данных.
Решение
Если содержимое файла данных соответствует стандартным правилам экраниро-
вания Unix (то есть внутренние кавычки в полях экранируются обратной ко-
сой чертой: "like V'thlsV", воспользуйтесь стандартным модулем Text: :ParseWords
и простой программой:
use Text::ParseWords:
sub parse_csvO {
return quotewords("," => 0, $_[0J):
}
Если кавычки в полях экранируются удваиванием ("like ""this......), мож-
но воспользоваться стандартной процедурой из книги Джеффри Фридла «Ре-
гулярные выражения: Библиотека программиста, 2 издание» (издательство «Пи-
тер», 2003 г.):
sub parse_csvl {
my Stext = shift: # Запись co значениями, разделенными запятыми
my Oflelds = ( ):
while (Stext =~ m{
# Произвольная последовательность символов, кроме запятых и кавычек:
( Г"’,] + )
# .. .или.. .
I
# ... поле в кавычках (внутри поля разрешаются удвоенные кавычки)
" # Открывающая кавычка поля (не сохраняем)
( # Теперь поле содержит либо
(?: [А"1 # символы, отличные от кавычек, либо
"" # смежные кавычки
78
Глава 1. Строки
) * # Повторяется сколько угодно раз
)
" # Закрывающая кавычка поля (не сохраняем)
}дх)
{
if (defined $1) {
$field = $1;
} else {
($field = $2) =- s/”77g:
}
push ^fields, $field:
}
return Ofields:
}
Также можно воспользоваться модулем CPAN Text::CSV:
use Text::CSV;
sub parse_csvl {
my $1ine = shift:
my $csv = Text::CSV->new( ):
return $csv->parse($line) && $csv->fields( );
}
Или модулем CPAN Tie: :CSV_F11e:
tie @data, "Tie::CSV_File", "data.csv":
for ($i = 0: $i < @data: $i++) {
printf "Row £d (Line W is %s\n". $i. $i+l, "@{$data[$i]}":
for ($j = 0: $j < @{$data[$i]}; $j++) {
print "Column $j is <$data[$i][$j]>\n":
}
}
Комментарий
Ввод данных, разделенных запятыми, — коварная и непростая задача. На первый
взгляд все просто, но в действительности приходится учитывать довольно слож-
ные возможности экранирования, поскольку сами поля могут содержать внут-
ренние запятые. В результате поиск по шаблону получается весьма сложным,
а о простом вызове функции split /,/ лучше и не думать. Что еще хуже, в фай-
лах стандарта Unix и в устаревших системах используются разные правила экра-
нирования. Из-за этого разработать единый алгоритм для всех файлов данных
CSV оказывается невозможно.
Стандартный модуль Text::ParseWords предназначен для обработки данных по
стандартам, используемым в большинстве файлов данных Unix. Благодаря
этому он чрезвычайно удобен для разбора всевозможных системных файлов Unix,
в которых поля разделяются двоеточиями — disktab(5), gettytabiS), printcap(5)
и termcap(5). Функции quotewords этого модуля передаются два аргумента и стро-
ка разделенных данных. Первый аргумент определяет символ-разделитель (в на-
шем случае запятая, но часто используется двоеточие), а второй — логический
1.20. Анализ данных, разделенных запятыми
79
флаг, который показывает, должны ли строки возвращаться вместе с кавычками,
в которые они заключены.
В таких файлах данных кавычки внутри полей экранируются обратной косой
чертой: "like \"th1s\". Кавычки, апострофы и обратная косая черта — единст-
венные символы, для которых этот префикс имеет специальное значение. Все
остальные экземпляры \ остаются в итоговой строке. Для работы с такими дан-
ными достаточно функции quotewords стандартного модуля Text::ParseWords.
Однако это решение не подходит для файлов данных из устаревших сис-
тем, в которых внутренние кавычки экранируются удваиванием: "like ""this............
В таких случаях приходится прибегать к другим решениям. Первое из них ос-
новано на регулярном выражении, приведенном во втором издании книги Джеф-
фри Фридла «Регулярные выражения: Библиотека программиста». Его пре-
имуществом следует считать то, что решение работает в любой системе без
установки дополнительных модулей, не входящих в стандартную поставку. Фак-
тически оно вообще не требует никаких модулей. Тем не менее, несмотря на
обилие комментариев это решение вызывает легкий шок у неподготовленного
читателя.
Объектно-ориентированный модуль CPAN Text::CSV, задействованный в сле-
дующем решении, скрывает сложности разбора в более удобных «обертках».
Модуль Tie::CSV из CPAN предлагает еще более элегантное решение: вы рабо-
таете с объектом, похожим на двумерный массив. Первый индекс представляет
строки файла, а второй — его столбцы.
Рассмотрим примеры практического использования наших функций parse_csv.
Здесь q() — всего лишь хитроумный заменитель кавычек, чтобы нам не прихо-
дилось расставлять повсюду символы \.
$11ne = q(XYZZY,"","O'Reilly. Inc","Wall. Larry"."a \"glug\" bit,",5."Error, Core Dumped"):
Ofields = parse_csvO($11ne);
for ($1 = 0:$1 < Oflelds: $i++) {
print "$1 : $f1elds[$1]\n":
}
0 : XYZZY
1 :
2 : O’Reilly, Inc
3 : Wall, Larry
4 : a "glug" bit,
5 : 5
6 : Error, Core Dumped
Если бы второй аргумент quotewords был равен 1 вместо 0, то кавычки были
бы сохранены, а результат принял бы следующий вид:
О : XYZZY
। . ""
2 : "O’Reilly, Inc"
3 : "Wall, Larry"
4 : "a VglugV bit,"
5 : 5
6 : "Error, Core Dumped"
80
Глава 1. Строки
Другая разновидность файлов данных обрабатывается точно так же, но вме-
сто parse_csvO используется parse_csvl. Обратите внимание на удвоение кавычек
вместо экранирования префиксом:
$11пе = q(Ten Thousand,10000, 2710 .."10,000".
"It's ""10 Grand"", baby",ЮК):
Ofields = parse_csvl($line):
for ($1 = 0: $i < Ofields: $i++) {
print "$i : $fields[$i]\n":
}
0 : Ten Thousand
1 : 10000
2 : 2710
3 :
4 : 10,000
5 : It's "10 Grand", baby
6 : 10K
См. также
Описание синтаксиса регулярных выражений в perlre(l); документация по стан-
дартному модулю Text::ParseWords; раздел «Разбор данных, разделенных запятыми»
главы 5 книги «Регулярные выражения: Библиотека программиста, 2 издание».
1.21. Константы
Проблема
Требуется создать переменную, значение которой не может изменяться после
первоначального присваивания.
Решение
Если величина не обязана быть скалярной переменной, которая может интерпо-
лироваться, можно обойтись директивой use constant:
use constant AVOGADRO => 6.02252e23:
printf "You need of those for guac\n", AVOGADRO:
Если нужна именно переменная, присвойте тип-глобу ссылку на литераль-
ную строку или число, а затем используйте скалярную переменную:
*AVOGADRO = \6.02252е23:
print "You need SAVOGADRO of those for guac\n";
Но самый надежный способ основан на использовании маленького класса tie
с выдачей исключения в методе STORE:
package Tie::Constvar:
use Carp;
1.21. Константы
81
sub TIESCALAR {
my ($class. $1n1tval) =
my $var = $1 nltval;
return bless \$var => $class:
}
sub FETCH {
my $selfref = shift;
return $$selfref:
}
sub STORE {
confess "Meddle not with the constants of the universe":
}
Комментарий
Проще всего воспользоваться директивой use constant, но у нее есть ряд недос-
татков, самый большой из которых — то, что она не создает нормальной пере-
менной, которая бы интерполировалась в строках, заключенных в кавычки.
Другой недостаток — отсутствие области видимости; директива включает про-
цедуру с заданным именем в пространство имен пакета.
В действительности директива use constant создает процедуру с заданным
именем, которая вызывается без аргументов и всегда возвращает одно и то же
значение (или несколько значений в виде списка). Это означает, что процедура
входит в пространство имен текущего пакета и не ограничивается по области
видимости. Такую же процедуру можно самостоятельно определить в программе:
sub AVOGADROO { 6.02252е23 }
Чтобы область видимости константы ограничивалась текущим блоком, мож-
но создать временную процедуру, для чего анонимная процедура присваивается
тип-глобу с нужным именем:
use subs qw(AVOGADRO):
local *AVOGADRO = sub 0 { 6.0225e23 }:
Надо признать, такие фокусы выглядят довольно загадочно. Если вы отказы-
ваетесь от использования директивы, прокомментируйте свой код.
Если вместо ссылки на процедуру присвоить тип-глобу ссылку на констат-
ный скаляр, то вы сможете использовать переменную с соответствующим име-
нем. На этом основан второй прием, приведенный в Решении. У него есть свои
недостатки: тип-глобы доступны только для пакетных переменных, но не для
лексических, созданных с ключевым словом ту. Под действием рекомендуемой
директивы use strict с необъявленными пакетными переменными возникнут
проблемы, но переменную можно объявить при помощи our:
our SAVOGADRO;
local *AVOGADRO = \6.02252e23:
Третье решение — с созданием маленького класса tie — может показаться са-
мым запутанным, но оно обеспечивает наибольшую гибкость. Кроме того, при
желании константу можно объявить как лексическую переменную:
tie my SAVOGARO. Tie::Constvar, 6.02252e23:
82
Глава 1. Строки
После этого можно спокойно использовать конструкции вида
print "You need $AVOGADRO of those for guac\n":
Любые попытки модификации константы будут отвергнуты:
$AVOGADRO = б.625бе-34: # Ничего не выйдет
См. также
Рецепты 1.15 и 5.3; некоторые идеи также можно почерпнуть из модуля CPAN
Tie::Seal ar::RestrlctUpdates.
1.22. Сравнение слов с похожим звучанием
Проблема
Имеются две английских фамилии. Требуется узнать, звучат ли они похожим
образом (независимо от написания). Это позволит выполнять «неформальный
поиск» в телефонной книге, в результатах которого наряду со Smith будут при-
сутствовать и другие похожие имена, например, Smythe, Smite и Smote.
Решение
Воспользуйтесь стандартным модулем Text::Soundex:
use Text::Soundex:
$CODE = soundex($STRING):
OCODES = soundex(OLIST);
Также можно воспользоваться модулем CPAN Text::Metaphone:
use Text::Metaphone:
$phoned_words = Metaphone(’Schwern'):
Комментарий
Алгоритм Soundex хэширует слова (особенно английские фамилии) в неболь-
шом пространстве с использованием простой модели, имитирующей произноше-
ние по правилам английского языка. Грубо говоря, каждое слово сокращается
до четырехсимвольной строки. Первый символ является буквой верхнего реги-
стра, а прочие — цифры. Сравнивая значения для двух строк, можно определить,
звучат ли они похожим образом.
Следующая программа предлагает ввести имя и ищет в файле паролей имена
с похожим звучанием. Аналогичный подход может использоваться для баз дан-
ных имен, поэтому при желании можно индексировать базу данных по ключам
Soundex. Конечно, такой индекс не будет уникальным.
use Text::Soundex:
use User::pwent:
1.22. Сравнение слов с похожим звучанием
83
print "Lookup user: ";
chomp($user = <STDIN>);
exit unless defined $user:
$name_code = soundex(Suser);
wh11e($uent = getpwentO) {
(Sflrstname, Slastname) = $uent->gecos =~ /(\w+)[\]*\b(\w+)/:
If ($name_code eq soundex($uent->name) ||
$name_code eq soundex(Slastname) ||
$name_code eq soundex($f1rstname) )
prlntf "Xs: Xs Xs\n". $uent->name. Sflrstname. Slastname:
}
}
Модуль Text::Metaphone из архива CPAN решает ту же задачу другим, более
разумным способом. Функция soundex возвращает код из буквы и трех цифр для
начала входной строки, а функция Metaphone возвращает код в виде последова-
тельности букв переменной длины. Пример:
soundex metaphone
Christiansen C623 KRSXNSN
Kris Jenson K625 KRSJNSN
Kyrle El el son K642 KRLSN
Curious Liaison C624 KRSLSN
Чтобы в полной мере реализовать возможности Metaphone, следует также вос-
пользоваться модулем String:: Approx из CPAN, более подробно описанным в ре-
цепте 6.13. Этот модуль позволяет найти успешное совпадение даже при нали-
чии отдельных ошибок в строках. Количество изменений, необходимых для пере-
хода от одной строки к другой, называется расстоянием между этими строками.
Следующая команда проверяет совпадение строк, разделенных расстоянием 2
и менее:
If (amatchC'strlngl". [2]. "str1ng2") { }
Также присутствует функция adi st, которая возвращает расстояние между
строками. Например, расстояние между «Kris Jenson» и «Christiansen» равно 6,
тогда как расстояние между их кодами Metaphone равно всего 1. Расстояние меж-
ду компонентами другой пары в исходном варианте равно 8, а при сравнении ко-
дов Metaphone оно снова уменьшается до 1:
use Text::Metaphone qw(Metaphone):
use String::Approx qw(amatch):
If (amatch(Metaphone($sl). [1]. Metaphone($sl)) {
print "Close enough!\n":
}
Этот фрагмент найдет успешные совпадения для обеих пар из рассмотренно-
го примера.
84
Глава 1. Строки
См. также
Документация по стандартным модулям Text:: Soundex и User::pwent; модули
CPAN Text::Metaphone и String::Approx; страница руководства passwd(5) вашей
системы; том 3, глава 6 «Искусства программирования».
1.23. Программа: fixstyle
Представьте себе таблицу с парами устаревших и новых слов:
Старые слова Новые слова
bonnet hood
rubber eraser
lorry truck
trousers pants
Программа из примера 1.4 представляет собой фильтр, который заменяет все
встречающиеся в тексте слова из первого столбца соответствующими элемента-
ми второго столбца.
При вызове без файловых аргументов программа выполняет функции про-
стого фильтра. Если в командной строке передаются имена файлов, то програм-
ма записывает в них изменения, а прежние версии сохраняются в файлах с рас-
ширениями *.or1g (см. рецепт 7.16). При наличии параметра командной строки
-V сообщения обо всех изменениях записываются в STDERR.
Таблица пар «исходное слово/заменитель» хранится в основной программе,
начиная с маркера_____END__(см. рецепт 7.12). Пары преобразуются в подстановки
(с экранированием символов) и накапливается в переменной $code так же, как
это делается в программе popgrep2 из рецепта 6.10.
Параметр -t выводит сообщение об ожидании ввода с клавиатуры при отсут-
ствии других аргументов. Если пользователь забыл ввести имя файла, он сразу
поймет, чего ожидает программа.
Пример 1.4. fixstyle
# !/usr/Ыn/perl -w
# fixstyle - замена строк секции <DATA> парными строками
# использование: $0 [-v] [файлы...]
use strict;
my $verbose = (@ARGV && $ARGV[0] eq '-v’ && shift);
If (@ARGV) {
$XI = ".orlg"; # Сохранить старые файлы
} else {
warn "$0: Reading from std1n\n" If -t STDIN;
}
my $code = "while (<>) {\n":
# Читать данные и строить код для eval
1.23. Программа: fixstyle
85
while (<DATA>) {
chomp:
my ($in, $out) = split /\s*=>\s*/:
next unless $in && $out:
$code .= "s{\\Q$in\\E}{$out}g":
$code .= ”&& printf STDERR qq($1n => $out at \$ARGV line \$.\\n)"
if $verbose;
$code .= ":\n":
}
$code .= "print:\n}\n";
eval "{ $code } 1" || die:
_ END_
analysed => analyzed
built-in => builtin
chastized => chastised
commandline => command-line
de-al locate => deallocate
dropin => drop-in
hardcode => hard-code
meta-data => metadata
multicharacter => multi-character
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
# fixstyle2 = аналог fixstyle для большого количества замен
use strict:
my $verbose = (@ARGV && $ARGV[0] eq ’-v’ && shift):
my ^change = ():
while (<DATA>) {
chomp;
my ($in, $out) = split /\s*=>\s*/:
next unless $1n && $out:
$change{$in} = $out:
}
продолжение &
86
Глава 1. Строки
Пример 1.5 (продолжение)
if (@ARGV) {
$Л1 = ".orig";
} else {
warn "$0: Reading from stdin\n" if -t STDIN;
}
while (<>) {
my $i =0;
s/x(\s+)// && print $1; # Выдать начальный пропуск
for (split /(\s+)/, $_, -1) { # Сохранить конечные пропуски
print( ($i++ & 1) ? $_ : ($change{$_) || $_));
}
}
_ _END_ _
analysed => analyzed
built-in => builtin
chastized => chastised
commandline => command-line
de-al locate => deallocate
dropin => drop-in
hardcode => hard-code
meta-data => metadata
multicharacter => multi-character
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
В новой версии программы каждая строка разбивается на пропуски и слова
(относительно медленная операция). Затем слова используются для поиска за-
мены в хэше, что выполняется существенно быстрее подстановки. Следователь-
но, первая часть работает медленнее, а вторая — быстрее. Выигрыш в скорости
зависит от количества совпадений.
Если бы мы не старались сохранить количество пропусков, разделяющих слова,
было бы нетрудно сделать так, чтобы вторая версия не уступала первой по ско-
рости даже при небольшом количестве замен. Если вам хорошо известна специ-
фика входных данных, пропуски можно заменить одиночными пробелами. Для
этого применяется следующий цикл:
# Работает очень быстро, но со сверткой пропусков
while (<>) {
for (split) {
print $change{$_} || $_, "
}
print "\n":
1.24. Программа: psgrep
87
В конце каждой строки появляется лишний пробел. Если это нежелательно,
воспользуйтесь методикой рецепта 16.5 и создайте выходной фильтр. Вставьте
следующий фрагмент перед циклом while, сжимающим пропуски:
my $p1d = open(STDOUT. "|=");
die "cannot fork: $!" unless defined $p1d;
unless ($p1d) {
while (<STDIN>) {
s/ $//:
print:
}
exit:
}
1.24. Программа: psgrep
Многие программы (в том числе ps, netstat, Is -1, find -Is и tcpdump) часто выдают
большие объемы данных. Файлы журналов тоже быстро увеличиваются в раз-
мерах, что затрудняет их просмотр. Такие данные можно обработать програм-
мой-фильтром типа grep и отобрать из них лишь часть строк, однако регуляр-
ные выражения плохо согласуются со сложной логикой — достаточно взглянуть
на ухищрения, на которые приходится пускаться в рецепте 6.18.
На самом деле нам хотелось бы иметь возможность обращаться с полноцен-
ными запросами к выводу программы или файлу журнала. Допустим, вы спра-
шиваете у ps: «Покажи мне все непривилегированные процессы размером боль-
ше 10 Кбайт» или «Какие команды работают на псевдоконсолях?»
Программа psgrep умеет делать все это — и бесконечно большее, потому что
в ней критерии отбора не являются регулярными выражениями; они состоят из
полноценного кода Perl. Каждый критерий последовательно применяется к каж-
дой строке вывода. В результате выводятся лишь те данные, которые удовлетво-
ряют всем аргументам. Ниже приведены примеры критериев поиска и соответ-
ствующие им командные строки:
О Строки со словами, заканчивающимися на sh:
X psgrep ’/sh\b/'
О Процессы с именами команд, заканчивающимися на sh:
X psgrep 'command =~ /sh$/’
О Процессы с идентификатором пользователя, меньшим 10:
X psgrep 'uld < 10'
О Интерпретаторы с активными консолями:
X psgrep 'command =~ '/А-/' 'tty пе "?'"
О Процессы, запущенные на псевдоконсолях:
X psgrep 'tty =~ /A[p-t]'
88
Глава 1. Строки
О Отсоединенные непривилегированные процессы:
X psgrep ’uid && tty eq
О Большие непривилегированные процессы:
I psgrep 'size > 10 * 2**10' 'uid != О'
Ниже показаны данные, полученные при последнем вызове psgrep на нашем
компьютере. Как и следовало ожидать, в них попал только netscape и его вспо-
могательный процесс:
FLAGS UID PID PPID PRI NI SIZE RSS WCHAN STA TTY TIME COMMAND
0 101 9751 1 0 0 14932 9652 do_select S pl 0:25 netscape
100000 101 9752 9751 0 0 10636 812 do_select S pl 0:00 (dns helper)
В примере 1.6 приведен исходный текст программы psgrep.
Пример 1.6. psgrep
# !/usr/bin/perl -w
# psgrep - фильтрация выходных данных ps
# с компиляцией пользовательских запросов в программный код
#
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 Hi elds: # Для хранения данных
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 (^fieldnames) {
no strict 'refs':
*name = *{lc $name} = sub () { $fields{$name} }:
}
my $code = "sub is_desirable { " . joint" and ". @ARGV) . " }
unless (eval $code.l) {
die "Error in code: $@\n\t$code\n";
}
open (PS. "ps wwaxl |") II die "cannot fork: $!":
print scalar <PS>: # Строка-заголовок
while (<PS> {
@fi el ds {(^fieldnames} = trimtunpack($fmt. $_)):
print if is_desirable(); # Строки, удовлетворяющие критериям
}
close(PS) || die "ps failed!":
# Преобразовать позиции разреза в формат распаковки
1.24. Программа: psgrep
89
sub cut2fmt {
my(@pos1t1ons) =
my $templ ate = " ;
my $lastpos = 1:
foreach $place(posit1ons) {
$template .= "A" . ($place - $lastpos) . " ":
$lastpos = $place:
}
$template .= "A*":
return $template:
}
sub trim {
my (^strings =
for (©strings) {
s/x\s+//:
s/\s+$//:
}
return wantarray ? ©strings : $str1ngs[0];
}
# Следующий шаблон использовался для определения позиций разреза.
# Далее следует пример входных данных
#123456789012345678901234567890123456789012345678901234567890123456789012345
# 1 2 3 4 5 6 7
# Позиции: # 8 14 20 26 30 34 41 47 59 63 67 72
# 1 1 1 | 1 | 1 1 | 1 | 1
_ _end_ FLAGS ”UID PID PPID PRI NI SIZE RSS WCHAN STA TTY TIME COMMAND
100 0 1 0 0 0 760 432 do_select S 7 0:02 init
140 0 187 1 0 0 784 452 do_select S ? 0:02 syslogd
100100 101 428 1 0 0 1436 944 do_exit S 1 0:00 /bin/login
100140 99 30217 402 0 0 1552 1008 posixlock S ? 0:00 httpd
0 101 593 428 0 0 1780 1260 copy_thread S 1 0:00 -tcsh
100000 101 30639 9562 17 0 924 496 R Pl 0:00 ps axl
0 101 25145 9563 0 0 2964 2360 idetape_rea S P2 0:06 trn
100100 0 10116 9564 0 0 1412 928 setup frame T p3 0:00 ssh -C www
100100 0 26560 26554 0 0 1076 572 setup_frame T P2 0:00 less
100000 101 19058 9562 0 0 1396 900 setup_frame T Pl 0:02 nvi /tmp/a
В программе psgrep объединены многие приемы, представленные в книге.
Об удалении начальных и конечных пропусков рассказано в рецепте 1.19. Пре-
образование позиций разреза в формат unpack для извлечения полей с фиксиро-
ванным положением рассматривается в рецепте 1.1. Поиску по регулярным вы-
ражениям посвящена вся глава 6.
Многострочный текст, передаваемый die, представляет собой встроенный
документ (см. рецепты 1.15 и 1.16). Присваивание @f 1 el ds {@f 1 el dnames} заносит
сразу несколько величин в хэш ^fields. Срезы хэшей рассматриваются в рецеп-
тах 4.8 и 5.11.
Входные данные программы-примера, расположенные под____END__, описаны
в рецепте 7.12. На стадии разработки для тестирования использовались «кон-
сервированные» данные, полученные через файловый манипулятор DATA. Когда
программа заработала, мы перевели ее на получение данных из присоединенной
команды ps, однако исходные данные были оставлены для будущего переноса на
90
Глава 1. Строки
другие платформы и сопровождения. Конвейерный запуск других программ рас-
сматривается в главе 16 «Управление процессами и межпроцессные взаимодей-
ствия» более подробно в рецептах 16.10 и 16.13.
Настоящая сила и выразительность psgrep обусловлена тем, что в Perl стро-
ковые аргументы могут представлять собой не просто строки, а программный
код Perl. Похожий прием использован в рецепте 9.9, за исключением того, что
в psgrep аргументы пользователя «упакованы» в процедуру 1s_des1 rable. При
этом строки компилируются в код Perl всего один раз — еще перед запуском
той программы, чей вывод мы обрабатываем. Например, при запросе UID ни-
же 10 будет сгенерирована следующая строка:
eval "sub is_desirable { uid < 10 } " . 1:
Загадочное .1 в конце присутствует для того, чтобы при компиляции пользо-
вательского кода команда eval возвращала истинное значение. В этом случае
нам даже не придется проверять $@ на предмет ошибок компиляции, как это де-
лается в рецепте 10.12.
Использование произвольного кода Perl в фильтрах для отбора записей —
невероятно мощная возможность, но она не является абсолютно оригинальной.
Perl многим обязан языку программирования awk, который часто применялся
для подобной фильтрации. Один из недостатков awk заключался в том, что он не
мог легко интерпретировать входные данные в виде полей фиксированной длины
(вместо полей, разделенных особыми символами). Другой недостаток — отсутст-
вие мнемонических имен полей; в awk использовались имена $1, $2 и т. д. К тому
же Perl может делать многое из того, на что не способен awk.
Пользовательские критерии даже не обязаны быть простыми выражениями.
Например, следующий вызов инициализирует переменную $1d номером пользо-
вателя nobody и затем использует ее в выражении:
X psgrep 'no strict "vans";
BEGIN { $id = get pwnamC nobody") }
uid == $id '
Но как использовать слова uid, command и size, даже не снабжая их символом $
для представления соответствующих полей входных записей? Мы напрямую
манипулируем с таблицей символических имен, присваивая замыкания (closures)
неявным тип-глобам (typeglobs), которые создают функции с соответствующими
именами. Имена функций создаются с использованием записи, как в верхнем, так
и в нижнем регистре, что позволяет использовать как "UID < 10", так и "uid > 10".
Замыкания описаны в рецепте 11.4, а их присвоение тип-глобам для создания
синонимов функций — в рецепте 10.14.
Однако в psgrep встречается нюанс, отсутствующий в этих рецептах, — речь
идет о пустых скобках в замыкании. Благодаря скобкам функция может исполь-
зоваться в выражениях везде, где допускается отдельная величина (например,
строка или числовая константа). В результате создается пустой прототип, а функ-
ция обращения к полю (например, uid) вызывается без аргументов, по аналогии
со встроенной функцией time. Если не создать для функций прототипы с пустыми
списками аргументов, выражения "uid < 10" или "size/2 > rss" приведут в заме-
1.24. Программа: psgrep
91
шательство лексический анализатор — он увидит в них незаконченный глоб
(wildcard glob) или шаблон поиска соответственно. Прототипы рассматриваются
в рецепте 10.11.
Показанная версия psgrep получает входные данные от команды ps в формате
Red Hat Linux. Чтобы адаптировать ее для другой системы, посмотрите, в каких
столбцах начинаются заголовки. Такой подход не ограничивается спецификой
ps или системы Unix. Это общая методика фильтрации входных записей с исполь-
зованием выражений Perl, которая легко адаптируется для другой структуры запи-
си. Поля могут быть выстроены в столбцы, разделены запятыми или быть получе-
ны в результате поиска по шаблону с применением сохраняющих круглых скобок.
После небольшого изменения в функциях отбора программа даже подойдет
для работы с пользовательской базой данных. Если у вас имеется массив запи-
сей (см. рецепт 11.9), пользователь может указать произвольный критерий отбора:
sub id() { $_->{ID} }
sub tltleO { $_->{TITLE} }
sub executive { title =~/(?:v1ce-)?pres1dent/1 }
# Критерии отбора указываются при вызове grep
@slowburners = grep { Id < 10 && 'executive } (^employees;
По причинам, связанным с безопасностью и быстродействием, такой подход
редко встречается в реальных механизмах, описанных в главе 14 «Базы данных».
В частности, он не поддерживается в SQL, но, имея в своем распоряжении Perl
и некоторую долю изобретательности, нетрудно создать свой собственный вариант.
Числа
«Каждый, кто занимается математическими методами
получения случайных чисел, несомненно, впадает в грех».
Джон фон Нейман (1951)
2.0. Введение
Числа составляют основные типы данных практически в любом языке програм-
мирования, однако даже с ними могут возникнуть неожиданные сложности.
Случайные числа, числа с дробной частью, числовые последовательности и пре-
образования строк в числа — все это вызывает немалые затруднения.
Perl старается по возможности облегчить вам жизнь, и его средства для ра-
боты с числами не являются исключением из этого правила. Если скалярное
значение интерпретируется в программе как число, то Perl преобразует его в чис-
ловую форму. Читаете ли вы числовые данные из файла, извлекаете отдельные
цифры из строки или иным образом получаете числа из бесчисленных тексто-
вых источников внешнего мира — вам не приходится преодолевать препятствия
в виде неудобных ограничений других языков на пути преобразования ASCII-
строк в числа.
Если строка используется в числовом контексте (например, в математическом
выражении), то Perl старается интерпретировать ее как число, однако у него нет
возможности сообщить о том, что строка не имеет действительного числового
представления. Встречая нечисловой символ, Perl прекращает интерпретацию
строки, при этом нечисловые строки считаются равными нулю — поэтому "А7"
преобразуется в 0, а "7А" — в 7 (хотя флаг -w предупредит вас о некорректных
преобразованиях). Иногда (например, при проверке вводимых данных) тре-
буется узнать, соответствует ли строка числу. Мы покажем, как это делается,
в рецепте 2.1.
В рецепте 2.16 объясняется, как получить число из строк с шестнадцате-
ричными, восьмеричными или двоичными представлениями чисел — например,
"Oxff", "0377" и "0М0110". Perl автоматически преобразует литералы в программ-
ном коде (поэтому команда $а = 3 + Oxff присвоит $а значение 258), но это не от-
носится к данным, прочитанным программой. Вы не можете прочитать "ff" или
даже "Oxff" в $b и затем написать $а = 3 + $Ь, чтобы присвоить $а значение 258.
А если трудностей с целыми числами окажется недостаточно, числа с плаваю-
щей запятой преподнесут целый букет новых проблем. Во внутреннем представ-
2.1. Проверка строк на соответствие числам
93
лении дробные числа хранятся в двоичном формате с плавающей запятой. Они
представляют вещественные числа лишь приближенно, с ограниченной точ-
ностью. Для представления бесконечного множества вещественных чисел ис-
пользуется конечное пространство, обычно состоящее из 264 элементов или около
того. Потеря точности неизбежна.
Числа, прочитанные из файла или встретившиеся в программе в виде литера-
лов, преобразуются из текстового представления (которое для дробных чисел
всегда записывается в десятичной системе) во внутреннее, двоичное представле-
ние. Точное представление дробных чисел конечным количеством цифр в неко-
торой системе счисления возможно только в том случае, если число представля-
ется в виде суммы конечного числа дробей, знаменатели которых представляют
собой целые степени основания этой системы счисления.
Например, число 0,13 равно 0,10+0,03, но такое представление относится
только к десятичной системе счисления. В двоичной системе счисления число
0,75 представляется точно, потому что оно равно 1/2 + 1/4, а 2 и 4 являются сте-
пенями 2. Но даже такое простое число, как 0,1 в десятичной системе, не может
быть представлено в виде суммы дробей 1/2, 1/4, 1/8, 1/16 и т. д. Подобно тому
как 1/3 не имеет конечного представления в десятичной системе, число 1/10 не
имеет конечного представления в двоичной системе. Внутреннее представление
0,1 в вашем компьютере не равно 0,1, хотя и достаточно близко к нему:
$ perl -е 'printf "ГбОПп". О.Г
0.100000000000000005551115123125782792118158340454101562500000
В рецептах 2.2 и 2.3 показано, как работать с вещественными представления-
ми чисел на вашем компьютере как с обычными числами.
Рецепт 2.4 описывает три способа выполнения некоторой операции с каждым
элементом последовательного множества целых чисел. Преобразование чисел
в римскую запись и обратно продемонстрировано в рецепте 2.5.
Случайным числам посвящено сразу несколько рецептов. Функция Perl rand
возвращает число с плавающей запятой от 0 до 1 или от 0 до своего аргумента.
Мы покажем, как получить случайное число в конкретном интервале, как сде-
лать их «еще более случайными» и как заставить rand генерировать новый набор
случайных чисел при каждом запуске программы.
Глава завершается рецептами, относящимися к тригонометрии, логарифмам,
умножению матриц, комплексным числам. Заодно вы найдете ответ на часто
встречающийся вопрос: «Как включить в выводимое число запятую?»
2.1. Проверка строк на соответствие числам
Проблема
Требуется проверить, представляет ли строка допустимое число. Эта проблема
часто возникает при проверке входных данных (например, в сценариях CGI,
конфигурационных файлах и аргументах командной строки).
94
Глава 2. Числа
Решение
Проверьте строку по регулярному выражению, которое совпадает со всеми ин-
тересующими вас разновидностями чисел:
if (Sstrlng =~ /PATTERN/) {
# является числом
} else {
# не является числом
}
Или воспользуйтесь готовыми шаблонами из модуля CPAN Regexp::Common:
if (Sstrlng =~ m{x$RE{num}{real }$}) {
# является вещественным числом
} else {
# не является вещественным числом
}
Комментарий
Все зависит от того, что именно понимать под числом. Даже простые на первый
взгляд понятия, например, целое, заставят вас поломать голову над тем, какие
строки следует отнести к этой категории. Например, что делать с начальным +
для положительных чисел? Разрешить, сделать обязательным или запретить?
А числа с плавающей запятой представляются таким огромным количеством
способов, что у вас в голове перегреется процессор.
Сначала решите, какие символы допустимы, а какие — нет. Затем сконструи-
руйте для отобранных символов регулярное выражение. Ниже приведены неко-
торые стандартные конструкции для самых распространенных ситуаций (что-то
вроде полуфабрикатов для нашей поваренной книги).
# Содержит нецифровые символы
warn "has nondlglts" # Не является натуральным числом If /\D/;
warn "not a natural number" # Не является целым числом unless /x\d+$/: # Отвергает -3
warn "not an Integer" warn "not an Integer" .# He является десятичным числом unless /x-?\d+$/; # Отвергает +3 unless /x[+-]?\d+$/;
warn "not a decimal number" unless /x-?\d+\.?\d*$/: # Отвергает .2
warn "not a decimal number" unless /x-?(? Ad+(? A Ad*)? |\ Ad+)$/:
# Не является вещественным числом С
warn "not а С float"
unless /А [+-]?)(?=\d|\.\d)\d*(\Ad*)?([Ее](L+-J?\d+))?$/:
В этих шаблонах не обрабатываются особые случаи Infinity и NaN в записи
IEEE. Если вы не боитесь, что члены комитета IEEE придут к вашему компью-
теру и начнут бить вас по голове копиями соответствующих стандартов, вероят-
но, об этих странных «числах» можно забыть.
Для строк с начальными или конечными пробелами эти шаблоны не подхо-
дят. Либо вставьте в них соответствующую логику, либо вызовите функцию trim
из рецепта 1.19.
2.1. Проверка строк на соответствие числам
95
Модуль Regexp: -.Common из архива CPAN содержит множество готовых решений
для проверки того, содержит ли строка текстовое представление числа. Помимо
того что вам не придется тратить время на самостоятельное составление этих шаб-
лонов, их использование сделает программу более удобочитаемой. По умолчанию
этот модуль экспортирует хэш с именем Ж, индексируемый по типу регулярного
выражения. Будьте внимательны и используйте якорные метасимволы там, где это
необходимо, иначе поиск по шаблону будет производиться во всей строке. Пример:
use Regexp::Common;
Sstring = "Gandalf departed from the Havens In 3021 TA.";
print "Is an 1nteger\n" If Sstring =~ / x $RE{num}{1nt} $ /x;
print "Contains the Integer $l\n" If Sstring =~ / ( $RE{num}{1nt} ) /x;
Ниже приводятся другие примеры шаблонов, которые могут использоваться
модулем для проверки чисел:
$RE{num}{1nt}{-sep=>'.?'}
$RE{num}{1nt}{-sep=>'.'}{-group=>4}
$RE{num}{1 nt}{-base => 8}
$RE{num}{1nt}{-sep=>'.'}{-group=3}
$RE{num}{1 nt}{-sep=>'.?'}{-group=3}
$RE{num}{real}
$RE{num}{roman}
$RE{num}{square}
# Совпадает c 1234567 и 1.234.567
# Совпадает с 1.2345.6789
# Совпадает с 014. но не с 99
# Совпадает с 1.234.594
# Совпадает с 1,234 и 1234
# Совпадает с 123.456 и -0.123456
# Совпадает с xvll и MCMXCVIII
# Совпадает с 9, а также 256 и 12321
Некоторые из этих шаблонов (в частности, square) отсутствовали в ранних
версиях модуля. Общее описание модуля приведено на странице руководства
Regexp: -.Common, а более подробная документация по числовым шаблонам содер-
жится на странице руководства Regexp::Common::number.
Некоторые способы идентификации чисел обходятся без регулярных выра-
жений. Вместо этого они используют функции системных библиотек или Perl.
Конечно, возможности таких функций ограничиваются определением «числа»,
принятым в системной библиотеке или в Perl.
В POSIX-системах Perl поддерживает функцию POSIX::strtod. Ее семантика
чрезвычайно громоздка, поэтому ниже приводится функция getnum для упроще-
ния работы с ней. Эта функция получает строку и возвращает либо найденное
число, либо undef для строк, не соответствующих вещественным числам С. Интер-
фейсная функция 1s_numer1c упрощает вызов getnum в ситуациях, когда вы просто
хотите спросить: «Это вещественное число?»
sub getnum {
use POSIX qw(strtod);
my Sstr = shift:
Sstr =~ s/x\s+//: # Удаление начальных пропусков
Sstr =~ s/\s+$//; # Удаление конечных пропусков
$! = 0;
my($num. Sunparsed) = strtod(Sstr);
If ((Sstr eq '') || (Sunparsed != 0) || $!) {
return;
} else {
return Snum;
}
}
sub 1s_numer1c { defined scalar Sgetnum }
96
Глава 2. Числа
Модуль Scalar::llti 1, ставший стандартным в недавней версии Perl 5.8.1, экс-
портирует функцию looks_like_number, которая использует одноименную внут-
реннюю функцию компилятора Perl (см. perlapi(\)). Функция возвращает true
для любого десятичного числа, приемлемого с точки зрения Perl, например, О,
0.8, 14.98 или 6.02е23, но не для чисел ОхЫОЮ, 077, 0x392 или чисел, содержа-
щих внутренние символы подчеркивания. Следовательно, если вы захотите раз-
решить ввод чисел в других системах счисления, вам придется самостоятельно
проверить их синтаксис и декодировать их, как показано в примере 2.1.
Пример 2.1. Декодирование чисел
#!/usr/bin/perl -w
use Scalar::Util qw(looks_l ike_number):
print "SO: hit XD (your eof character) to exit\n":
for (::) {
my (Son, $n): # Исходная строка и ее числовое представление
print "Pick a number, any number: ":
Son = $n = <STDIN>:
last if !defined $n:
chomp($on,$n):
$n =~ s/_//g: # Разрешить 186_282.398_280_685
$n = oct(Sn) if $n =~ /х0/: # Разрешить OxFF, 037, OblOlO
if (looks_like_number($n)) {
printf "Decimal double of Son is £g\n", 2*$n;
} else {
print "That doesn't look like a number to PerlAn":
}
}
print ”\nBye.\n”:
См. также
Описание синтаксиса регулярных выражений в perlre(l); страница руковод-
ства strtod(3y, страница руководства perlapi(Vy документация по модулю CPAN
Regexp: -.Common, включая страницу руководства Regexp::Common::number; документа-
ция по стандартным модулям POSIX и Scalar::llti 1.
2.2. Округление чисел с плавающей запятой
Проблема
Число с плавающей запятой требуется округлить до определенного десятичного
разряда. Проблема связана с теми же погрешностями представления, которые за-
трудняют сравнение чисел (см. рецепт 2.3), а также возникает в ситуациях, когда
точность ответа намеренно снижается для получения более наглядного результата.
Решение
Чтобы просто вывести число, воспользуйтесь функцией Perl sprintf или printf:
# Округление до двух разрядов
Srounded = sprintf("Г2f"", Sunrounded):
2.2. Округление чисел с плавающей запятой
97
Или воспользуйтесь другими функциями округления, рассмотренными в Ком-
ментарии.
Комментарий
Работа с вещественными числами практически неизбежно сопровождается округ-
лением (видимым или незаметным для программиста). Применение специальных
стандартов (а именно IEEE 754, стандарта двоичной вещественной математики)
в сочетании с разумным механизмом стандартного округления в Perl часто по-
зволяет устранить или по крайней мере скрыть ошибки округления.
Более того, автоматическое округление при выводе в Perl обычно работает
так хорошо, что его результаты очень редко оказываются неожиданными для
пользователя. Числа почти всегда лучше хранить в неокругленном виде до мо-
мента вывода, и если вас не устраивает стандартное округление Perl — восполь-
зуйтесь функцией printf или sprintf с явно заданным форматом округления.
Форматы %f, %е и %д позволяют задать количество десятичных разрядов, до кото-
рого должен округляться аргумент. Следующий пример демонстрирует работу
всех трех форматов; в каждом случае запрашивается поле с шириной 12 пози-
ций, но не более 4 цифр в дробной части:
for $п ( 0.0000001. 10.1. 10.00001. 100000.1 ) {
printf "И2.4е И2.4f П2.4д\п”, $n. $n. $n:
}
Результат выглядит так:
1.0000е-07 0.0000 1е-07
1.0100е+01 10.1000 10.1
1.0000е+01 10.0000 10
1.0000е+05 100000.1000 1е+05
Если бы этим все и ограничивалось, с округлением не было бы никаких про-
блем. Вы просто выбираете свой любимый формат вывода, и дело с концом.
Однако на практике все не так просто. Иногда приходится более глубоко за-
думываться о том, чего же вы в действительности добиваетесь и что происходит
на самом деле. Как объяснялось во Введении, даже простые числа вида 10.1 и 0.1
в двоичной системе могут храниться лишь в приближенном виде. Из всех деся-
тичных вещественных чисел точное представление возможно только в том слу-
чае, если число представляется в виде суммы конечного числа дробей, знамена-
тели которых представляют собой целые степени двойки. Например, фрагмент
$а = 0.625: # 1/2 + 1/8
$Ь = 0.725: # 725/1000. или 29/40
printf is O0g\n". $_ for $a. $b:
выводит следующий результат:
0.625 is 0.625
0.725 is 0.724999999999999977795539507497
Число, хранящееся в переменной $а, может быть точно представлено в двоич-
ной системе, а число в переменной $Ь не имеет точного представления. Когда
98
Глава 2. Числа
Perl получает распоряжение вывести вещественное число без указания точности,
как это происходит с интерполируемым значением $_ в строке, число автоматиче-
ски округляется до той точности, которая поддерживается вашим компилятором.
Обычно происходит то же, что и при использовании формата вывода "Я. 15g",
а при выводе будет получено число, присвоенное $Ь.
Как правило, ошибки округления настолько малы, что программист их даже
не замечает, а если и заметит, всегда существует возможность задать нужную
точность результата. Но поскольку приближенное значение все равно немного
отличается от того, которое выводится простой командой print, иногда это при-
водит к неожиданным последствиям. Например, числа 0,325 и 0,725 не имеют
точного двоичного представления, в отличие от чисел 0,125 и 0,625. Допус-
тим, потребовалось округлить такое число до двух цифр после запятой. Какое
округленное значение будет использовано для 0,325 — 0,32 или 0,33? А для
0,725 - 0,72 или 0,73?
$а = 0.325; # 1/2 + 1/8
$Ь = 0.725; # 725/1000, или 29/40
prlntf 'Is Is T2f or OOg\n", ($_) x 3 for $a. $b;
Результат:
0.325 Is 0.33 or 0.325000000000000011102230246252
0.725 Is 0.72 or 0.724999999999999977795539507497
Поскольку приближенное представление 0.325 оказывается чуть больше точ-
ного значения, оно округляется до 0.33. Однако, приближенное представле-
ние 0.725 оказывается чуть меньше, поэтому оно округляется вниз, и мы по-
лучаем 0.72.
А что происходит с числами, имеющими точное представление, — такими,
как 1.5 или 7.5? Такие числа равны сумме целого числа с 1/2. Вероятно, правило
округления, используемое в этом случае, отличается от того, которое вы прохо-
дили в начальной школе. Посмотрите:
for $п (-4 .. +4) {
$п += 0.5;
prlntf "M.lf £2.0f\n", $n. $n;
}
Результат:
-3.5 -4
-2.5 -2
-1.5 -2
-0.5 -0
0.5 0
1.5 2
2.5 2
3.5 4
4.5 4
Дело в том, что специалисты в области математического анализа вместо ме-
тода «округления вверх» предпочитают метод «округления к четному числу»,
поскольку он обеспечивает взаимную компенсацию ошибок округления.
2.2. Округление чисел с плавающей запятой
99
Существуют три функции, предназначенные для округления чисел с плаваю-
щей запятой до целых: Int, cell и floor. Встроенная функция Perl int возвращает
целую часть передаваемого ей вещественного числа (это называется «округ-
лением по направлению к нулю» или «отсечением дробной части», поскольку
функция игнорирует дробную часть: положительные числа округляются вниз,
а отрицательные — вверх). Функции модуля POSIX floor и ceil тоже игнорируют
дробную часть, но они всегда осуществляют округление до ближайшего меньше-
го или большего числа соответственно независимо от знака.
use POSIX qw(floor ceil);
printf '18s £8s £8s £8s £8s\n",
qw(number even zero down up):
for $n (-6 .. +6) {
$n += 0.5;
printf '18g £8.Of £8s £8s £8s\n”.
$n. $n. int($n), floor($n), ceil($n);
}
Ниже приведена таблица, выводимая этим фрагментом; каждый столбец по-
казывает, что происходит при округлении числа в заданном направлении.
number even zero down up
-5.5 -6 -5 -6 -5
-4.5 -4 -4 -5 -4
-3.5 -4 -3 -4 -3
-2.5 -2 -2 -3 -2
-1.5 -2 -1 -2 -1
-0.5 -0 0 -1 0
0.5 0 0 0 1
1.5 2 1 1 2
2.5 2 2 2 3
3.5 4 3 3 4
4.5 4 4 4 5
5.5 6 5 5 6
6.5 6 6 6 7
Если вычислить сумму по каждому столбцу, вы получите сильно различаю-
щиеся результаты:
6.5 6 б 0 13
Отсюда можно сделать вывод, что выбор стиля округления (а в сущности,
выбор ошибки округления) может оказать огромное влияние на окончательный
результат. Это одна из причин, по которым округление рекомендуется отклады-
вать до момента окончательного вывода. Впрочем, в особо важных приложениях
(например, в финансовых вычислениях или системах наведения ракет) грамот-
ный программист реализует свою собственную функцию округления, не полага-
ясь на встроенную логику языка (или ее отсутствие). Также полезно почитать
хорошую книгу по математическому анализу.
См. также
Функции sprintf и int в perlfunc(l); описания floor и ceil в документации по
стандартному модулю POSIX; пример использования sprintf из рецепта 2.3.
100
Глава 2. Числа
2.3. Сравнение вещественных чисел
Проблема
Арифметика с плавающей запятой не является абсолютно точной. Сравнивая два
числа, вы хотите узнать, совпадают ли они до определенного десятичного раз-
ряда. Как правило, именно так следует сравнивать числа с плавающей запятой.
Решение
Воспользуйтесь функцией sprintf и отформатируйте числа до определенного
десятичного разряда, после чего сравните полученные строки:
# equal(NUM1. NUM2. PRECISION); возвращает true, если NUM1 и NUM2
# совпадают на PRECISION десятичных разрядов.
sub equal {
my ($А. $В. $dp) =
return sprintf('T${dp}g". $А) eq sprintfCl. ${dp}g". $B);
}
Альтернативное решение — преобразовать числа в целые, умножая их на со-
ответствующий коэффициент.
Комментарий
Процедура equal понадобилась из-за того, что в компьютерах многие числа с пла-
вающей запятой являются приближенными представлениями реальных чисел
(об этом говорилось во Введении). Стандартные функции вывода Perl выводят
числа с округлением до 15 десятичных разрядов, но при числовых сравнени-
ях округление не применяется. Следовательно, некоторые числа при выводе
могут выглядеть одинаково (после округления), но не совпадать при сравнении
(без округления).
Проблема особенно заметна в циклах, где ошибки округления незаметно на-
капливаются. Допустим, вы обнуляете переменную и десять раз увеличиваете ее
на 0,1; логично предположить, что результат будет равен 1. На самом деле это не
так, поскольку в двоичной системе число 0,1 не имеет точного представления.
Например, фрагмент
for ($num = $1 =0; $1 <10; $i++) { $num +=0.1 }
if ($num != 1) {
printf "Strange. $num is not 1; it's ^.45f\n". $num;
}
выводит следующий результат:
Strange, 1 is not 1; it's 0.999999999999999888977697537484345957636833191
В строке, заключенной в кавычки, переменная $num интерполируется с ис-
пользованием формата "%. 15g", принятого по умолчанию в большинстве систем,
поэтому сначала выводится значение 1. Однако во внутреннем представлении
2.4. Действия с последовательностями целых чисел
101
переменная Snum отлична от 1, но если ограничить проверку несколькими деся-
тичными разрядами, например, пятью:
!equal($num. 1. 5)
сравнение даст желаемый результат.
При фиксированном количестве цифр в дробной части (например, в денежных
суммах) проблему можно решить преобразованием в целое число. Если сумма
3.50 будет храниться в виде 350, а не 3.5, необходимость в числах с плавающей
запятой отпадает. Десятичная точка снова появляется в выводимых данных:
Swage = 536: # $5.36/час
$week = 40 * Swage; # $214.40
printfCOne week’s wage Is: Ш.2Лп", $week/100):
One week’s wage is: $214.40
На практике сравнение чисел более чем до 15 разряда обычно не имеет смыс-
ла — вполне возможно, что оборудование вашего компьютера не поддерживает
более высокой точности.
См. также
Описание функции sprlntf в perlfunc(Vy, описание переменной SOFMT на странице
руководства perlvar(l); документация по стандартному модулю Math: :BigFloat.
Функция sprlntf используется в рецепте 2.2. Также обращайтесь к разделу 4.2.2
тома 2 «Искусства программирования».
2.4. Действия с последовательностями
целых чисел
Проблема
Требуется выполнить некоторую операцию со всеми целыми между X и Y.
Подобная задача может возникнуть при работе с непрерывной частью масси-
ва или в любой ситуации, когда необходимо обработать все числа1 из заданного
интервала.
Решение
Воспользуйтесь циклом for или .. в сочетании с циклом foreach:
foreach (SX .. SY) {
# $_ принимает все целые значения от X до Y включительно
}
1 Точнее, все целые числа. Найти все вещественные числа будет нелегко. Не верите —
посмотрите у Кантора.
102
Глава 2. Числа
foreach $1 ($Х .. $Y) {
# $1 принимает все целые значения от X до Y включительно
for ($1 = $Х: $1 <= $Y: $1++) {
# $1 принимает все целые значения от X до Y включительно
for ($1 = $Х; $1 <= $Y; $1+=7) {
# $1 принимает целые значения от X до Y включительно с шагом 7
Комментарий
В двух первых методах используется цикл foreach в сочетании с конструкци-
ей $Х. .$Y, которая создает список всех целых чисел между $Х и $Y. Простое
присваивание интервала массиву приведет к большим расходам памяти, если $Х
и $Y расположены далеко друг от друга. В цикле foreach Perl учитывает это
обстоятельство и не тратит память на создание временного списка. При пере-
боре последовательных целых чисел цикл foreach работает быстрее эквивалент-
ного цикла for.
Другое различие между двумя конструкциями состоит в том, что в цикле
foreach переменная цикла локализуется в тело цикла, а в цикле for этого не про-
исходит. Таким образом, после завершения цикла for счетчик цикла содержит
значение, действовавшее при последней итерации. Однако, после завершения
цикла foreach это значение становится недоступным, а переменная содержит то
значение, которое хранилось в ней до входа в цикл (если такое значение вообще
было). Впрочем, в качестве управляющей переменной цикла можно использо-
вать лексическую переменную:
foreach my $1 ($Х .. $Y) { ... }
for (my $i=$X; $1 <= $Y; $i++) { ... }
В следующем фрагменте продемонстрированы все три способа. В данном
случае мы ограничиваемся выводом сгенерированных чисел:
print "Infancy is:":
foreach (0 .. 2) {
print "$_
}
print "\n";
print "Toddling is: ":
foreach $1 (3 .. 4) {
print "$i
}
print "\n";
print "Childhood is: ":
for ($1 = 5: $1 <= 12: $i++) {
print "$i ";
print "\n":
2.5. Работа с числами в римской записи
103
Infancy is: 0 1 2
Toddling is: 3 4
Childhood is: 5 6 7 8 9 10 11 12
См. также
Описание операторов for и foreach в perlsyn(V).
2.5. Работа с числами в римской записи
Проблема
Требуется осуществить преобразование между обычными числами и числами
в римской записи. Такая необходимость часто возникает при оформлении сносок
и нумерации страниц в предисловиях.
Решение
Воспользуйтесь модулем Roman из архива CPAN:
use Roman:
$roman = roman($arabic): # Преобразование
# в римскую запись
$arabic = arabic(Sroman) 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
В следующем примере выводится текущий год:
use Time::1ocaltime:
use Roman:
printf "The year is now %s\n", Roman(1900 + localtime->year):
The year is now MMIII
104
Глава 2. Числа
Если в вашем распоряжении имеются шрифты Юникода, вы можете убедить-
ся, что кодовые пункты в интервале от U+2160 до U+2183 представляют рим-
ские числа, в том числе и отсутствующие в обычной кодировке ASCII:
use charnames ":ful1":
print "2003 is \N{ROMAN NUMERAL ONE THOUSAND}" x 2.
"\N{ROMAN NUMERAL THREE}\n";
2003 is MMIII
Поддержка этих символов пока отсутствует в модуле Roman.
Хотите — верьте, хотите — нет, но в CPAN существует даже модуль, позво-
ляющий выполнять вычисления в римской записи:
use Math::Roman qw(roman):
print $a = roman('Г): # I
print $a += 2000: # MMI
print $a -= "III": # MCMXCVIII
print $a -= "MOM"; # XCVIII
См. также
Документация по модулям CPAN Roman и Math::Roman; рецепт 6.23.
2.6. Генератор случайных чисел
Проблема
Требуется генерировать случайные числа в заданном интервале, например, чтобы
выбрать произвольный элемент массива, имитировать бросок кубика в игре или
сгенерировать случайный пароль.
Решение
Воспользуйтесь функцией Perl rand:
$random = int( rand( $Y-$X+1 ) ) + $X:
Комментарий
Следующий фрагмент генерирует и выводит случайное число в интервале от 25
до 75 включительно:
Srandom = int( rand(51)) + 25:
print "$random\n";
Функция rand возвращает дробное число от 0 (включительно) до заданного
аргумента (не включается). Мы вызываем ее с аргументом 51, чтобы случайное
число было больше либо равно 0, но никогда не было бы равно 51 и выше. Затем
от сгенерированного числа берется целая часть, что дает число от 0 до 50 вклю-
2.7. Получение повторяющихся серий случайных чисел
105
чительно (функция Int превращает 50,9999... в 50). К полученному числу при-
бавляется 25, что дает в результате число от 25 до 75 включительно.
Одно из распространенных применений этой методики — выбор случайного
элемента массива:
$elt = SarrayL rand @array ]:
Эта запись эквивалентна следующей:
$elt = SarrayL 1nt( rand(O+@array) ) ]:
В соответствии с прототипом функция rand вызывается с одним аргумен-
том, поэтому аргумент неявно интерпретируется в скалярном контексте, что
для именованного массива означает количество элементов. Функция возвра-
щает вещественное число, меньшее аргумента, но большее либо равное нулю.
При использовании в качестве индекса массива вещественное число автома-
тически усекается до целой части. В результате мы получаем элемент масси-
ва, случайно выбранный с равномерным распределением, и присваиваем его
$elt.
Так же легко сгенерировать случайный пароль из заданной последовательно-
сти символов:
@chars = ( "А" .. "Z". "а" .. "z". О .. 9, ! @ $ Я ' & *) );
$password = joinC", @chars[ map { rand @chars } ( 1 .. 8 ) ]):
Мы генерируем восемь случайных индексов @chars с помощью функции тар,
извлекаем соответствующие символы в виде среза и объединяем их в случай-
ный пароль. Впрочем, такие случайные числа являются недостаточно случай-
ными, потому что надежность пароля зависит от стартового значения (seed)
генератора случайных чисел, который (в старых версиях Perl) инициализиро-
вался на основании времени запуска программы. В рецепте 2.7 показано, как
«раскрутить» генератор случайных чисел и сделать генерируемые числа более
случайными.
См. также
Описание функций Int, rand и join в perlfunc(\.). Случайные числа исследуются
в рецептах 2.7, 2.8 и 2.9, а используются в рецепте 1.13.
2.7. Получение повторяющихся серий
случайных чисел
Проблема
При каждом запуске программы вы получаете разные наборы (псевдо-) слу-
чайных чисел. Требуется, чтобы Perl при каждом запуске выдавал одну и ту же
серию случайных чисел (например, в процессе отладки программы).
106
Глава 2. Числа
Решение
Воспользуйтесь функцией Perl srand:
srand EXPR; # Вызов с константой генерирует повторяющиеся серии
Комментарий
Генерация случайных чисел — непростое дело. Лучшее, на что способен компь-
ютер без специального оборудования — генерация псевдослучайных чисел, рав-
номерно распределенных в области своих значений. Псевдослучайные числа
генерируются по математическим формулам, а это означает, что при одинако-
вом стартовом значении генератора две программы сгенерируют одни и те же
псевдослучайные числа.
Функция srand задает новое стартовое значение для генератора псевдослу-
чайных чисел. Если она вызывается с аргументом, то указанное число будет ис-
пользовано в качестве стартового. При отсутствии аргумента srand использует
величину, значение которой трудно предсказать заранее.
Если вызвать rand без предварительного вызова srand, Perl автоматически вы-
зывает srand с «хорошим» стартовым значением. Таким образом, при каждом за-
пуске программы вы будете получать разные серии случайных чисел. Старые
версии Perl не вызывали srand, поэтому программы всегда генерировали одну
и ту же последовательность чисел. Однако в некоторых ситуациях разные серии
не нужны; наоборот, при каждом запуске должен выдаваться один и тот же
набор. Если вы предпочитаете именно такое поведение, вызовите srand с кон-
кретным аргументом:
srand( 42 ); # Выбор любого фиксированного стартового значения
То, что Perl старается выбрать хорошее стартовое значение, еще не гаран-
тирует криптографической безопасности сгенерированных чисел от усердных
попыток взлома. Информацию о построении надежных генераторов случайных
чисел можно найти в учебниках по криптографии.
См. также
Описание функции srand в perlfunc(\}. Примеры ее применения приведены в ре-
цептах 2.6 и 2.8.
2.8. Повышение фактора случайности
Проблема
Требуется генерировать случайные числа, которые были бы «более случайны-
ми», чем выдаваемые генератором Perl. Иногда возникают проблемы, связанные
с ограниченным выбором стартовых значений в библиотеках С. В некоторых
2.9. Получение случайных чисел с неравномерным распределением
107
приложениях последовательность псевдослучайных чисел начинает повторять-
ся слишком рано.
Решение
Воспользуйтесь другими генераторами случайных чисел, например, теми, кото-
рые присутствуют в модулях CPAN Math::Random и Math: :TrulyRandom:
use Math::TrulyRandom:
$random = truly_random_value():
use Math_Random:
$random = random_uniform():
Комментарий
Процесс сборки Perl выбирает лучшую библиотечную функцию С для построе-
ния случайных чисел из rand(3), random^) и drand48(3) (впрочем, на стадии
компоновки это можно изменить). Стандартные библиотечные функции работа-
ют достаточно хорошо, но некоторые древние реализации функции rand возвра-
щают только 16-разрядные случайные числа или используют слабые алгоритмы,
не обеспечивающие достаточной степени случайности.
Модуль Math: :TrulyRandom генерирует случайные числа, используя погрешно-
сти системного таймера. Процесс занимает некоторое время, поэтому им не сто-
ит пользоваться для генерации большого количества случайных чисел.
Модуль Math::Random генерирует случайные числа с помощью библиотеки
randlib. Кроме того, он содержит многочисленные вспомогательные функции
для получения случайных чисел с заданными распределениями, включая бино-
миальное, пуассоновское и экспоненциальное.
См. также
Описание функций srand и rand в perlfunc(l); рецепты 2.6 и 2.7; документация
по модулям CPAN Math::Random и Math: :TrulyRandom.
2.9. Получение случайных чисел
с неравномерным распределением
Проблема
Требуется генерировать случайные числа в ситуации, когда одни значения по-
являются с большей вероятностью, чем другие (неравномерное распределение).
Допустим, вы отображаете на своей веб-странице случайный баннер, и у вас
имеется набор весовых коэффициентов, определяющих частоту появления того
108
Глава 2. Числа
или иного баннера. А может быть, вы имитируете нормальное распределение
(закон распределения Гаусса).
Решение
Если вам потребовались случайные величины, распределенные по конкретному
закону (допустим, по закону Гаусса), загляните в учебник по статистике и най-
дите в нем нужную функцию или алгоритм. Следующая функция генерирует
случайные числа с нормальным распределением, со стандартным отклонением 1
и нулевым математическим ожиданием.
sub gaussian_rand {
my ($ul, $u2): # Случайные числа с однородным распределением
ту $w: # Отклонение, затем весовой коэффициент
my ($gl. $g2); # Числа с гауссовским распределением
do {
$ul = 2 * randO - 1:
$u2 = 2 * randO - 1:
$w = $ul*$ul + $u2*u2;
} while ($w >= 1 || $w == 0);
$w = sqrt( (-2 * log($w)) / $w):
$g2 = Sul * $w;
$gl = Su2 * $w;
# Возвратить оба числа или только одно
return wantarray ? ($gl. Sg2) : $gl;
Если у вас есть список весовых коэффициентов и значений, которые должны
выбираться случайным образом, выполните два последовательных шага. Снача-
ла преобразуйте весовые коэффициенты в вероятностное распределение с по-
мощью приведенной ниже функции we1ght_to_dist, а затем воспользуйтесь функ-
цией weighted_rand для случайного выбора чисел.
# weight_to_dist: получает хэш весовых коэффициентов
# и возвращает хэш вероятностей
sub weight_to_dist {
my ^weights =
my ^dlst = ():
my Stotal = 0;
my (Skey, Swelght);
local $ :
foreach (values ^weights) {
Stotal += $_;
}
while ( (Skey, Swelght) = each ^weights ) {
$d1st{$key} = Swelght/Stotal:
}
return ^dlst:
2.9. Получение случайных чисел с неравномерным распределением
109
# weighted_rand: получает хэш вероятностей
# и возвращает случайный элемент хэша
sub we1ghted_rand {
my %dist =
my ($key, Swelght):
while (1) { # Чтобы избежать погрешностей вычислений
# с плавающей запятой.
my $rand = rand;
while ( ($кеу. Swelght) = each %d1st ) {
return $key If ($rand -= Swelght) <0;
} } }
Комментарий
Функция gauss1an_rand реализует полярный метод Бокса—Мюллера для преобра-
зования двух независимых случайных чисел с равномерным распределением, ле-
жащих в интервале от 0 до 1 (такие числа возвращаются функцией rand), в два
числа с математическим ожиданием 0 и стандартным отклонением 1 (то есть
распределенных по закону Гаусса). Чтобы сгенерировать числа с другим мате-
матическим ожиданием и стандартным отклонением, умножьте выходные данные
gauss1an_rand на нужное стандартное отклонение и прибавьте математическое
ожидание:
# gaussian_rand - см. выше
$mean = 25;
$sdev = 2:
Ssalary - gauss1an_rand() * Ssdev + $mean;
prlntfC’You have been hired at \$^.2f\n". Ssalary);
Модуль Math:: Random содержит готовые реализации для нормального и других
распределений:
use Math::Random qw(random_normal);
Ssalary = random_normal(1, Smean, $sdev);
Функция we1ghted_rand получает случайное число из интервала от 0 до 1. За-
тем она использует вероятности, сгенерированные we1ght_to_dist, и определяет,
какому элементу соответствует это случайное число. Из-за погрешностей пред-
ставления с плавающей запятой накопленные ошибки могут привести к тому,
что возвращаемый элемент не будет найден. Поэтому код размещается в цикле
while, который в случае неудачи выбирает новое случайное число и делает оче-
редную попытку.
Кроме того, модуль CPAN Math::Random содержит функции, генерирующие
случайные числа для многих распределений.
См. также
Описание функции rand в perlfunc(l); рецепт 2.6; документация по модулю
CPAN Math:: Random.
110
Глава 2. Числа
2.10. Выполнение тригонометрических
вычислений в градусах
Проблема
Требуется, чтобы тригонометрические функции использовали градусы вместо
стандартных для Perl радианов.
Решение
Создайте функции для преобразований между градусами и радианами (2л ради-
ан соответствует 360 градусам).
use constant PI => (4 * atan2 (1. D):
sub deg2rad {
my $degrees = shift:
return ($degrees / 180) * PI:
sub rad2deg {
my $radians = shift:
return ($radians / PI) * 180:
Также можно воспользоваться модулем Math: Trig:
use Math: Trig:
$radians = deg2rad($degrees):
$degrees = rad2deg($radians):
Комментарий
Если вам приходится выполнять большое количество тригонометрических вычис-
лений, подумайте об использовании стандартных модулей Math: Trig или POSIX.
В них присутствуют многие дополнительные тригонометрические функции, ко-
торых нет в стандартном Perl. Другое решение основано на использовании при-
веденных выше функций rad2deg и deg2rad. В Perl нет встроенной константы л,
однако при необходимости ее можно вычислить настолько точно, насколько по-
зволит ваше оборудование для вычислений с плавающей запятой. В приведен-
ном выше решении л является константой, определяемой командой use constant.
Чтобы не запоминать, что число л равно 3,14159265358979, мы используем
вызов встроенной функции, результат которого вычисляется на стадии компи-
ляции. Этот прием не только избавляет от необходимости запоминать длинную
цепочку цифр, но и гарантирует максимальную точность, обеспечиваемую данной
платформой.
Синус угла, заданного в градусах, вычисляется следующим образом:
# Функции deg2rad и rad2deg приведены выше или взяты из Math::Trig
sub degree_sine {
2.11. Тригонометрические функции 111
my $degrees = shift;
my $radians = deg2rad($degrees);
my $result= sin($radians):
return $result;
См. также
Описание функций sin, cos и atan2 в perlfunc(\.y, документация по стандартным
модулям POSIX и Math::Trig.
2.11. Тригонометрические функции
Проблема
Требуется вычислить значения различных тригонометрических функций, таких
как синус, тангенс или арккосинус.
Решение
В 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:
$y = acos(3.7):
Комментарий
Если значение $theta равно я/2, Зл/2 и т. д., в функции tan возникает исключи-
тельная ситуация деления на нуль, поскольку для этих углов косинус равен
112
Глава 2. Числа
нулю. Аналогичные ошибки могут происходить и во многих функциях модуля
Math::Trig. Чтобы перехватить их, воспользуйтесь конструкцией eval:
eval {
$у = tan($р1/2):
} or return undef:
См. также
Описание функций sin, cos и atan2 в perlfunc(\.\, документация по стандартному
модулю Math::Trig. Тригонометрия в контексте комплексных чисел рассматривает-
ся в рецепте 2.14, а применение eval для перехвата исключений — в рецепте 10.12.
2.12. Вычисление логарифмов
Проблема
Требуется вычислить логарифм по различным основаниям.
Решение
Для натуральных логарифмов (по основанию е) существует встроенная функ-
ция log:
$log_e = log(VALUE):
Чтобы вычислить логарифм по основанию 10, воспользуйтесь функцией log 10
модуля POSIX:
use POSIX qw(loglO);
$log_10 = loglO(VALUE):
Для других оснований следует использовать соотношение:
logn(x) = loge(x)/loge(n)
где х — число, логарифм которого вычисляется, п — нужное основание, а е — ос-
нование натуральных логарифмов.
sub log_base {
my ($base, $value) =
return log($value)/log($base):
}
Комментарий
Функция log_base позволяет вычислять логарифмы по любому основанию. Если
основание заранее известно, намного эффективнее вычислить его натуральный
логарифм заранее и сохранить для последующего использования вместо того,
чтобы каждый раз пересчитывать его заново.
2.13. Умножение матриц
113
# Определение log_base см. выше
$answer = log_base(10, 10. 10_000):
print "loglOdO. 100) = $answer\n":
logl0(10,000) = 4
В модуле Math::Complex для вычисления логарифмов по произвольному осно-
ванию существует функция logn(), поэтому вы можете написать:
use Math::Complex:
printf "log2(1024) = Ш\п", logn(1024. 2): # Обратите внимание
# на порядок аргументов!
1од2(1024) = 10.000000
хотя комплексные числа в вычислениях не используются. Функция не очень
эффективна, однако в будущем планируется переписать модуль Math::Complex на
С для ускорения его работы.
См. также
Описание функции log в perlfunc(l); документация по стандартным модулям
POSIX и Math::Complex.
2.13. Умножение матриц
Проблема
Требуется перемножить два двумерных массива. Умножение матриц часто ис-
пользуется в математических и инженерных вычислениях.
Решение
Воспользуйтесь модулями PDL с CPAN. Модули PDL (Perl Data Language, то есть
«язык данных Perl») содержат быстрые и компактные матричные и математиче-
ские функции:
use PDL:
# $а и $b - объекты pdl
$с = $а х $b:
Возможен и другой вариант — самостоятельно реализовать алгоритм умно-
жения матриц для двумерных массивов:
sub mmult {
my ($ml.$m2) =
my ($mlrows.$mlcols) = matdim($ml):
my ($m2rows.$m2cols) = matdim($m2):
unless ($mlcols == $m2rows) { # Инициировать исключение
die "IndexError: matrices don’t match: $mlcols != $m2rows";
}
114
Глава 2. Числа
my $result = [];
my ($1. $j. $k):
for $1 (range($mlrows)) {
for $j (range($m2cols)) {
for $k (range($mlcols)) (
$result->[$1][$j] += $ml->[$i][$k] * $m2->[$k][$j];
}
}
}
return $result:
}
sub range {0 .. ($_[0] - 1) }
sub veclen {
my $ary_ref = $_[0];
my type = ref $ary_ref:
If ($type ne "ARRAY") {die "$type is bad array ref for $ary_ref" }
return scalar(@$ary_ref);
}
sub matdim {
my $matrix =
my $rows = veclen($matrix);
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 L
[8, 1],
];
$c = $a x $b: # Перегруженный оператор x
2.14. Операции с комплексными числами
115
Если библиотека PDL недоступна или вы не хотите привлекать ее для столь
тривиальной задачи, матрицы всегда можно перемножить вручную:
# mmultO и другие процедуры определены выше
$х = [
[ 3. 2. 3 ],
[ 5. 9. 8 ],
$У = [
[ 4. 7 L
[ 9, 3 L
[ 8, 1 L
$z = mmult($x, $у):
См. также
Документация по модулю CPAN PDL.
2.14. Операции с комплексными числами
Проблема
Ваша программа должна работать с комплексными числами, часто используе-
мыми в инженерных, научных и математических расчетах.
Решение
Либо самостоятельно организуйте раздельное хранение вещественной и мнимой
составляющих комплексного числа:
# $с = $а * $Ь - моделирование операции
$c_real = ( $a_real * $b_real ) - ($а_1magi nary * $b_1maginary ):
$c_1mag1nary = ( $a_real * $b_1mag1nary ) - ($b_real * $a_1maginary );
либо воспользуйтесь модулем Math::Complex (из стандартной поставки Perl):
# Умножение комплексных чисел с помощью Math::Complех
use Math::Complex:
$c = $a * $b:
Комментарий
Ручное умножение комплексных чисел 3+5i и 2—2i выполняется следующим об-
разом:
$a_real = 3: $a_1mag1nary = 5: #3 + 51:
$b_real = 2: $b_1mag1nary = -2: #2-21:
$c_real = ($a_real * $b_real ) - ( $a_1mag1nary * $b_1mag1nary );
116
Глава 2. Числа
$с_1 magi nary = ($a_real * $b_1maginary ) - ( $b_real * $a_1mag1nary ):
print "c = ${c_real }+${c_1mag1nary}1\n":
c = 16+41
To же с применением модуля Math::Complex:
use Math::Complex;
$a = Math::Complex->new(3,5);
$b = Math::Complex->new(2,-2):
$c = $a * $b:
print "c = $c\n";
c = 16+41
Комплексные числа могут создаваться с помощью конструкции cplx или экс-
портированной константы i:
use Math::Complex:
$c = cplx(3,5) * cplx(2.-2): # Лучше воспринимается
$d = 3 + 4*1: #3 + 41
printf ”sqrt($d) = £s\n", sqrt($d);
sqrt(3+41) = 2+1
Модуль Math::Complex используется во внутренних операциях модуля Math::Trig,
поскольку некоторые функции могут выходить за пределы вещественной оси
в комплексную плоскость, например, арксинус 2.
См. также
Документация по стандартному модулю Math::Complex.
2.15. Преобразования двоичных,
восьмеричных и шестнадцатеричных чисел
Проблема
Требуется преобразовать строку с двоичным, восьмеричным или шестнадцатерич-
ным представлением (например, "ОЫОПО", "0x55" или "0755") в правильное число.
Perl воспринимает лишь те двоичные, восьмеричные и шестнадцатеричные
числа, которые встречаются в программе в виде литералов. Если числа были по-
лучены при чтении из файла или переданы в качестве аргументов командной
строки, автоматическое преобразование не выполняется.
Решение
Если вы работаете с шестнадцатеричными строковыми представлениями вида
"2е" или "0х2е", воспользуйтесь функцией Perl hex:
Snumber = hex(Shexadeclmal): # Шестнадцатеричное число
2.15. Преобразования двоичных, восьмеричных и шестнадцатеричных чисел
117
Для шестнадцатеричных строк вида "0х2е", восьмеричных строк вида "057"
и двоичных строк вида "OblOlllO" можно воспользоваться функцией Perl oct:
Snumber = oct(Shexadecimal):
Snumber = oct(Soctal);
Snumber = oct(Sbinary);
# "0x2e" преобразуется в 47
# "057" преобразуется в 47
# "ОЬОШО" преобразуется в 47
Комментарий
Функция oct преобразует восьмеричные числа как с начальными нулями, так
и без них (например, "0350" и "350"). Вопреки своему названию, она не ограни-
чивается восьмеричной системой счисления и преобразует шестнадцатеричные
числа с префиксом "Ох" (например, "0x350"), а также двоичные числа с префик-
сом "0Ь" ("ОЫОШО"). Функция hex преобразует только шестнадцатеричные чис-
ла с префиксом "Ох" или без него, например, "0x255", "ЗА", "ft" или "deadbeef"
(допускаются символы верхнего и нижнего регистра).
Следующий пример получает число в десятичном, двоичном, восьмеричном
или шестнадцатеричном представлении и выводит его во всех четырех системах
счисления. Если введенное число начинается с 0, число преобразуется из двоич-
ной, восьмеричной и шестнадцатеричной системы функцией oct. Затем функция
printf при выводе преобразует число во все четыре системы счисления:
print "Gimme a number in decimal, octal, or hex: ";
$num = <STDIN>;
chomp Snum;
exit unless defined Snum;
Snum = oct(Snum) is Snum =~ /x0/: # Находит 077 OblO 0x20
printf "ftd %#x %#o ft#b\n", (Snum) x 4;
Символ # между знаком % и кодом формата заставляет printf выводить дан-
ные с указанием системы счисления, в которой отображается целое число. На-
пример, если ввести число 255, программа выдаст следующий результат:
255 Oxff 0377 Obllllllll
Без знака # результат будет менее очевидным:
255 ff 377 11111111
Следующий фрагмент преобразует режимы доступа к файлам Unix. Режим
всегда задается в восьмеричном виде, поэтому вместо hex используется функция
oct:
print "Enter file permission in octal: ":
Spermissions = <STDIN>;
die "Exiting ...\n" unless defined Spermissions:
chomp Spermissions;
Spermissions = oct(Spermissions); # Режим доступа всегда задается
# в восьмеричной системе
print "The decimal value is Spermissions\n";
118
Глава 2. Числа
См. также
Раздел «Scalar Value Constructors» в perldata{\\, описание функций oct и hex
в perlfunc(l).
2.16. Вывод запятых в числах
Проблема
При выводе числа требуется вывести запятые после соответствующих разрядов.
Длинные числа так воспринимаются намного лучше, особенно в отчетах.
Решение
Обратите строку, чтобы перебирать символы в обратном порядке, это позво-
лит избежать подстановок в дробной части числа. Затем воспользуйтесь регу-
лярным выражением, найдите позиции для запятых и вставьте их с помощью
подстановки. Наконец, восстановите исходный порядок символов в строке.
sub commify {
my Stext = reverse $_[0];
Stext =~ s/(\d\d\d)(?=\d)(?!\d*\.)/$l,/g:
return scalar reverse Stext;
}
Комментарий
Регулярные выражения намного удобнее применять в прямом, а не в обратном
направлении. Учитывая этот факт, мы меняем порядок символов в строке на про-
тивоположный и вносим небольшие изменения в алгоритм, который многократ-
но вставляет запятые через каждые три символа от конца. После выполнения
всех вставок мы снова изменяем порядок символов в строке и возвращаем ито-
говую строку из функции. Поскольку функция reverse учитывает подразумевае-
мый контекст возврата, мы принудительно переводим ее в скалярный контекст.
Функцию нетрудно модифицировать так, чтобы вместо запятых разряды раз-
делялись точками, как принято в некоторых странах.
Пример использования функции commi fy:
# Достоверный счетчик обращений :-)
use Math::TrulyRandom;
Shits = truly_random_value(); # Отрицательное значение!
Soutput = "Your web page received Shits accesses last month.\n";
pri nt commi fy(Soutput);
Your web page received -1,740,525,205 accesses last month.
См. также
perllocale(\y, описание функции reverse в perlfunc(l); раздел «Разделение разря-
дов числа запятыми» в главе 2 книги «Регулярные выражения: Библиотека про-
граммиста», 2 издание (издательство «Питер», 2003 г.).
2.17. Правильный вывод во множественном числе
119
2.17. Правильный вывод
во множественном числе
Проблема
Требуется вывести фразу типа: "It took $time hours" («Это заняло $time часов»).
Однако фраза "It took 1 hours" («Это заняло 1 часов») не соответствует прави-
лам грамматики. Необходимо исправить ситуацию1.
Решение
Воспользуйтесь printf и тернарным оператором X?Y:Z, чтобы изменить глагол
или существительное:
printf "It took ftd hour%s\n". $time. $time == 1 ? "" : "s":
printf "ftd hour^s enough.\n", $time,
$time == 1 ? "" : "s".
$time == 1 ? "is" : "are":
Кроме того, можно воспользоваться модулем CPAN Lingua: :EN::Inflect, упо-
минаемым в Комментарии.
Комментарий
Невразумительные сообщения наподобие "1 file(s) updated" встречаются толь-
ко из-за того, что автору программы лень проверить, равен ли счетчик 1.
Если образование множественного числа не сводится к простому добавлению
суффикса -s, измените функцию printf соответствующим образом:
printf "It took ftd centur^s". $time. $time == 1 ? "y" : "ies":
В простых ситуациях такой вариант подходит, однако вам быстро надоест
писать его снова и снова. Возникает желание написать для него специальную
функцию:
sub noun_plural {
local $_ = shift:
# Порядок проверок крайне важен!
s/ss$/sses/ ||
s/([psc]h)$/${l}es/ ||
s/z$/zes/ ||
s/ff/$/ffs/ ||
s/f$/ves/ ||
s/ey$/eys/ ||
s/y$/ies/ ||
s/ix$/ices/
1 К сожалению, для русского языка этот рецепт не подойдет, поскольку множественное
число в нем образуется по более сложным правилам с большим количеством исключе-
ний. — Примеч. перев.
120
Глава 2. Числа
s/(Csx])$/$les/ 11
s/$/s/ II
die "can't get here":
return $_:
*verb_s1ngular = \&noun_plural: # Синоним функции
Однако co временем будут находиться новые исключения, и функция будет
становиться все сложнее и сложнее. Если у вас возникнет потребность в подоб-
ных морфологических изменениях, воспользуйтесь универсальным решением,
которое предлагает модуль CPAN Lingua:EN:: Infl ect.
use Lingua::EN::Inflect qw(PL classical):
classical(1): # Почему не сделать по умолчанию?
while (<DATA>) { # Каждая строка данных
for (split) { # Каждое слово в строке
print "One $_. two ". PL($_). "An";
}
}
# И еще один вариант
$_ = 'secretary general':
print "One $_. two ". PL($_). "An":
_ _END_ _
fish fly ox
species genus phylum
cherub radius 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.
Без вызова classical вывод в следующих строках будет отличаться от приве-
денного выше:
One phylum, two phylums.
One cherub, two cherubs.
One radius, two radiuses.
One Index, two Indexes.
One matrix, two matrixes.
One formula, two formulas.
2.18. Программа: разложение на простые множители
121
Мы рассмотрели лишь одну из многих возможностей модуля. Кроме того, он
обрабатывает склонения и спряжения для других частей речи, содержит функции
сравнения без учета регистра символов, выбирает между использованием а и ап,
а также делает многое другое.
См. также
Описание тернарного оператора выбора в рег/ор(1); документация по модулю
CPAN Lingua: :EN::Inflect.
2.18. Программа: разложение
на простые множители
Следующая программа получает один или несколько целых аргументов и рас-
кладывает их на простые множители. В ней используется традиционное число-
вое представление Perl, кроме тех ситуаций, когда представление с плавающей
запятой может привести к потере точности. В противном случае (или при запус-
ке с ключом -Ь) используется стандартная библиотека Math::Biglnt, что позволяет
работать с большими числами. Однако библиотека загружается лишь при необ-
ходимости, поэтому вместо 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 25000000000000000000000000
+25000000000000000000000000 2**24 5**26
Исходный текст программы приведен в примере 2.2.
Пример 2.2. bigfact
# !/usr/bin/perl
# bigfact - разложение на простые множители
use strict:
use Integer:
our ($opt b $opt d): Л
продолжение у
122
Глава 2. Числа
Пример 2.2 (продолжение)
use Getopt::Std:
@ARGV && getopts(’bd’) or die "usage: $0 [-b] number :
load_b1glib() If $opt_b:
ARG: foreach my $or1g ( @ARGV ) {
my ($n, $root. ^factors. Sfactor):
$n = $opt_b ? Math::B1gInt->new($or1g) : $or1g:
If ($n + 0 ne $n) { # Для этого не используйте -w
printf STDERR "bignum: %s would become %s\n". $n. $n+0 If $opt_d:
Ioad_b1gl1b():
$n = Math::B1gInt->new($or1g);
}
printf "%-10s ". $n:
# $sq1 равно квадрату $1. Используется тот факт.
# что ($1 + 1) ** 2 == $1 ** 2 + 2 * $1 + 1.
for (my ($1. $sq1) = (2. 4): $sq1 <= $n: $sq1 += 2 * $1 ++ + 1) {
while ($n % $1 == 0) {
$n /= $1:
print STDERR "<$1>" If $opt_d:
$factors {$1} ++:
}
If ($n != 1 && $n != $or1g) { $factors{$n}++ }
If (! ^factors) {
print "PRIME\n":
next ARG;
}
for $factor ( sort { $a <=> $b } keys ^factors ) {
print "Sfactor";
If ($factors{$factor) > 1) {
print "**$factors{$factor}":
}
print " ";
}
print ”\n":
}
# Имитирует use. но на стадии выполнения
sub Ioad_b1gl1b {
require Math::Blglnt:
Math: :B1gInt->1mport(); immaterial?
}
Время и дата
«Не следует требовать, чтобы время в секундах с начала
эпохи точно соответствовало количеству секунд между
указанным временем и началом эпохи».
Стандарт IEEE 1003.1b-1993 (POSIX) раздел В.2.2.2
3.0. Введение
Время и дата — очень важные величины, и с ними необходимо уметь работать.
«Сколько пользователей регистрировалось за последний месяц?», «Сколько се-
кунд я должен проспать, чтобы проснуться к полудню?» и «Не истек ли срок
действия пароля данного пользователя?» — вопросы кажутся тривиальными,
однако ответ на них потребует на удивление нетривиальных операций.
В Perl моменты времени представлены в виде интервалов, измеряемых в се-
кундах, прошедших с некоторого момента, называемого началом эпохи. В Unix и
многих других системах начало эпохи соответствует 00 часов 00 минут 1 января
1970 года в формате UTC1.
Говоря о времени и датах, мы часто путаем две разные концепции: момент
времени (дата, время) и интервал между двумя моментами (недели, дни, месяцы
и т. д.). При отсчете секунд с начала эпохи интервалы и моменты представляют-
ся в одинаковых единицах, поэтому с ними можно выполнять простейшие мате-
матические операции.
Однако люди не привыкли измерять время в секундах с начала эпохи. Мы
предпочитаем работать с конкретным годом, месяцем, днем, часом, минутой и се-
кундой. Более того, название месяца может быть как полным, так и сокращен-
ным; число может указываться как перед месяцем, так и после него. Использова-
ние разных форматов затрудняет вычисления, поэтому введенная пользователем
или прочитанная из списка строка даты/времени обычно преобразуется в коли-
чество секунд с начала эпохи, с ней производятся необходимые операции, после
чего секунды снова преобразуются для вывода.
Для удобства вычислений количество секунд с начала эпохи всегда измеряется
в абсолютном значении, без учета часовых поясов или летнего времени. В любых
1 Сейчас рекомендуется использовать сокращение UTC (Universal Corrected Time) вместо
прежнего сокращения GMT (Greenwich Mean Time).
124
Глава 3. Время и дата
преобразованиях всегда необходимо учитывать, представлено ли время в форма-
те UTC или в местном часовом поясе. Различные функции преобразования по-
зволяют перейти от времени UTC к местному времени и наоборот.
Функция Perl time возвращает количество секунд, прошедших с начала эпо-
хи... более или менее точно1. В соответствии со стандартом POSIX функция time
не должна возвращать секунды, которые накапливаются из-за замедления вра-
щения Земли, обусловленного воздействием приливов (за дополнительной ин-
формацией обращайтесь к разделу 3 sci.astro FAQ, расположенному по адресу
http://sc1astro.astronomy.net/sd .astro.3.FAQ). Для преобразования секунд, прошед-
ших с начала эпохи, для конкретных дней, месяцев, лет, часов, минут и секунд
используются функции local time и gmtlme. В списковом контексте эти функции
возвращают список, состоящий из девяти элементов (табл. 3.1).
Таблица 3.1. Элементы (и интервалы их значений), возвращаемые функциями localtime и gettime
Переменная Значение Интервал
$sec секунды 0-60
$min минуты 0-59
$hours часы 0-23
$mday день месяца 1-31
$mon месяц 0-11, 0 == январь
$year год, начиная с 1900 1-138 (и более)
$wday день недели 0-6, 0 == воскресенье
$yday день года 0-365
$isdist 0 или 1 true, если действует летнее время
Секунды изменяются в интервале 0-60 с учетом возможных корректировок;
трудно сказать, когда по требованию какого-нибудь комитета по стандартизации
в нашу жизнь может войти лишняя секунда2.
В дальнейшем совокупность «день/месяц/год/час/минута/секунда» будет
обозначаться выражением «полное время» — хотя бы потому, что писать каж-
дый раз «отдельные значения дня, месяца, года, часа, минут и секунд» довольно
утомительно. Сокращение не связано с конкретным порядком возвращаемых
значений.
Perl не возвращает данные о годе в виде числа из двух цифр. Он возвраща-
ет разность между текущим годом и 1900, которая до 1999 года представляет
собой число из двух цифр. У Perl нет своей «проблемы 2000 года», если толь-
ко вы не изобретете ее сами (впрочем, у вашего компьютера и Perl может
возникнуть проблема 2038 года, если к тому времени еще будет использоваться
1 Скорее, менее. На момент написания книги функция возвращала на 22 секунды меньше.
2 В среднем лишняя секунда набегает каждые 18 месяцев. Перевод часов обычно совер-
шается добавлением лишней («високосной») секунды к последнему дню года, то есть
через раз возникает дата: 31 декабря, 23:59:60. — Примеч. ред.
3.0. Введение
125
32-разрядная адресация). Для получения полного значения года прибавьте к его
представлению 1900. Не пользуйтесь конструкцией "20$уеаг", иначе вскоре ваши
программы начнут выдавать «год 20103». Мы не можем точно зафиксировать
интервал года, потому что все зависит от размера целого числа, используемо-
го вашей системой для представления секунд с начала эпохи. Малые числа
дают небольшой интервал; большие (64-разрядные) числа означают огромные
интервалы.
В скалярном контексте local time и gmtlme возвращают дату и время, отформа-
тированные в виде ASCII-строки:
Fri Apr 11 09:27:08 1997
Объекты стандартного модуля Time: :tm позволяют обращаться к компонентам
даты/времени по именам. Стандартные модули Time:: 1 ocaltlme и Time: :gmt1me
переопределяют функции local time и gmtlme, возвращающие списки, и заменя-
ют их версиями, возвращающими объекты Time: :tm. Сравните два следующих
фрагмента:
# Массив
print "Today Is day ", (localt1me)[7], " of the current yearAn";
Today is day 117 of the current year.
# Объекты Time::tm
use Time::1ocaltime:
$tm = local time:
print "Today Is day ", $tm->yday, " of the current yearAn";
Today is day 117 of the current year.
Чтобы преобразовать список в количество секунд с начала эпохи, восполь-
зуйтесь стандартным модулем Time::Local. В нем имеются функции timelocal
и tlmegm, которые получают список из девяти элементов и возвращают целое
число. Элементы списка и интервалы допустимых значений совпадают с теми,
которые возвращаются функциями localtime и gettlme.
Количество секунд с начала эпохи ограничивается размером целого числа.
32-разрядное целое со знаком позволяет представить время (в формате UTC)
от 20:45:52 13 декабря 1901 года до 03:14:07 19 января 2038 года включительно.
Предполагается, что к 2038 году в компьютерах будут использоваться целые
числа большей разрядности. Во всяком случае, будем надеяться на это. Чтобы
работать с временем за пределами этого интервала, вам придется воспользовать-
ся другим представлением или выполнять операции с отдельными компонента-
ми года, месяца и числа.
Модули Date:: Cal с и Date::Maniр из архива CPAN работают с этими отдельны-
ми компонентами, но учтите — они не всегда вычитают из года 1900, как это де-
лает local time, а нумерация месяцев и недель в них не всегда начинается с 0. Как
всегда, на страницах руководства можно найти достоверные сведения о том, ка-
кая информация передается модулю, а какая — возвращается им. Только пред-
ставьте, как будет неприятно, если рассчитанные вами финансовые показатели
уйдут на 1900 лет в прошлое!
126
Глава 3. Время и дата
3.1. Определение текущей даты
Проблема
Требуется определить год, месяц и число для текущей даты.
Решение
Воспользуйтесь функцией local time. Без аргументов она возвращает текущую
дату и время. Вы можете вызвать local time и извлечь необходимую информа-
цию из полученного списка:
($DAY. SMONTH. SYEAR) = (localtime)[3.4.5]:
Модуль Time:: localtime переопределяет local time так, чтобы функция возвра-
щала объект Time: :tm:
use Time::local time:
Stm = local time:
(SDAY, SMONTH, SYEAR) = ($tm->mday, $tm->mon, $tm->year):
Комментарий
Вывод текущей даты в формате ГГГГ-ММ-ДД с использованием стандартной
функции local time выполняется следующим образом:
($day. Smooth, Syear) = (localt1me)[3,4,5];
printf("The current date Is %04d %02d Wd\n", Syear+1900, $month+l, Sday):
The current date Is 2003 03 06
Нужные поля из списка, возвращаемого local time, извлекаются с помощью
среза. Запись могла выглядеть иначе:
(Sday, Smonth, Syear) = (localt1me)[3..5]:
А вот как текущая дата выводится в формате ГГГГ-ММ-ДД (рекомендован-
ном стандартом ISO 8601) с использованием Time:: 1 ocaltime:
use Time::1ocaltime:
Stm = localtime;
printfC'The current date Is %04d-Wd-W\n", $tm->year+1900.
($tm->mon)+l, $tm->mday):
The current date Is 2003-03-06
В короткой программе объектный интерфейс выглядит неуместно. Однако
при большом объеме вычислений с отдельными компонентами даты обращения
по имени заметно упрощают чтение программы.
То же самое можно сделать и хитроумным способом, не требующим создания
временных переменных:
printfC'The current date Is %04d-Wd-Wd\n".
sub {($_[5]+1900, SJ4J+1. $_[3])}->(localt1me)):
3.2. Преобразование полного времени в секунды с начала эпохи
127
Кроме того, в модуле POSIX имеется функция strftlme, упоминаемая в рецепте 3.8:
use POSIX qw(strftlme):
print strftlme "H-£m-£d\n", localtime:
Функция gmtlme работает аналогично local time, но возвращает время в фор-
мате UTC вместо времени в местном часовом поясе.
См. также
Описание функций localtime и gmtlme в perlfunc(l)', документация по стандарт-
ному модулю Time:: local time.
3.2. Преобразование полного времени
в секунды с начала эпохи
Проблема
Требуется преобразовать дату/время, выраженные отдельными значениями дня,
месяца, года и т. д., в количество секунд с начала эпохи.
Решение
Воспользуйтесь функцией timelocal или tlmegm стандартного модуля Time::Local.
Выбор зависит от того, задается ли дата/время для UTC или для текущего часо-
вого пояса:
use Time::Local:
$TIME = timelocal($sec, $m1n, $hours. $mday, $mon, $year):
$TIME = t1megm($sec, $m1n, $hours, $mday, $mon, $year):
Комментарий
Встроенная функция local time преобразует количество секунд с начала эпохи
в компоненты полного времени; процедура timelocal из стандартного модуля
Time::Local преобразует компоненты полного времени в секунды. Следующий
пример показывает, как определяется количество секунд с начала эпохи для
текущей даты. Значения дня, месяца и года получаются при помощи функции
local time:
# Shours, $m1nutes и $seconds задают время для текущей даты
# и текущего часового пояса
use Time: -.Local:
$t1me = timelocal(Sseconds, Smlnutes, $hours. (1ocaltime)L3.4.5]):
Если функции timelocal передаются месяц и год, они должны принадлежать
тем же интервалам, что и значения, возвращаемые local time. А именно нумера-
ция месяцев начинается с 0, а из года вычитается 1900.
128
Глава 3. Время и дата
Функция timelocal предполагает, что компоненты полного времени соот-
ветствуют текущему часовому поясу. Модуль Time::Local также экспортирует
процедуру tlmegm, для которой компоненты полного времени задаются для часо-
вого пояса UTC. К сожалению, удобных средств для работы с другими часовы-
ми поясами, кроме текущего или UTC, не существует. Лучшее, что можно сде-
лать, — преобразовать время к Гринвичскому и вычесть или прибавить смещение
часового пояса в секундах.
В следующем фрагменте продемонстрировано как применение tlmegm, так и на-
стройка интервалов года и месяца:
# $day - день месяца (1-31)
# $month - месяц (1-12)
# $уеаг - год. состоящий из четырех цифр (например, 1999)
# Shours, $m1notes и $seconds - компоненты времени UTC (GMT)
use Time::Local:
$t1me = t1megm($seconds, $m1nutes. $hours, $day, $month-l, $year-1900):
Как было показано во Введении, количество секунд с начала эпохи не может
выходить за пределы интервала от 20:45:52 13 декабря 1901 года до 03:14:07
19 января 2038 года включительно. Не преобразуйте такие даты — либо восполь-
зуйтесь модулем Date:: из архива CPAN, либо выполняйте вычисления вручную.
См. также
Документация по стандартному модулю Time::Local. Обратное преобразование
рассматривается в рецепте 3.3.
3.3. Преобразование секунд с начала
эпохи в полное время
Проблема
Требуется преобразовать количество секунд с начала эпохи в отдельные значе-
ния дня, месяца, года и т. д.
Решение
Воспользуйтесь функцией local time или gmtlme в зависимости от того, хотите ли вы
получить дату/время для текущего часового пояса или для часового пояса UTC.
($seconds, $m1nutes. $hours, $day_of_month. $year,
$wday. $yday. $1sdst) = Iocalt1me($t1me):
Стандартные модули Time: :t1melocal и Time: :gmt1me переопределяют функции
localtime и gmtlme так, чтобы к компонентам можно было обращаться по именам:
use Time: .-localtime; # или Time::gmtlme
$tm = localt1me($TIME): # или gmt1me($TIME)
$seconds = $tm->sec:
# ...
3.4. Операции сложения и вычитания для дат
129
Комментарий
Функции local time и gettlme возвращают несколько странную информацию о годе
и месяце; из года вычитается 1900, а нумерация месяцев начинается с 0 (январь).
Не забудьте внести поправку в полученные величины, как это делается в следую-
щем примере:
($seconds, Smlnutes, Shours. $day_of_month, $month, $year,
$wday. $yday, $1sdst) = localt1me($time);
printf("Datel 1 ne: %02d:%02d:Wd-204d/Wd/Wd\n",
$hours, Smlnutes, $seconds, $year+1900, $month+l,
$day_of_month):
Модуль Time:: local time позволяет избавиться от временных переменных:
use Time::1ocaltime:
$tm = Iocalt1me($t1me):
printf("Datel1ne: %02d:%02d:%02d-^04d/%02d/%02d\n",
$tm->hour, $tm->m1n, $tm->sec, $tm->year+1900.
$tm->mon+l. $tm->mday):
См. также
Описание функции localtime в perlfunc(l); документация по стандартным моду-
лям Time::localtime и Time::gmtlme. Обратное преобразование рассматривается
в рецепте 3.2.
3.4. Операции сложения
и вычитания для дат
Проблема
Имеется значение даты/времени. Требуется определить дату/время, отделен-
ную от них некоторым промежутком в прошлом или будущем.
Решение
Проблема решается простым сложением или вычитанием секунд с начала эпохи:
$when = $now + $d1fference:
$then = $now - $d1fference;
Если у вас имеются отдельные компоненты полного времени, воспользуйтесь
модулем CPAN Date:: Cal с. Если вычисления выполняются только с целыми дня-
ми, примените функцию Add_Delta_Days (смещение Soffset может представлять
собой как положительное, так и отрицательное целое количество дней):
use Date::Cal с qw(Add_Delta_Days):
($у2. $m2, $d2) = Add_Delta_Days($y, $m. $d, $offset):
130
Глава 3. Время и дата
Если в вычислениях используются часы, минуты и секунды (то есть не толь-
ко дата, но и время), воспользуйтесь функцией Add_Delta_DHMS:
use Date::DateCalс qw(Add_Delta_DHMS):
($year2, $month2. $day2, $h2, $m2. $s2) =
Add_Delta_DHMS( $year. $month. $day, $hour, $m1nute. $seconds,
$days_offset. $hour_offset. $m1nute_offset. $seconds_offset ):
Комментарий
Вычисления с секундами от начала эпохи выполняются проще всего (если не
считать усилий на преобразования даты/времени в секунды и обратно). В следую-
щем фрагменте показано, как прибавить смещение (в данном примере — 55 дней,
2 часа, 17 минут и 5 секунд) к заданной базовой дате и времени:
$Ь1rthtlme = 96176750: # 18 января 1973 года. 03:45:50
$1nterval = 5 + #5 секунд
17 * 60 + #17 минут
2 * 60 * 60 + #2 часа
55 * 60 * 60 * 24: # и 55 дней
$then = Sblrthtlme + $1nterval:
print "Then Is ". scalar(localtinie($then)), "\n":
Then is Wed Mar 14 06:02:55 1973
Мы также могли воспользоваться функцией Add_Del ta_DHMS и обойтись без
преобразований к секундам с начала эпохи и обратно:
use Date: :Calc qw(Add_Delta_DHMS):
($year. $month. $day. $hh. $mm. $ss) = Add_Delta_DHMS(
1973. 1. 18. 3. 45. 50. # 18 января 1973 года. 93 45.50
55. 2. 17. 5): # 55 дней. 2 часа. 17 минут. 5 секунд
print "То be precise: $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::DateCalс:
use Date::DateCalс qw(Add_Delta_Days):
($year, $month. $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
См. также
Документация по модулю CPAN Date:: Cal с.
3.5. Вычисление разности между датами
Проблема
Требуется определить количество дней между двумя датами или моментами
времени.
3.5. Вычисление разности между датами
131
Решение
Если даты представлены в виде секунд с начала эпохи и принадлежат интервалу
от 20:45:52 13 декабря 1901 года до 03:14:07 19 января 2038 года включительно,
достаточно вычесть одну дату из другой и преобразовать полученные секунды
в дни:
Sseconds = Srecent = Searlier;
Если вы работаете с отдельными компонентами полного времени или беспо-
коитесь об ограничениях интервалов для секунд с начала эпохи, воспользуйтесь
модулем CPAN Date:: Cal с. Он позволяет вычислять разность дат:
use Date::Cal с qw(Delta_Days):
$days = Delta_Days( $yearl, $monthl, $dayl, $year2, $month2. $day2);
Также существует возможность вычисления разности с учетом даты и времени:
use Date::Cal с qw(Delta_DHMS);
($days, Shours, $minutes. $seconds) =
Delta_DHMS( $yearl. Smonthl, $dayl. $hourl. $minutel, $secondsl. # Ранний
# момент
$year2, $month2. $day2. $hour2. $minute2, $seconds2. # Поздний
# момент
Комментарий
Одна из проблем, связанных с секундами с начала эпохи, — преобразование боль-
ших целых чисел в форму, понятную для человека. Следующий пример демон-
стрирует один из способов преобразования секунд с начала эпохи в привычные
недели, дни, часы, минуты и секунды:
$bree = 361535725;
$nat = 96201950:
# 04:35:25 16 июня 1981 года
# 03:45:50 18 января 1973 года
$difference = $bree - $nat:
print "There were $difference seconds between Nat and Bree\n";
There were 265333775 seconds between Nat and Bree
$seconds = $difference % 60:
Sdifference = (Sdifference - $seconds) / 60:
$minutes = Sdifference % 60;
Sdifference = ($difference - $minutes) / 60:
Shours = Sdifference $ 24;
Sdifference = (Sdifference - Shours) / 24;
$days = $difference % 7;
$weeks = (Sdifference - $days) / 7;
print "($weeks weeks. $days days, $hours;$minutes:$seconds)\n":
(438 weeks. 4 days, 23:49:35)
Функции модуля Date: Talc упрощают подобные вычисления. Функция Delta_
Days возвращает количество дней между двумя датами. Даты передаются ей в виде
списка «год/месяц/день» в хронологическом порядке, то есть начиная с более
ранней.
132
Глава 3. Время и дата
use Date::Calc qw(Delta_Days):
@bree = (1981, 6. 16); # 16 июня 1981
@nat = (1973, 1. 18); #18 января 1973
Sdifference = Delta_Days(@nat, @bree);
print "There were $difference days between Nat and Bree\n";
There were 3071 days between Nat and Bree
Функция Delta_DHMS возвращает список из четырех элементов, определяющих
количество дней, часов, минут и секунд между двумя переданными датами.
use Date:;Calc qw(Delta_DHMS):
@bree = (1981, 6. 16. 4, 35. 25): # 16 июня 1981 г. 4:35:25
@nat = (1973, 1. 18. 3. 45. 50): # 18 января 1973 г. 3:45:50
©diff = Delta_DHMS(@nat, @bree);
print "Bree came $diff[O] days, $diff[l]:$diff[2]:$diff[3] after Nat\n";
Bree came 3071 days, 0:49:35 after Nat
См. также
Документация по стандартному модулю CPAN Date: :Calc.
3.6. Определение номера недели
или дня недели/месяца/года
Проблема
Имеется дата в секундах с начала эпохи или в виде отдельных компонентов —
года, месяца и т. д. Требуется узнать, на какой номер недели или день неде-
ли/месяца/года она приходится.
Решение
Если дата выражена в секундах с начала эпохи, день года, день месяца или неде-
ли возвращается функцией local time. Номер недели легко рассчитывается по
дню года (но ознакомьтесь с Комментарием, потому что в разных национальных
стандартах используются разные схемы нумерации недель):
(SMONTHDAY. SWEEKDAY, SYEARDAY) = (localtime $DATE) [3,6,7];
SWEEKNUM = int($YEARDAY / 7) + 1;
Отдельные компоненты полного времени можно преобразовать в число секунд
с начала эпохи (см. рецепт 3.2) и воспользоваться приведенным выше решени-
ем. Возможен и другой вариант — применение функций Day_of_Week, Week_Number
и Day_of_Year модуля Date:: Cal с из архива CPAN:
use Date:;Calc qw(Day_of_Week Week_Number Day_of_Year);
# Исходные величины - $year, Smonth и $day
# По определению $day является днем месяца
$wday = Day_of_Week($year. $month, $day):
$wnum = Week_Number($year. $month, $day);
$dnum = Day_of_Year($year, $month, $day);
3.7. Анализ даты и времени в строках
133
Комментарий
Функции 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 Day_of_Week_To_Text):
Syear = 1981:
Smonth =6: # (Июнь)
Sday = 16:
Swday = Day_of_Week(Syear, Smonth, Sday):
print "Smonth/Sday/Syear was a ", Day_of_Week_to_Text(Swday), "\n":
# См. выше
Swnum = Week_Number(Syear, Smonth, Sday):
print "in the Swnum weekAn":
6/16/1981 was a Tuesday
in the 25 week.
В некоторых странах существуют специальные стандарты, касающиеся пер-
вой недели года. Например, в Норвегии первая неделя должна содержать не ме-
нее 4 дней (и начинаться с понедельника). Если 1 января выпадает на неделю из
3 и менее дней, она считается 52 или 53 неделей предыдущего года. В Америке
первая рабочая неделя обычно начинается с первого понедельника года. Возможно,
при таких правилах вам придется написать собственный алгоритм или, по край-
ней мере, изучить форматы £G, £L, W и W функции UnixDate модуля Date::Manip.
См. также
Описание функции local time в perlfunc(X)\ документация по стандартному мо-
дулю CPAN Date:: Cal с.
3.7. Анализ даты и времени в строках
Проблема
Спецификация даты или времени читается в произвольном формате, однако ее
требуется преобразовать в отдельные компоненты (год, месяц и т. д.).
Решение
Если дата уже представлена в виде числа или имеет жесткий, легко анализируе-
мый формат, воспользуйтесь регулярным выражением (а возможно — хэшем,
связывающим названия месяцев с номерами) для извлечения отдельных значений
134
Глава 3. Время и дата
дня, месяца и года. Затем преобразуйте их в секунды с начала эпохи с помощью
функций timelocal и tlmegm стандартного модуля Time::Local.
use Time::Local:
# $date хранится в формате ”2003-02-13" (ГГГГ-ММ-ДД).
($уууу, $mm, $dd) = ($date =~ /(\d+)-(\d+)-(\d+)/):
# Вычислить секунды с начала эпохи для полночи указанного дня
# в текущем часовом поясе
$epoch_seconds = timelocal(0, 0. 0. $dd. $mm-l. $yyyy):
Более гибкое решение — применение функции ParseDate из модуля CPAN
Date::Maniр и последующее извлечение отдельных компонентов с помощью
UnixDate.
use Date::Manip qw(ParseDate UnixDate):
$date = ParseDate($STRING):
if (!$date) {
# Неверная дата
} else {
LVALUES = UnixDate($date. ^FORMATS):
}
Комментарий
Универсальная функция ParseDate поддерживает различные форматы дат. Она
даже преобразует такие строки, как «today» («сегодня»), «2 weeks ago Friday»
(«в пятницу две недели назад») и «2nd Sunday in 1996» («2-е воскресенье
1996 года»), а также понимает форматы даты/времени в заголовках почты и но-
востей. Расшифрованная дата возвращается в собственном формате — строке
вида «ГГГГММДДЧЧ:ММ:СС». Сравнение двух строк позволяет узнать, сов-
падают ли представленные ими даты, однако математические операции вы-
полняются иначе. По этой причине мы воспользовались функцией UnixDate для
извлечения года, месяца и дня в нужном формате.
Функция UnixDate получает дату в виде строки, возвращаемой ParseDate, и спи-
сок форматов. Она последовательно применяет каждый формат к строке и воз-
вращает результат. Формат представляет собой строку с описанием одного или
нескольких элементов даты/времени и способов оформления этих элементов.
Например, формат И обозначает год, состоящий из четырех цифр. Пример:
use Date::Manip qw(ParseDate UnixDate):
while (<>) {
$date = ParseDate($_):
if (!$date) {
warn "Bad date string: $_\n":
next:
} else {
($year. $month, $day) = UnixDate($date. "И", W, '7d"):
print "Date was $month/$day/$year\n":
}
}
3.8. Вывод даты
135
См. также
Документация по модулю CPAN Date::Maniр; пример использования приведен
в рецепте 3.11.
3.8. Вывод даты
Проблема
Требуется преобразовать дату и время, выраженные в секундах с начала эпохи,
в более понятную для человека форму.
Решение
Вызовите функцию local time или gmtlme в скалярном контексте — в этом случае
функция получает количество секунд с начала эпохи и возвращает строку вида
Tue July 22 05:15:20 2003:
SSTRING = localtime($EPOCH_SECONDS):
Кроме того, функция strftlme из стандартного модуля POSIX обладает допол-
нительными возможностями настройки формата вывода и работает с отдельны-
ми компонентами полного времени:
use POSIX qw(strftime):
SSTRING = strftime($FORMAT. SSECONDS. SMINUTES. $HOUR.
$DAY_OF_MONTH, $MONTH. $YEAR, SWEEKDAY.
$YEARDAY, SDST):
В модуле CPAN Date: :Manip есть функция UnixDate — нечто вроде специализи-
рованного варианта sprlntf, предназначенного для работы с датами. Ей переда-
ется дата в формате Date::Maniр. Преимущество Date::Maniр перед POSIX::strftlme
состоит в том, что от системы не требуется совместимость со стандартом POSIX.
use Date::Man1p qw(UnixDate):
SSTRING = UnixDate($DATE. SFORMAT):
Комментарий
Простейшее решение — функция local time — относится к встроенным средствам
Perl. В скалярном контексте эта функция возвращает строку, отформатирован-
ную особым образом:
Wed July 16 23:58:36 2003
Программа получается простой, хотя формат строки сильно ограничен:
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
136
Глава 3. Время и дата
Разумеется, дата и время для local time должны исчисляться в секундах с нача-
ла эпохи. Функция POSIX: : strftime получает набор компонентов полного времени
и строку в формате printf и возвращает также строку. Поля в строке задаются
при помощи директив X. Полный список директив приведен в документации по
strftime для вашей системы. Функция strftime ожидает, что отдельные компо-
ненты даты/времени принадлежат тем же интервалам, что и значения, возвра-
щаемые local time:
use POSIX qw(strftime):
use Time::Local:
$time = timelocal(50, 45, 3, 18. 0. 73):
print "strftime gives: ", strftimeU'U W", localtime($time)), "\n";
strftime gives: Thursday 01/18/73
При использовании POSIX::strftime все значения выводятся в соответствии
с национальными стандартами. Так, во Франции ваша программа вместо "Sunday"
выведет "Dimanche". Однако учтите: интерфейс Perl к функции POSIX strftime
всегда преобразует дату в предположении, что она относится к текущему часо-
вому поясу.
Если функция strftime модуля POSIX недоступна, у вас всегда остается надеж-
ный модуль Date:: Mani р, описанный в рецепте 3.6.
use Date::Manip qw(ParseDate UnixDate):
$date = ParseDate("18 Jan 1973, 3:45:50"):
$datestr = UnixDate($date, '7a %e И"): # скалярный контекст
print "Date::Manip gives: $datestr\n":
Date::Manip gives: Thu Jan 18 03:45:50 GMT 1973
См. также
Описания функций gmtime и localtime в perlfunc(l)\ perllocale(\y, страница руко-
водства strftime(3) вашей системы; документация по модулю POSIX и модулю
CPAN Date::Maniр.
3.9. Таймеры высокого разрешения
Проблема
Функция time возвращает время с точностью до секунды. Требуется измерить
время с более высокой точностью.
Решение
Средства работы с таймерами высокого разрешения для большинства систем
инкапсулируются в модуле Time:: Hi Res, включенном в число стандартных моду-
лей, начиная с Perl версии 5.8:
use Time::HiRes qw(gettimeofday);
$t0 = gettimeofday;
3.9. Таймеры высокого разрешения
137
# # Ваши операции
$tl = gettimeofday;
Selapsed = $tl - $t0;
# Selapsed - вещественное значение, представляющее число секунд
# между $tl и $t2
Комментарий
В следующем фрагменте модуль Time:: Hi Res используется для измерения проме-
жутка между выдачей сообщения и нажатием клавиши RETURN:
use Time::H1Res qw(gettimeofday):
print "Press return when ready: ":
$before = gettimeofday:
$1ine = <STDIN>:
Selapsed. = gettimeofday() - Sbefore:
print "You took $elapsed seconds.\n";
Press return when ready:
You took 0.228149 seconds.
При вызове в списковом контексте функция gettimeofday этого модуля воз-
вращает список из двух элементов, представляющий секунды и микросекунды,
а при вызове в скалярном контексте — одно вещественное число, объединяющее
оба значения. Вы также можете импортировать функцию time для замены стан-
дартной базовой версии с этим именем; она всегда работает как скалярная вер-
сия gettimeofday.
Модуль также содержит функции usleep и ualarm — альтернативные версии
стандартных функций Perl sleep и alarm, которые работают с точностью до мик-
росекунд (вместо секунд). Эти функции получают аргументы в микросекундах;
кроме того, вы можете импортировать функции sleep и alarm этого модуля, по-
лучающие вещественные значения в секундах, для замены стандартных версий,
получающих целые значения в секундах. Для обращения к низкоуровневым
функциям itimer вашей системы (если они поддерживаются) предусмотрены
функции setitimer и getitimer.
Если ваша система не поддерживает этот модуль, можно попытаться решить
задачу вручную при помощи syscall. Сравните Time:: Hi Res с эквивалентным ко-
дом syscall (пример приводится в основном для того, чтобы продемонстриро-
вать использование малопонятной и архаичной функции Perl syscall):
require 'sys/syscal1.ph':
# Инициализировать структуры, возвращаемые gettimeofday
$TIMEVAL_T = "LL":
$done = $start = pack($TIMEVAL_T, (0,0)):
# Вывод приглашения
print "Press return when ready: ":
# Прочитать время в $start
syscall(&SYS_gettimeofday, $start, 0)) != -1
|| die "gettimeofday: $!":
138
Глава 3. Время и дата
# Прочитать перевод строки
$11пе = <>;
# Прочитать время в $done
syscall(&SYS_gettimeofday. $done, 0) != -1
|| die "gettimeofday: $!":
# Распаковать структуру
Ostart = unpack($TIMEVAL_T.
Odone = unpack($TIMEVAL_T.
# Исправить микросекунды
for ($done[l], $start[l]) {
$start);
$done):
$_ /= l_000_000 }
# Вычислить разность
$delta_time = sprlntf ’T4f", ($done[0] + $done[l] )
($start[0] + $start[l] );
print "That took $delta_time seconds\n":
Press return when ready:
That took 0.3037 seconds
Программа получилась более длинной, поскольку системные функции вызы-
ваются непосредственно из Perl, а в модуле Time::HI Res они реализованы одной
функцией С. К тому же она стала сложнее — для вызова специфических функ-
ций операционной системы необходимо хорошо разбираться в структурах С,
которые передаются системе и возвращаются ею. Некоторые программы, входящие
в поставку Perl, пытаются автоматически определить форматы pack и unpack
по заголовочному файлу С. В нашем примере sys/syscall .ph — библиотечный
файл Perl, сгенерированный утилитой h2ph, которая преобразует заголовочный
файл sys/syscal 1 ,h в sys/syscal 1 .ph. В частности, в нем определена функция
&SYS_gettimeofday, возвращающая номер системного вызова для gettimeofday.
Следующий пример показывает, как использовать Time:: Hi Res для проведе-
ния хронометража (если вы почему-либо не хотите использовать стандартный
модуль Benchmark):
use Time::HiRes qw(gettimeofday);
# Вычисление среднего времени сортировки
$size = 2000;
$number_of_times = 100;
$total_time = 0;
for ($i = 0; $i < number_of_times; $i++) {
my (Oarray. $j. Sbegin, $time);
# Заполнение массива
Oarray = ():
for ($j=0; $j < $size: $j++) { push(Oarray. rand) }
# Выполнение сортировки
Sbegin = gettimeofday;
Oarray = sort { $a <=> $b } Oarray;
3.10. Короткие задержки
139
$time = gettimeofday-$begin:
$total_time += $time;
}
printf "On average, sorting random numbers takes %5.f seconds\n",
$size, ($total_tlme/$number_of_times):
On average, sorting 500 random numbers takes 0.01033 seconds
См. также
Документация по модулям Time:: Hi Res и BenchMark; описание функции syscall
в perlfunc(l); шап-страница syscall(2).
3.10. Короткие задержки
Проблема
Требуется сделать в программе паузу продолжительностью менее секунды.
Решение
Воспользуйтесь функцией select О, если она поддерживается вашей системой:
select(undef, undef, undef, $time_to_sleep):
где $time_to_sleep — длительность паузы.
Некоторые системы не поддерживают select с четырьмя аргументами. В мо-
дуле Time:: Hi Res присутствует функция sleep, которой передается продолжи-
тельность паузы в вещественном формате:
use Time::HiRes qw(sleep);
sleep($time_to_sleep);
Комментарий
Следующий пример демонстрирует применение функции select; он представля-
ет собой упрощенную версию программы из рецепта 1.6. Можете рассматривать
его как эмулятор 300-бодного терминала:
while (<>) {
seiect(undef, undef, undef, 0.25):
print:
}
С помощью Time:: Hi Res это делается так:
use Time::HiRes qw(sleep):
while (<>) {
sleep(0.25):
print:
}
140
Глава 3. Время и дата
См. также
Документация по модулям CPAN Time:: HI Res и BenchMark; описание функций
sleep и select в perlfunc(l). Функция select используется для организации корот-
кой задержки в программе slowest из рецепта 1.6.
3.11. Программа: hopdelta
Вы никогда не задавались вопросом, почему какое-нибудь важное письмо так
долго добиралось до вас? Обычная почта не позволит узнать, как долго ваше
письмо пылилось на полках всех промежуточных почтовых отделений. Однако
в электронной почте такая возможность имеется. В заголовке сообщения при-
сутствует строка Received: с информацией о том, когда сообщение было получе-
но каждым промежуточным транспортным агентом.
Время в заголовках воспринимается плохо. Заголовки приходится читать
в обратном направлении, снизу вверх. Время записывается в разных форматах
по прихоти каждого транспортного агента. Но хуже всего то, что каждое время
регистрируется в своем часовом поясе. Взглянув на строки "Тие. 26 Мау 1998
23:57:38 -0400" и "Wed. 27 Мау 1998 05:04:03 +0100", вы вряд ли сразу поймете, что
эти два момента разделяют всего 6 минут 25 секунд.
На помощь приходят функции ParseDate и DateCalс модуля Date::Maniр из ар-
хива CPAN:
use Date::Manip qw(ParseDate DateCalc):
$dl = ParseDateCSun. 09 Mar 2003 23:57:38 -0400”):
$d2 = ParseDateU'Mon, 10 Mar 2003 05:04:03 +0100”);
print DateCalc($dl, $d2);
+0:0:0:0:0:6:25
Возможно, с такими данными удобно работать программе, но пользователь
все же предпочтет что-нибудь более привычное. Программа hopdelta из приме-
ра 3.1 получает заголовок сообщения и пытается проанализировать дельты (раз-
ности) между промежуточными остановками. Результаты выводятся для местного
часового пояса.
Пример 3.1. hopdelta
#!/usr/bin/perl
# hopdelta - по заголовку почтового сообщения выдает сведения
# о задержке почты на каждом промежуточном участке.
use strict:
use Date::Manip qw (ParseDate UnixDate);
# Заголовок печати: из-за сложностей printf следовало
# бы использовать format/write
printf ”£-20.20s &-20.20s £-20.20s %s\n”.
"Sender”. "Recipient". "Time". "Delta":
$/=’’; # Режим абзаца
$_ = <>: # Читать заголовок
s/\n\s+/ /д: # Объединить строки продолжения
3.11. Программа: hopdelta
141
# Вычислить, когда и где начался маршрут сообщения
my($start_from) = /^From.*\@([^\s>]*)/m;
my($start_date) = /4)ate:\s+(.*)/m:
my $then = getdate($start_date):
printf '7-20.20s £-20.20s %s\n", 'Start', $start_from, fmtdate(Sthen):
my Sprevfrom = $start_from:
# Обрабатывать строки заголовка снизу вверх
for (reverse split(/\n/)) {
my (Sdelta, Snow, Sfrom, Sby, Swhen);
next unless /^Received;/:
s/\bon (.*?) (Id.*)/: $l/s; # Кажется, заголовок qmail
unless ((Swhen) = I ;\s+(.*)$/) {
warn "bad received line: $_":
next;
}
(Sfrom) = /from\s+(\S+)/:
(Sfrom) = /\((.*?)\)/ unless Sfrom: # Иногда встречается
Sfrom =~ s/\)$//: # Кто-то пожадничал
(Sby) = /by\s+(\S+\,\S+)/: # Отправитель для данного участка
# Операции, приводящие строку к анализируемому формату
for (Swhen) {
s/ (for|via) .*$//:
s/([+-]\d\d\d\d) \(\S+\)/$l/:
s/id \S+:\s*//:
}
next unless Snow = getdate(Swhen): # Перевести в секунды
# с начала эпохи
Sdelta = Snow - Sthen;
printf "£-20.20s %-20.20s %s ", Sfrom. Sby. fmtdate(Snow):
Sprevfrom = Sby:
puttime(Sdelta):
Sthen = Snow:
}
exit:
# Преобразовать произвольные строки времени в секунды с начала эпохи
sub getdate {
my Sstring = shift:
Sstring =~ s/\s+\(.*\)\s*$//: # Убрать нестандартные
# терминаторы
my Sdate = ParseDate(Sstring):
my $epoch_secs = UnixDate(Sdate.’7s"):
return $epoch_secs:
}
# Преобразовать секунды с начала эпохи в строку определенного формата
sub fmtdate {
my Sepoch = shift:
my($sec,$min,$hour,$mday.$mon.$year) = localtime(Sepoch):
return sprintf "%02d:%02d:%02d £04d/Wd/Wd",
продолжение &
142
Глава 3. Время и дата
Пример 3.1 (продолжение)
Shoiir. $m1n, $sec,
Syear + 1900, Smon + 1, Smday,
}
# Преобразовать секунды в удобочитаемый формат
sub puttime {
my(Sseconds) = shift;
my(Sdays, Shours, Sminutes);
Sdays = pull_count($seconds, 24 * 60 * 60);
Shours = pull_count($seconds. 60 * 60);
Sminutes = pull_count($seconds, 60);
put_field('s'. Sseconds);
put_field(’m', Sminutes);
put_field(’h’, Shours);
put_field(’d’, Sdays);
print "\n";
}
# Применение: Scount = pull_count(seconds, amount)
# Удалить из seconds заданную величину, изменить версию вызывающей
# стороны и вернуть число удалений,
sub pull_count {
my(Sanswer) = int($_[0] / $_[1]):
SJO] -= Sanswer * $_[!];
return Sanswer;
}
# Применение: put_field(char. number)
# Вывести числовое поле в десятичном формате с 3 разрядами и суффиксом char
# Выводить лишь для секунд (char == 's’)
sub put_field {
my (Schar, Snumber) =
printf " ^3d^s", Snumber. Schar if Snumber || Schar eq 's';
}
=end
Sender Recipient Time Delta
Start wal1.org 09:17:12 1998/05/23
wall.org mail.brainstorm.net 09:20:561998/05/23 44s 3m
mail.brainstorm.net jhereg.perl.com 09:20:58 1998/05/23 2s
Массивы
«Я считаю, что произведения искусства — единственные
объекты материальной Вселенной, обладающие внутренним
порядком. И потому, не веря в высшую ценность искусст-
ва, я все же верю в Искусство ради Искусства».
Э. М. Фостер
4.0. Введение
Если попросить вас перечислить содержимое своих карманов, назвать имена
трех последних президентов или объяснить, как пройти к нужному месту, в лю-
бом случае получится список: вы называете объекты один за другим в опре-
деленном порядке. Списки являются частью нашего мировоззрения. Мощные
примитивы Perl для работы со списками и массивами помогают преобразовать
мировоззрение в программный код.
Термины список (list) и массив (array) трактуются в этой главе в соответст-
вии с канонами Perl. Например, ("alpha", "beta", "gamma") — это список назва-
ний первых трех букв греческого алфавита. Чтобы сохранить его в переменной,
воспользуйтесь массивом: @greeks = ("alpha", "beta", "gamma"). Каждый из этих
терминов относится к упорядоченной совокупности скалярных величин; отли-
чие состоит в том, что массив представляет собой именованную переменную,
размер которой можно непосредственно изменить, а список является скорее
отвлеченным понятием. Можно рассматривать массив как переменную, а спи-
сок — как содержащиеся в ней значения.
Различие может показаться надуманным, но операции, изменяющие размер
этой совокупности (например, push или pop), работают с массивом, а не со спи-
ском. Нечто похожее происходит с $а и 4: в программе можно написать $а++, но
не 4++. Аналогично, рор(@а) — допустимо, a pop (1,2,3) — нет.
Главное — помнить, что списки и массивы в Perl представляют собой упоря-
доченные совокупности скалярных величин. Операторы и функции, работающие
со списками и массивами, обеспечивают более быстрый или удобный доступ
к элементам по сравнению с ручным извлечением. Поскольку размер массива
изменяется не так уж часто, термины «массив» и «список» обычно можно счи-
тать синонимами.
144
Глава 4. Массивы
Вложенные списки не создаются простым вложением скобок. Если попытать-
ся сделать это в Perl, происходит сглаживание списка. Иначе говоря, следующие
строки эквивалентны:
^nested = ("this", "that", "the", "order"):
^nested = ("this", "that", ("the", "order"));
Почему Perl не поддерживает вложенные списки напрямую? Отчасти по ис-
торическим причинам, но также и потому, что это позволяет многим операциям
(типа print или sort) работать со списками произвольной длины и произвольно-
го содержания.
Что делать, если требуется более сложная структура данных, например, мас-
сив массивов или массив хэшей? Вспомните, что в скалярных переменных могут
храниться не только числа или строки, но и ссылки. Сложные (многоуровневые)
структуры данных в Perl всегда образуются с помощью ссылок. Следовательно,
«двумерные массивы» или «массивы массивов» в действительности реализуют-
ся как массив ссылок на массивы — по аналогии с двумерными массивами С, ко-
торые могут представлять собой массивы указателей на массивы.
Для большинства рецептов этой главы содержимое массивов несущественно.
Например, проблема слияния двух массивов решается одинаково для массивов
строк, чисел или ссылок. Решения некоторых проблем, связанных с содержимым
массивов, приведены в главе И «Ссылки и записи». Рецепты этой главы ограни-
чиваются обычными массивами.
Давайте введем еще несколько терминов. Скалярные величины, входящие
в массив или список, называются элементами. Для обращения к элементу ис-
пользуется его позиция, или индекс. Индексация в Perl начинается с 0, поэтому
в следующем списке:
@greeks = ("alpha", "beta", "gamma" ):
элемент "alpha" находится в первой позиции, но для обращения к нему исполь-
зуется индекс 0: $greeks[O]. Это объясняется странностями как компьютерной
логики, в которой ряд представимых чисел начинается с 0, так и разработчиков
языка, которые решили идентифицировать элементы по смещению внутри мас-
сива, а не по порядковому номеру элемента.
4.1. Определение списка в программе
Проблема
Требуется включить в программу список, например, при инициализации мас-
сива.
Решение
Перечислите элементы, разделяя их запятыми:
@а = ("quick", "brown", "fox");
4.1. Определение списка в программе
145
При большом количестве однословных элементов воспользуйтесь операто-
ром qw():
@а = qw(Meddle not in the affairs of wizards.):
Если список содержит большое количество элементов, состоящих из несколь-
ких слов, создайте встроенный документ и последовательно извлекайте из него
строки:
@lines = («"END_OF_HERE_DOC" =~ m/A\s*( .+)/gm):
I sit beside the fire and think
of all that I have seen,
of meadow-flowers and butterflies
and summers that have been;
END_OF_HERE_DOC
Комментарий
Наиболее распространен первый способ — в основном из-за того, что в виде лите-
ралов в программе инициализируются лишь небольшие массивы. Инициализа-
ция большого массива загромождает программу и усложняет ее чтение, поэто-
му такие массивы либо инициализируются в отдельном библиотечном файле
(см. главу 12 «Пакеты, библиотеки и модули»), либо просто читаются из файла
данных:
@b1garray = О:
open(FH, "<". "myinfo") or die "Couldn't open myinfo: $!\n":
while (<FH>) {
chomp:
push(@bigarray, $_):
}
close(FH):
Во втором способе используется qw() — одна из нескольких псевдофункций
Perl, предназначенных для определения строковых величин в программе. Псев-
дофункция qw() разбивает свой аргумент по пропускам и создает список слов,
при этом «словом» считается любая строка, не содержащая пропусков. В аргу-
менте не выполняется интерполяция переменных и не обрабатывается большин-
ство экранированных последовательностей:
@banner =('Costs'. 'only'. '$4.95'):
^banner = qw(Costs only $4.95):
^banner = splitC ', ' Costs only $4.95'):
Оператор qw() подходит лишь для списков, в которых каждый элемент явля-
ется отдельным словом, ограниченным пробелами. Будьте внимательны, а то во
флотилии Колумба вместо трех кораблей появится четыре:
$ships = qw(Nina Pinta Santa Maria): # НЕВЕРНО!!!
$ships = (’Nina’. ’Pinta’, ’Santa Maria’): # Правильно
В третьем решении используется встроенный документ — текст, состоящий
из нескольких логических строк. Во встроенном документе производится глобаль-
ный поиск по шаблону. Шаблон /x\s*(.+)/ игнорирует все пропуски в начале
146
Глава 4. Массивы
текста, а затем сохраняет все символы до конца каждой строки. Модификатор /д
обеспечивает глобальное применение шаблона, а модификатор /т означает, что
метасимвол х может совпадать не только в начале всего текста, но и в начале каж-
дой логической строки, что и требуется в нашем случае. Применяя этот способ
в примере с кораблями, мы получаем следующее решение:
@sh1ps = ( « "END_OF_FLOTILLA" =~ /A\s*(.+)/gm):
Nina
Pinta
Santa Maria
END_OF_FLOTILLA
См. также
Раздел «List Value Constructors» perldata(V)\ раздел «Quote and Quote-Like
Operators» perlop(V)\ оператор s/// описан в perlop(l).
4.2. Вывод списков с запятыми
Проблема
Требуется вывести список с неизвестным количеством элементов. Элементы
должны разделяться запятыми (если их больше двух), а перед последним эле-
ментом выводится слово «and».
Решение
Следующая функция возвращает строку, отформатированную требуемым об-
разом:
sub commify_ser1es {
(@_ == 0) ? "
(@_ == 1) ? $_[0] :
(@_ == 2) ? joinC and ", @_) :
joinC, ". @_[0 .. ($#_-!], "and $_[-!]"):
}
Комментарий
При выводе содержимое массива порой выглядит довольно странно:
@array = Cred", "yellow", "green");
print "I have ", @array, " marbles.\n":
print "I have @array marbles\n";
I have redyel1owgreen marbles.
I have red yellow green marbles.
На самом деле вам нужна строка "I have red, yellow, and green marbles". При-
веденная выше функция генерирует строку именно в таком формате. Между
4.2. Вывод списков с запятыми
147
двумя последними элементами списка вставляется "and". Если в списке больше
двух элементов, все они разделяются запятыми.
Пример 4.1 демонстрирует применение этой функции с одним дополнением:
если хотя бы один элемент списка содержит запятую, в качестве разделителя ис-
пользуется точка с запятой.
Пример 4.1. commify_series
#!/usr/bin/perl -w
# commify_series - демонстрирует вставку запятых при выводе списка
# @lists - массив ссылок на анонимные массивы (массив массивов).
@11 sts = (
[ ’just one thing' ].
[ qw(Mutt Jeff) ].
[ qw(Peter Paul Mary) ].
[ 'To our parents'. 'Mother Theresa'. 'God' J.
[ '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 (@11sts) {
print "The list Is: " . comm1fy_ser1es(@$aref) . "An";
}
# Демонстрация для одного списка
@11 st = qw(one two three):
print "The last list Is: " . comm1fy_ser1es(@11st) . "An":
sub comm1fy_ser1es {
my $sepchar = grep(/./ => @_) ? ":" :
(@_ = = 0) ? " :
(@_ = = 1) ? $_[0] :
(@_ = = 2) ? jo1n(" and ". @_) :
jo1n("$sepchar ". @_[0 .. ($#_-!)]. "and $_[-!]");
}
Результаты выглядят так:
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.
The list is: recycle tired, old phrases; ponder
big. happy thoughts; and sleep and dream peacefully.
The last list is: one. two. and three.
Как видите, мы отвергаем порочную практику исключения последней запя-
той из списка, так как это нередко приводит к появлению двусмысленностей.
148
Глава 4. Массивы
См. также
Описание синтаксиса вложенных списков в рецепте 11.1; описание функции
grep в perlfunc(\y, описание тернарного оператора выбора в perlop(l). Синтаксис
вложенных списков рассматривается в рецепте 11.1.
4.3. Изменение размера массива
Проблема
Требуется увеличить или уменьшить размер массива. Допустим, у вас имеется
массив работников, отсортированный по размерам оклада, и вы хотите ограни-
чить его пятью самыми высокооплачиваемыми работниками. Другой пример —
если окончательный размер массива точно известен, намного эффективнее выде-
лить сразу всю память вместо того, чтобы увеличивать массив постепенно, до-
бавляя по одному элементу в конец.
Решение
Присвойте значение $#ARRAY:
# Увеличить или уменьшить @ARRAY
$#ARRAY = $NEW_LAST_ELEMENT_INDEX_NUMBER
Присваивание элементу, находящемуся за концом массива, автоматически
увеличивает массив:
$ARRAY[$NEW_LAST_ELEMENT_INDEX_NUMBER] = SVALUE:
Комментарий
$#ARRAY — последний допустимый индекс массива ©ARRAY. Если ему присваивает-
ся значение меньше текущего, массив уменьшается. Отсеченные элементы без-
возвратно теряются. Если присвоенное значение больше текущего, массив уве-
личивается. Новые элементы получают неопределенное значение.
Однако $#ARRAY не следует путать с ©ARRAY. $#ARRAY представляет собой послед-
ний допустимый индекс массива, a ©ARRAY (в скалярном контексте, то есть в чи-
словой интерпретации) — количество элементов. $#ARRAY на единицу меньше
©ARRAY, поскольку нумерация индексов начинается с 0.
В следующем фрагменте использованы оба варианта. В команде print прихо-
дится использовать scalar @array, потому что Perl интерпретирует аргументы
(большинства) функций в списковом контексте, а нам для @аггау нужен скаляр-
ный контекст:
sub what_about_that_array {
print "The array now has ". scalar(@people), " elements An":
print "The Index of the last element Is $#peopleAn";
print "Element #3 Is ’$peopleL3]’An";
}
4.3. Изменение размера массива
149
@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 ’'.
Третий элемент пропал при уменьшении массива. Если бы программа запус-
калась с ключом -w, Perl также выдал бы предупреждение об использовании не-
инициализированной величины, поскольку значение $реор!е[3] не определено.
В следующем примере
$#реор!е = 10-000;
what_about_that_array():
результат выглядит так:
The array now has 10001 elements.
The index of the last element is 10000.
Element #3 is ' ’.
Элемент "Young" безвозвратно утерян. Вместо присваивания $#people можно
было указать:
$people[10_000]=undef:
хотя это не совсем одно и то же. Например, если в массиве из трех элементов
^colors = qw(red blue green):
присвоить undef последнему элементу
undef $colors[2]: # Элемент green удаляется
у вас остается массив из трех элементов, просто его последний элемент не опре-
делен. Однако при удалении элемента из массива при помощи функции или руч-
ным изменением $#colors:
$last_color = ScolorsE $#colors-- ]:
размер массива уменьшается на один элемент.
Массивы Perl не являются разреженными. Другими словами, если у вас име-
ется 10 000-й элемент, то должны присутствовать и остальные 9999 элементов.
Они могут быть неопределенными, но все равно будут занимать память. Из-за
этого $array[time()] или любая другая конструкция, где в качестве индекса ис-
пользуется очень большое целое число, является неудачным решением. Лучше
воспользуйтесь хэшем.
150
Глава 4. Массивы
См. также
Описание $#ARRAY в perldata(Y).
4.4. Реализация разреженного массива
Проблема
На хранение массива, в котором элементы разделяются большими свободными
блоками, расходуется слишком много памяти. Как избавиться от лишних затрат?
Решение
Воспользуйтесь хэшем вместо массива.
Комментарий
Если присвоить значение миллионному элементу массива, то Perl выделит
память для 1 000 001 скалярной величины. Однако данные хранятся только
в последнем элементе, а все предшествующие элементы равны undef; на каждый
свободный элемент расходуется 4 байта памяти.
В последних версиях Perl элементы, автоматически получившие значение
undef в результате присваивания за концом массива или модификации $#ARRAY,
можно отличить от элементов, которым значение undef было присвоено. Для
этого вместо defined следует использовать функцию exists:
$#foo = 5;
@bar = ( (undef) x 5 ) ;
prlntf "foo element 3 is^s defined\n",
defined $foo[3] ? ........n't":
printf "foo element 3 does^s exist\n",
exists $fooE33 ? "" : "n’t":
prlntf "bar element 3 isfcs definedXn".
defined $bar[3] ? "" : "n't":
prlntf "bar element 3 does^s exist\n".
exists $bar[3] ? "" : "n’t":
foo element 3 isn't defined
foo element 3 doesn't exist
bar element 3 isn't defined
bar element 3 does exist
Впрочем, и в этом случае память будет расходоваться неэффективно. Дело
в том, что реализация массивов в Perl резервирует непрерывный блок памяти
для всех элементов до последней занятой позиции:
$real_array[ 1_000_000 ] = 1: # Расходует более 4 Мбайт
Хэш работает иначе: память выделяется только под реально используемые
данные. Хотя элемент хэша занимает чуть больше памяти, чем элемент массива,
4.4. Реализация разреженного массива
151
поскольку в нем сохраняется пара «ключ/значение», для разреженных массивов
достигается фантастическая экономия:
$fake_array{ 1_000_000 } = 1; # Расходует 28 байт
Достоинства такого решения очевидны, как насчет недостатков? Поскольку
ключи хэша не упорядочены, сортировка числовых ключей по порядку их хра-
нения в настоящем массиве потребует дополнительной работы. Например, пере-
бор элементов в порядке индексов может осуществляться так:
foreach Selement ( @real_array ) {
# Выполнить операцию с Selement
}
Перебор индексов по возрастанию производится так:
foreach Sidx ( 0 .. $#real_array ) {
# Выполнить операцию с $real_array[$1dx]
}
При представлении массива в виде хэша перебор элементов в порядке индек-
сов выполняется сложнее:
foreach Selement ( @fake_array{ sort {Sa <=> Sb} keys £fake_array } ) {
# Выполнить операцию c Selement
}
Перебор индексов по возрастанию:
foreach Sidx ( sort {Sa <=> Sb} keys £fake_array ) {
# Выполнить операцию c $fake_array{$idx}
}
Если вместо хэша в программе должен использоваться именно массив, в не-
которых ситуациях встречаются два весьма специфических случая, позволяю-
щие заметно экономить память за счет использования альтернативной схемы
хранения. Оба случая также относятся не только к разреженным, но и к плотно
заполненным массивам.
Первый случай — увеличение массива многократным присоединением новых
элементов. Используемая в Perl схема выделения памяти при увеличении мас-
сива такова, что затраты памяти могут оказаться в четыре раза больше необходи-
мых. Если максимальный размер массива известен заранее, затраты на перерас-
пределение памяти можно предотвратить. Для этого следует либо присваивать
значения элементов, начиная со старших индексов:
for ($1 = 10_000; $1 >= 0: $1--) { $real_array[$i] = 1 }
либо зарезервировать память под весь массив при помощи специальной конст-
рукции $#:
$#real_array = 10_000:
Второй частный случай встречается тогда, когда каждый элемент массива со-
держит всего один бит данных. Например, при работе с пронумерованными
статьями Usenet в элементе массива может храниться информация о том, была
152
Глава 4. Массивы
ли прочитана соответствующая статья. В таких ситуациях вместо массива ис-
пользуется битовый вектор:
my $have_read = '':
for ($1 = 10_000; $1 >= 0: $1--) { vec($have_read, $1. 1) = 1 }
В этом примере состояние флага проверяется следующим образом:
If (vec($have_read. $artno. D) { .... }
См. также
Описание функции vec в perlfunc(\).
4.5. Выполнение операции с каждым
элементом списка
Проблема
Требуется повторить некоторую операцию для каждого элемента списка.
Массивы часто используются для сбора интересующей информации, напри-
мер, имен пользователей, превысивших свои дисковые квоты. Данные обрабаты-
ваются, при этом с каждым элементом массива выполняется некоторая операция.
Скажем, в примере с дисковыми квотами каждому пользователю отправляется
предупреждающее сообщение.
Решение
Воспользуйтесь циклом foreach:
foreach $1tem (LIST) {
# Выполнить некоторые действия с $1tem
}
Комментарий
Предположим, в массиве @bad_users собран список пользователей, превысивших
свои дисковые квоты. В следующем фрагменте для каждого нарушителя вызы-
вается процедура complaln():
foreach $user (@bad_users) {
compla1n($user):
}
Столь тривиальные случаи встречаются редко. Вместо этого списки часто ге-
нерируются при помощи функций:
foreach $var (sort keys %ENV) {
print "$var=$ENV{$var}\n";
4.5. Выполнение операции с каждым элементом списка
153
В этом примере функции sort и keys строят отсортированный список имен
переменных окружения. Конечно, многократно используемые списки следует
сохранять в массивах. Но для одноразовых задач удобнее работать со списком
напрямую.
Возможности этой конструкции расширяются не только за счет построения
списка в foreach, но и за счет дополнительных операций в блоке кода. Одно из
распространенных применений foreach — сбор информации о каждом элементе
списка и принятие некоторого решения на основании полученных данных. Вер-
немся к примеру с квотами:
foreach $user (@all_users) {
$disk_space = get_usage($user):
if ($disk_space > $MAX_QUOTA) {
complaln($user):
# Определить объем используемого
# дискового пространства
# Если он больше допустимого...
# ... предупредить о нарушении.
Возможны и более сложные управляющие конструкции. Команда last пре-
рывает цикл, next переходит к следующему элементу, a redo возвращается к пер-
вой команде внутри блока. Фактически вы говорите: «Нет смысла продолжать,
это не то, что мне нужно» (next), «Я нашел то, что искал, и проверять остальные
элементы незачем» (last) или «Я тут кое-что изменил, так что проверки и вы-
числения лучше выполнить заново» (redo).
Переменная, которой последовательно присваиваются все элементы списка,
называется переменной цикла, или итератором. Если итератор не указан, ис-
пользуется глобальная переменная Она используется по умолчанию во мно-
гих строковых, списковых и файловых функциях Perl. В коротких программных
блоках пропуск $_ упрощает чтение программы (хотя в длинных блоках изли-
шек неявных допущений делает программу менее понятной). Например:
foreach ('who') {
If (/tchrist/) {
print;
}
}
Или в сочетании с циклом while:
while (<FH>) {
chomp;
foreach (split) {
$_ = reverse;
print;
}
}
# Присвоить $_ очередную прочитанную строку
# Удалить из $_ конечный символ \п.
# если он присутствует
# Разделить $_ по пропускам и получить @_
# Последовательно присвоить $_
# каждый из полученных фрагментов
# Переставить символы $_
# в противоположном порядке
# Вывести значение $_
Многочисленные применения $_ заставляют понервничать. Особенно бес-
покоит то, что значение $_ изменяется как в foreach, так и в while. Возникает
154
Глава 4. Массивы
вопрос — не будет ли полная строка, прочитанная в $_ в <FH>, навсегда потеряна
после выполнения foreach?
К счастью, эти опасения необоснованны — по крайней мере, в данном случае.
Perl не уничтожает старое значение поскольку переменная-итератор ($_) суще-
ствует в течение всего выполнения цикла. При входе во внутренний цикл старое
значение автоматически сохраняется, а при выходе — восстанавливается.
Однако причины для беспокойства все же есть. Если цикл while будет внут-
ренним, a foreach — внешним, ваши страхи в полной мере оправдаются. В отличие
от foreach, конструкция while <FH> разрушает глобальное значение $_ без предва-
рительного сохранения! Следовательно, в начале любой процедуры (или блока),
где $_ используется в подобной конструкции, всегда должно присутствовать
объявление local
Если в области действия (scope) присутствует лексическая переменная (объяв-
ленная с ту), то временная переменная будет иметь лексическую область действия,
ограниченную данным циклом. В противном случае она будет считаться гло-
бальной переменной с динамической областью действия. Во избежание стран-
ных побочных эффектов лучше использовать более наглядную и четкую запись:
foreach my $item (Oarray) {
print "i = $item\n":
}
Цикл foreach обладает еще одним свойством: в цикле переменная-итератор
является не копией, а скорее синонимом (alias) текущего элемента. Иными сло-
вами, изменение итератора приводит к изменению каждого элемента списка.
Oarray = (1.2.3):
foreach $item (Oarray) {
$item--:
}
print "Oarray\n":
0 1 2
# Умножить каждый элемент Oa и Ob на семь
Оа = (.5. 3): 0b = (0. 1):
foreach $item (Oa. Ob) {
$item *= 7;
}
print "Oa Ob\n":
3.5 21 0 7
Однако изменять константы нельзя, поэтому следующий фрагмент недопустим:
foreach $n (1. 2, 3) {
$п **= 2:
}
Механизм синонимов означает, что модификация списков в цикле foreach
оказывается более понятной и быстрой, чем в эквивалентном коде с циклом for
и указанием конкретных индексов. Это не ошибка; такая возможность была на-
меренно предусмотрена разработчиками языка. Не зная о ней, можно случайно
изменить содержимое списка. Теперь вам это известно.
4.6. Перебор массива по ссылке
155
Например, для удаления начальных и конечных пропусков из элементов
хэша используется особенность функции values: элементы возвращаемого спи-
ска в действительности являются значениями хэша, а их модификация приво-
дит к изменению исходного хэша. Непосредственное применение s/// к эле-
ментам списка, возвращаемого функцией values, без копирования в переменную,
приведет к модификации самого хэша.
# Убрать пропуски из скалярной величины, массива и всех значений хзша
foreach ($scalar. @array. values ^hash) {
s/^\s+//:
s/\s+$//:
}
По причинам, связанным с эквивалентными конструкциями командного ин-
терпретатора Борна для UNIX, ключевые слова for и foreach взаимозаменяемы:
for $1tem (@array) { # То же. что и foreach $1tem (Oarray)
# Сделать что-то
}
for (Oarray) { # То же. что и foreach $_ (Oarray)
# Сделать что-то
}
Подобный стиль часто показывает, что автор занимается написанием или со-
провождением сценариев интерпретатора и связан с системным администриро-
ванием UNIX. Жизнь таких людей и без того сложна, поэтому не стоит судить
их слишком строго. Вспомните главный принцип Perl: «У каждой задачи всегда
существует несколько решений».
См. также
Разделы «For Loops», «Foreach Loops» и «Loop Control» perlsynt^y, раздел «Tempo-
rary Values via local()» perlsub(V). Оператор local О рассматривается в рецеп-
те 10.13, a my О — в рецепте 10.2.
4.6. Перебор массива по ссылке
Проблема
Имеется ссылка на массив. Вы хотите использовать цикл для обращения к каж-
дому элементу массива.
Решение
Для перебора разыменованного (dereferenced) массива используется цикл foreach
или for:
# Перебор элементов массива $ARRAYREF
foreach $1tem(0$ARRAYREF) {
# Сделать что-то с $1tem
156
Глава 4. Массивы
for ($1 = 0; $i <= $#$ARRAYREF; $i++) {
# Сделать что-то c $ARARAYREF->[$1]
}
Комментарий
Приведенное решение предполагает, что у вас имеется скалярная переменная,
содержащая ссылку на массив. Это позволяет делать следующее:
Ofruits = ( "Apple", "Blackberry" );
$fruit_ref = \@fruits;
foreach Sfruit (@$fruit_ref) {
print "Sfruit tastes good in a pie.\n";
}
Apple tastes good in a pie.
Blackberry tastes good in a pie.
Цикл foreach можно переписать в виде цикла for следующего вида:
for ($1=0; $1 <= $#$fruit_ref: $i++) {
print ”$fru1t_ref->[$1] tastes good In a pieAn";
Однако ссылка на массив нередко является результатом более сложного вы-
ражения. Для превращения такого результата в массив применяется конструк-
ция EXPR }:
$namel1st{felines} = \@rogue_cats:
foreach Scat ( @{ $namelist{felines} } ) {
print "Scat purrs hypnotically.An";
}
print "--More-AnYou are control led.\n";
Как и прежде, цикл foreach можно заменить эквивалентным циклом for:
for ($1=0; $1 <= $#{ Snamel1st{felInes} }; S1++) {
print "$namelist{felines}[$1] purrs hypnotically.\n";
}
См. также
perlrefiX) и perllol(V)-, рецепт 11.1; рецепт 4.5.
4.7. Выборка уникальных
элементов из списка
Проблема
Требуется удалить из списка повторяющиеся элементы, например, при построе-
нии списка из файла или на базе выходных данных некоей команды. Рецепт
в равной мере относится к удалению дубликатов как при вводе, так и в уже за-
полненных массивах.
4.7. Выборка уникальных элементов из списка
157
Решение
Хэш используется для сохранения встречавшихся ранее элементов, а функция
keys — для их извлечения. Принятая в Perl концепция истинности позволит
уменьшить объем программы и ускорить ее работу.
О Прямолинейно:
^seen = ():
@un1q = ():
foreach $1tem (@11st) {
unless ($seen{$1tem})
# Если мы попали сюда, значит, элемент не встречался ранее
$seen{$1tem} = 1;
push(@uniq, $1tem):
}
}
О Быстро:
^seen = ():
foreach $1tem (@11st) {
push(@un1q. $1tem) unless $seen{$1tem}++:
}
О Аналогично, но с пользовательской функцией:
^seen = ();
foreach $1tem (@11st) {
some_func($1tem) unless $seen{$1tem}++:
}
О Быстро, но по-другому:
^seen = ();
foreach $1tem (@11st) {
$seen{$1tem}++;
}
@uniq = keys ^seen:
О Быстро и совсем по-другому:
^seen = ();
^unique = grep { ! $seen{$_} ++ } @11 st:
Комментарий
Суть сводится к простому вопросу — встречался ли данный элемент раньше?
Хэши идеально подходят для подобного поиска. В первом варианте («Прямоли-
нейно») массив уникальных значений строится по мере обработки исходного
списка, а для регистрации встречавшихся значений используется хэш.
Второй вариант («Быстро») представляет собой самый естественный способ
решения подобных задач в Perl. Каждый раз, когда встречается новое значение,
в хэш с помощью оператора ++ добавляется новый элемент. Побочный эффект
состоит в том, что в хэш попадают все повторяющиеся экземпляры. В данном
случае хэш работает как множество.
158
Глава 4. Массивы
Третий вариант («Аналогично, но с пользовательской функцией») похож на
второй, однако вместо сохранения значения мы вызываем некоторую пользова-
тельскую функцию и передаем ей это значение в качестве аргумента. Если ниче-
го больше не требуется, хранить отдельный массив уникальных значений будет
излишне.
В следующем варианте («Быстро, но по-другому») уникальные ключи извле-
каются из хэша %seen лишь после того, как он будет полностью построен. Иногда
это удобно, но исходный порядок элементов утрачивается.
В последнем варианте («Быстро и совсем по-другому») построение хэша % seen
объединяется с извлечением уникальных элементов. При этом сохраняется ис-
ходный порядок элементов.
Использование хэша для записи значений имеет два побочных эффекта: при
обработке длинных списков расходуется много памяти, а список, возвращаемый
keys, не отсортирован.
Ниже показано, как обрабатывать данные по мере ввода. Мы используем 'who'
для получения сведений о текущем списке пользователей, а перед обновлением
хэша извлекаем из каждой строки имя пользователя:
# Построить список зарегистрированных пользователей с удалением дубликатов
Client = О;
for ('who') {
s/\s.*\n//; # Стереть от первого пробела до конца строки -
# остается имя пользователя
$ucnt{$_}++: # Зафиксировать присутствие данного пользователя
# Извлечь и вывести уникальные ключи
@users = sort keys %ucnt;
print "users logged In: @users\n":
См. также
Раздел «Foreach Loops» perlsyn(l); описание функции keys в perlfunc(l). Анало-
гичное применение хэшей продемонстрировано в рецептах 4.8 и 4.9.
4.8. Поиск элементов одного массива,
отсутствующих в другом массиве
Проблема
Требуется найти элементы, которые присутствуют в одном массиве, но отсутст-
вуют в другом.
Решение
Мы ищем элементы @А, которых нет в @В. Постройте хэш из ключей @В — он бу-
дет использоваться в качестве таблицы просмотра. Затем проверьте каждый
элемент @А и посмотрите, присутствует ли он в @В.
4.8. Поиск элементов одного массива, отсутствующих в другом массиве
159
О Простейшая реализация:
# Предполагается, что @А и @В уже загружены
^seen =0; # Хзш для проверки принадлежности элемента В
Oaonly = О; # Результат
# Построить таблицу просмотра
foreach $1tem (OB) { $seen{$1tem} = 1 }
# Найти элементы ОА. отсутствующие в @В
foreach $1tem (ОА) {
unless ($seen{$1tem}) {
# Отсутствует в ^seen. поэтому добавить в Oaonly
push(Oaonly, $1tem);
}
}
О Идиоматическая версия:
my ^seen: # Таблица просмотра
my Oaonly; # Результат
# Построить таблицу просмотра
@seen{@B} = О:
foreach $item (OA) {
push(@aonly, $item) unless exists $seen{$item};
}
О Версия без цикла:
my ОА = ...;
my OB = ...;
my ^seen:
Oseen {OA} = 0;
delete Oseen {OB};
my Oaonly = keys ^seen;
Комментарий
Практически любая проблема, при которой требуется определить принадлежность
скалярной величины к списку или массиву, решается в Perl с помощью хэшей.
Сначала мы обрабатываем ОВ и регистрируем в хэше %seen все элементы ОВ, при-
сваивая соответствующему элементу хэша значение 1. Затем мы последователь-
но перебираем все элементы ОА и проверяем, присутствует ли данный элемент
в хэше %seen (то есть в ОВ).
В приведенном фрагменте ответ будет содержать дубликаты из массива ОА.
Проблема легко решается, для этого достаточно включать элементы ОА в %seen по
мере обработки:
foreach $1tem (ОА) {
push (Oaonly. $1tem) unless $seen{$item}:
$seen{$item} = 1: # Пометить как уже встречавшийся
}
160
Глава 4. Массивы
Эти решения в основном отличаются по способу построения хэша. В первом
варианте перебирается содержимое @В. Во втором для инициализации хэша ис-
пользуется срез. Работу со срезами хэшей проще всего продемонстрировать на
примере. Фрагмент
$hash{"keyl"} = Г,
$hash{"key2"} = 2:
эквивалентен следующему:
@hash{"keyl". "key2"} = (1.2);
Список в фигурных скобках содержит ключи, а список справа — значения.
В первом решении %seen инициализируется перебором всех элементов @В и при-
сваиванием соответствующим элементам % seen значения 1. Во втором мы просто
указываем:
@seen{@B} = О;
В этом случае элементы @В используются в качестве ключей для %seen, а с ними
ассоциируется undef, поскольку количество значений в правой части меньше ко-
личества позиций для их размещения. Показанный вариант работает, поскольку
мы проверяем только факт существования ключа, а не его логическую истинность
или определенность. Но даже если с элементами @В потребуется ассоциировать
истинные значения, срез все равно позволит сократить объем кода:
@seen{@B} = (1) х @В;
В третьем решении мы развиваем этот принцип и полностью исключаем из
программы циклы (не из каких-то высших соображений, а просто чтобы пока-
зать, что задача решается несколькими способами). В результате присваивания
срезу все элементы, присутствующие в @А, становятся ключами, а при удалении
среза из хэша исключаются все элементы, присутствующие в @В; остаются толь-
ко элементы, присутствующие в @А, но не в @В.
Довольно распространенная ситуация: есть два файла, и вы хотите знать, ка-
кие строки одного файла присутствуют (или, наоборот, отсутствуют) в другом
файле. Ниже приведено простое решение, основанное на данном рецепте:
open(OLD, $pathl) || die "can't open Spathl: $!":
@seen{ <OLD> } = ( ):
open(NEW, $path2) || die "can't open $path2; $!":
while (<NEW>) {
print if exists $seen{$_};
}
Программа выводит те строки второго файла, которые уже встречались в пер-
вом файле. Чтобы вывести строки второго файла, отсутствующие в первом, за-
мените if на unless.
Допустим, у нас имеются два файла. Первый содержит строки:
red
уel 1ow
green
blue
4.9. Вычисление объединения, пересечения и разности уникальных списков
161
Второй файл содержит строки:
green
orange
purple
black
yel1ow
С 1 f результат выглядит так:
green
yel1ow
Результат c unless:
orange
purple
black
Проверку даже можно выполнить из командной строки. При наличии про-
граммы типа cat(l) это делается легко:
% perl -е '@s{'cat OLD'}=(): exists $s{$_} && print for 'cat NEW'1
% perl -e ’@s{'cat OLD'}=(): exists $s{$_} || print for 'cat NEW'1
На самом деле эти команды эмулируют следующие вызовы программы Unix
fgrep(l):
« fgrep -Ff OLD NEW
% fgrep -vFf OLD NEW
См. также
Описание срезов хэшей в perldata(\). Аналогичное применение хэшей проде-
монстрировано в рецептах 4.7 и 4.9.
4.9. Вычисление объединения, пересечения
и разности уникальных списков
Проблема
Имеются два списка, каждый из которых содержит неповторяющиеся элементы.
Требуется узнать, какие элементы присутствуют в обоих списках (пересечение),
присутствуют в одном и отсутствуют в другом списке (разность) или хотя бы
в одном из списков (объединение).
Решение
В приведенных ниже решениях списки инициализируются следующим образом:
@а = (1. 3, 5, 6. 7, 8):
@Ь = (2, 3. 5, 7, 9):
162
Глава 4. Массивы
@union = @1sect = @diff = О:
bunion = bisect = ();
£count = 0:
О Простое решение для объединения и пересечения:
foreach $е(@а) { $un1on{$e} = 1 }
foreach $е (@b) {
If ( $un1on{$e} ) { $1sect{$e} = 1 }
Siinlon {$e} = Г,
}
@union = keys bunion;
@1sect = keys bisect:
О Идиоматическое решение:
foreach $e (@a. @b) { $union{$e}++ && $1sect{$e}++ }
@union = keys bunions:
@1sect = keys bisect:
О Объединение, пересечение и симметричная разность:
foreach $е (@а. @b) { $count{$e}++ }
foreach $е (keys fccount) {
push(@union, $e):
If ($count{$e} == 2) {
push @1sect, $e:
} else {
push @diff, $e;
}
}
О Косвенное решение:
@1sect = @diff = @union = 0:
foreach $e (@a. @b) { $count{$e}++ }
@union = keys £count;
foreach $e (keys £count) {
push @{ $count{$e} == 2 ? \@1sect : \@diff }, $e:
}
Комментарий
В первом решении происходит непосредственное вычисление объединения и пе-
ресечения двух списков, ни один из которых не содержит дубликатов. Для запи-
си элементов, принадлежащих к объединению и пересечению, используются два
разных хэша. Сначала мы заносим каждый элемент первого массива в хэш объ-
единения и ассоциируем с ним истинное значение. Затем при последовательной
обработке элементов второго массива мы проверяем, присутствует ли элемент
в объединении. Если присутствует, он также включается и в хэш пересечения.
4.10. Присоединение массива
163
В любом случае элемент заносится в хэш объединения. После завершения пере-
бора мы извлекаем ключи обоих хэшей, а ассоциированные с ними значения не
нужны.
Второе решение («идиоматическое»), в сущности, делает то же самое, одна-
ко для него потребуется хорошее знание операторов Perl (а также awk, С, C++
и Java) ++ и &&. Если ++ находится после переменной, то в программе использует-
ся ее старое значение до приращения. Когда элемент встречается впервые, он
еще отсутствует в объединении, поэтому первая часть && будет ложной, а вторая
часть попросту игнорируется. Когда тот же элемент встретится во второй раз, он
уже присутствует в объединении, поэтому мы заносим его и в пересечение.
В третьем решении информация о том, сколько раз встретился тот или иной
элемент, хранится всего в одном кэше. Записав элементы обоих массивов в хэш,
мы последовательно перебираем его ключи. Каждый ключ автоматически по-
падает в объединение. Ключи, с которыми ассоциировано значение 2, присутст-
вуют в обоих массивах и потому заносятся в массив пересечения. Ключи с ассо-
циированным значением 1 встречаются лишь в одном из двух массивов и зано-
сятся в массив разности. В отличие от исходного решения, порядок элементов
в выходных массивах не совпадает с порядком элементов входных массивов.
В последнем решении, как и в предыдущем, используется всего один хэш
с количеством экземпляров каждого элемента. Однако на этот раз мы динамиче-
ски выбираем один из двух возможных массивов, размещая в блоке разыменова-
ния массива @{...} выражение, результат вычисления которого дает ссылку на
нужный массив.
Мы вычисляем не простую, а симметричную разность. Эти термины проис-
ходят из теории множеств. Симметричная разность представляет собой на-
бор всех элементов, являющихся членами либо @А, либо @В, но не обоих сразу.
Простая разность — набор всех элементов @А, отсутствующих в @В (см. рецепт 4.8).
См. также
Аналогичное применение хэшей продемонстрировано в рецептах 4.7 и 4.8.
4.10. Присоединение массива
Проблема
Требуется объединить два массива, дописав все элементы одного из них в конец
другого.
Решение
Воспользуйтесь функцией push:
# push
push(@ARRAYl. @ARRAY2):
164
Глава 4. Массивы
Комментарий
Функция push оптимизирована для присоединения списка в конец массива. Два
массива также можно объединить посредством сглаживания (flattening) списков
Perl, однако в этом случае выполняется намного больше операций копирования,
чем при использовании push:
OARRAY1 = (OARRAY1, 0ARRAY2):
Ниже показан пример практического использования push:
Omembers = ("Time", "Flies"):
©Initiates = ("An", "Arrow"):
push(Omembers, ©Initiates):
#0members содержит элементы ("Time", "Flies", "An". "Arrow")
Если содержимое одного массива требуется вставить в середину другого, вос-
пользуйтесь функцией splice:
splice (Omembers. 2, 0, "Like", ©Initiates):
print "@members\n":
spl1ce(@members, 0, 1, "Fruit"):
spl1ce(@members, -2, 2, "A". "Banana"):
print "@members\n":
Результат выглядит так:
Time Flies Like An Arrow
Fruit Flies Like A Banana
См. также
Описание функций splice и push в perlfunc(l); раздел «List Value Constructors»
perldata(V).
4.11. Обращение массива
Проблема
Требуется обратить массив (то есть переставить элементы в противоположном
порядке).
Решение
Воспользуйтесь функцией reverse:
# Обращение OARRAY дает ©REVERSED
©REVERSED = reverse OARRAY:
Также можно воспользоваться циклом foreach:
foreach $element (reverse OARRAY) {
# Сделать что-то c Selement
}
4.12. Обработка нескольких элементов массива
165
или циклом for, начиная с индекса последнего элемента и продвигаясь к на-
чалу:
for ($1 = $#ARRAY: $1 >= 0; $1--) {
# Сделать что-то с $ARRAY[$1]
}
Комментарий
В списковом контексте функция reverse переставляет элементы списка-аргу-
мента в обратном порядке. Вы можете сохранить копию обращенного списка
в массиве или просто воспользоваться циклом foreach для перебора элемен-
тов в обратном порядке, если этого достаточно. Цикл for просто перебирает
элементы в обратном порядке с явным заданием индексов. Если обращенная
копия списка не нужна, цикл for экономит память и время для очень больших
массивов.
Если функция reverse используется для обращения только что отсортиро-
ванного списка, логичнее будет сразу отсортировать список в нужном порядке.
Например:
# Два шага: сортировка, затем обращение
Oascending = sort { $а cmp $b } Ousers;
^descending = reverse Oascending:
# Один шаг: сортировка с обратным сравнением
^descending = sort { $b cmp $a } Ousers;
См. также
Описание функции reverse в perlfunc(l); пример использования reverse в ре-
цепте 1.7.
4.12. Обработка нескольких
элементов массива
Проблема
Требуется удалить сразу несколько элементов в начале или в конце массива.
Решение
Воспользуйтесь функцией splice:
# Удалить $N элементов с начала OARRAY (shift $N)
CFRONT = splice(OARRAY, 0, $N):
# Удалить $N элементов с конца массива (pop $N)
OEND = splice(OARRAY, -$N):
166
Глава 4. Массивы
Комментарий
Функция splice позволяет добавлять и/или удалять элементы в произволь-
ной позиции массива, не только с концов. Все остальные операции, изменяю-
щие длину массива, также могут быть записаны в виде эквивалентных вызовов
splice:
Операция Эквивалентный вызов splice
push(@a, $х, $у) splice(@a, @а, 0, $х, $у)
рор(@а) spliec(@a, -1)
shift(@a) splice(@a, 0, 1)
unshift(@a, $х, $у) splice(@a, 0, 0, $х, $у)
$а[$х] = $у splice(@a, $х, 1, $у)
(@а, @а = ()) splice(@a)
Однако в отличие от функций pop и unshift, которые всегда удаляют и воз-
вращают по одному элементу (и только с концов), splice позволяет задать коли-
чество элементов. Так получаются конструкции вроде тех, что приведены в на-
чале Решения.
Часто бывает удобно оформить эти операции в виде функций:
sub shift2 (\@) {
return spl1се(@{$_[0]}. 0. 2);
}
sub pop2 (\@) {
return splice(@{$_[0]}, 0. -2):
}
Использование функций делает код более наглядным:
@fr1ends = qw(Peter Paul Mary Jim Tim);
(Sthls. $that) = shift2(@fr1ends);
# $this содержит Peter. $that - Paul.
# a @friends - Mary. Jim и Tim
^beverages = qw(Dew Jolt Cola Sprite Fresca):
@pa1r = pop2(@beverages);
# $pair[0] содержит Ssprlte, $pair[l] - Fresca.
# a ^beverages - (Dew. Jolt. Cola)
Функция splice возвращает элементы, удаленные из массива, поэтому shift2
не заменяет первые два элемента @ARRAY ничем (то есть удаляет их) и возвраща-
ет два удаленных элемента. Функция рор2 удаляет и возвращает два последних
элемента.
В качестве аргументов этим функциям передается ссылка на массив — это сде-
лано для того, чтобы они лучше имитировали встроенные функции shift и pop.
При вызове ссылка не передается явно, с использованием символа \. Вместо это-
го компилятор, встречая прототип со ссылкой на массив, организует передачу
4.13. Поиск первого элемента списка, удовлетворяющего некоторому критерию
167
массива по ссылке. Преимущества такого подхода — эффективность, наглядность
и проверка параметров на стадии компиляции. Недостаток — передаваемый объ-
ект должен выглядеть как настоящий массив с префиксом а не как скалярная
величина, содержащая ссылку на массив. В противном случае придется добав-
лять префикс вручную, что сделает функцию менее наглядной:
$11ne[5] = \@list;
@got = рор2( @{ $11пе[5] } );
Перед вами еще один пример, когда вместо простого списка должен исполь-
зоваться массив. Прототип \@ требует, чтобы объект, занимающий данную пози-
цию в списке аргументов, был массивом. $11 пе[5] представляет собой не массив,
а ссылку на него. Вот почему нам понадобился «лишний» знак
См. также
Описание функции splice в perlfunc(iy раздел «Prototypes» perlsub(V). Функ-
ция splice используется в рецепте 4.10.
4.13. Поиск первого элемента списка,
удовлетворяющего некоторому критерию
Проблема
Требуется найти первый элемент списка, удовлетворяющего некоторому крите-
рию (или индекс этого элемента). Возможна и другая формулировка — опреде-
лить, проходит ли проверку хотя бы один элемент. Критерий может быть как
простым («Присутствует ли элемент в списке?»)1, так и сложным («Имеется
список работников, отсортированный в порядке убывания оклада. У кого из ме-
неджеров самый высокий оклад?»). В простых случаях дело обычно ограничи-
вается значением элемента, но если сам массив может изменяться, вероятно,
следует определять индекс первого подходящего элемента.
Решение
Перебирайте элементы в цикле foreach и вызовите last, как только критерий бу-
дет выполнен:
my($match, $found. $item);
foreach $1tem(@array) {
If (КРИТЕРИЙ) {
$match = $1tem: # Необходимо сохранить
$found = 1:
last;
}
1 Но тогда почему бы не воспользоваться хэшем?
168
Глава 4. Массивы
1f($found) {
# # Сделать что-то с $match
} else {
# # Неудачный поиск
}
Чтобы определить индекс, перебирайте все индексы массива и вызовите last,
как только критерий выполнится:
my($1, $match_idx):
for ($1 = 0; $1 < @array: $i++) {
if (КРИТЕРИЙ) {
$match_1dx = $i; # Сохранить индекс
last:
}
}
if(defined $match_1dx) {
# # Найден элемент $array[$match_idx]
} else {
# # Неудачный поиск
}
Модуль List: :Ut11, включенный в стандартную поставку Perl, начиная с вер-
сии 5.8, и доступный через CPAN для предыдущих версий, предоставляет еще
более простое решение:
use List::llti 1 qw(first):
$match = first { КРИТЕРИЙ } @1ist
Комментарий
Стандартных механизмов для решения этой задачи не существует, поэтому мы
напишем собственный код для перебора и проверки каждого элемента. В нем
используются циклы foreach и for, а вызов last прекращает проверку при вы-
полнении условия. Но перед тем как прерывать поиск с помощью last, следует
сохранить найденный индекс.
Одно из распространенных решений основано на использовании функции
grep. Но grep проверяет все элементы и находит все совпадения; если вас инте-
ресует только первое совпадение, этот вариант неэффективен. И все же grep
в некоторых ситуациях работает быстрее. Дело в том, что вызов grep уменьшает
объем исходного кода, а следовательно порождает меньше внутренних опера-
ций Perl, которые на практике оказывают сильное влияние на время выполне-
ния программы.
Если объем данных больше некоторой пороговой величины, цикл с ранним
завершением цикла все равно работает быстрее — если раннее завершение воз-
можно. Согласно эмпирическим данным, цикл for работает быстрее в том слу-
чае, если он прерван до того, как будут обработаны две трети списка.
Если нас интересует значение первого найденного элемента, присвойте его
переменной $match. Мы не можем просто проверять $item в конце цикла, так как
4.13. Поиск первого элемента списка, удовлетворяющего некоторому критерию
169
foreach автоматически локализует1 переменную-итератор и потому не позволяет
узнать ее последнее значение после завершения цикла (см. рецепт 4.5).
Рассмотрим пример. Предположим, в массиве @all_emps находится список
объектов с информацией о работниках, отсортированный в порядке убывания
оклада. Мы хотим найти инженера с максимальным окладом; это будет первый
инженер в массиве. Требуется только вывести имя инженера, поэтому нас инте-
ресует не индекс, а значение элемента.
foreach Semployee (@all_emps) {
if ( $employee->category() eq ’engineer’ ) {
$top_engr = Semployee:
last:
}
}
print "Highest paid engineer is: ", $top_engr->name(), "\n”;
Если нас интересует лишь значение индекса, программу можно сократить — дос-
таточно вспомнить, что при неудачном поиске $i будет содержать недопустимый
индекс. В основном экономится объем кода, а не время выполнения, поскольку
затраты на присваивание невелики по сравнению с затратами на проверку элемен-
тов списка. Однако проверка условия if ($i < @ARRAY) выглядит несколько туманно
по сравнению с очевидной проверкой defined из приведенного выше Решения.
for ($i = 0; $i < 0ARRAY: $i++) {
last if КРИТЕРИЙ;
}
if ($i < @ARRAY) {
# # Критерий выполняется для элемента с индексом $i
} else {
# # Неудачный поиск
}
Функция first из List::Uti 1 инкапсулирует логику всего цикла в простом
и удобном виде. Можно рассматривать ее как упрощенную форму встроенной
функции grep, которая прекращает работу сразу же после успешно найденного
совпадения. Во время работы функции каждый элемент списка последовательно
заносится в локализованную переменную $_. Пример:
$first_odd = first { $_ % 2 = = 1 } @ARRAY:
Или для предыдущего примера с инженером:
$top_engr = first { $_->category( ) eq 'engineer' } @all_emps:
См. также
Разделы «For Loops», «Foreach Loops» и «Loop Control» perlsyn(i)\ описание
функции grep в perlfunc(l).
1 Термин «локализация» по отношению к переменной означает придание ей локальной
области действия. — Примеч. перев.
170
Глава 4. Массивы
4.14. Поиск всех элементов массива,
удовлетворяющих определенному критерию
Проблема
Требуется найти все элементы списка, удовлетворяющие определенному критерию.
Это стандартная задача извлечения подмножества из списка: как найти всех
инженеров в списке работников, всех пользователей в административной груп-
пе, все интересующие вас имена файлов и т. д.
Решение
Воспользуйтесь функцией grep. Функция применяет критерий ко всем элемен-
там списка и возвращает лишь те, для которых он выполняется:
©matching = grep { КРИТЕРИЙ ($_) } @11 st:
Комментарий
То же самое можно было сделать в цикле foreach:
@match1ng = ():
foreach (©list) {
push(@match1ng, $_) if КРИТЕРИЙ ($_):
}
Функция Perl grep позволяет записать всю эту возню с циклами более ком-
пактно. В действительности функция grep сильно отличается от одноименной
команды Unix — она не имеет параметров для нумерации строк или инвертиро-
вания критерия и не ограничивается проверками по регулярным выражениям.
Например, чтобы отфильтровать из массива очень большие числа или опреде-
лить, с какими ключами хэша ассоциированы очень большие значения, приме-
няется следующая запись:
@b1gs = grep { $_ > 1_000_000 } @nums:
©pigs = grep { $users{$_} > le7 } keys fusers:
В следующем примере в (^matching заносятся строки, полученные от команды
who и начинающиеся с "gnat ":
@match1ng = grep { /Agnat / } 'who';
Или другой пример:
@engineers = grep { $_->posit1on() eq ’Engineer’ } @employees;
Из массива ^employees извлекаются только те объекты, для которых метод
positionO возвращает строку Engineer.
Функция grep позволяет выполнять и более сложные проверки:
@secondary_ass1stance = grep { $_->1ncome >= 26_000 &&
$_->1ncome < 30_000 }
(^applicants:
Однако в таких ситуациях вариант с циклом выглядит более понятно.
4.15. Числовая сортировка массива
171
См. также
Разделы «For Loops», «Foreach Loops» и «Loop Control» perlsyn(V)\ описание
функции grep в perlfunc(l)', страница руководства who(l) вашей системы (если
есть); рецепт 4.13.
4.15. Числовая сортировка массива
Проблема
Требуется отсортировать список чисел, однако функция Perl sort (по умолча-
нию) выполняет алфавитную сортировку в ASCII-порядке.
Решение
Воспользуйтесь функцией Perl sort с оператором числового сравнения <=>:
^sorted = sort { $а <=> $b } Ounsorted:
Комментарий
При вызове функции 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 =~ /A\d+$/:
kill (‘TERM’.$pid):
sleep 2:
kill ('KILL',$pid):
172
Глава 4. Массивы
При использовании условия $а<=>$Ь или $а стр $Ь список сортируется в по-
рядке возрастания. Чтобы сортировка выполнялась в порядке убывания, доста-
точно поменять местами $а и $Ь в функции сравнения:
^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;
Такая попытка тихо заканчивается неудачей — впрочем, при наличии ключа
-w о неудаче будет заявлено вслух. Дело в том, что вызов sort создает пакетные
переменные $а и $Ь в своем собственном пакете, Other_Pack, а функция revnum бу-
дет использовать версии из своего пакета. Это еще один аргумент в пользу пря-
мого определения функций сортировки при вызове:
@all = sort { $b <=> $а } 4. 19. 8. 3:
За дополнительной информацией о пакетах обращайтесь к главе 10 «Проце-
дуры».
См. также
Описание операторов стр и <=> вperlop(l)\ описание функций kill, sort и sleep
в perlfunc(\y, рецепт 4.16.
4.16. Сортировка списка
по вычисляемому полю
Проблема
Требуется отсортировать список, руководствуясь более сложным критерием, не-
жели простыми строковыми или числовыми сравнениями.
Такая проблема часто встречается при работе с объектами («отсортировать
по заработной плате») или сложными структурами данных («отсортировать по
4.16. Сортировка списка по вычисляемому полю
173
третьему элементу массива, на который указывает данная ссылка»). Кроме того,
она относится к сортировке по нескольким ключам, например, когда список
сортируется по дню рождения, а затем по имени (когда у нескольких людей сов-
падают дни рождения).
Решение
Воспользуйтесь вызовом sort с нестандартной функцией сравнения:
bordered = sort { compareO } Qunordered;
Для ускорения работы значение поля можно вычислить заранее:
^precomputed = map { [compute(),$_] } Qunordered:
@ordered_precomputed = sort { $a->[0] <=> $b->[0] } ^precomputed:
bordered = map { } @ordered_precomputed;
Наконец, эти три шага можно объединить:
bordered = map { $_->[1] }
sort { $а->[0] <=> $b->[0] }
map { [compute(),$_] }
@unordered;
Комментарий
О том, как пользоваться функциями сравнения, рассказано в рецепте 4.15. Поми-
мо использования встроенных операторов наподобие <=>, можно конструировать
более сложные условия:
bordered = 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 bonus!\n";
}
}
В функцию можно включить несколько условий и разделить их оператора-
ми 11. Оператор | | возвращает первое истинное (ненулевое) значение. Следо-
вательно, сортировку можно выполнять по одному критерию, а при равенстве
174
Глава 4. Массивы
элементов (когда возвращаемое значение равно 0) сортировать по другому кри-
терию. Получается «сортировка внутри сортировки»:
Osorted = sort {$a->name cmp $b->name
II
$b->age <=> $a->age} ^employees:
Первый критерий сравнивает имена двух работников. Если они не совпада-
ют, 11 прекращает вычисления и возвращает результат стр (сортировка в поряд-
ке возрастания имен). Но если имена совпадают, 11 продолжает проверку и воз-
вращает результат <=> (сортировка в порядке убывания возраста). Полученный
список будет отсортирован по именам и по возрасту в группах с одинаковыми
именами.
Рассмотрим реальный пример сортировки. Мы собираем информацию обо
всех пользователях в виде объектов User: :pwent, после чего сортируем их по име-
нам и выводим отсортированный список:
use User::pwent qw(getpwent):
Ousers = О;
# Выбрать всех пользователей
while (def1ned($user = getpwent)) {
push(@users, $user);
}
Ousers = sort { $a->name cmp $b->name } Ousers:
foreach $user (Ousers) {
print $user->name, ’An";
}
Возможности не ограничиваются простыми сравнениями или комбинациями
простых сравнений. В следующем примере список имен сортируется по второй
букве имени. Вторая буква извлекается функцией substr:
Osorted = sort { substr($a,1.1) cmp substr($b,1.1) } Onames:
А ниже список сортируется по длине строки:
Osorted = sort { length $а <=> length $b } Ostrlngs:
Функция сравнения вызывается sort каждый раз, когда требуется сравнить
два элемента. Число сравнений заметно увеличивается с увеличением количества
сортируемых элементов. Сортировка 10 элементов требует (в среднем) 46 срав-
нений, однако при сортировке 1000 элементов выполняется 14 000 сравнений.
Медленные операции (например, split или вызов функции) при каждом сравне-
нии тормозят работу программы.
К счастью, проблема решается однократным выполнением операции для ка-
ждого элемента перед сортировкой. Воспользуйтесь тар для сохранения резуль-
татов операции в массиве, элементы которого являются анонимными массивами
с исходным и вычисленным полем. Этот «массив массивов» сортируется по
предварительно вычисленному полю, после чего тар используется для получе-
ния отсортированных исходных данных. Концепция map/sort/map применяется
часто и с пользой, поэтому ее стоит рассмотреть более подробно.
4.16. Сортировка списка по вычисляемому полю
175
Применим ее к примеру с сортировкой по длине строки:
@temp = map { [ length $_,$_] } @strings:
@temp = sort { $a->[0] <=> $b->[0] } @temp;
^sorted = map { } @temp:
В первой строке map создает временный массив строк с их длинами. Вторая
строка сортирует временный массив, сравнивая их предварительно вычислен-
ные длины. Третья строка превращает временный массив строк/длин в отсор-
тированный массив строк. Таким образом длина каждой строки вычисляется
всего один раз.
Поскольку входные данные каждой строки представляют собой выходные
данные предыдущей строки (массив @temp, созданный в строке 1, передается sort
в строке 2, а результат сортировки передается тар в строке 3), их можно объеди-
нить в одну команду и отказаться от временного массива:
Osorted = map { }
sort {$а->[0] <=> $b->[0] }
map { [ length $_. $_] }
^strings:
Теперь операции перечисляются в обратном порядке. Встречая конструкцию
map/sort/map, читайте ее снизу вверх:
О (^strings: в конце указываются сортируемые данные. В данном случае это
массив, но как вы вскоре убедитесь, это может быть вызов процедуры или
даже команда в обратных апострофах. Подходит все, что возвращает список
для последующей сортировки;
О тар: нижний вызов тар строит временный список анонимных массивов. Спи-
сок содержит пары из предварительно вычисленного поля (length $__) и ис-
ходного элемента ($_). Эта строка показывает, как происходит вычисление
поля;
О sort: список анонимных массивов сортируется посредством сравнения пред-
варительно вычисленных полей. По этой строке трудно о чем-то судить —
разве что о том, будет ли список отсортирован в порядке возрастания или
убывания;
О тар: вызов тар в начале команды превращает отсортированный список аноним-
ных массивов в список исходных отсортированных элементов. Как правило,
во всех конструкциях map/sort/map он выглядит одинаково.
Ниже показан более сложный пример, в котором сортировка выполняется по
первому числу, найденному в каждой строке ^fields:
@temp = map { [ /(\d+)/, $_ ] } ^fields:
@sorted_temp = sort {$a->[0] <=> $b->[0] } @temp:
@sorted_fields = map { $_->[!] } @sorted_temp:
Регулярное выражение в первой строке извлекает из строки, обрабатываемой
тар, первое число. Мы используем регулярное выражение /(\d+)/ в списковом
контексте.
176
Глава 4. Массивы
Из этого фрагмента можно убрать временные массивы. Программа принима-
ет следующий вид:
@sorted_fields =
map { }
sort { $а->[0] <=> $b->[0] }
map { [ /(\d+)/, $_ ] }
@flei ds;
В последнем примере выполняется компактная сортировка данных, разделен-
ных запятыми (они взяты из файла Unix passwd). Сначала выполняется число-
вая сортировка файла по четвертому полю (идентификатору группы), затем —
числовая сортировка по третьему полю (идентификатору пользователя) и алфа-
витная сортировка по первому полю (имени пользователя).
print map { } # Целая строка
sort { $a->[l] <=> $b->[l] # Идентификатор группы
$a->[2] <=> 1 1 $b->[2] # Идентификатор пользователя
1 1 $a->[3] cmp $b->[3] # Имя пользователя
}
map { [ (split /:/)[3.2.0] 1 }
'cat /etc/passwd':
См. также
Описание функции sort в рег1/ипс(Д\, описание операторов стр и <=> в perlop(i)\
рецепт 4.15.
4.17. Реализация циклических списков
Проблема
Требуется создать циклический список и организовать работу с ним.
Решение
Воспользуйтесь функциями unshift и pop (или push и shift) для обычного массива.
unshIft(@circular, pop(@circular)); # Последний становится первым
push (©circular, shlft(@drcular)): # И наоборот
Комментарий
Циклические списки обычно применяются при многократном выполнении од-
ной и той же последовательности действий, например, обработки подключений
к серверу. Приведенный выше фрагмент не является полноценной компьютер-
ной реализацией циклических списков с указателями и настоящей цикличностью.
4.18. Случайная перестановка элементов массива
177
Вместо этого мы просто перемещаем последний элемент на первую позицию
и наоборот.
sub grab_and_rotate (\@ ) {
my $11stref = shift:
my $element = $11stref->[0]:
push(@11stref. shift @$11stref);
return $element:
}
^processes =(1,2,3,4.5):
while (1) {
$process = grab_and_rotate(@processes):
print "Handling process $process\n":
sleep 1:
}
См. также
Описание функций unshift и push вperlfunc{\\, рецепт 13.13.
4.18. Случайная перестановка
элементов массива
Проблема
Требуется случайным образом переставить элементы массива. Наиболее оче-
видное применение — тасование колоды в карточной игре, однако аналогичная
задача возникает в любой ситуации, где элементы массива обрабатываются в про-
извольном порядке.
Решение
Воспользуйтесь функцией shuffle стандартного модуля List::Util. Функция
возвращает элементы входного списка, переставленные в случайном порядке:
use List::Ut11 qw(shuffle):
@array = shuffle(@array):
Комментарий
Случайные перестановки на удивление коварны. Написать плохую программу
перестановки очень просто:
sub na1ve_shuffle { # НЕ ДЕЛАЙТЕ ТАК!
for (my $1 = 0: $1 < $1++) {
my $j = Int rand # Выбрать случайный элемент
($_[$1J, $_[$1]): # Переставить
}
}
178
Глава 4. Массивы
Такой алгоритм является смещенным — одни перестановки имеют большую
вероятность, чем другие. Это нетрудно доказать: предположим, мы получили
список из 3 элементов. Мы генерируем 3 случайных числа, каждое из которых
может принимать 3 возможных значения — итого 27 возможных комбинаций.
Однако для списка из трех элементов существует всего 6 перестановок. Посколь-
ку 27 не делится на 6, некоторые перестановки появляются с большей вероят-
ностью, чем другие.
Функция shuffle модуля List: :Util решает эту проблему и генерирует пере-
становки с более равномерным распределением.
Простая выборка одного случайного элемента из массива производится так:
Svalue = SarrayE 1nt(rand(@array)) ];
См. также
Описание функции rand в perlfunc{\}. Дополнительная информация о случай-
ных числах приведена в рецептах 2.6, 2.7 и 2.8. В рецепте 4.20 показан другой
способ построения случайных перестановок.
4.19. Программа: words
Вас когда-нибудь интересовало, каким образом программы типа 1 s строят столб-
цы отсортированных выходных данных, расположенных по столбцам, а не по
строкам? Например:
awk cp ed login mount rmdir sum
basename csh egrep Is mt sed sync
cat date fgrep mall mv sh tar
chgrp dd grep mkdlr ps sort touch
chmod df kill mknod pwd stty vl
chown echo In more rm su
В примере 4.2 показано, как это делается.
Пример 4.2. words
# !/usr/Ыn/perl -w
# words - вывод данных по столбцам
use strict:
my ($1tem, $cols. $rows, $maxlen):
my ($xp1xel. Syplxel, $mask, @data):
getwInsIzeO:
# Получить все строки входных данных
# и запомнить максимальную длину строки
Smaxlen = 1:
while (<>) {
4.19. Программа: words
179
my $mylen;
s/\s+$//;
$maxlen = $mylen If (($mylen = length) > $maxlen):
push(@data. $_);
}
$maxlen += 1; # Дополнительный пробел
# Определить границы экрана
$cols = int($cols / $maxlen) || 1:
$rows = 1nt(($#data+$cols) / $cols):
# Задать маску для ускорения вычислений
$mask = sprintf("И-^ds ". $maxlen-l):
# Подпрограмма для обнаружения последнего элемента строки
sub EOL { ($item+l) % $cols == 0 }
# Обработать каждый элемент, выбирая нужный фрагмент
# на основании позиции
for ($1tem = 0: $1tem < $rows * $cols; $1tem++) {
my $target = ($1tem % $cols) * $rows + int($item/$cols);
my $piece = sprintf($mask. $target < @data ? $data[$target] : "");
$piece =~ s/\s+$// if EOLO: # Последний элемент не выравнивать
print $piece:
print "\n" if EOLO;
}
# Завершить при необходимости
print "\n" if EOLO;
# He переносится -- только для Linux
sub getwinsize {
my $winsize = "\0" x 8;
my $TIOCGWINSZ = 0x40087468:
if (ioctl(STDOUT. $TIOCGWINSZ. $winsize)) {
Orows. $cols. $xpixel. $ypixel) = unpack( *S4‘, $winsize);
} else {
$cols = 80;
}
}
Наиболее очевидный способ вывести отсортированный список по столбцам —
последовательно выводить каждый элемент списка, выравнивая его пробелами
до определенной ширины. Когда вывод достигает конца строки, происходит пе-
реход на следующую строку. Но такой вариант хорош лишь тогда, когда строки
читаются слева направо. Если данные должны читаться по столбцам, сверху
вниз, приходится искать другое решение.
Программа words представляет собой фильтр, который генерирует выходные
данные по столбцам. Она читает все входные данные и запоминает максималь-
ную длину строки. После того как все данные будут прочитаны, ширина экрана
делится на длину самой большой входной записи — результат равен ожидаемо-
му количеству столбцов.
180
Глава 4. Массивы
Затем программа входит в цикл, который выполняется для каждой входной
записи. Однако порядок вывода неочевиден. Предположим, имеется список из
девяти элементов:
Неправильно Правильно
12 3 14 7
4 5 6 2 5 8
7 8 9 3 6 9
Программа words производит все необходимые вычисления, чтобы элементы
(1,4,7) выводились в одной строке, (2,5,8) — в другой и (3,6,9) — в последней
строке.
Текущие размеры окна определяются вызовом 1 octi. Этот вариант прекрасно
работает — в той системе, для которой он был написан. В любой другой он не
подойдет. Если в вашей системе он работает — считайте, вам повезло. В рецепте
12.17 показано, как определить размер окна в вашей системе с помощью файла
1 octi .pch или программы на С. Решение из рецепта 15.4 более универсально, од-
нако вам придется установить модуль с CPAN.
См. также
Рецепт 15.4.
4.20. Программа: 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
4.20. Программа: permute
181
6 720
7 5040
8 40320
9 362880
10 3628800
11 39916800
12 479001600
13 6227020800
14 87178291200
15 1307674368000
Соответственно, выполнение операции для всех возможных перестановок
занимает много времени. Сложность факториальных алгоритмов превышает ко-
личество частиц во Вселенной даже для относительно небольших входных зна-
чений. Факториал 500 больше, чем десять в тысячной степени!
use Math::Bl glut:
sub factorial {
my $n = shift;
my $s = 1;
$s *= $n-- while $n > 0:
return $s;
}
print factorial(Math::BigInt->new("500")):
+1220136...(1035 digits total)
Два решения, приведенных ниже, отличаются порядком возвращаемых пере-
становок.
Решение из примера 4.3 использует классический алгоритм списковых пе-
рестановок, используемый знатоками Lisp. Алгоритм относительно прямоли-
неен, однако в нем создаются ненужные копии. Кроме того, в решении жестко
закодирован простой вывод перестановок без каких-либо дополнительных дей-
ствий.
Пример 4.3. tsc-permute
#!/usr/bin/perl -n
# tsc_permute: вывод всех перестановок введенных слов
permute([split]. []):
sub permute {
my @items = @{ $_[0] };
my @perms = @{ $_[1] };
unless (@items) {
print "@perms\n”;
} else {
my(@newi terns,@newpe rms, $ i):
foreach $i (0 .. $#iterns) {
@newiterns = @iterns:
@newperms = @perms;
unshift(@newperms, splice(@newiterns. $i. 1)):
permute(\@newitems]. \@newperms]);
}
}
}
182
Глава 4. Массивы
Решение из примера 4.4, предложенное Марком-Джейсоном Доминусом (Mark-
Jason Dominus), более элегантно и работает примерно на 25 % быстрее. Вместо
того чтобы рассчитывать все перестановки, программа генерирует n-ю конкретную
перестановку. Элегантность проявляется в двух аспектах. Во-первых, в програм-
ме удается избежать рекурсии, кроме как при вычислении факториала (который
алгоритмом перестановок обычно не используется). Во-вторых, вместо переста-
новки реальных данных генерируется перестановка целых чисел.
В программе для экономии времени использована методика запоминания. Ее
суть заключается в том, что функция, которая всегда возвращает конкретный от-
вет для конкретного набора аргументов, запоминает этот ответ. При следующем
вызове с теми же аргументами дальнейшие вычисления уже не потребуются.
Функция factorial сохраняет ранее вычисленные значения факториала в при-
ватном массиве @fact (см. рецепт 10.3). Этот прием настолько полезен, что для
него был создан стандартный модуль, обеспечивающий поддержку кэширования.
Если у вас имеется обычная факториальная функция, не имеющая собственного
механизма кэширования, ее можно легко наделить этой возможностью:
use Memorize:
memorize ("factorial"):
Функция n2perm вызывается с двумя аргументами: номером генерируемой пе-
рестановки (от 0 до N!, где N — размер массива) и индексом последнего элемента
массива. Функция n2perm для расчета шаблона перестановки вызывает проце-
дуру n2pat, после чего шаблон преобразуется в перестановку целых чисел под-
программой pat2perm. Шаблон представляет собой список вида (0 2 0 1 0), что
означает: «Вырезать нулевой элемент, затем второй элемент оставшегося списка,
затем нулевой, первый и снова нулевой».
Пример 4.4. mjd-permute
# !/usr/bin/perl -w
# mjd_permute: перестановка всех введенных слов
use strict:
sub factorial($): # Опережающее объявление прототипа
while (<>) {
my @data = split:
my $num_permutations = factorial(scalar @data):
for (my $i=0: $i < $num_permutations: $i++) {
my ^permutation = @data[n2perm($i. $#data)J:
print "Opermutation\n";
}
}
# Вспомогательная функция: факториал с запоминанием
BEGIN {
my @fact = (1):
sub factorial($) {
my $n = shift:
return $fact[$n] if defined $fact[$n]:
$fact[$n] = $n * factorial($n - 1):
}
}
4.20. Программа: permute
183
# n2pat($N. $1еп) : построить $Ы-й шаблон перестановки длины $1еп
sub n2pat {
my $1 =1;
my $N = shift:
my $len = shift:
my @pat;
while ($i <= $len + 1) { # На самом деле просто while ($N) { ...
push @pat. $N % $i:
$N = int($N/$i):
$i++:
}
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); описания замыканий (closures)
Bperlsub(l) и perlref(l); рецепт 2.6; рецепт 10.3.
Хэши
«Выполнять линейный просмотр в ассоциатив-
ном массиве — все равно, что пытаться забить
кого-нибудь до смерти заряженным ,,Узи“».
Ларри Уолл
5.0. Введение
Как люди, так и части компьютерных программ взаимодействуют между собой
самым причудливым образом. Отдельные скалярные переменные похожи на от-
шельников, ведущих замкнутое существование в рамках собственной личности.
Массив напоминает партию, где множество индивидуумов объединяется под име-
нем харизматического предводителя. Где-то между ними расположилась удобная
ниша, в которой обитают совокупности связей «один-к-одному» — хэши (в старой
документации по Perl хэши часто назывались ассоциативными массивами, но тер-
мин получается слишком длинным). Аналогичные структуры данных существу-
ют и в других языках, где они обозначаются другими терминами — хэш-табли-
цы, таблицы, словари, отображения и даже a-списки, в зависимости от языка.
К сожалению, отношения в хэшах являются не равными, а подчиненными.
Если сохранить в хэше информацию о том, что начальником Ната является Тим,
то вы не сможете напрямую получить ответ на обратный вопрос: «Чьим началь-
ником является Тим?». Впрочем, поиску ответов на подобные вопросы посвящен
один из рецептов этой главы.
Однако у хэшей есть свои преимущества. В Perl хэш является встроенным
типом данных. Благодаря применению хэшей многие сложные алгоритмы сво-
дятся к простой выборке значений. Кроме того, хэши предоставляют быстрые
и удобные средства для построения индексов и таблиц просмотра.
Префикс % относится лишь к ссылкам на хэш в целом (например, %boss). Значе-
ние, ассоциированное с заданным ключом, представляет собой скалярную величи-
ну, поэтому для него используется символ $ (по аналогии с тем, как для ссылок
на отдельный элемент массива используется префикс $). Следовательно, отно-
шение «начальник Ната» должно записываться в виде $boss{"Nat"}. Ему можно
присвоить значение "Tim":
$boss{"Nat"} = "Tim";
Имена хэшей часто выбираются по названию отношения, которое в нем хра-
нится. Возможно, знак $ в предыдущем примере вас удивит, поскольку мы вроде
5.0. Введение
185
бы работаем с хэшем, а не со скаляром. Но в данном случае речь идет о задании
отдельного скалярного значения в хэше, поэтому мы используем признак ска-
лярной величины $. Скалярные величины обозначаются префиксом $, массивы —
префиксом @, а для хэшей используется префикс %.
В обычных массивах используются целочисленные индексы, но индексы хэ-
шей всегда являются строковыми. Ассоциированные значения могут быть про-
извольными скалярными величинами, в том числе ссылками. Используя ссылки
в качестве ассоциированных значений, можно создавать хэши для хранения не
только строк и чисел, но и массивов, других хэшей или объектов (вернее, ссылок
на массивы, хэши или объекты).
Хэши могут инициализироваться с помощью списков, содержащих пары
«ключ/значение»:
%age = ( "Nat". 30.
"Jules". 31.
"Josh". 23 );
Такая запись эквивалентна следующей:
$age{"Nat"} = 30;
$age{"Jules"} = 31:
$age{"Josh"} = 23;
Для упрощения инициализации хэшей был создан оператор =>. В основном
он представляет собой более наглядную замену для запятой. Например, возмож-
на следующая инициализация хэша:
&food_color = (
"Apple" => "red".
"Banana" => "yellow",
"Lemon" => "yellow".
"Carrot" => "orange"
):
(хэш %food_color используется во многих примерах этой главы). Такая инициа-
лизация также является примером списковой эквивалентности — в некоторых
отношениях хэш ведет себя так, словно он является списком пар «ключ/значе-
ние». Мы воспользуемся этим в нескольких рецептах, в частности — при объ-
единении и инвертировании.
В отличие от обычной запятой, оператор => обладает особым свойством: любое
предшествующее ему слово интерпретируется как строка. Это позволяет убрать
кавычки и сделать программу более понятной. Однословные ключи хэшей также
автоматически интерпретируются как строки, поэтому вместо $hash{"somekey"} мож-
но написать просто $hash{somekey}. Приведенная выше инициализация %food_color
записывается в следующем виде:
Uood_color = (
Apple => "red".
Banana => "yellow".
Lemon => "yellow".
Carrot => "orange"
);
186
Глава 5. Хэши
Одно из важных свойств хэшей заключается в том, что их элементы хранятся
в особой последовательности, обеспечивающей эффективную выборку. Следова-
тельно, независимо от порядка занесения данных в хэш, порядок их хранения
будет непредсказуемым.
См. также
Страница руководства perldata(\).
5.1. Занесение элемента в хэш
Проблема
Требуется добавить в хэш новый элемент.
Решение
Присвойте нужное значение в формате:
$ХЭШ[$КЛЮЧ} = ^ЗНАЧЕНИЕ:
Комментарий
Процесс занесения данных в хэш весьма тривиален. В языках, где хэш не относит-
ся к встроенным типам данных, приходится учитывать возможное переполнение,
изменение размеров и коллизии в хэш-таблицах. В Perl все проблемы решаются
обычным присваиванием. Если ключ уже занят, то есть содержит предыдущее
значение, память автоматически освобождается (по аналогии с присваиванием
скалярной переменной).
# Хэш Kood_color определяется во Введении
$food_color{Raspberry} = "pink":
print "Known foods:\n";
foreach $food (keys Uood_color) {
print "$food\n":
}
Known foods:
Banana
Apple
Raspberry
Carrot
Lemon
Если требуется не заменять существующее значение, а как-то связать с суще-
ствующим ключом несколько значений, обращайтесь к рецептам 5.8 и 11.2.
См. также
Раздел «List Value Constructors» perldata(\y, рецепт 5.2.
5.2. Проверка наличия ключа в хэше
187
5.2. Проверка наличия ключа в хэше
Проблема
Требуется узнать, содержит ли хэш конкретный ключ независимо от ассоцииро-
ванного с ним значения.
Решение
Воспользуйтесь функцией exists:
# Содержит ли ПЭШ ключ $КЛЮЧ?
if (ex1sts($X3UI{$KPI04})) {
# Ключ существует
} else {
# Ключ не существует
}
Комментарий
В следующем фрагменте функция exists проверяет, присутствует ли ключ в хэше
%food_color:
# Хэш £food_color определяется во Введении
foreach Sname ("Banana". "Martini") {
if (exists $food_color{Sname}) {
print "Sname is a food An":
} else {
print "Sname is a drink An";
}
}
Banana is a food.
Martini is a drink.
Функция exi sts проверяет только наличие ключа в хэше. Она не сообщает об
ассоциированном значении, определено ли оно, истинно или ложно. На первый
взгляд кажется, что отличия несущественны, но в действительности проблемы
такого рода плодятся быстро, как кролики. Возьмем следующий фрагмент:
&аде = О:
$age{"Toddler"} = 3:
$аде{"Unborn"} = 0;
$аде{"Phantasm"} = undef:
foreach Sthing ("Toddler", "Unborn", "Phantasm", "Relic"} {
print "Sthing: ";
print "Exists " if exists $age{$thing}:
print "Defined "if defined $age{thing}:
print "True " if $age{$thing}:
print "\n":
188
Глава 5. Хэши
Toddler: Exists Defined True
Unborn: Exists Defined
Phantasm: Exists
Relic:
Элемент $age{"Toddler"} проходит все три проверки — существования, опре-
деленности и истинности. Он существует, потому что с ключом "Toddler" в хэше
ассоциируется значение. Он определен, потому что значение не равно undef. На-
конец, он истинен, потому что присвоенная величина не является одним из лож-
ных значений Perl.
Элемент $age{"Unborn"} проходит только проверки существования и опре-
деленности. Он существует, потому что с ключом "Unborn" в хэше ассоциирует-
ся значение, и определен, потому что это значение не равно undef. Однако он не
является истинным, потому что 0 интерпретируется в Perl как одна из ложных
величин.
Элемент $age{"Phantasm"} проходит только проверку существования. Он суще-
ствует, потому что с ключом "Phantasm" в хэше ассоциируется значение. Посколь-
ку это значение представляет собой undef, проверка определенности не работает.
Так как undef также считается в Perl одним из ложных значений, проверка ис-
тинности тоже не работает.
Наконец, $age{"Relic"} не проходит ни одной из проверок. Значение для "Relic"
не заносилось в хэш, поэтому проверка на существование завершается неудачей.
Из-за отсутствия ассоциированного значения попытка обратиться к $age{"Relic"}
дает undef. Как мы знаем из примера с "Phantasm", undef не проходит проверки оп-
ределенности и истинности.
Иногда хранение undef в хэше вполне оправданно. Это означает: «такой ключ
встречается, но с ним не связано никакого полезного значения». Например, рас-
смотрим программу, которая определяет размер файлов из переданного спи-
ска. Следующий фрагмент пытается пропускать файлы, которые уже встреча-
лись в списке, однако это не касается файлов нулевой длины и встречавшихся
ранее несуществующих файлов:
^пате = ():
while (<>) {
chomp:
next if $name{$_}: # НЕВЕРНО !
$name{$_} = -s $_:
}
Замена неправильной строки следующим вызовом exi sts позволяет пропус-
кать нулевые и несуществующие файлы:
next if exists $name{$_}:
См. также
Описание функций exists и defined в perlfunc(V). Концепция истинности рас-
сматривается в разделе «Scalar Values» perldata(V).
5.3. Создание хэша с неизменяемыми ключами или значениями
189
5.3. Создание хэша с неизменяемыми
ключами или значениями
Проблема
Требуется создать хэш, ключи или значения которого не могут изменяться по-
сле присваивания.
Решение
Воспользуйтесь соответствующими функциями стандартного модуля Hash::Util:
use Hash::Util qw{ lock_keys unlock_keys
lock_value unlock_value
lock_hash unlock_hash }:
Ограничение доступа к ключам хэша с запретом создания новых ключей:
lock_keys(^hash); # Блокировка текущих ключей
lock_keys(^hash, @klist); # Блокировка ключей из списка @klist
Запрет на удаление ключа или модификацию его значения:
lock_value(^hash. $key):
Предоставление доступа к ключам и значениям только для чтения:
lock_hash(%hash):
Комментарий
Допустим, вы используете хэш для реализации записи (или объекта) с заранее
определенным набором ключей — "NAME", "RANK", "SERNO" и т. д. Обращение по
ключу, не входящему в исходный набор (например, "AMNE"), является ошибкой.
Но Perl всегда создает элементы хэша по требованию, поэтому такая ошибка не
будет обнаружена, как обнаруживаются обращения по неправильно указанному
имени переменной под действием директивы use strict.
Проблема решается при помощи функции lock_keys модуля Hash::Uti 1. После
фиксации ключей в хэш нельзя будет добавлять другие ключи, кроме заблоки-
рованных. Ключи могут еще отсутствовать в хэше, и даже если они присутству-
ют, их можно будет удалить. Запрещается лишь создание новых ключей.
Функция lock_keys не ограничивает доступ к значениям, ассоциированным
с заблокированными ключами. Чтобы значения в хэше были доступны только
для чтения, следует воспользоваться функцией lock_value. Хэш также может со-
держать заблокированные ключи, но это не обязательно, если все, что вам требу-
ется, — запретить модификацию одного или нескольких значений,
Если нужно заблокировать весь хэш, тем самым ограничив доступ как к клю-
чам, так и к значениям, воспользуйтесь функцией lock_hash.
См. также
Документация модуля Hash::Uti1.
190
Глава 5. Хэши
5.4. Удаление из хэша
Проблема
Требуется удалить элемент из хэша, чтобы он не опознавался функциями keys,
values или each. Например, если в хэше имена работников ассоциируются с окла-
дами, то после увольнения работника необходимо удалить его строку из хэша.
Решение
Воспользуйтесь функцией delete:
# Удалить $КЛЮЧ и ассоциированное значение из хэша %ХЭШ
delКЛЮЧ}):
Комментарий
Многие ошибочно пытаются удалять элементы из хэша с помощью undef —
undef ${$hash{$key} или $hash{$key} = undef. В обоих случаях в хэше остается эле-
мент с ключом $кеу и значением undef.
Функция delete — единственное средство для удаления конкретных элемен-
тов из хэша. Удаленный элемент не появится ни в списке keys, ни в итерациях
each; функция exists возвращает для него ложное значение.
Следующий фрагмент демонстрирует отличия undef от delete:
# Хэш %food_color определяется во Введении
sub print_foods {
my @foods = keys Uood_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 "InitiallyAn":
print_foods():
print "\nWith Banana undef\n";
undef $food_color{"Banana"}:
print_foods():
5.5. Перебор хэша
191
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(\.). Применение keys продемонстри-
ровано в рецепте 5.5.
5.5. Перебор хэша
Проблема
Требуется выполнить некоторые действия с каждым элементом (то есть парой
«ключ/значение») хэша.
Решение
Воспользуйтесь функцией each в цикле while:
while(($key. Svalue) = each(^HASH)) {
# Сделать что-то с $key и $value
}
Если хэш не очень велик, можно вызвать keys в цикле foreach:
foreach $key (keys &HASH) {
Svalue = $HASH{$key}:
# Сделать что-то c $key и $value
192
Глава 5. Хэши
Комментарий
Следующий простой пример перебирает элементы хэша %food_color из Введения:
# Хзш %food_color определяется во Введении
while(($food, $color) = each(£food_color)) {
print "$food is $color.\n";
}
Banana is yellow.
Apple is red.
Carrot is orange.
Lemon is yellow.
foreach $food (keys %food_color) {
my $color = $food_color{$foodj;
print "$food is $color.\n":
}
Banana is yellow.
Apple is red.
Carrot is orange.
Lemon is yellow.
В примере c foreach можно обойтись без переменной $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.
Подобное применение foreach встречается довольно часто. Функция keys
строит список ключей в хэше, после чего foreach перебирает их. Если хэш состо-
5.5. Перебор хэша
193
ит из большого числа элементов, возникает опасность, что возвращаемый keys
список займет много памяти. Таким образом, приходится выбирать между за-
тратами памяти и возможностью обработки элементов в определенном порядке.
Сортировка подробнее рассматривается в рецепте 5.10.
Поскольку функции keys, values и each используют одни и те же внутрен-
ние структуры данных, следует внимательно следить за чередованием вызовов
этих функций или преждевременным выходом из цикла each. При каждом вы-
зове keys или values текущая позиция each сбрасывается. Следующий фрагмент
зацикливается и бесконечно выводит первый ключ, возвращаемый each:
while ( ($k,$v) = each ftfood_color) {
print "Processing $k\n";
keys ftfood_color: # Возврат к началу ftfood_color
}
Модификация хэша во время его перебора в each или foreach, как прави-
ло, сопряжена с опасностью. При добавлении или удалении ключей из хэша
функция each ведет себя по-разному для связанных и несвязанных хэшей.
Цикл foreach перебирает заранее построенный список ключей, поэтому по-
сле начала цикла он ничего не знает о добавленных или удаленных ключах.
Ключи, добавленные внутри цикла, не включаются автоматически в список
перебираемых ключей, а удаленные внутри цикла ключи не удаляются из это-
го списка.
Программа countfrom из примера 5.1 читает файл почтового ящика и выводит
количество сообщений от каждого отправителя. Отправитель определяется по
строке From: (в этом отношении сценарий не очень интеллектуален, однако нас
сейчас интересуют операции с хэшами, а не обработка почтовых файлов). Пере-
дайте имя почтового ящика в командной строке или используйте " -" для пере-
направления (когда Perl открывает файл с именем " -" для чтения с менее чем
тремя аргументами, используется текущий стандартный ввод).
Пример 5.1. countfrom
#!/usr/bin/perl
# countfrom - подсчет сообщений от каждого отправителя
$filename = $ARGV[O] || означает стандартный ввод
open(FII_E. "< $filename") or die "Can't open $filename : $!":
while(<FILE>) {
if (/"From: (.*)/) { $from{$1}++ }
}
foreach $person (sort keys ftfrom) {
print "$person: $from{$person}\n";
}
См. также
Описание функций each и keys в perlfunc(\y, описание циклов for и foreach в ре-
цепте 4.6.
194
Глава 5. Хэши
5.6. Вывод содержимого хэша
Проблема
Требуется вывести содержимое хэша, однако конструкции print "%hash" и print
%hash не работают. Первая является обычным литералом, а вторая просто выво-
дит подряд все ключи и значения.
Решение
Одно из возможных решений — перебрать все пары «ключ/значение» в хэше
(см. рецепт 5.5) и вывести их:
while ( ($k,$v) = each £hash) {
print "$k => $v\n":
}
Также можно построить список строк с помощью тар:
print тар { "$_ => $hash{$_}\n" } keys &hash;
Или воспользуйтесь приемом из рецепта 1.15 и интерполируйте хэш как список:
print "@{[ £hash ]}\п";
Или сохраните хэш во временном массиве и выведите его:
{
my @temp = &hash;
print "@temp":
}
Комментарий
Все перечисленные приемы обладают различными возможностями по управле-
нию порядком и форматированием вывода, а также различной эффективностью.
Первый способ (перебор хэша) чрезвычайно гибок и эффективен по затратам
памяти. Вы можете как угодно форматировать выходные данные, при этом пона-
добится всего две скалярные переменные — текущий ключ и значение. Цикл
foreach позволяет вывести хэш с упорядочением ключей (ценой построения от-
сортированного списка):
foreach $k (sort keys %hash) {
print "$k => $hash{$k}\n";
}
Функция map не уступает перебору по богатству возможностей. Сортировка
ключей по-прежнему позволяет работать с элементами в произвольном порядке.
Выходные данные можно как угодно форматировать. На этот раз создается спи-
сок строк (например, "КЛЮЧ=>ЗНАЧЕНИЕ\п", как в приведенном выше примере), пе-
редаваемый print.
Два последних приема представляют собой фокусы из области интерполяции.
Интерпретация хэша как списка не позволяет предсказать или управлять поряд-
5.7. Перебор элементов хэша в порядке вставки
195
ком вывода пар «ключ/значение». Более того, данные в этом случае выводятся
в виде списка ключей и значений, элементы которого разделяются текущим
содержимым переменной $". В отличие от других приемов, вам не удастся вывес-
ти каждую пару на новой строке или отделить ключи от значений символом =>.
Другое решение основано на выводе хэша в списковом контексте после вре-
менной локализации переменной $, и ее инициализации пробелом:
{
local
print %hash;
}
Этот вариант напоминает решение с копированием в массив и его последую-
щей интерполяцией, но при нем содержимое хэша не дублируется вдвое чаще
необходимого (сначала для массива, потом для строки).
Модуль Dumpvalue, описанный в рецепте 11.11, помогает получить красиво
оформленные выходные данные, а также делает многое другое. Пример:
use Dumpvalue:
$dumper = Dumpvalue->new;
$dumper->dumpValue(Ufood_color):
'Apple' => 'red'
'Banana' => 'yellow'
'Carrot' => 'orange'
'Lemon' => 'yellow'
См. также
Описание переменных $" и $, в perlvar(l)\ описание функций foreach, map, keys,
sort и each в perlfunc(l). Интерполяция в строках рассматривается в рецепте 1.15,
а методика перебора хэша — в рецепте 5.5.
5.7. Перебор элементов хэша
в порядке вставки
Проблема
Функции keys и each извлекают элементы хэша в довольно странном порядке.
Вы хотите получить элементы в том порядке, в котором они заносились в хэш.
Решение
Воспользуйтесь модулем Tie:: IxHash.
use Tie::IxHash:
tie ИЭШ. "Tie::IxHash":
# Операции с хзшем ИЭШ
@keys = keys ИЭШ: # Массив @keys отсортирован в порядке вставки
196
Глава 5. Хэши
Комментарий
Модуль 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_col or{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.
См. также
Документация по модулю CPAN Tie:: IxHash; рецепт 13.5.
5.8. Хэши с несколькими ассоциированными
значениями
Проблема
Требуется хранить в хэше несколько значений, ассоциированных с одним ключом.
Решение
Сохраните в $hash{$key} ссылку на массив, затем сохраните значения в массиве.
5.8. Хэши с несколькими ассоциированными значениями
197
Комментарий
В хэше могут храниться только скалярные величины. Однако ссылки явля-
ются скалярными величинами. Таким образом, проблема решается сохранением
в $hash{$key} ссылки на массив со значениями, ассоциированными с ключом $кеу.
Обычные операции с хэшами — вставка, удаление, перебор и проверка сущест-
вования — переписываются для операций с массивами (push, splice и foreach).
Следующий фрагмент демонстрирует простую вставку в хэш. Он обрабаты-
вает выходные данные команды who(l) на компьютере с Unix и выводит крат-
кий список пользователей с терминалами, на которых они зарегистрированы:
Htys = ();
open(WHO, "whoI") or die "can't open who: $!":
while (<WHO>) {
($user, $tty) = split;
push( @{$ttys{$user}}, $tty ):
}
foreach $user (sort keys Htys) {
print "$user: @{$ttys{$user}}\n";
}
Вся суть этого фрагмента заключена в строке push, где содержится версия
$ttys{$user} = $tty для многозначного хэша. Изначально ассоциированное зна-
чение не определено, поэтому Perl автоматически создает новый анонимный мас-
сив и сохраняет ссылку на него в значении, чтобы вызов push завершился успешно.
Все имена терминалов интерполируются конструкцией @{$ttys{user}} в стро-
ке print. Если бы, например, нам потребовалось вывести владельца каждого тер-
минала, мы бы организовали перебор анонимного массива:
foreach $user (sort keys Utys) {
print "$user: ". scalar( @{$ttys{$user}} ). "ttysAn";
foreach $tty (sort @{$ttys{$user}}) {
@stat = stat('7dev/$tty"):
$user = @stat ? ( getpwu1d($stat[4]) )[0] : "(not available)";
print "\t$tty (owned by $user)\n";
}
}
Функция exists может иметь две интерпретации: «Существует ли в хэше
хотя бы одно значение для данного ключа?» и «Существует ли данное значение
для данного ключа?». Чтобы реализовать вторую интерпретацию, придется про-
смотреть массив в поисках нужной величины. Первая трактовка exl sts косвенно
связана с функцией delete: если мы можем гарантировать, что ни один аноним-
ный массив никогда не остается пустым, можно воспользоваться встроенной
функцией exists. Чтобы убедиться, что анонимные массивы не остаются пусты-
ми, их следует проверять после удаления элемента:
sub multihash_delete {
my {$hash, $key. $value) =
my $1;
198
Глава 5. Хэши
return unless ref( $hash->{$key} ):
for ($1 = 0: $1 < @{ $hash->{$key} }: $i++) {
If ($hash->{$key}->[$1] eq $value) {
splice( @{$hash->{$key}}, $1, 1);
last;
}
}
delete $hash->{$key} unless @{$hash->{$key}};
}
Альтернативная реализация многозначных хэшей приведена в главе 13 «Клас-
сы, объекты и связи», где они реализуются как связанные обычные хэши.
См. также
Описание функций splice, delete, push, foreach и exists вperlfunc(l); рецепт 11.1.
Связи рассматриваются в рецепте 13.15.
5.9. Инвертирование хэша
Проблема
Хэш связывает ключ с ассоциированным значением. У вас имеется хэш и значе-
ние, для которого требуется определить ключ.
Решение
Воспользуйтесь функцией reverse для создания инвертированного хэша, где ассо-
циированные значения исходного хэша являются ключами, и наоборот.
# ЖХЭШ связывает ключи со значениями
ХОБРАТНЫЙ = reverse ХХЭШ;
Комментарий
В этом решении используется списковая эквивалентность хэшей, о которой упо-
миналось во Введении. В списковом контексте reverse интерпретирует ХХЭШ
как список и меняет местами составляющие его элементы. Одно из важнейших
свойств списковой интерпретации хэша заключается в том, что элементы списка
представляют собой пары «ключ/значение». После инвертирования такого спи-
ска первым элементом становится значение, а вторым — ключ. Если интерпре-
тировать такой список как хэш, то его значения будут являться ключами исход-
ного хэша, и наоборот.
Рассмотрим пример:
^surname = ( "Mickey” => "Mantle". "Babe" => "Ruth");
%first_name = reverse ^surname;
print $first_name{"Mantie", "\n";
Mickey
5.9. Инвертирование хэша
199
Если интерпретировать ^surname как список, мы получим следующее:
("Mickey", "Mantle", "Babe", "Ruth")
(а может быть, ("Babe", "Ruth", "Mickey", "Mantle"), поскольку порядок элемен-
тов непредсказуем). После инвертирования список выглядит так:
("Ruth", "Babe". "Mantle", "Mickey")
Интерпретация его в качестве хэша дает следующее:
("Ruth" => "Babe", "Mantle" => "Mickey")
В примере 5.2 приведена программа foodfind. Если передать ей название про-
дукта, она сообщает цвет, а если передать цвет — она сообщает название.
Пример 5.2. foodfind
# !/usr/bin/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 yellow foods.n":
Banana Lemon were yellow foods.
Кроме того, это позволит модифицировать программу foodfind так, чтобы она
работала с цветами, соответствующими сразу нескольким продуктам. Например,
при вызове foodfind yellow будут выводиться и Banana, и Lemon.
200
Глава 5. Хэши
Если какие-либо значения исходного хэша были не простыми строками и чис-
лами, а ссылками, при инвертировании возникает проблема — ссылки не могут
использоваться в качестве ключей, если только вы не воспользуетесь модулем
Tie::RefHash (см. рецепт 5.12).
См. также
Описание функций reverse в perlfunc(iy рецепт 13.15.
5.10. Сортировка хэша
Проблема
Требуется работать с элементами хэша в определенном порядке.
Решение
Воспользуйтесь функцией keys для построения списка ключей, а затем отсорти-
руйте их в нужном порядке:
# &hash - сортируемый хзш
@keys = sort { crlterlonO } (keys %hash):
foreach $key (@keys) {
$value = $hash{$key}:
# Сделать что-то c $key, $value
Комментарий
Хотя хранить элементы хэша в заданном порядке невозможно (без использова-
ния модуля Tie: IxHash, упомянутого в рецепте 5.7), перебирать их можно в лю-
бом порядке.
Существует множество разновидностей одного базового механизма: вы извле-
каете ключи, упорядочиваете их функцией 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}An";
}
5.11. Объединение хэшей
201
Наконец, сортировка выполняется по длине ассоциированных значений:
@foods = sort {
1 ength($food_color{$a}) <=> length($food_color{$b})
} keys %food_color:
foreach Stood (@foods) {
print "Stood is $tood_color{$tood}.\n":
}
См. также
Описание функций sort и keys в perlfunc(l)', рецепт 5.7. Сортировка списков
рассматривается в рецепте 4.16.
5.11. Объединение хэшей
Проблема
Требуется создать новый хэш, содержащий элементы двух существующих хэшей.
Решение
Интерпретируйте хэши как списки и объедините их так, как это делается со
списками:
Emerged = (%А. ЯВ):
Для экономии памяти можно организовать перебор элементов и построить
новый хэш следующим образом:
Emerged = О:
while ( (Sk.Sv) = each(^A) ) {
$merged{$k} = Sv:
}
while ( (Sk.Sv) = eachCT) ) {
$merged{$k} = Sv:
}
Комментарий
В первом варианте, как и в предыдущем рецепте инвертирования хэшей, исполь-
зуется списковая эквивалентность, о которой говорилось во Введении. Конст-
рукция (%/\, W) интерпретируется как список пар «ключ/значение». Когда список
присваивается объединенному хэшу Emerged, Perl преобразует список пар снова
в хэш.
Рассмотрим, как эта методика реализуется на практике:
# Хзш %tood_color определяется во Введении
%drink_color = ( Galliano => "yellow".
"Mai Tai" => "blue" );
%ingested_colors = (%drink_color. %tood_color):
202
Глава 5. Хэши
Ключи обоих входных хэшей встречаются в выходном не более одного раза.
Если в хэшах найдутся совпадающие ключи, в итоговый хэш включается тот
ключ, который встретился последним.
Прямое присваивание компактно и наглядно, но при больших размерах хэшей
оно приводит к значительным расходам памяти. Это связано с тем, что перед вы-
полнением присваивания итоговому хэшу Perl разворачивает оба хэша во времен-
ный список. Пошаговое объединение с помощью each, показанное ниже, избавит вас
от этих затрат. Заодно вы сможете решить, как поступать с совпадающими ключами.
С применением each первый фрагмент записывается следующим образом:
# Хэш Xfood_color определяется во Введении
Sdr1nk_color = ( Galliano => "yellow",
"Mai Tai" => "blue" );
Ssubstance_color = ();
while (($k, Sv) = each Sfood_color) {
$substance_color{$k} = Sv:
while (($k, Sv) = each Sdr1nk_color) {
$substance_color{$k} = Sv;
В этом решении дублируются циклы while с присваиванием. Следующий об-
ходной путь позволяет избавиться от дублирования:
foreach Ssubstanceref (\Sfood_color, \Sdr1nk_color ) {
while (($k. Sv) = each Ssubstanceref) {
$substance_color{$k} = $v;
}
}
Если в объединяемых хэшах присутствуют одинаковые ключи, можно вста-
вить код для обработки дубликатов:
foreach Ssubstanceref (\Sfood_color, \Sdr1nk_color ) {
while (($k, Sv) = each Ssubstanceref) {
If (exists $substance_color{$k}) {
print "Warning: $k seen twice. Using the first definition.\n":
next:
}
$substance_color{$k} = Sv:
В частном случае присоединения одного хэша к другому можно воспользо-
ваться срезом для получения более элегантной записи:
@all_colors{keys Snew_colors} = values Snew_colors:
Данное решение требует памяти в объеме, достаточном для хранения списков
всех ключей и значений Snew_colors. Как и в первом варианте, расходы памяти
при очень большом размере списков могут сделать этот способ неприемлемым.
См. также
Рецепт 4.10 (разновидностью которого является этот рецепт); описание функ-
ции each в perlfunc(X).
5.12. Поиск общих или различающихся ключей в двух хэшах
203
5.12. Поиск общих или различающихся
ключей в двух хэшах
Проблема
Требуется найти в хэше ключи, присутствующие в другом хэше или, наоборот,
не входящие в другой хэш.
Решение
Организуйте перебор ключей хэша с помощью функции keys и проверяйте, при-
сутствует ли текущий ключ в другом хэше.
О Поиск общих ключей:
ту @соттоп = ():
foreach (keys Xhashl) {
push(@common, $_) If exists $hash2{$_}:
}
# Ocommon содержит общие ключи
О Поиск ключей, отсутствующих в другом хэше:
my @th1s_not_that = О;
foreach (keys Xhashl) {
push(@th1s_not_that. $_) unless exists $hash2{$_}:
}
Комментарий
При поиске общих или различающихся ключей хэшей можно воспользоваться
рецептами для поиска общих или различающихся элементов в массивах ключей
хэшей. За подробностями обращайтесь к рецепту 4.8.
В следующем фрагменте поиск различающихся ключей применяется для на-
хождения продуктов, не входящих в хэш с описаниями цитрусовых:
# Хэш £food_color определяется во Введении
# Xcitrus_color - хэш. связывающий названия цитрусовых с их цветом
£dtrus_color = (Lemon => "yellow".
Orange => "orange".
Lime => "green" );
# Построить список продуктов, не входящих в хэш цитрусовых
@non-citrus = ();
foreach (keys Xfood_color) {
push (@non_citrus. $_) unless exists $c1trus_color{$_};
}
См. также
Описание функции each в perlfunc(\). Срезы хэшей рассматриваются в perldata(V).
204
Глава 5. Хэши
5.13. Хэширование ссылок
Проблема
Если функция keys вызывается для хэша, ключи которого представляют собой
ссылки, то возвращаемые ею ссылки не работают. Подобная ситуация часто воз-
никает при создании перекрестных ссылок в двух хэшах.
Решение
Воспользуйтесь модулем Tie::RefHash:
use Tie::RefHash;
tie £hash, "Tie::RefHash";
# Теперь в качестве ключей хэша %hash можно использовать ссылки
Комментарий
Ключи хэшей автоматически преобразуются в строки — то есть интерпретиру-
ются так, словно они заключены в кавычки. Для чисел и строк при этом ничего
не теряется. Однако со ссылками дело обстоит иначе.
После преобразования в строку ссылка принимает следующий вид:
Class::Somewhere=HASH(0x72048)
ARRAY(0x72048)
Преобразованную ссылку невозможно вернуть к прежнему виду, поскольку
она перестала быть ссылкой и превратилась в обычную строку. Следовательно,
при использовании ссылок в качестве ключей хэша они теряют свои «волшеб-
ные свойства».
Для решения этой проблемы обычно создается специальный хэш, ключами
которого являются ссылки, преобразованные в строки, а значениями — настоя-
щие ссылки. Именно это и происходит в модуле Tie::RefHash. Мы воспользуемся
объектами ввода/вывода для работы с файловыми манипуляторами и покажем,
что даже такие странные ссылки могут использоваться для индексации хэша,
связанного с Tie::RefHash.
Приведем пример:
use Tie::RefHash;
use 10::Fi1e;
tie £name, "Tie;:RefHash";
foreach Sfilename ("/etc/termcap","/vmunix", "/bin/cat") {
$fh = 10::F11e->(”< Sfilename") or next:
$name{$fh} = Sfilename;
}
print "open files: ", joint", values £name", "\n":
foreach Sfile (keys £name) {
seek($file, 0, 2): # Позиционирование в конец файла
printfC'^s is bytes longAn", $name{Sfile}, tell (Sfile)):
5.14. Предварительное выделение памяти для хэша
205
Однако вместо применения объекта в качестве ключа хэша почти всегда луч-
ше использовать какой-нибудь уникальный атрибут объекта (например, имя
или идентификатор).
См. также
Документация по стандартному модулю Tie::RefHash; раздел «Warning» perlreffX).
5.14. Предварительное выделение
памяти для хэша
Проблема
Требуется заранее выделить память под хэш, чтобы ускорить работу програм-
мы — в этом случае Perl не придется выделять новые блоки при каждом добав-
лении элемента. Окончательный размер хэша часто бывает известен в начале
построения, и эта информация пригодится для ускорения работы программы.
Решение
Присвойте количество пар «ключ/значение» конструкции keys(%hash):
# Выделить в хэше %hash память для $num элементов.
keys(Xhash) = $niim;
Комментарий
Эта возможность может положительно повлиять на быстродействие вашей про-
граммы (хотя это и не гарантировано). В хэшах Perl и так применяются общие
ключи, поэтому при наличии хэша с ключом "Apple" Perl уже не выделяет память
под другую копию "Apple" при включении этого ключа в другой хэш.
# В Xusers резервируется место для 512 элементов.
keys(^users) = 512:
Внутренние структуры данных Perl требуют, чтобы количество ключей было
равно степени 2. Если написать:
keys(Xusers) = 1000:
Perl выделит для хэша 1024 «гнезда». Количество ключей не всегда равно коли-
честву гнезд. Совпадение обеспечивает оптимальное быстродействие, однако кон-
кретное соответствие между ключами и гнездами зависит от ключей и внутрен-
него алгоритма хэширования Perl.
См. также
Описание функции keys в perlfunc(\)\ рецепт 4.3.
206
Глава 5. Хэши
5.15. Поиск самых распространенных
значений
Проблема
Имеется сложная структура данных (например, массив или хэш). Требуется уз-
нать, как часто в ней встречается каждый элемент массива (или ключ хэша). До-
пустим, в массиве содержатся сведения о транзакциях веб-сервера, и вы хотите
узнать, какой файл запрашивается чаще остальных. Или для хэша, в котором
имя пользователя ассоциируется с количеством регистраций в системе, требует-
ся определить наиболее распространенное количество регистраций.
Решение
Воспользуйтесь хэшем и подсчитайте, сколько раз встречается тот или иной
элемент, ключ или значение:
Scount = О;
foreach Selement (©array) {
Scount{$element}++;
}
Комментарий
Каждый раз, когда возникает задача подсчета различных объектов, вероятно,
стоит воспользоваться хэшем. В приведенном выше цикле foreach для каждого
экземпляра Selement значение Scount{Selement} увеличивается на 1.
См. также
Рецепты 4.7 и 4.8.
5.16. Представление отношений
между данными
Проблема
Требуется представить отношения между данными, например, отношения «пре-
док/потомок» в генеалогическом дереве или «родитпелъский/пороэ1сденный про-
цесс» в таблице процессов. Задача тесно связана с представлением таблиц в реля-
ционных базах данных (отношения между записями) и графов в компьютерных
технологиях (отношения между узлами графа).
Решение
Воспользуйтесь хэшем.
5.16. Представление отношений между данными
207
Комментарий
Следующий хэш представляет часть генеалогического дерева из Библии:
^father = ( 'Cain' => 'Adam'.
'Abel' => 'Adam1.
'Seth' => 'Adam',
'Enoch' => 'Cain',
'lead' => 'Enoch',
'Mehujael' => 'lead',
'Methusael' => 'Mehujael',
'Lamech' => 'Methusael'.
'Jabal' => 'Lamech'.
'Jubal' => 'Lamech',
'Tubalcain' => 'Lamech',
'Enos' => 'Seth' ):
Например, мы можем легко построить генеалогическое дерево любого персонажа:
while (<>) {
chomp:
do {
print ": # Вывести текущее имя
$_ = $father{$_}: # Присвоить $_ отца $_
} while defined; # Пока отцы находятся
print "\п":
}
Просматривая хэш ^father, можно отвечать на вопросы типа: «Кто родил Сета?»
При инвертировании хэша отношение заменяется противоположным. Это позво-
ляет использовать рецепт 5.9 для ответов на вопросы типа: «Кого родил Ламех?»
while ( ($k, Sv) = each ^father ) {
push( @{ $children{$v} }, $k ):
# Выходные данные разделяются запятыми
while (<>) {
chomp:
if ($children{$_}) {
©children = @{$children{$_}}:
} else {
©children = "nobody":
}
print "$_ begat @children.\n";
}
Хэши также могут представлять такие отношения, как директива find ude язы-
ка С — А включает В, если А содержит #1 ncl ude В. Следующий фрагмент строит
хэш (он не проверяет наличие файлов в /usr/1 ncl ude, как следовало бы, но этого
можно добиться ценой минимальных изменений):
foreach $file (©files) {
local *FH:
unless (open (F. "< Sfile")) {
warn "Couldn’t read file: $!: skipping.\n":
next:
}
208
Глава 5. Хэши
while (<FH>) {
next unless /*\s*#\s*include\s*<([*>]+)>/:
push(@{$1ncludes{$1}}, $file):
close FH:
Другой фрагмент проверяет, какие файлы не включают других файлов:
@1nclude_free = О; # Список файлов, не включающих других файлов
@uniq{map { } values ^includes} = undef:
foreach $file (sort keys £uniq) {
push( @include_free , Sfile ) unless $1ncludes{$fi1e};
Значения ^includes представляют собой анонимные массивы, поскольку один
файл может включать (и часто включает) сразу несколько других файлов. Мы
используем тар для построения большого списка всех включенных файлов и уда-
ляем дубликаты с помощью хэша.
См. также
Рецепт 4.7; описание более сложных структур данных в рецептах 11.9-11.14.
5.17. Программа: dutree
Программа dutree (см. пример 5.3) преобразует выходные данные du:
% du cookbook
19 pcb/fix
20 pcb/rev/maybe/yes
10 pcb/rev/maybe/not
705 pcb/rev/maybe
54 pcb/rev/web
1371 pcb/rev
3 pcb/pending/mine
1016 pcb/pending
2412 pcb
в отсортированную иерархическую структуру с расставленными отступами:
2412 pcb
1371 rev
705 maybe
675 .
20 yes
10 not
| 612 .
| 54 web
1016 pending
1013 .
3 mine
19 fix
6 .
5.17. Программа: dutree
209
Аргументы передаются программе dutree через du. Это позволяет вызвать
dutree любым из приведенных ниже способов, а может быть, и иначе — если
ваша версия du поддерживает другие параметры.
% dutree
X dutree /usr
X dutree -a
% dutree -a /bln
Хэш Wlrslze сопоставляет имена с размерами файлов. Например, значение
$D1 rslze{ "pcb"} в нашем примере равно 2412. Этот хэш используется как для вы-
вода, так и для сортировки подкаталогов каждого каталога по размерам.
Хэш ЯК1 ds представляет больший интерес. Для любого пути Spath значение
$K1ds{path} содержит (ссылку на) массив с именами подкаталогов данного катало-
га. Так, элемент с ключом "pcb" содержит ссылку на анонимный массив со стро-
ками "fix", "rev" и "pending". Элемент "rev" содержит строки "maybe" и "web". В свою
очередь, элемент "maybe" содержит "yes" и "по", которые не имеют собственных
элементов, поскольку являются «листами» (конечными узлами) дерева.
Функции output передается начало дерева — последняя строка, прочитанная
из выходных данных du. Сначала функция выводит этот каталог и его размер,
затем сортирует его подкаталоги (если они имеются) так, чтобы подкаталоги
наибольшего размера оказались наверху. Наконец, output вызывает саму себя,
рекурсивно перебирая все подкаталоги. Дополнительные аргументы использу-
ются при форматировании.
Программа получается рекурсивной, поскольку рекурсивна сама файловая
система. Однако ее структуры данных не рекурсивны — по крайней мере, не в том
смысле, в котором рекурсивны циклические связанные списки. Каждое ассоции-
рованное значение представляет собой массив ключей для дальнейшей обработ-
ки. Рекурсия проявляется в обработке, а не в способе хранения.
Пример 5.3. dutree
# ! /usr/Ыn/perl -w
# dutree - печать сортированного иерархического представления
# выходных данных du
use strict:
my Wlrslze;
my XKIds:
getdots(my Stopdir = InputO):
output(Stopdir);
# Запустить du. прочитать входные данные, сохранить размеры и подкаталоги
# Вернуть последний прочитанный каталог (файл?)
sub Input {
my($s1ze. Sname. Sparent):
@ARGV = ("du @ARGV |"): # Подготовить аргументы
while (<>)
(Sslze. Sname) = split:
$D1rs1ze{$name} = Sslze:
(Sparent = Sname) =~ s#/C*/]+$##: # Имя каталога
продолжение &
210
Глава 5. Хэши
Пример 5.3 (продолжение)
push @{ $K1ds{$parent} }, Sname unless eof:
return Sname;
# Рассчитать, сколько места занимают файлы каждого каталога,
# не находящиеся в подкаталогах. Добавить новый фиктивный
# подкаталог с именем ", содержащий полученную величину,
sub getdots {
my Sroot = $_[0];
my($s1ze, Scurslze);
Ssize = Scurslze = $Dirsize{$root};
if (SKI ds{Sroot}) {
for my Skid (@{ $Kids{$root} }) {
Scurslze -= $D1rslze{Skid}:
getdots(Skid);
}
if (Ssize != Scursize) {
my Sdot = "Sroot/.";
$D1rsize{$dot} = Scursize;
push @{ $K1ds{$root} }, Sdot;
}
# Рекурсивно вывести все данные,
# передавая при рекурсивных вызовах
# выравнивающие пробелы и ширину числа
sub output {
my($root, Sprefix, Swidth) = (shift, shift || 'shift || 0);
my Spath;
(Spath = Sroot) =~ s#.*/##; # Базовое имя
my Ssize = $D1rsize{Sroot};
my $1 ine = sprintf("X${width}d Xs", Ssize, Spath);
print Sprefix, Sline. "\n";
for (Sprefix .= Sline) { # Дополнительный вывод
s/\d /| /;
s/ГЦ/ /g;
if (SKI ds{Sroot}) { # Узел имеет подузлы
my @Kids = @{ $Kids{$root} };
©Kids = sort { $Dirsize{$b} <=> $D1rsize{$a} } ©Kids;
$Dirsize{$Kids[O]} =~ /(\d+)/:
my Swidth = length $1;
for my Skid (©Kids) { output($kid. Sprefix, Swidth) }
}
До того как в Perl появилась прямая поддержка хэшей массивов, эмуляция
подобных конструкций высшего порядка требовала титанических усилий. Неко-
торые программисты использовали многократные вызовы split и join, но это ра-
ботало чрезвычайно медленно.
5.17. Программа: dutree
211
В примере 5.4 приведена версия программы dutree из тех далеких дней. По-
скольку у нас не было прямых ссылок на массивы, приходилось самостоятельно
залезать в символьную таблицу Perl. Программа на ходу создавала переменные
с жутковатыми именами. Удастся ли вам определить, какой хэш используется
этой программой?
Массив @{"pcb"} содержит ссылку на анонимный массив, содержащий "pcb/fix",
"pcb/rev" и "pcb/pendlng". Массив @{"pcb/rev"} содержит "pcb/rev/maybe" и "pcb/
rev/web". Массив @{"pcb/rev/maybe"} содержит "pcb/rev/yes" и "pcb/rev/not".
Когда вы присваиваете *kid что-нибудь типа "pcb/fix", строка в правой части
преобразуется в тип-глоб. ©kid становится синонимом для @{"pcb/fix"}, но это
отнюдь не все. &kid становится синонимом для &{"pcb/fix"} и т. д.
Если эта тема покажется неинтересной, подумайте, как local использует ди-
намическую область действия глобальных переменных, чтобы избежать переда-
чи дополнительных аргументов. Заодно посмотрите, что происходит с перемен-
ной $wi dth в процедуре output.
Пример 5.4. dutree-org
#!/usr/bi n/perl
# dutree_orig: старая версия, которая появилась
# до выхода perl5 (начало 90-х)
©lines = 'du @ARGV';
chop(@l1nes);
&1nput($top = pop ©lines):
&output($top):
exit;
sub Input {
local(Sroot, *kid, $him) = @_[0,0];
while (©lines && &childof(Sroot, $11nes[$#l1nes])) {
&1nput($h1m = рор(©11nes)):
push(@k1d. $h1m):
1}
if (@kid) {
local(Smysize) = (Sroot =~ /*(\d+)/);
for (©kid) { Smyslze -= (/*(\d+)/)[0]; }
push(©k1d, "Smyslze .") If Sslze != Smyslze;
}
@kid = &sizesort(*kid);
}
sub output {
locaKSroot, *kid, Spreflx) = @_[0,0,l];
local (Sslze, Spath) = splitC 1, Sroot):
Spath =~ s!.*/!!:
Sllne = sprlntf("£${w1dth}d fcs". Sslze. Spath);
print Spreflx, $1Ine, "\n";
Spreflx .= Sllre;
Spreflx =~ s/\d /| /;
Spreflx =~ s/[A|]/ /g;
local (Swldth) = Sk1d[0] =~ /(\d+)/ && lengthCSl");
for (©kid) { &output($_, Spreflx); };
}
продолжение &
212
Глава 5. Хэши
Пример 5.4 (продолжение)
sub sizesort {
local(*list, @1ndex) = shift:
sub bynum { $index[$b] <=> $index[$a]; }
for (@list) { push(@index, /(\d+)/): }
@listCsort bynum O..$#list];
}
sub childof {
local(@pair) =
for (@pair) { s/A\d+\s+//g: s/$/\//; }
index($pair[l], $pair[0]) >= 0:
}
Итак, какой же хэш используется старой программой dutree? Правильный
ответ — Жта1 п::, то есть символьная таблица Perl. Не стоит и говорить, что эта
программа не будет работать с use strict. Мы рады сообщить, что новая версия
работает втрое быстрее старой. Дело в том, что старая версия постоянно ищет
переменные в символьной таблице, а новая обходится без этого. Кроме того, нам
удалось избежать медленных вызовов split для занимаемого места и имени ката-
лога. Однако мы приводим и старую версию, поскольку она весьма поучительна.
Поиск по шаблону
«Искусство — это шаблон, наполняемый разумом».
Сэр Герберт Рид, «Значение Искусства»
6.0. Введение
В большинстве современных языков программирования существуют прими-
тивные средства поиска по шаблону (обычно вынесенные в дополнительные
библиотеки), но шаблоны Perl интегрируются на уровне самого языка. Они
обладают возможностями, которыми не могут похвастаться другие языки; воз-
можностями, которые позволяют взглянуть на данные с принципиально новой
точки зрения. Подобно тому как шахматист воспринимает расположение фигур
на доске как некий образ, адепты Perl рассматривают данные с позиций шаб-
лонов. Шаблоны записываются на языке регулярных выражений1, обладающем
чрезвычайно высокой смысловой насыщенностью, и позволяют работать с мощны-
ми алгоритмами, обычно доступными лишь экспертам в области компьютерных
технологий.
«Если поиск по шаблону — такая потрясающая и мощная штука, — спросите
вы, — то почему же эта глава не содержит сотни рецептов по применению ре-
гулярных выражений?». Да, регулярные выражения обеспечивают естествен-
ное решение многих проблем, связанных с числами, строками, датами, веб-до-
кументами, почтовыми адресами и буквально всем, что встречается в этой книге.
В других главах поиск по шаблону применяется свыше 100 раз. А в этой главе
в основном представлены те рецепты, в которых шаблоны являются частью
вопроса, а не ответа.
Обширная, интегрированная поддержка регулярных выражений в Perl озна-
чает, что в вашем распоряжении оказываются не только те средства, которые не
встречаются ни в одном другом языке, но и принципиально новые возможности
их использования. Программисты, недавно познакомившиеся с Perl, часто ищут
в нем функции поиска и подстановки:
match( ^строка, $шаблон);
subst( ^строка, ^шаблон, ^замена):
1 Строго говоря, шаблоны Perl по своим возможностям значительно опережают обычные
регулярные выражения в классическом понимании этого термина.
214
Глава 6. Поиск по шаблону
Однако поиск и подстановка — настолько распространенные задачи, что они
заслуживают собственного синтаксиса:
$meadow =~ m/sheep/: # Истинно, если $meadow содержит "sheep"
$meadow !~ m/sheep/; # Истинно, если $meadow не содержит "sheep"
$meadow =~ s/old/new; # Заменить в Smeadow "old" на "new"
Поиск по шаблону даже в упрощенном виде не похож на обычные строковые
сравнения. Он больше похож на поиск строк с применением универсальных
символов-мутантов, к тому же накачанных допингом. Без специального «якоря»
позиция, в которой ищется совпадение, свободно перемещается по всей строке.
Допустим, если вы захотите найти слово ovine или ovlnes и воспользуетесь выра-
жением $meadow =~ /ovine/, то в каждой из следующих строк произойдет ложное
совпадение:
Fine bovlnes demand fine toreadors.
Muskoxen are a polar ovlbovine species.
Grooviness went out of fashion decades ago.
Иногда нужная строка находится прямо у вас перед глазами, а совпадения
все равно не происходит:
Ovlnes are found typically In ovlarles.
Проблема в том, что вы мыслите категориями человеческого языка, а ме-
ханизм поиска по шаблону — нет. Когда этот механизм получает шаблон /ovine/
и другую строку, в которой происходит поиск, он ищет в строке символ "о", за
которым сразу же следует "v", затем "1", "п" и "е". Все, что находится до этой по-
следовательности символов или после нее, не имеет значения. Вдобавок поиск
производится с точным соблюдением регистра символов, поэтому в последнем
примере не была найдена подстрока "Ovlnes", начинающаяся с прописной буквы.
Итак, выясняется, что шаблон находит совпадения там, где они не нужны,
и не узнает то, что действительно нужно. Придется усовершенствовать его. На-
пример, для поиска последовательности ovine или ovlnes шаблон должен выгля-
деть примерно так:
If ($meadow =~ /\bovines?\b/1) { print "Here be sheep!" }
Шаблон начинается co метасимвола \b, который совпадает только с границей
слова1, s? обозначает необязательный символ s — он позволяет находить как
ovine, так и ovlnes. Модификатор /1 в конце шаблона означает, что поиск осуще-
ствляется без учета регистра.
Как видите, некоторые символы и последовательности символов имеют осо-
бый смысл для механизма поиска по шаблону (и называются метасимволами).
Метасимволы фиксируют шаблон в начале или конце строки, описывают аль-
тернативные значения для частей шаблона, организуют повторы и позволяют
запомнить часть найденной подстроки, чтобы в дальнейшем использовать ее
в шаблоне или в программном коде.
Освоить синтаксис поиска по шаблону не так уж сложно. Конечно, служеб-
ных символов много, но существование каждого из них объясняется вескими
1 Конечно, речь идет о «слове» в понимании Perl.
6.0. Введение
215
причинами. Регулярное выражение — это не просто беспорядочная груда зна-
ков... это тщательно продуманная груда знаков! Если вы что-нибудь забыли, всегда
можно заглянуть в документацию. Сводка по синтаксису регулярных выражений
имеется в книге «Регулярные выражения: Библиотека программиста, 2 изда-
ние» (издательство «Питер», 2003), а также на страницах руководстваperlre(Y)
и perlop(l), входящих в любую поставку Perl.
Три затруднения
Синтаксис регулярных выражений — это еще цветочки по сравнению с их хитро-
умной семантикой. Похоже, большинство трудностей вызывают три особенно-
сти поиска по шаблону: максимализм, торопливость и возврат (а также то, как
эти три аспекта взаимодействуют между собой).
Принцип максимализма: если стандартный квантификатор (например, *) мо-
жет совпасть в нескольких вариантах, он всегда совпадает со строкой наиболь-
шей длины. Объяснения приведены в рецепте 6.15.
Принцип торопливости: механизм поиска старается обнаружить совпадение
как можно скорее, иногда даже раньше, чем вы ожидаете. Рассмотрим конструкцию
"Fred" =~ /х*Л Если попросить вас объяснить ее смысл, вы, вероятно, скажете:
«Содержит ли строка "Fred" символы х?». Вероятно, результат поиска окажется
неожиданным — компьютер убежден, что символы присутствуют. Дело в том,
что /х*/ означает не просто «символы х», а «любое количество символов х». Или
более формально — ноль и более символов. В данном случае нетерпеливый меха-
низм поиска удовлетворяется нулем.
Приведем более содержательный пример:
Sstrlng = "good food":
Sstrlng =~ s/o*/e/;
Как вы думаете, какое из следующих значений примет Sstrlng после подста-
новки?
goof food
geod food
geed food
geed feed
ged food
ged fed
egood food
Правильный ответ — последний, поскольку первая точка, в которой встреча-
ется ноль и более экземпляров "о", находится прямо в начале строки. Удивлены?
С регулярными выражениями это бывает довольно часто.
А теперь попробуйте угадать, как будет выглядеть результат при добавлении
модификатора /д, который делает подстановку глобальной? Строка содержат
много мест, в которых встречается ноль и более экземпляров "о" — точнее, восемь.
Итак, правильный ответ — "egeede efeede".
Приведем другой пример, в котором максимализм уступает место торопливости:
% echo longest | perl -ne 'print "$&\n" If /long|longer|longest/'
long
216
Глава 6. Поиск по шаблону
Это объясняется тем, что при поиске в Perl используются так называемые
традиционные недетерминированные конечные автоматы (в отличие от неде-
терминированных конечных автоматов POSIX). Подобные механизмы поиска
гарантируют возврат не самого длинного итогового совпадения, а лишь самого
длинного совпадения начиная с левого края. Можно считать, что максимализм
Perl проявляется лишь слева направо, а не в глобальном контексте.
Механизм НКА работает медленнее, однако формулировка шаблона с учетом
конкретных особенностей реализации НКА позволяет добиться существенного
выигрыша по быстродействию. Этой теме посвящена значительная часть книги
Джеффри Фридла «Регулярные выражения: Библиотека программиста».
Последняя и самая интересная из трех особенностей — возврат. Чтобы шаб-
лон совпал, должно совпасть все регулярное выражение, а не лишь его отдель-
ная часть. Следовательно, если начало шаблона с квантификатором совпадает,
а одна из последующих частей шаблона — нет, механизм поиска возвращается
к началу и пытается найти для него другое совпадение — отсюда и термин «воз-
врат». Фактически это означает, что механизм поиска должен систематически
перебирать разные возможности до тех пор, пока не найдет полное совпадение.
В некоторых реализациях поиска возврат используется для поиска других сов-
падающих компонентов, которые могли бы увеличить длину найденного совпа-
дения. Механизм поиска Perl этого не делает; найденное частичное совпадение
используется немедленно — если позднее другая часть шаблона сделает полное
совпадение невозможным, происходит возврат и поиск другого частичного сов-
падения (см. рецепт 6.16).
Модификаторы
Модификаторы, используемые при поиске по шаблону, намного проще перечис-
лить и понять, чем другие метасимволы. В табл. 6.1 приведена их краткая сводка.
Таблица 6.1 Модификаторы поиска по шаблону
Модификатор Описание
/1 Игнорировать регистр (с учетом национальных алфавитов)
/X Игнорировать большинство пропусков в шаблонах и разрешить комментарии
/д Глобальный модификатор — поиск/замена выполняются во всех позициях, где это возможно
/дс /S Не сбрасывать позицию при неудачном поиске Разрешить совпадение символа «.» с символом новой строки
/т Разрешить совпадение и $ соответственно в начале и конце логических (то есть внутренних) строк
/о Однократная компиляция шаблонов
/е Правая часть s/// представляет собой фрагмент кода, результат выполнения которого используется как замена
/ее Правая часть s/// представляет собой строку с программным кодом, которая выполняется дважды; окончательный результат используется как замена
6.0. Введение
217
На практике чаще всего используются модификаторы /1 и /д. Шаблон /ram/i
совпадает со строками "ram", "RAM", "Ram" и т. д. При наличии этого модификато-
ра обратные ссылки проверяются без учета регистра (пример приведен в рецеп-
те 6.16). Под действием директивы use locale в сравнениях будет учитываться
состояние текущих локальных настроек.
Модификатор /д используется с s/// для замены всех неперекрывающихся
совпадений, а не только первого. Кроме того, /д используется ст// в циклах по-
иска (но не замены!) всех совпадений:
while (m/(\d+)/g) {
print "Found number $l\n":
}
При использовании cm// в списковом контексте /д извлекает все совпадения
в массив:
^numbers = m/(\d+)/g:
В этом случае будут найдены только неперекрывающиеся совпадения. Для
поиска перекрывающихся совпадений придется идти на хитрость — организо-
вать опережающую проверку нулевой ширины с помощью конструкции (?=...).
Раз ширина равна нулю, механизм поиска вообще не смещается вперед, при
этом данные все равно сохраняются при помощи сохраняющих круглых скобок.
Однако Perl обнаруживает, что при наличии модификатора /д текущая позиция
осталась в прежнем состоянии, и перемещает ее на один символ вперед.
Продемонстрируем различия на примере:
$digits = "123456789":
@nonlар = $digits =~/(\d\d\d)/g:
@yeslap = $digits =~/(?=(\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+)/sprintf("^#x",$1)/де преобразует все числа в шестнадцатерич-
ную систему счисления — скажем, 2581 превращается в 0хЬ23.
В разных странах существуют разные понятия об алфавите, поэтому стандарт
POSIX предоставляет в распоряжение систем (а следовательно, и программ)
стандартные средства для представления алфавитов, упорядочения наборов сим-
волов и т. д. Директива Perl use locale предоставляет доступ к некоторым из них;
дополнительную информацию можно найти на странице руководства perllocale.
218
Глава 6. Поиск по шаблону
При действующей директиве use locale в символьный класс \w попадают симво-
лы с диакритическими знаками и прочая экзотика. Служебные символы измене-
ния регистра \u, \U, \1 и \L (а также соответствующие функции uc, ucfirst и т. д.)
также учитывают use locale, поэтому \u превратит с в Е, если этого потребует
локальный контекст. Впрочем, это относится только к 8-разрядным кодиров-
кам — таким, как греческая кодировка ISO 8859-7. При работе с этими символа-
ми в Юникоде преобразование выполняется автоматически независимо от теку-
щего выбора локального контекста.
Специальные переменные
В результате некоторых операций поиска по шаблону Perl устанавливает значе-
ния специальных переменных. Так, переменные $1, $2, $3 и т. д. до бесконечно-
сти (Perl не останавливается на $9) устанавливаются в том случае, если шаблон
содержит обратные ссылки (то есть часть шаблона заключена в сохраняющие
круглые скобки). Каждая открывающая круглая скобка, встречающаяся в шаб-
лоне при его просмотре слева направо, начинает заполнение новой переменной.
Переменная $+ содержит значение последней обратной ссылки для последнего
успешного поиска. С ее помощью можно определить, какой из альтернативных
вариантов поиска вошел в совпадение (например, при обнаруженном совпаде-
нии для /(х,*у)|(y.*z)/ в переменной $+ будет находиться содержимое $1 или
$2 — в зависимости от того, какая из этих переменных была заполнена). Пере-
менная $& содержит полный текст совпадения при последнем успешном поиске.
В переменных $' и $' хранятся строки, соответственно предшествующие и сле-
дующие за совпадением при успешном поиске:
Sstrlng = "And little lambs eat ivy";
Sstrlng =~ /1[As]*s/;
print "($') ($&) ($')\n";
(And ) (little lambs) ( eat ivy)
Переменные $', $& и $' соблазнительны, но опасны. Само их присутствие в лю-
бом месте программы замедляет поиск по шаблону, поскольку механизм должен
присваивать им значения при каждом поиске. Сказанное справедливо даже в том
случае, если вы всего один раз используете лишь одну из этих переменных, или
даже если они совсем не используются, а лишь встречаются в программе. Впро-
чем, сейчас переменная $& обходится не так дорого, как две другие переменные.
Существует и другое, более экономичное решение; в нем используется функ-
ция substr в сочетании со встроенными массивами и @+, появившимися в Perl
версии 5.6. Эти массивы представляют соответственно начальные и конечные по-
зиции сохраненных групп. N-e элементы этих двух массивов содержат начальное
и конечное смещения для N-й группы. Таким образом, $- [1] определяет начальное
смещение совпадения группы $1, а $+[1] — его конечное смещение; $-[2] определя-
ет начальное смещение совпадения группы $2, а $+[2] — его конечное смещение,
ит.д. $-[0] определяет смещение начала всего совпадения, а $+[0] — смещение
конца всего совпадения. (Говоря о «смещении конца», мы имеем в виду смещение
первого символа, следующего за совпадением, что позволяет определять длину
совпадения простым вычитанием начального смещения из конечного.)
6.1. Копирование с подстановкой
219
При обнаружении совпадения в переменной Sstring следующие конструкции
эквивалентны:
Variable Equivalent
S' substr(Sstring, 0. $-[0])
$& substr($str1ng, $-[0]. $+[0] - $-[0])
S' substr($str1ng, $+[0])
$1 substr($str1ng, $-[1]. $+[l] - S-[l])
$2 substr($str1ng. $-[2]. $+[2] -
$3 substr($str1ng, $+[3] - $-[3])
И так далее и тому подобное.
Чтобы узнать о регулярных выражениях больше, чем вы могли бы себе пред-
ставить, обратитесь к книге Джеффри Фридла «Регулярные выражения: Библио-
тека программиста» (издательство «Питер», 2003 г.). Книга посвящена практи-
ческому применению регулярных выражений. В ней рассматриваются не только
общие принципы работы регулярных выражений и специфика их реализации
в Perl, но и проводится их сравнение с аналогичными средствами других языков
программирования.
6.1. Копирование с подстановкой
Проблема
Вам надоело многократно использовать две разные команды для копирования
и подстановки.
Решение
Замените фрагменты вида:
$dst = Ssrc;
$dst =~ s/thls/that/:
следующей командой:
($dst.= Ssrc) =~ s/thls/that/:
Комментарий
Иногда подстановка должна выполняться не в исходной строке, а в ее копии,
однако вам не хочется делить ее на два этапа. К счастью, это и не обязательно,
поскольку операцию с регулярным выражением можно применить к результату
операции копирования.
Например:
# Выделить базовое имя
(Sprogname = $0) =~ s!".*/!!:
# Начинать Все Слова С Прописной Буквы
(Scapword = Sword) =~ s/(\w+)/\u\L$l/g:
220
Глава 6. Поиск по шаблону
# /usr/man/man3/foo.1 заменяется на /usr/man/man/cat3/foo.1
(Scatpage = Smanpage) =~ s/man(?=\d)/cat/:
Подобная методика работает даже с массивами:
@b1ndirs = qw( /usr/Ып /bin /usr/local/bin );
for (@libdirs = @Mnd1 rs) { s/bln/llb/ }
print "@11bd1rs\n":
/usr/lib /lib /usr/local/lib
При изменении результата, хранящегося в левой переменной, из-за относитель-
ного приоритета операторов необходимо использовать круглые скобки. Резуль-
тат подстановки равен либо "" в случае неудачи, либо целому числу, обозначаю-
щему количество выполненных замен. Сравните с предыдущими примерами, где
в скобки заключалась сама операция присваивания. Например:
($а = $b) =~ s/x/y/g; # 1: Скопировать $Ь и затем изменить $а
$а = ($b =~ s/x/y/g); # 2: Изменить $Ь, занести в $а количество замен
$а = $b =~ s/x/y/g; # 3: То же, что 2.
См. также
Раздел «Assignment Operators» perlop(\.}.
6.2. Идентификация алфавитных символов
Проблема
Требуется узнать, состоит ли строка только из алфавитных символов.
Решение
Наиболее очевидное решение не подходит для общего случая:
if ($var =~ r[A-Za-z]+$/) {
# Только алфавитные символы
}
Дело в том, что такой вариант не учитывает локальный контекст пользовате-
ля. Если наряду с обычными должны идентифицироваться символы с диакрити-
ческими знаками, лучше всего воспользоваться свойствами Юникода:
If ($var =~ /Лр{Alphabetlс}+$/) { # Или просто /ж\р1_+$/
print "var Is purely alphabet1c\n":
}
В старых версиях Perl, не поддерживающих Юникод, остается использовать
либо инвертированные символьные классы:
If ($var =~ Г[ЛЫ\Ь_]+$/) {
print "var Is purely alphabetlc\n";
}
6.2. Идентификация алфавитных символов
221
либо символьные классы POSIX (если они поддерживаются):
If ($var =~ /А[[:alpha:]]+$/) {
print "var Is purely alphabet1c\n":
}
Но чтобы эти решения работали с символами, не входящими в кодировку
ASCII, необходимо использовать директиву use locale, а система должна поддер-
живать локальные контексты POSIX.
Комментарий
Если не считать свойств Юникода и символьных классов POSIX, в Perl нет
средств для выражения понятия «алфавитный символ», поэтому нам придет-
ся немного схитрить. Метасимвол \w совпадает с одним алфавитным или циф-
ровым символом, а также символом подчеркивания. Следовательно, \W не яв-
ляется одним из этих символов. Инвертированный символьный класс [x\W\d_]
определяет байт, который не является алфавитным символом, цифрой или под-
черкиванием. После инвертирования остаются одни алфавитные символы, кото-
рые нас и интересуют.
В программе это выглядит так:
use locale:
use POSIX 'locale_h'
# Строка локального контекста на вашем компьютере может выглядеть иначе
unless (setlocale(LC_ALL. "fr_CA.IS08859-1”)) {
die "couldn't set locale to French CanadianXn":
}
while (<DATA>) {
chomp:
if (/A[A\W\d_]+$/) }
print alphabetic\n":
} else [
print line noiseXn":
}
}
_ END_
silly
facade
cooperate
nino
Renee
Moliere
haemogl obi n
naive
tschuB
random!stuff#here
При решении этой задачи также могут пригодиться символьные классы POSIX.
В Perl поддерживаются классы alpha, al num, ascii, blank, cntrl, digit, graph, lower,
222
Глава 6. Поиск по шаблону
print, punct, space, upper, word и xdigit. Имена символьных классов действительны
только в спецификациях символьных классов, заключенных в квадратные скобки:
Sphone =~ /\Ь[:dig1t:]{3}[[:space:][:punct:]]?[:digit:]{4}\Ь/: # ОШИБКА
Sphone =~ /\Ь[[:digit:]]{3}[[:space:И:punct:]]?[[:digit:]]{4}\Ь/: # ВЕРНО
Со свойствами Юникода работать удобнее, потому что их не обязательно за-
ключать в другие квадратные скобки:
Sphone =~ /\Ь\р{Number}{3}[\p{Space}\р{Punctuationj?\р{Number}{4}\Ь/;
Sphone =~ /\b\pN{3}[\pS\pP]?\pN{4}\b/; # Сокращенная форма
Один произвольный символ со свойством Юникода prop описывается кон-
струкцией \р{ргор}. Символ, не обладающий свойством prop, описывается конст-
рукцией \?{ргор} или [А\р{/?го/?}1. При поиске алфавитных символов используется
свойство Alphabetic, которое может сокращаться до Letter или даже до про-
стого L. Также следует упомянуть и такие важные свойства, как UppercaseLetter,
LowercaseLetter и TitlecaseLetter, сокращаемые до Lu, L1 и Lt соответственно.
См. также
Описание работы с локальным контекстом в perllocale(\.y, страница руководства
localetS) вашей системы; рецепт 6.12; главы 3 и 7 книги «Регулярные выраже-
ния: Библиотека программиста, 2 издание» (издательство «Питер», 2003 г.).
6.3. Поиск слов
Проблема
Требуется выделить из строки отдельные слова.
Решение
Хорошенько подумайте, что должно считаться словом и как одно слово отделя-
ется от остальных. Затем напишите регулярное выражение, в котором будут во-
площены ваши решения. Примеры:
/\8+/ # Максимальная серия байтов, не являющихся пропусками
/[A-Za-z’-]+/ # Максимальная серия букв, апострофов и дефисов
Комментарий
Концепция «слова» зависит от приложения, языка и входного потока, поэтому
в Perl не существует встроенного определения слов. Слова приходится собирать
вручную из символьных классов и квантификаторов, как это сделано выше.
Во втором примере мы пытаемся сделать так, чтобы "shepherd's" и "sheep-sheering"
воспринимались как отдельные слова.
У большинства реализаций имеются ограничения, связанные с вольностями
письменного языка. Например, хотя второй шаблон успешно опознает слова
6.4. Комментирование регулярных выражений
223
"spank'd" и "counter-clockwise", он выдернет "rd" из строки "23rd Psalom". Чтобы
повысить точность идентификации слов в строке, можно указать то, что окружает
слово. Как правило, при этом указываются метасимволы границ1, а не пропусков:
/\Ь([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. Комментирование регулярных
выражений
Проблема
Требуется сделать ваше сложное регулярное выражение более понятным и уп-
ростить его изменение в будущем.
Решение
В вашем распоряжении четыре способа: альтернативные ограничители для со-
кращения числа символов \, внешние комментарии, внутренние комментарии
с модификатором /хи последовательное построение шаблонов в именованных
переменных.
Комментарий
Во фрагменте из примера 6.1 использованы первые два способа. Начальный ком-
ментарий описывает, для чего предназначено регулярное выражение. Для относи-
1 Хотя метасимвол \Ь выше был назван «границей слова», в действительности он опреде-
ляется как позиция между двумя символами, по одну сторону которой располагается
\w, а по другую — \W (в любом порядке). — Примеч. перев.
224
Глава 6. Поиск по шаблону
тельно простых шаблонов ничего больше не потребуется, но в сложных шаблонах
(наподобие приведенного) желательно привести дополнительные комментарии.
Пример 6.1. resname
#!/usr/Ыn/perl -р
# resname - заменить все имена в стиле ”foo.bar.com” во входном потоке
# на "foo.bar.com [204.148.40.9]" (или аналогичными)
# Загрузить inet_addr
use Socket:
#
( # Сохранить имя хоста в $1
(?: # Скобки только для группировки
(?! [-_] ) # Ни подчеркивание, ни дефис
[\w-] + # Компонент имени хоста
\. # и точка домена
) + # Повторяется несколько раз
[A-Za-z] # Следующий символ должен быть буквой
[\w-] + # Завершающая часть домена
) # Конец записи $1
# Заменить следующим:
"$1 " . # Исходная часть плюс пробел
( ($addr = gethostbyname($l)) # Если имеется адрес
? "[" . inet_ntoa($addr) . "]" # отформатировать
: "[???]" # иначе пометить как сомнительный
)
}дех:
# /д - глобальная замена
# /е - выполнение
# /х - улучшенное форматирование
Из эстетических соображений в этом примере использованы альтернативные
ограничители. Когда шаблон поиска или замены растягивается на несколько
строк, наличие парных скобок делает его более понятным. Другая частая причи-
на для использования альтернативных ограничителей — присутствие в шаблоне
символов / (например, s/\/\//\/. Л//д'). Альтернативные ограничители упроща-
ют чтение такого шаблона (например, s!//!/. ./!д или s{//}{/. ./}g).
При наличии модификатора /х Perl игнорирует большинство пропусков в шаб-
лоне (в символьных классах они учитываются) и интерпретирует символы # вме-
сте со следующим за ним текстом как комментарий. Такая возможность весьма
полезна, однако у вас могут возникнуть проблемы, если пропуски или символы #
являются частью шаблона. В таких случаях снабдите символы префиксом \, как
это сделано в следующем примере:
s/ # Заменить
\# # знак фунта
(\w+) # имя переменной
\# # еще один знак фунта
/${$1}/хд; # значением глобальной переменной
Помните: комментарий должен пояснять программу, а не пересказывать ее.
Комментарии типа "$1++ # Увеличить $1 на 1" станут причиной плохих оценок на
курсах программирования и подорвут вашу репутацию среди коллег.
6.4. Комментирование регулярных выражений
225
Последний способ получения более понятных (а следовательно, и более про-
стых в сопровождении) шаблонов основан на размещении каждой семантической
единицы в переменной с соответствующим именем. Чтобы в строке не потеря-
лись символы \, вместо кавычек строка заключается в апострофы.
$optional_sign = '[-+]?’:
$mandatory_digits = ’\d+';
$decimal_point = ’ \.?1;
$optional_digits = ’\d*’;
Snumber = $optional_sign
. $mandatory_digits
. Sdecimal_point
. $optional_digits;
В дальнейшем переменная Snumber используется при построении шаблонов:
if (/(Snumber)/) { # Поиск одного вхождения
Sfound = $1:
}
@alInums = /$number/g: # Поиск всех вхождений
unless (/^Snumber$/) { # Что-нибудь еще?
print "need a number, just a number\n";
}
Все эти способы даже можно объединять:
# Проверка строки из чисел, разделенных пропусками
т{
\s * # Необязательные начальные пропуски
Snumber # По крайней мере одно число
(?: # Начало несохраняющей группы
\s + # Необходимые разделители
Snumber # Следующее число
) * # Повторяется несколько раз
\s * $ # Необязательные завершающие пропуски
}х
Конечно, такая запись гораздо нагляднее, чем
/^\s*[-+]?\d+\,?\d*(?:\s+[-+]?\d+\,?\d*)*\s*/
Вероятно, шаблоны, сохраняемые в переменных, не должны содержать сохра-
няющих круглых скобок или обратных ссылок, поскольку сохранение в одной
переменной может повлиять на нумерацию групп в других переменных.
Однако с несохраняющими круглыми скобками (то есть /(?:...)/ вместо /(...)/)
таких проблем не возникает. Они не только возможны, но и необходимы, если
вы хотите применить квантификатор ко всей переменной. Пример:
Snumber = ”(?:”
$optional_sign
$mandatory_digits
Sdecimal_point
$optional_digits
. ")":
226
Глава 6. Поиск по шаблону
Если теперь использовать запись /$number+/, квантификатор + будет отно-
ситься ко всей группе. Без группировки он оказался бы в итоговом выражении
сразу же после завершающего квантификатора * что недопустимо.
У несохраняющих круглых скобок есть еще одна особенность — вы може-
те использовать модификаторы, которые относятся только к данной группе.
Пример:
$hex_digit = '(?i:[0-9a-z])’;
Shdrjine = ’ (?m:[х:]*: .*) ’;
Конструкция qr// автоматически использует несохраняющие круглые скоб-
ки, что обеспечивает активизацию всех заданных модификаторов и подавление
тех модификаторов, которые не были заданы для группы:
$hex_digit = qr/[0-9a-z]/i;
Shdrjine = qr/^E^:]*:.*/m:
print "hex digit is: $hex_digit\n";
print "hdr line is: $hdr_line\n";
hex digit is: (?i-xsm:[0-9a-z])
hdr line is: (?m-xis<[^:]*: .*)
Наверное, лучше использовать qr// с самого начала:
$optional_sign = qr/[-+]?/;
$mandatory_digits = qr/\d+/:
$decimal_point = qr/\.?/:
$optional_digits = qr/\d*/:
Snumber = qr{
$optional_sign
$mandatory_digits
$decimal_point
$optional_digits
}x;
Однако вывод будет выглядеть несколько странно:
print "Number is $number\n":
Number is (?x-ism:
(?-xism:[-+]?)
(?-xism:\d+)
(?-xism:\.?)
(?-xism:\d*)
)
См. также
Описание модификатора /х в perlre(l\t глава 7 книги «Регулярные выражения:
Библиотека программиста, 2 издание».
6.5. Поиск N-ro совпадения
227
6.5. Поиск N-ro совпадения
Проблема
Требуется найти не первое, а У-е совпадение шаблона в строке. Допустим, вы
хотите узнать, какое слово предшествует третьему экземпляру слова fish:
One fish two fish red fish blue fish
Решение
Воспользуйтесь модификатором /g и считайте совпадения в цикле while:
SWANT = 3:
Scount = 0:
while (/(\w+)\s+fish\b/gi) {
If (++$count == SWANT) {
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
Scount = 0:
whi1е(Sstring =~ /РАТ/g) {
$count++; # Или что-нибудь другое
}
# To же с завершающим циклом while
Scount = 0;
$count++ while Sstring =~ /PAT/g:
# С циклом for
for (Scount = 0; Sstring =~ /РАТ/g: $count++) { }
# Аналогично, но с подсчетом перекрывающихся совпадений
$count++ while Sstring =~ /(?=PAT)/g;
Чтобы найти N-й экземпляр, проще всего завести отдельный счетчик. Когда
он достигнет N, сделайте то, что считаете нужным. Аналогичная методика может
применяться и для поиска каждого А-го совпадения — в этом случае проверяет-
ся кратность счетчика N посредством вычисления остатка при делении. Напри-
мер, проверка (++$count % 3) == 0 находит каждое третье совпадение.
228
Глава 6. Поиск по шаблону
Если вам не хочется брать на себя дополнительные хлопоты, всегда можно
извлечь все совпадения и затем выбрать из них то, что вас интересует.
Spond = ’One fish two fish red fish blue fish’:
# С применением временного массива
^colors = ($pond =~ /(w+)\s+f1sh\b/g1): # Найти все совпадения
Scolor = $colors[2]; # Выбрать одно.
# интересующее нас
# Без временного массива
Scolor = ( Spond =~ /(\w+)\s+f1sh\b/g1 )[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':
Sevens = grep {$count++ % 2 == 1} /(\w+)\s+f1sh\b/g1:
print "Even numbered fish are Sevens.\n":
Even numbered fish are two blue.
При подстановке заменяющая строка должна представлять собой программ-
ное выражение, которое возвращает соответствующую строку. Не забывайте воз-
вращать оригинал как заменяющую строку в том случае, если замена не нужна.
В следующем примере мы ищем четвертый экземпляр "fish" и заменяем пред-
шествующее слово другим:
Scount = 0:
s{
\b # Делает поиск совпадения для \w более эффективным
( \w+) # То. что мы собираемся изменять
(
\s+ fish \b
)
}{
If (++$count === 4) {
"sushi" . $2;
} else {
$1 . $2:
}
}gex:
One fish two fish red fish sushi fish
Задача поиска последнего совпадения также встречается довольно часто. Про-
стейшее решение — пропустить все начало строки. Например, после / .*\b(\w+)\s+
fish\b/s переменная $1 будет содержать слово, предшествующее последнему эк-
земпляру "fish".
Другой способ — глобальный поиск в списковом контексте для получения
всех совпадений и последующее извлечение нужного элемента этого списка:
Spond = 'One fish two fish red fish blue fish swim here.':
Scolor = ( Spond =~ /\b(\w+)\s+f1sh\b/g1
print "Last fish Is Scolor.\n":
Last fish is blue.
6.6. Межстрочный поиск
229
Если потребуется найти последнее совпадение без применения /д, то же самое
можно сделать с негативной опережающей проверкой (?!...). Если вас интересует
последний экземпляр произвольного шаблона Р, вы ищете Р, сопровождаемый
любым количеством «не-Р», до конца строки. Обобщенная конструкция имеет
вид Р(?! .*₽)*$, однако для удобства чтения ее можно разделить:
т{
А # Найти некоторый шаблон А
(?! # При этом не должно находиться
* # что-то другое
А # и А
)
$ # До конца строки
}х
В результате поиск последнего экземпляра "fish" принимает следующий вид:
$pond = ’One fish two fish red fish blue fish’:
if ($pond — m{
\b ( \w+) \s+ fish \b
(?! .* \b fish \b )
}s1x )
{
print "Last fish is $l/\n";
} else {
print "Failed!\n":
}
Last fish is blue.
Такой подход имеет свои преимущества — он ограничивается одним шабло-
ном и потому подходит для ситуаций, аналогичных описанной в рецепте 6.18.
Впрочем, имеются и недостатки. Он однозначно труднее записывается и воспри-
нимается — впрочем, если общий принцип понятен, все выглядит не так плохо.
К тому же это решение медленнее работает — для протестированного набора
данных быстродействие снижается примерно в два раза.
См. также
Поведение конструкции m//g в скалярном контексте описано в разделе «Regexp
Quote-like Operators» perlop(Vp Негативные опережающие проверки нулевой
ширины продемонстрированы в разделе «Regular Expressions» perlre(l).
6.6. Межстрочный поиск
Проблема
Требуется использовать регулярные выражения для последовательности, состоя-
щей из нескольких логических строк, но специальные символы . (любой сим-
вол, кроме перевода строки), (начало строки) и $ (конец строки) почему-то не
работают. Это может произойти при одновременном чтении нескольких записей
или всего содержимого файла.
230
Глава 6. Поиск по шаблону
Решение
Воспользуйтесь модификатором /т, /s или обоими сразу. Модификатор /s разре-
шает совпадение метасимвола . с переводом строки (обычно этого не происходит).
Если последовательность символов распространяется на несколько логических
строк, шаблон /foo.*bar/s совпадет с "foo" и "bar", находящимися в двух разных
строках. Это не относится к точкам в символьных классах (например, [Д.]),
которые всегда представляют собой обычные точки.
Модификатор /т разрешает совпадение и $ непосредственно после и перед
внутренними переводами строк. Например, совпадение для шаблона /Miead[l-7]/m
возможно не только в начале записи, но и в начале любой внутренней логиче-
ской строки.
Комментарий
При разборе документов, в которых переводы строк несущественны, часто исполь-
зуется «силовое» решение — файл читается по абзацам (а иногда даже целиком),
после чего происходит последовательное извлечение лексем. Для успешного меж-
строчного поиска необходимо, чтобы символ . совпадал с переводом строки —
обычно этого не происходит. Если в буфер читается сразу несколько строк, веро-
ятно, вы предпочтете, чтобы символы и $ могли совпадать с началом и концом
внутренних логических строк, а не только всего текста.
Необходимо хорошо понимать, чем /т отличается от /s: первый метасимвол
заставляет и $ совпадать на внутренних переводах строк, а второй заставляет .
совпадать с переводом строки. Эти модификаторы можно использовать вместе,
они не являются взаимоисключающими.
Фильтр из примера 6.2 удаляет теги HTML из всех файлов, переданных в @ARGV,
и отправляет результат в STDOUT. Сначала мы отменяем разделение записей, что-
бы при каждой операции чтения читалось содержимое всего файла. (Если OARGV
содержит несколько аргументов, файлов также будет несколько; в этом случае
при каждом чтении загружается содержимое всего файла.) Затем мы удаляем
все открывающие и закрывающие угловые скобки и все, что находится между
ними. Мы не можем просто воспользоваться .* по двум причинам: во-первых,
этот шаблон не учитывает закрывающих угловых скобок, а во-вторых, он не под-
держивает межстрочных совпадений. Проблема решается применением .*? в со-
четании с модификатором /s — по крайней мере, в данном случае.
Пример 6.2. killtags
#!/usr/Ы n/perl
# killtags - очень плохое удаление тегов HTML
undef $/: # При каждом чтении загружается весь файл
while (<>) { # Читать по одному файлу
s/<.*?>//gs: # Удаление тегов (очень скверное)
print; # Вывод в STDOUT
}
Шаблон s*>//д работает намного быстрее, но такой подход наивен: он
приведет к неправильной обработке тегов в комментариях HTML или угловых
скобок в кавычках (<IMG SRO"here.gif" ALT="«Ooh la la!»">). В рецепте 20.6 по-
казано, как решаются подобные проблемы.
6.6. Межстрочный поиск
231
Программа из примера 6.3 получает простой текстовый документ и ищет в на-
чале абзацев строки вида "Chapter 20: Better Living Through Chemisery". Такие
строки оформляются заголовками HTML первого уровня. Поскольку шаблон
получился довольно сложным, мы воспользовались модификатором /х, который
разрешает внутренние пропуски и комментарии.
Пример 6.3. headerfy
#!/usr/biп/perl
# headerfy: оформление заголовков глав в HTML
$/ =
while ( <> ) { # Получить абзац
S{
\A # Начало записи
( # Сохранить в $1
Chapter # Текстовая строка
\s+ # Обязательный пропуск
\d+ # Десятичное число
\s* # Необязательный пропуск
: # Двоеточие
. * # Все. кроме перевода строки, до конца строки
}{<Н1>$1</Н1>}дх:
print: }
Если комментарии лишь затрудняют понимание, ниже тот же пример пере-
писан в виде короткой командной строки:
% perl -ООре ’s{\A(Chapter\s+\d+\s*:.*)}{<H1>$1</Hl>}gx’ datafile
Возникает интересная проблема: в одном шаблоне требуется указывать как
начало записи, так и конец строки. Начало записи можно было бы определить с по-
мощью но символ $ должен определять не только конец записи, но и конец стро-
ки. Мы добавляем модификатор /т, отчего изменяется смысл как так и $. Вместо
того чтобы использовать для определения начала записи, мы используем \А.
Кстати говоря, метасимвол \Z (хотя в нашем примере он не используется) совпа-
дает с концом записи даже при наличии модификатора /т. Совпадение с настоя-
щим концом без возможного перевода строки обеспечивается метасимволом \z.
Следующий пример демонстрирует совместное применение /s и /т. На этот
раз мы хотим, чтобы символ совпадал с началом любой строки абзаца, а точ-
ка — с переводом строки. Стандартная переменная $. содержит число записей
последнего файла, прочитанного конструкцией readline(FH) или <FH>. Стандарт-
ная переменная $ ARG V содержит имя файла, автоматически открываемого при об-
работке <ARGV>.
$/=''; # Режим чтения абзацев
while (<ARGV>) {
while (/^START(.*?)^END/sm) { # /s - совпадение . с переводом строки
# /т - совпадение * с началом
внутренних строк
print "chunk $. in $ARGV has «$l»\n":
232
Глава 6. Поиск по шаблону
Если вы уже привыкли работать с модификатором /т, то Л и $ можно заменить
на \А и \Z. Но что делать, если вы предпочитаете /s и хотите сохранить исходный
смысл метасимвола «точка»? Воспользуйтесь конструкцией [Л\п].
Наконец, хотя $ и \Z могут совпадать в позиции, предшествующей концу
строки, если последним символом является перевод строки, \z всегда совпадает
только в фактическом конце строки. При помощи опережающей проверки мож-
но определить для двух других метасимволов эквиваленты с использованием \z:
$ без /т (?=\n)?\z
$ с /т (?=\п)|\z
\Z (всегда) (?=\n)?\z
См. также
Описание переменной $/ в perlvar(l); описание модификаторов /s и /т врег1ге(1);
раздел «Якорные метасимволы и другие проверки с нулевой длиной совпадения»
главы 3 книги «Регулярные выражения: Библиотека программиста, 2 издание».
Мы вернемся к специальной переменной $/ в главе 8.
6.7. Чтение записей с разделением
по шаблону
Проблема
Требуется прочитать записи, разделение которых описывается некоторым шаб-
лоном. Perl не позволяет присвоить регулярное выражение переменной-разде-
лителю входных записей.
Многие проблемы — в первую очередь связанные с синтаксическим анали-
зом сложных файловых форматов — заметно упрощаются, если у вас имеются
удобные средства для чтения записей, разделенных в соответствии с определен-
ным шаблоном.
Решение
Прочитайте весь файл и воспользуйтесь функцией split:
undef $/;
@chunks = spl1t(/шаблон/,<ФАЙЛОВЫЙ_МАНИПУЛЯТОР>):
Комментарий
В Perl разделитель записей должен быть фиксированной строкой, а не шабло-
ном. Чтобы обойти это ограничение, отмените разделитель входных записей,
чтобы следующая операция чтения прочитала весь файл. Иногда это называется
режимом поглощающего ввода (slurp mode), потому что весь файл поглощается
как одна большая строка. Затем разделите эту большую строку функцией split,
используя шаблон разделения записей в качестве первого аргумента.
6.8. Извлечение строк из определенного интервала
233
Рассмотрим пример. Допустим, входной поток представляет собой текстовый
файл, содержащий строки " .Se", ".Ch" и " .Ss" — служебные коды для макросов
troff. Эти строки представляют собой разделители. Мы хотим найти текст, рас-
положенный между ними.
# .Ch. .Se и .Ss отделяют фрагменты данных STDIN
{
local $/ = undef:
©chunks = spl 1t(/Л.(Ch|Se|Ss)$/m. <>):
}
print "I read ". scalar(@chunks), "chunks.\n":
Мы создаем локальную версию переменной $/, чтобы после завершения бло-
ка было восстановлено ее прежнее значение. Если шаблон содержит круглые
скобки, функция split также возвращает разделители. Это означает, что данные
в возвращаемом списке будут чередоваться с элементами "Se", "Ch" и "Ss".
Если разделители вам не нужны, но вы все равно хотите использовать круглые
скобки, воспользуйтесь «несохраняющими» скобками в шаблоне вида /Л. (?:Ch |
Se|Ss)$/m.
Чтобы записи разделялись перед шаблоном, но шаблон включался в возвра-
щаемые записи, воспользуйтесь опережающей проверкой: /?(?=\. (? :Ch |Se|Ss))/m.
В этом случае каждый фрагмент, кроме первого, будет начинаться с разделителя.
Учтите, что для больших файлов такое решение потребует значительных рас-
ходов памяти. Однако для современных компьютеров и типичных текстовых
файлов эта проблема уже не так серьезна. Конечно, не стоит применять это ре-
шение для 200-мегабайтного файла журнала, не располагая достаточным местом
на диске для подкачки. Впрочем, даже при избытке виртуальной памяти ничего
хорошего не выйдет.
См. также
Описание переменной $/ в perlvar(Y) и в главе 8; описание функции split
в perlfunc(Y).
6.8. Извлечение строк из определенного
интервала
Проблема
Требуется извлечь все строки, расположенные в определенном интервале. Интер-
вал может быть задан двумя шаблонами (начальным и конечным) или номера-
ми первой и последней строки.
Часто встречающиеся примеры — чтение первых 10 строк файла (строки с 1
по 10) или основного текста почтового сообщения (все, что следует после пустой
строки).
234
Глава 6. Поиск по шаблону
Решение
Используйте оператор .. или ... для шаблонов или номеров строк.
Оператор .. проверяет правый операнд в той же итерации, в которой левый
операнд переводит оператор в истинное состояние.
while (<>) {
if (/НАЧАЛЬНЫЙ ШАБЛОН/ .. /КОНЕЧНЫЙ ШАБЛОН/) {
# Строка находится между начальным
# и конечным шаблоном включительно.
}
}
while (<>) {
if ($НОМЕР_НАЧАЛЬНОЙ_СТРОКИ .. $НОМЕР_КОНЕЧНОЙ_СТРОКИ) {
# Строка находится между начальной
# и конечной включительно.
}
}
Если первый операнд оказывается истинным, оператор ... не проверяет вто-
рой операнд.
while (<>) {
if (/НАЧАЛЬНЫЙ ШАБЛОН/ ... /КОНЕЧНЫЙ ШАБЛОН/) {
# Строка находится между начальным
# и конечным шаблоном, расположенными в разных строках.
}
}
while (<>) {
if ($НОМЕР_НАЧАЛЬНОЙ_СТРОКИ ... $НОМЕР_КОНЕЧНОЙ_СТРОКИ) {
# Оператор находится между начальной
# и конечной строками включительно.
}
}
Комментарий
Из бесчисленных операторов Perl интервальные операторы .. и ..., вероятно,
вызывают больше всего недоразумений. Они создавались для упрощения выбор-
ки интервалов строк, чтобы программисту не приходилось сохранять информа-
цию о состоянии. В скалярном контексте (например, в условиях операторов 1 f
и while) эти операторы возвращают значение true или false, отчасти зависящее
от предыдущего состояния. Выражение левый_операнд .. правый_операнд воз-
вращает false до тех пор, пока левый_операнд не станет истинным. Когда это
условие выполняется, левый_операнд перестает вычисляться, а оператор возвра-
щает true до тех пор, пока не станет истинным правый операнд. После этого
цикл начинается заново. Другими словами, истинность первого операнда «акти-
визирует» конструкцию, а истинность второго операнда «выключает» ее.
Условия могут быть абсолютно произвольными. Границы интервала могут
быть заданы проверочными функциями mytestfunc(l) .. mytestfunc(2), хотя на
6.8. Извлечение строк из определенного интервала
235
практике это происходит редко. Как правило, операндами интервальных опера-
торов являются либо номера строк (первый пример), шаблоны (второй пример)
или их комбинация.
# Командная строка для вывода строк с 15 по 17 включительно (см. ниже)
perl -ne 'print if 15 .. 17' datafile
# Вывод всех фрагментов <ХМР> .. </ХМР> из документа HTML
while (<>) {
print if m#<XMP>#1 .. 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 { Stop=3; Sbottom=5 } print if Stop .. Sbottom' /etc/passwd
# Работает
perl -ne 'BEGIN {Stop=3: Sbottom=5 }
print if $. == Stop .. S. == 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 (<>) {
Sin_header = 1 .. /х$/;
Sin_body = /х$/ .. eof():
}
Переменная $in_header становится истинной, начиная с первой входной стро-
ки и заканчивая пустой строкой, отделяющей заголовок от основного текста —
например, в почтовых сообщениях, новостях Usenet и даже в заголовках HTTP
236
Глава 6. Поиск по шаблону
(теоретически строки в заголовках HTTP должны завершаться комбинацией
CR/LF, но на практике серверы относятся к их формату весьма либерально).
Второе присваивание делает переменную $1n_body истинной в момент обнаруже-
ния первой пустой строки и до конца файла. Поскольку интервальные операто-
ры не перепроверяют начальное условие, остальные пустые строки (например,
между абзацами) игнорируются.
Рассмотрим пример. Следующий фрагмент читает файлы с почтовыми сооб-
щениями и выводит адреса, найденные в заголовках. Каждый адрес выводится
один раз. Заголовок начинается строкой "From:" и завершается первой пустой
строкой. Если текущая строка не входит в такой интервал, мы переходим к сле-
дующей строке. Хотя такое определение заголовка и не соответствует RFC-822,
оно легко реализуется.
ftseen = О:
while (<>) {
next unless /xFrom:?\s/1 .. /х$/;
while (/(['<>().:\s]+\@[x<>().:\s]+)/g) {
print "$l\n" unless $seen{$l}++:
}
}
См. также
Описание операторов .. и ... в разделе «Range Operator» perlop(V); описание
переменной $NR в perlvar(l).
6.9. Работа с метасимволами командных
интерпретаторов
Проблема
Вы хотите, чтобы вместо регулярных выражений Perl пользователи могли вы-
полнять поиск с помощью традиционных метасимволов командного интерпре-
татора. В тривиальных случаях шаблоны с метасимволами выглядят проще, не-
жели полноценные регулярные выражения.
Решение
Следующая процедура преобразует метасимволы командного интерпретатора
в эквивалентные регулярные выражения; все остальные символы заключаются
в кавычки, чтобы они интерпретировались как литералы.
sub glob2pat {
my Sglobstr = shift;
my ^patmap = (
6.9. Работа с метасимволами командных интерпретаторов
237
'[' => ’[’.
=>
):
Sglobstr =~ s{(.)} { $patmap{$l} || "\0$Г }де;
return ,х' . Sglobstr .
}
Комментарий
Шаблоны Perl отличаются от применяемых в командных интерпретаторах кон-
струкций с метасимволами. Конструкция *. * интерпретатора не является допус-
тимым регулярным выражением. Она соответствует шаблону /\*\. .*$/, который
совершенно не хочется вводить с клавиатуры.
Функция, приведенная в Решении, выполняет все преобразования за вас. При
этом используются стандартные правила встроенной функции glob. В табл. 6.2
приводятся эквивалентные шаблоны командного интерпретатора и Perl.
Таблица 6.2. Метасимволы командного интерпретатора и Perl
Командный интерпретатор Perl
list.? Alist\..$
project.* Aproject\„*$
*old A *old*
type*.[ch] Atype.*\.[ch]$
A.*\..*$
* A*$
Функция возвращает строку, а не объект регулярного выражения, поскольку
это привело бы к жесткой фиксации всех заданных (и не заданных) модифика-
торов типа /1, а это решение лучше отложить на будущее.
Правила использования метасимволов в командном интерпретаторе отлича-
ются от аналогичных правил для регулярных выражений. Весь шаблон неявно
привязывается к концам строки. Вопросительный знак соответствует любому
символу, звездочка — произвольному количеству любых символов, а квадратные
скобки определяют интервалы. Все остальное как обычно.
Многие интерпретаторы не ограничиваются простыми обобщениями в одном
каталоге. Например, конструкция */* означает «все файлы во всех подкаталогах
текущего каталога». Кроме того, многие интерпретаторы не выводят имена фай-
лов, начинающиеся с точки, если точка не была явно включена в шаблон поиска.
Функция glob2pat такими возможностями не обладает — если они нужны, вос-
пользуйтесь модулем CPAN File: :KGlob.
См. также
Страницы руководства различных командных интерпретаторов, например, cs/z( 1),
&s/z(l), sh(l), ksh(l) и bash(l); описание функции glob в perlfunc(l); документация
по модулю CPAN Glob::DosGlob; раздел «I/O Operators» perlop(l); рецепт 9.6.
238
Глава 6. Поиск по шаблону
6.10. Ускорение интерполированного поиска
Проблема
Требуется, чтобы одно или несколько регулярных выражений передавались в ка-
честве аргументов функции или программы. Однако такой вариант работает мед-
леннее, чем при использовании литералов.
Решение
Если имеется всего один шаблон, который не изменяется в течение всей работы
программы, сохраните его в строке и воспользуйтесь шаблоном /Spattern/о:
while (SHne = <>) {
If (SHne =~ /$pattern/o) {
# Сделать что-то
}
}
Однако такое решение подходит только для одного шаблона. В этом случае
выполните предварительную компиляцию строк шаблонов оператором qr//, а за-
тем проверьте каждый результат по каждому выражению:
@pats = map { qr/$_/ } @strings;
while (SHne = <>) {
for Spat (@pats) {
If ($1Ine =~ /Spat/) {
# Сделать что-то
}
}
}
Комментарий
Во время компиляции программы Perl преобразует шаблоны во внутреннее
представление. На стадии компиляции преобразуются шаблоны, не содержащие
переменных, однако преобразование шаблонов с переменными происходит во
время выполнения. В результате интерполяция переменных в шаблонах (напри-
мер, /Spattern/) замедляет работу программы. Это особенно заметно при частых
изменениях Spattern.
Модификатор /о фиксирует значения переменных, интерполируемых в шаб-
лоне. Таким образом, переменные интерполируются только один раз — при пер-
вом поиске. Поскольку Perl игнорирует дальнейшие изменения переменных, вы
должны следить за тем, чтобы этот модификатор применялся только для неиз-
меняемых переменных.
Модификатор /о в шаблонах без интерполированных переменных не по-
вредит, но и не даст никакого выигрыша в скорости. Кроме того, он бесполезен
в ситуации, когда у вас имеется неизвестное количество регулярных выражений,
и строка должна поочередно сравниваться со всеми шаблонами. Не поможет он
6.10. Ускорение интерполированного поиска
239
и тогда, когда интерполируемая переменная является аргументом функции, по-
скольку при каждом вызове функции ей присваивается новое значение.
В примере 6.4 показана медленная, но очень простая методика многострочно-
го поиска для нескольких шаблонов. Массив @popstates содержит стандартные
сокращенные названия некоторых американских штатов, в которых безалко-
гольные газированные напитки обозначаются словом «рор». Задача — вывести
все строки входного потока, в которых хотя бы одно из этих сокращений при-
сутствует в виде отдельного слова. Модификатор /о в этом случае не подходит,
поскольку переменная, содержащая шаблон, постоянно изменяется.
Пример 6.4. popgrepl
# popgrepl - поиск строк с названиями штатов
# версия 1: медленная, но понятная
Opopstates = qw(CO ON MI WI MN);
LINE: while (defined($line = <>)) {
for $state (Opopstates) {
if (Sline =~ /\bSstate\b/) { # M e д л e н н о
print; next LINE;
}
}
}
Столь примитивное, убогое, «силовое» решение оказывается ужасно медлен-
ным — для каждой входной строки все шаблоны приходится перекомпилировать
заново. Другое, более качественное решение основано на использовании операто-
ра qr// (см. пример 6.5). Этот оператор появился в Perl версии 5.6 и помог изба-
виться от проблем с эффективностью. Оператор qr/// оформляет свой аргумент
как строку, а возможно и компилирует его, возвращая скалярную величину, кото-
рая будет использоваться в последующих операциях поиска. Если эта скалярная
величина используется в интерполируемом поиске, Perl использует кэширован-
ную откомпилированную форму и тем самым избегает перекомпиляции шаблона.
Пример 6.5. popgrep2
#!/usr/bin/perl
# popgrep2 - поиск строк с названиями штатов
# Версия 2: быстрая, с использованием qr//
Opopstates = qw(CO ON MI WI MN);
Opoppats = map { qr/\b$_\b/ } Opopstates;
LINE: while (defined($line = <>)) {
for Spat (Opoppats) {
if (Sline =~ /Spat/) { # Работает быстро
print; next LINE;
}
1
1
При выводе массива Opoppats вы увидите строки следующего вида:
(?-xism:\bCO\b)
(?-xi sm:\bON\b)
(?-xism:\bMI\b)
(?-xism:\bWI\b)
(?-xism:\bMN\b)
240
Глава 6. Поиск по шаблону
Такой формат используется при выводе значения оператора qr//, преобразо-
ванного в строку, а также для построения больших шаблонов, если результат
интерполируется в большей строке. Но с каждым значением также ассоциирует-
ся кэшированная, откомпилированная версия этой строки как шаблона; именно
она используется Perl в том случае, когда интерполяция при поиске или подста-
новке не содержит ничего более.
См. также
Описание оператора qr// в рег1ор(У).
6.11. Проверка правильности шаблона
Проблема
Требуется, чтобы пользователь мог ввести свой собственный шаблон. Однако
первая же попытка применить неправильный шаблон приведет к аварийному
завершению программы.
Решение
Сначала проверьте шаблон с помощью конструкции eval {} для какой-нибудь
фиктивной строки. Если переменная $@ не устанавливается, следовательно, ис-
ключение не произошло, шаблон был успешно откомпилирован и содержит дей-
ствительное регулярное выражение. Следующий цикл выполняется до тех пор,
пока пользователь не введет допустимый шаблон:
do {
print "Pattern?";
chomp($pat = <>);
eval { "" =~ /$pat/ };
warn "INVALID PATTERN $@" if $@:
} while $@:
Отдельная функция для проверки шаблона выглядит так:
sub is_valid_pattern {
my $pat = shift:
eval { "" =~ /$pat/ }:
return $@ ? 0 : 1;
}
To же самое можно записать и иначе:
sub is_valid_pattern {
my $pat = shift:
return eval { "" =~ /$pat/: 1 } || 0:
}
Эта версия обходится без $@; если поиск по шаблону не приводит к возникнове-
нию исключения, то программа достигает следующей команды (а это просто 1)
6.11. Проверка правильности шаблона
241
и возвращает это значение. В противном случае следующая команда пропускает-
ся, поэтому процедура возвращает 0.
Комментарий
Некомпилируемые шаблоны встречаются сплошь и рядом. Пользователь может
по ошибке ввести "*** GET RICH ***" или "+5-1". Если слепо воспользо-
ваться введенным шаблоном в программе, возникнет исключение; как правило,
это приводит к аварийному завершению программы.
Крошечная программа из примера 6.6 показывает, как проверяются шаблоны.
Пример 6.6. paragrep
#!/usr/blп/perl
# paragrep - простейший поиск
die "usage: $0 pat [f11es]\n" unless @ARGV:
$/ =
Spat = shift:
eval { "" =- /Spat/: 1 } or die "SO: Bad pattern Spat: $@\n":
while (<>) {
print "SARGV $.: $_" If /$pat/o:
}
Модификатор /о означает, что переменные должны интерполироваться толь-
ко один раз, даже если позднее их значения изменятся.
Проверку можно инкапсулировать в функции, которая возвращает 1 при ус-
пешном завершении блока и 0 в противном случае (см. выше Решение). Хотя
исключение можно также перехватить с помощью eval "/Spat/", у такого реше-
ния есть два недостатка. Прежде всего, во введенной пользователем строке не
должно быть символов / (или других ограничителей шаблонов, выбранных
вами). Важнее другое: в системе безопасности открывается зияющая брешь, ко-
торую было бы крайне желательно избежать. Некоторые строки могут сильно
испортить настроение:
Spat = "You lose @{[ systemCrm -rf *’)]} big here":
Если вы не желаете предоставлять пользователю настоящие шаблоны, снача-
ла всегда можно выполнить метапреобразование строки:
$safe_pat = quotemeta(Spat):
someth!ng() If /$safe_pat/:
Или еще проще:
someth!ng() If /\QSpat/:
Но если вы делаете нечто подобное, зачем вообще связываться с поиском по
шаблону? В таких случаях достаточно простого применения 1 ndex. Впрочем, иногда
шаблон должен содержать как литеральную часть, так и регулярное выражение:
someth!ng() If /x\s*\Q$pat\E\s*S/:
Разрешая пользователю вводить настоящие шаблоны, вы открываете перед
ним много интересных и полезных возможностей. Это, конечно, хорошо. Просто
242
Глава 6. Поиск по шаблону
придется проявить некоторую осторожность, вот и все. Допустим, пользователь
желает выполнять поиск без учета регистра, а вы не предусмотрели в своей про-
грамме ключ типа -1 в grep. Работая с полными шаблонами, пользователь смо-
жет установить внутренний модификатор /1 в виде (?1), например, /(?i )stuff/.
Что произойдет, если в результате интерполяции получается пустая строка?
Если $pat — пустая строка, с чем совпадет /$pat/ — иначе говоря, что произой-
дет при пустом поиске //? С началом любой возможной строки? Неправильно.
Как ни странно, при поиске по пустому шаблону повторно используется шаблон
предыдущего успешного поиска. Подобная семантика выглядит сомнительно,
а найти для нее практическое применение в Perl нелегко.
См. также
Описание функции eval в perlfunc(\.}.
6.12. Локальный контекст в регулярных
выражениях
Проблема
Требуется преобразовать регистр в другом локальном контексте или заставить
метасимвол \w совпадать с символами национальных алфавитов, например, Jose
или deja vu.
Предположим, у вас имеется полгигабайта текста на немецком языке, для ко-
торого необходимо составить алфавитный указатель. Вы хотите извлекать слова
(с помощью \w+) и преобразовывать их в нижний регистр (с помощью 1с или \L).
Однако обычные версии \w и 1 с не находят слова немецкого языка и не изменя-
ют регистр символов с диакритическими знаками.
Решение
Регулярные выражения и функции обработки текста Perl имеют доступ к ло-
кальному контексту POSIX. Если включить в программу директиву use locale,
Perl позаботится о символах национальных алфавитов, конечно, при наличии
разумной спецификации LC_CTYPE и системной поддержки.
use locale:
Комментарий
По умолчанию \w+ и функции преобразования регистра работают с буквами
верхнего и нижнего регистра, цифрами и подчеркиваниями. Преобразуются
лишь простейшие английские слова, и даже в очень распространенных заим-
ствованных словах происходят сбои. Директива use locale помогает справиться
с затруднениями.
6.13. Неформальный поиск
243
Пример 6.7 показывает, чем отличаются выходные данные для английского
(еп) и немецкого (de) локальных контекстов.
Пример 6.7. localeg
#!/usr/bin/perl -w
# localeg - выбор локального контекста
use locale:
use POSIX 'locale_h‘:
$name = "andreas k\xF6n1g";
@locale{qw(German English)} = qw(de_DE.IS0_8859-l us-ascil):
setlocale(LC_CTYPE. $1ocale{English})
or die "Invalid locale $locale{English}":
@english_names = ():
while ($name =~ /\b(\w+)\b/g) {
push(@english_names, ucfirst($l)):
}
setlocale(LC_CTYPE. $1ocale{German})
or die "Invalid locale $locale{German}":
@german_names = ():
while ($name =~ /\b(\w+)\b/g) {
push(@german_names. ucfirst($l)):
}
print "English names: @english_names\n";
print "German names: @german_names\n":
English names: Andreas К Nig
German names: Andreas Konig
Решение зависит от поддержки локальных контекстов в стандарте POSIX.
Ваша система может обладать, а может и не обладать такой поддержкой. Но
даже если система заявляет о поддержке локальных контекстов POSIX, в стан-
дарте не определены имена локальных контекстов. Разумеется, переносимость
такого решения не гарантирована. Если данные изначально хранятся в Юнико-
де, поддержка локальных контекстов POSIX не обязательна.
См. также
Описание метасимволов \b, \w и \s в perlre(l), описание локальных контекстов
Perl в perllocale(V) и странице руководства locale(3) вашей системы; рецепт 6.2;
раздел «POSIX — попытка стандартизации» главы 3 книги «Регулярные выра-
жения: Библиотека программиста, 2 издание».
6.13. Неформальный поиск
Проблема
Требуется выполнить неформальный поиск по шаблону.
Задача часто возникает в ситуации, когда пользовательский ввод может быть
неточным или может содержать ошибки.
244
Глава 6. Поиск по шаблону
Решение
Воспользуйтесь модулем CPAN String:: Approx:
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: $!";
whl1e(<DICT>) {
print If amatchC'balast"):
}
ballast
ballustrade
blast
blastula
sandblast
Функции amatch также можно передать параметры, управляющие учетом ре-
гистра и количеством допустимых вставок, удалений и подстановок. Параметры
передаются в виде ссылки на список. Они полностью описаны в документации
по String::Approx.
Следует заметить, что поисковые функции модуля работают в 10—40 раз мед-
леннее встроенных функций Perl. Используйте String::Approx лишь в том слу-
чае, если регулярные выражения Perl не справляются с неформальным поиском.
См. также
Документация по модулю CPAN String:: Approx; рецепт 1.22.
6.14. Поиск от последнего совпадения
Проблема
Требуется возобновить поиск с того места, где было найдено последнее совпаде-
ние. Такая возможность пригодится при многократном извлечении фрагментов
данных из строки.
6.14. Поиск от последнего совпадения
245
Решение
Воспользуйтесь комбинацией модификаторов /д и /с, якорного метасимвола \G
и функции pos.
Комментарий
При наличии модификатора /д механизм поиска запоминает текущую позицию
в строке. Если при следующем поиске в этой строке также используется модифи-
катор /д, то совпадения ищутся, начиная с сохраненной позиции. В частности,
это позволяет создать цикл while для последовательного извлечения совпадений
из строки. В следующем примере из строки извлекаются все неотрицательные
целые числа:
while (/(\d+)/g) {
print "Found $l\n";
}
Присутствие \G в шаблоне привязывает поиск к концу предыдущего совпаде-
ния. Например, если число хранится в строке с начальными пробелами, то заме-
на каждого пробела нулем может выполняться так:
$п = " 49 here":
$n =~ s/\G /О/g;
print $n:
00049 here
Модификатор \G часто применяется в циклах while. Например, в следующем
примере он применяется для разбора списка чисел, разделенных запятыми:
while (/\G,?(\d+)/g) {
print "Found number $l\n";
}
Если поиск закончился неудачей (например, если в последнем примере кончи-
лись числа), сохраненная позиция по умолчанию перемещается в начало строки.
Если это нежелательно (например, требуется продолжить поиски с текущей пози-
ции, но с другим шаблоном), воспользуйтесь модификатором /с в сочетании с /д:
$_ = "The year 1752 lost 10 days on the 3rd of September":
while (/(\d+)/gc) {
print "Found number $l\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.
246
Глава 6. Поиск по шаблону
Как видите, при последовательном применении шаблонов можно изменять
позицию начала поиска с помощью модификатора /д. Позиция последнего сов-
падения связывается со скалярной величиной, в которой происходит поиск, а не
с шаблоном, и сбрасывается в случае изменения строки.
Позиция последнего совпадения читается и задается функцией pos. Аргумен-
том функции является строка, для которой читается или задается позиция по-
следнего совпадения.
$а = "Didst thou think that the eyes of the White Tower were blind?";
$a =~ /(\w{5.})/g:
print "Got $1. position in \$a is ". pos($a). "\n":
Got Didst, position in $a is 5
pos($a) = 30:
$a =~ /(\w{5.})/g;
print "Got $1. position in \$a now ". pos($a). "\n":
Got White, position in $a now 43
Если аргумент не указан, pos работает с переменной
$_ = "Nay, I have seen more than thou knowest. Grey Fool.":
/(\w{5.})/g:
print "Got $1. position in \$_ is ". pos. "\n";
pos = 42:
/\b(\w+)/g:
print "Next full word after position 42 is $l\n":
Got knowest, position in $_ is 39
Next full word after position 42 is Fool
См. также
Описание модификаторов /g и /с в perlre(l).
6.15. Максимальный и минимальный поиск
Проблема
Шаблон содержит максимальный квантификатор — *,+,? или {}. Требуется пе-
рейти от максимального поиска к минимальному.
Классический пример — наивная подстановка для удаления тегов из HTML-
документа. Хотя s#<TT>.*</TT>##gsi выглядит соблазнительно, в действительности
будет удален весь текст от первого открывающего до последнего закрывающего
тега ТТ. От строки "Even <TT>v1</TT> can edit <TT>troff</TT> effectively." остает-
ся лишь "Even effectively" — смысл полностью изменился!
Решение
Замените максимальный квантификатор соответствующим минимальным. Дру-
гими словами, *, +, ? или {} соответственно заменяются *?, +?, ?? и {}?.
6.15. Максимальный и минимальный поиск 247
Комментарий
В Perl существует два набора квантификаторов: максимальные (*,+,? и {})
и минимальные1 (*?, +?, ?? и {}?). Например, для строки "Perl is a Swiss Army
Chainsaw!" шаблон /(r.*s)/ совпадет c "rl is a Swiss Army Chains", а шаблон
/(r.*?s)/ - c "rl is".
Если шаблон содержит максимальный квантификатор, то при поиске под-
строки, которая может встречаться переменное число раз (например, 0 и более
раз для * или 1 и более раз для +), механизм поиска всегда предпочитает «и более».
Следовательно, шаблон /foo.*bar/ совпадает от первого "foo" до последнего "bar" —
а не до следующего "bar", как можно ожидать. Чтобы при поиске предпочтение
отдавалось минимальным, а не максимальным совпадениям, поставьте после кван-
тификатора вопросительный знак. Таким образом, *?, как и * соответствует О
и более повторений, но при этом выбирается совпадение минимальной, а не мак-
симальной длины.
# Максимальный поиск
s/<.*>//gs; # Неудачная попытка удаления тегов
# Минимальный поиск
s/<.*?>//gs; # Неудачная попытка удаления тегов
Показанное решение не обеспечивает правильного удаления тегов из HTML-
документа, поскольку отдельное регулярное выражение не заменит полноцен-
ного анализатора. Правильное решение этой проблемы продемонстрировано
в рецепте 20.6.
Впрочем, с минимальными совпадениями дело обстоит не так просто. Не сто-
ит ошибочно полагать, что BEGIN.*?END в шаблоне всегда соответствует самому
короткому текстовому фрагменту между соседними экземплярами BEGIN и END.
Возьмем шаблон /BEGIN(.*?)END/. После поиска в строке "BEGIN and BEGIN and END"
переменная $1 будет содержать "and BEGIN and". Вероятно, вы рассчитывали на
другой результат.
Представьте, что мы хотим извлечь из HTML-документа весь текст, оформ-
ленный полужирным и курсивным шрифтом одновременно:
<b><1>this</1> and <1>that</i> are important</b> Oh, <b><i>me too!</1></b>
Может показаться, что шаблон для поиска текста, находящегося между пара-
ми тегов HTML (то есть не включающий теги), должен выглядеть так:
т{ <Ь><1>(.*?)</1></b> }sx;
Как ни странно, шаблон этого не делает. Многие ошибочно полагают, что он
сначала находит последовательность "<Ь><1>", затем нечто отличное от "<Ь><1>",
а затем — "</1></Ь>", оставляя промежуточный текст в $1. Хотя по отношению
к входным данным он часто работает именно так, в действительности делается
совершенно иное. Шаблон просто находит ближнюю к левому краю строку
1 Также часто называемые «жадными» (greedy) и «ленивыми» (lazy) квантификаторами. —
Примеч. перев.
248
Глава 6. Поиск по шаблону
минимальной длины, которая соответствует всему шаблону. В данном примере
это вся строка. Если вы хотели ограничиться текстом между "<Ь><1>" и парными
тегами "</1></Ь>", не включающим другие теги полужирного или курсивного на-
чертания, результат окажется неверным.
Если искомая строка состоит всего из одного символа, инвертированный класс
(например, /Х[^Х]*)Х/) работает гораздо эффективнее минимального поиска.
Однако обобщенный шаблон, который находит «сначала BEGIN, затем не-BEGIN,
затем END» для произвольных BEGIN и END и сохраняет промежуточный текст в $1,
выглядит следующим образом:
/BEGIN((?:(?!BEGIN).)*)END/s
Или в более наглядном виде:
BEGIN # Найти начальную часть
( # Сохранить группу в $1
(?: # Несохраняющая группировка
(?! BEGIN) # проверка: исключаем другие вхождения BEGIN
# Один произвольный символ
) * # Вся группа 0 и более раз
) # Завершение группы $1
END # Найти завершающую часть
} SX
Впрочем, может оказаться, что и этот вариант вас не устроит. Максимальный
квантификатор * означает максимизацию части, хранящейся в $1, а это означает,
что в $1 сохраняется часть от последнего вхождения BEGIN до последнего (а не
первого!) вхождения END. Следовательно, для исходной строки
$ = "BEGIN1 BEGIN2 BEGIN3 3END 2END 1END"
в $1 будут сохранены символы "3 3END 2END 1". При переходе на минимальный
квантификатор
/BEGIN((?:(?'BEGIN).)*?)END/s
в $1 окажется строка "3 3". Теперь добавим рядом с существующей опережаю-
щей проверкой еще одну: (?!END). Получится следующее регулярное выражение:
BEGIN
(
(?:
(?! BEGIN
(?! END
) *
)
END
}sx
# Найти начальную часть
# Сохранить группу в $1
# Несохраняющая группировка
) # проверка: исключаем другие вхождения BEGIN
) # проверка: также исключаются вхождения END
# Один произвольный символ
# Вся группа 0 и более раз
# Завершение группы $1
Вместо введения новой опережающей проверки также можно дополнить суще-
ствующую конструкцией выбора: (?!BEGIN|END). В этом случае наш пример с тега-
ми HTML выглядит приблизительно так:
т{ <Ь><1>( (?: (?!</Ь>|</1>). )* ) </1></b> }sx:
6.16. Поиск повторяющихся слов
249
или так:
т{ <Ь><1>( (?: (?!</[1Ь]>). )* ) </1></b> }sx:
Как замечает Джеффри Фридл, это скороспелое решение не очень эффективно.
В ситуациях, где скорость действительно важна, он предлагает воспользоваться
более сложным шаблоном:
т{
<Ь><1>
[ж<]* # Заведомо допустимо
(?:
# Символ '<’ возможен, если он не входит в недопустимую конструкцию
(?! </?[1Ь]> ) # Недопустимо
< # Все нормально, найти <
[ж<]* # и продолжить
) *
</1></Ь>
} SX
Данное решение является разновидностью методики «раскрутки цикла», опи-
санной в главе 6 книги «Регулярные выражения: Библиотека программиста, 2 из-
дание».
См. также
Описание минимальных квантификаторов в разделе «Regular Expressions» perlre(V).
6.16. Поиск повторяющихся слов
Проблема
Требуется найти в документе повторяющиеся слова.
Решение
Воспользуйтесь обратными ссылками в регулярных выражениях.
Комментарий
Механизм поиска запоминает часть строки, которая совпала с частью шаблона,
заключенной в круглые скобки. Позднее в шаблоне конструкция \1 ссылается
на первый совпавший фрагмент, \2 — на второй и т. д. Не используйте обозначе-
ние $1 — оно интерпретируется как переменная и интерполируется до начала
поиска. Шаблон /([А-Z])\1/ совпадает с символом верхнего регистра, за которым
следует не просто другой символ верхнего регистра, а именно тот, что был со-
хранен в первой паре скобок.
Следующий фрагмент читает входной файл по абзацам. При этом исполь-
зуется принятое в Perl определение абзаца как фрагмента, заканчивающегося
250
Глава 6. Поиск по шаблону
двумя и более смежными переводами строк. Внутри каждого абзаца программа
находит все повторяющиеся слова. Программа не учитывает регистр символов
и допускает межстрочные совпадения.
Модификатор /х разрешает внутренние пропуски и комментарии, упрощаю-
щие чтение регулярных выражений. Модификатор /1 позволяет найти оба эк-
земпляра "1s" в предложении "Is Is this ok?". Модификатор /g в цикле while
продолжает поиск повторяющихся слов до конца текста.
$/=’’: # Режим чтения абзацев
while (<>) {
while ( m{
\b # Начать с границы слова
(\S+) # Искать последовательность "не-пропусков"
\Ь # До другой границы слова
(
\s+ # Разделяющие пропуски
\1 # И тот же самый фрагмент
\Ь # До другой границы слова
) + # Повторяется один или несколько раз
}х1д
)
print "dup word '$Г at paragraph $.\n":
}
}
Приведенный фрагмент найдет удвоенное test в следующем примере:
This is a test
test of the duplicate word funder.
Проверка \S+ между двумя метасимволами границ слов обычно нежелательна,
поскольку при этом происходит нечто неожиданное. Граница слова в Perl опреде-
ляется как переход между \w (алфавитно-цифровым символом или подчеркива-
нием) и либо концом строки, либо не-Xw. Но между двумя \Ь последовательность
\S+ (один и более символов, не являющихся пропусками) приобретает несколь-
ко иной смысл — она интерпретируется как последовательность символов, не
являющихся пропусками, первый и последний символ которой должны быть
алфавитно-цифровыми символами или подчеркиваниями.
Впрочем, иногда именно это и нужно. Рассмотрим следующую строку:
Sstring = q("I can't see this." she remarked.):
@a = Sstring =~ /\b\S+\b/g;
@b = Sstring =~ /\S+/g:
Массив @a содержит следующие элементы:
0 I
1 can't
2 see
3 this
4 she
5 remarked
6.16. Поиск повторяющихся слов
251
тогда как массив @Ь выглядит так:
О "I
1 can't
2 see
3 this."
4 she
5 remarked.
Рассмотрим другой интересный пример использования обратных ссылок.
Представьте себе два слова, причем конец первого совпадает с началом второго,
например, "nobody" и "bodysnatcher". Требуется найти подобные «перекрытия»
и сформировать строку вида "nobodysnatcher". Это вариация на тему нашей основ-
ной проблемы — повторяющихся слов.
Чтобы решить эту задачу, программисту на С, привыкшему к традицион-
ной последовательной обработке байтов, придется написать длинную и запу-
танную программу. Но благодаря обратным ссылкам задача сводится к одному
простому поиску:
$а = 'nobody* ;
$b = 'bodysnatcher':
If ("$а $b" =~ /^(\w+)(\w+) \2(\w+)$/) {
print "$2 overlaps in $l-$2-$3\n":
}
body overlaps in no-body-snatcher
Казалось бы, из-за наличия максимального квантификатора переменная $1
должна захватывать все содержимое "nobody". В действительности так и про-
исходит — на некоторое время. Но после этого не остается ни одного символа,
который можно было бы занести в $2. Механизм поиска дает задний ход, и $1
неохотно уступает один символ переменной $2. Пробел успешно совпадает, но
далее в шаблоне следует конструкция \2, которая в настоящий момент содержит
просто "у". Следующий символ в строке — не "у", а "Ь". Механизм поиска делает
следующий шаг назад; через некоторое время $1 уступит $2 достаточно симво-
лов, чтобы шаблон нашел фрагмент, пробел и затем тот же самый фрагмент.
Этот прием не работает, если само перекрытие содержит повторяющиеся
фрагменты, как, например, для строк "rococo" и "cocoon". Приведенный выше
алгоритм решит, что перекрываются символы "со", а не "coco". Однако мы хотим
получить не "rocococoon", а "гососооп". Задача решается включением минималь-
ного квантификатора в группу $1:
/4\w+?)(\w+) \2(\w+)$/
Трудно представить, насколько мощными возможностями обладают обратные
ссылки. Пример 6.8 демонстрирует принципиально новый подход к проблеме
разложения числа на простые множители (см. главу 2 «Числа»).
Пример 6.8. prime-pattern
#!/usr/bin/perl
# prime_pattern - разложение аргумента на простые множители по шаблону
for ($N = ('o' х shift): $N =~ /ж(оо+?)\1+$/: $N =~ s/$l/o/g) {
print 1ength($1). "
}
print length ($N), "\n";
252
Глава 6. Поиск по шаблону
Несмотря на свою непрактичность этот подход отлично демонстрирует воз-
можности обратных ссылок и потому весьма поучителен.
Приведем другой пример. Гениальная идея, предложенная Дугом Мак-Илроем
(Doug McIlroy), — во всяком случае, так утверждает Эндрю Хьюм (Andrew
Hume), — позволяет решать диофантовы уравнения первого порядка с помощью
регулярных выражений. Рассмотрим уравнение 12х + 15у + 16z = 281. Сможете
ли вы найти возможные значения х, у и z? А вот Perl может!
# Решение 12х + 15у + 16z = 281 для максимального х
if (($Х. $Y. $Z) =
(('o' х 281) =~ Г(о*)\1{11}(о*)\2{14}(о*)\3{15}$/))
{
($х. $у, $z) = (length($X). length($Y). length($Z)):
print "One solution Is: x=$x; y=$y: z=$z.\n":
} else {
print "No solution.\n";
1
One solution is: x=17; y=3; z=2.
Поскольку для первого о* ищется максимальное совпадение, х растет до мак-
симума. Замена одного или нескольких квантификаторов * на*?, + или +? дает
другие решения:
((’о1 х 281) =~ /х(о+)\1{11}(о+)\2{14}(о+)\3{15}$/))
One solution is: х=17; у=3; z=2.
(('o' х 281) =~ /х(о*?)\1{11}(о*)\2{14}(о*)\3{15}$/))
One solution is: x=0; y=17; z=ll.
(('o' x 281) =~ /x(o+?)\l{ll}(o*)\2{14}(o*)\3{15}$/))
One solution is: x=l; y=3; z=14.
Подобные демонстрации математических возможностей выглядят потрясающе,
но из них следует вынести один важный урок: механизм поиска по шаблону (осо-
бенно с применением обратных ссылок) всей душой желает предоставить вам
ответ и будет трудиться с феноменальным усердием. Однако обратные ссылки
в регулярных выражениях могут привести к экспоненциальному росту времени
выполнения. Для любых нетривиальных данных программа будет работать так
медленно, что даже дрейф континентов по сравнению с ней покажется быстрым.
См. также
Описание обратных ссылок в разделе «Regular Expressions» perlre(l); раздел
«Задача с повторяющимися словами» книги «Регулярные выражения: Библио-
тека программиста, 2 издание».
6.17. Поиск вложенных конструкций
Проблема
Требуется найти парные ограничители, внутри которых могут находиться вло-
женные пары ограничителей, например, круглые скобки при вызове функции.
6.17. Поиск вложенных конструкций
253
Решение
Используйте рекурсивную интерполяцию шаблона во время поиска:
ту $пр;
Snp = qr{
\(
(?:
(?> [х( )]+ ) # Несохраняющая группа без возврата
(??{ $пр }) # Группировка с парными круглыми скобками
)*
\)
}х:
Также можно воспользоваться функцией extract_bracketed модуля Text: balanced.
Комментарий
Конструкция $(??{ КОД }) выполняет заданный фрагмент кода и интерполирует
полученную строку в шаблон. Для примера рассмотрим простую, нерекурсив-
ную программу поиска палиндромов:
If (Sword =~ /x(\w+)\w?(??{reverse $1})$/ ) {
print "Sword is a pal indrome.\n":
Допустим, программа находит слово «reviver», которое правильно распозна-
ется этим шаблоном как палиндром. В определенный момент поиска в перемен-
ной $1 окажется строка "rev". Следующий необязательный метасимвол \w совпа-
дает с "i". После этого выполняется фрагмент reverse $1 и дает строку "ver"; этот
результат интерполируется в шаблон.
При поиске парных конструкций приходится использовать рекурсию, что
несколько усложняет решение. Откомпилированный шаблон с конструкцией
(??{...}) может содержать ссылку на самого себя. Приведенный в Решении шаб-
лон находит парные круглые скобки независимо от глубины вложения. При
таком определении $пр поиск круглых скобок при вызове функции может вы-
полняться так:
Stext = "myfunfund, (2*(3+4)) .5)";
Sfunpat = qr/\w+$np/: # Определение Snp см. выше
Stext =~ /x$funpat$/: # Есть совпадение!
Архив CPAN содержит много модулей, предназначенных для поиска вложен-
ных строк. Модуль Regexp:: Common содержит готовые шаблоны для многих нетри-
виальных ситуаций. Например:
use Regexp::Common:
Stext = "myfunfund, (2*(3+4)) ,5)";
if (Stext =~ /(\w+\s*$RE{balanced}{-parens=>'( )'})/o) {
print "Got function call: $l\n":
254
Глава 6. Поиск по шаблону
Другие шаблоны, содержащиеся в этом модуле, предназначены для поис-
ка чисел в разных вариантах записи, а также строк, заключенных в ограничи-
тели:
$RE{ num} {1 rrt}
$RE{num}{real}
$RE{num}{real}{’-base=2*}{'-sep=,'}{'-group=3‘}
$RE{quoted}
$RE{del1mlted}{-del1m=>’/’}
Стандартный (начиная с версии 5.8) модуль Text: -.Balanced содержит общее
решение этой проблемы:
use Text::Balanced qw/extract_bracketed/:
Stext = "myfunfunU,(2*(3+4)).5)":
If ((Sbefore. Sfound. Safter) = extract_bracketed($text. "("I) {
print "answer Is $found\n":
} else {
print "FAILEDW;
См. также
Документация по модулю CPAN Regexp:: Common и стандартному модулю Text:
balanced.
6.18. Логические операции AND,
OR и NOT в одном шаблоне
Проблема
Имеется готовая программа, которой в качестве аргумента или входных данных
передается шаблон. В нее невозможно включить дополнительную логику, на-
пример, параметры для управления учетом регистра при поиске, AND и NOT.
Следовательно, вы должны написать один шаблон, который будет совпадать
с любым из двух разных шаблонов (OR), двумя шаблонами сразу (AND) или
менять смысл поиска на противоположный (NOT).
Подобная задача часто возникает при загрузке данных из конфигурационных
файлов, веб-форм или аргументов командной строки. Пусть у вас имеется про-
грамма, в которой присутствует следующий фрагмент:
chomp($pattern = <CONFIG_FH>):
If ( $data =- /Spattern/ ){...}
Если вы отвечаете за содержимое CONFIG_FH, вам понадобятся средства для
передачи программе поиска логических условий через один-единственный
шаблон.
6.18. Логические операции AND, OR и NOT в одном шаблоне
255
Решение
Следующие выражения истинны при совпадении /ALPHA/ или /ВЕТА/ (аналогич-
но /ALPHA/ || /ВЕТА/):
/ALPHA|ВЕТА/
/(?:ALPHA)|(?:ВЕТА)/ # Работает независимо от содержания ALPHA и ВЕТА
Выражение истинно, если и /ALPHA/ и /ВЕТА/ совпадают с возможными пе-
рекрытиями (то есть когда подходит строка "BETALPHA’). Аналогично /ALPHA/
&& /ВЕТА/:
/x(?=.*ALPHA)BETA)/s
Выражение истинно, если и /ALPHA/ и /ВЕТА/ совпадают при запрещенных
перекрытиях (то есть когда "BETALPHA” не подходит):
/ALPHA.*ВЕТА|ВЕТА.*ALРНА/S
Выражение истинно, если шаблон /РАТ/ не совпадает (аналогично Svar !~
/РАТ/):
/А(?: (?! РАТ). )*$/s
Выражение истинно, если шаблон BAD не совпадает, а шаблон GOOD совпа-
дает:
/(?=0?:(?'BAD)0*$)GOOD/s
(Вообще говоря, нельзя рассчитывать на возможность включения модифика-
тора /s после завершающего символа /, но в конце Комментария будет показано,
как включить этот модификатор прямо в шаблон.)
Комментарий
Предположим, вы пишете программу и хотите проверить некоторый шаблон на
несовпадение. Воспользуйтесь одним из вариантов:
if (!(Sstring =~ /pattern/)) { someth!ng() } # Некрасиво
if ( Sstring /pattern/) { somethingO } # Рекомендуется
unless ( Sstring =~ /pattern/) { somethingO } # Более наглядно
Если потребовалось убедиться в совпадении обоих шаблонов, примените сле-
дующую запись:
If (Sstring =~ /patl/ && Sstring =~ /pat2/ ) { somethingO }
Проверка совпадения хотя бы одного из двух шаблонов выполняется так:
If (Sstring =~ /patl/ || Sstring =~ /pat2/ ) { somethingO }
Вместо того чтобы совмещать все проверки в одном шаблоне, часто бывает
проще и эффективнее использовать нормальные логические связки Perl. Но да-
вайте рассмотрим программу mini grep из примера 6.9, которая в качестве аргу-
мента получает всего один шаблон.
256
Глава 6. Поиск по шаблону
Пример 6.9. minigrep
#!/usr/Ы n/perl
# minigrep - тривиальный поиск
Spat = shift:
while (<>) {
print If /$pat/o;
}
Если потребуется сообщить mini grep, что некоторый шаблон не должен сов-
падать или что должны совпасть оба мини-шаблона в произвольном порядке, вы
оказываетесь в тупике. Программа просто не предусматривает подобных конст-
рукций. Как сделать все в одном шаблоне? Подобные задачи нередко возникают
в программах, читающих шаблоны из конфигурационных файлов.
Проблема с OR решается просто благодаря символу альтернативного вы-
бора |. Однако AND и NOT потребуют особого кодирования.
В случае с AND придется различать перекрывающиеся и неперекрывающие-
ся совпадения. Допустим, вы хотите узнать, совпадают ли в некоторой строке
шаблоны "bell" и "lab”. Если разрешить перекрытия, слово "labelled" пройдет
проверку, а если отказаться от перекрытий — нет. В случае с перекрытиями по-
требуются две опережающие проверки:
"labelled" =~ /А(?=.*Ье11)lab/s
Помните: в нормальной программе подобные извращения не нужны. Доста-
точно указать:
Sstrlng =~ /bell/ && Sstrlng =~ /lab/
Чтобы раскрыть смысл этого шаблона, мы воспользуемся модификатором /х
с комментариями. Развернутая версия шаблона выглядит так:
If (Smurray_h111 =~ m{
х # Начало строки
(?= # Опережающая проверка нулевой ширины
.* # Любое количество промежуточных символов
bell # Искомая строка bell
) # Вернуться, мы лишь проверяем
lab # Искомая строка labs
}sx ) # /s разрешает совпадение . с переводом строки
{
print "Looks like Bell Labs might be In Murray Hill!\n":
}
Мы не воспользовались .*? для раннего завершения поиска, поскольку мини-
мальный поиск обходится дороже максимального. Поэтому для произвольных
входных данных, где совпадение с равной вероятностью может произойти как
в начале, так и в конце строки, .* будет эффективнее нашего решения. Разу-
меется, выбор между . * и . *? иногда определяется правильностью программы,
а не эффективностью, но не в данном случае.
Для обработки неперекрывающихся совпадений шаблон будет состоять из двух
частей, разделенных OR. В первой части "lab" следует после "bel 1", а во второй —
наоборот:
"labelled" =~ /(?:'.*bell .*lab) | (? :\*lab.*bell)/
6.18. Логические операции AND, OR и NOT в одном шаблоне
257
или в развернутой форме:
$brand = "labelled":
if ($brand =~ m{
(?: # Группировка без сохранения
# Любое количество начальных символов
bell # Искомая строка bell
.*? # Любое количество промежуточных символов
lab # Искомая строка lab
) # Конец группировки
1 # Или попробовать другой порядок
(?: # Группировка без сохранения
A.*? # Любое количество начальных символов
lab # Искомая строка lab
.*? # Любое количество промежуточных символов
bell # Искомая строка bell
) # Конец группировки
}sx ) # /s разрешает совпадение . с переводом строки
{
print "Our brand has bell and lab separate.\n";
Такие шаблоны не всегда работают быстрее. $murray_hi 11 =~ /bel 1 / && $murray_
hille =~ /lab/ сканирует строку не более двух раз, однако для (?=A.*?bell)
(?=А.*?1аЬ) механизм поиска ищет "lab" для каждого экземпляра "bell", что
в наихудшем случае приводит к квадратичному времени выполнения.
Тем, кто внимательно рассмотрел эти два случая, шаблон NOT покажется
тривиальным. Обобщенная форма выглядит так:
$тар =~ /А(?:(?!waldo).)*$/s
То же в развернутой форме:
if ($map =~ m{
А # Начало строки
(?: # Группировка без сохранения
(?! # Опережающая негативная проверка
waldo # Нашли впереди?
) # Если да, отрицание не выполняется
# Любой символ (благодаря /s)
) * # Повторить группировку 0 и более раз
$ # До конца строки
}sx ) # /s разрешает совпадение . с переводом строки
{
print "There's no waldo here!\n":
}
Как объединить в одном шаблоне AND, OR и NOT? Результат выглядит от-
вратительно, и в обычных программах делать нечто подобное практически нико-
гда не следует. Однако при обработке конфигурационных файлов или команд-
ных строк, где вводится всего один шаблон, у вас нет выбора. Объедините все
изложенное выше. Будьте осторожны.
Предположим, вы хотите запустить программу UNIX w и узнать, зарегистри-
ровался ли пользователь tchrist с любого терминала, имя которого начинается
не с ttyp; иначе говоря, шаблон "tchrist" должен совпадать, a "ttyp" — нет.
258
Глава 6. Поиск по шаблону
Примерный вывод w в моей системе Linux выглядит так:
7:15am up 206 days, 13:30, 4 users, load average: 1.04, 1.07, 1.04
USER TTY FROM LOGINS IDLE JCPU PCPU WHAT
tchri st ttyl 5:16pm 36days 24:43 0.03s xinit
tchri st tty2 5:19pm 6days 0.43s 0.43s -tcsh
tchri st ttypO chthon 7:58am 3days 23:44s 0.44s -tcsh
gnat ttys4 coprolith 2:01pm 13:36m 0.30s 0.30s -tcsh
Посмотрим, как поставленная задача решается с помощью приведенной выше
программы mini grep или программы tcgrep, приведенной в конце главы:
% w | minigrep '(?!.*ttyp)tchrist'
Расшифровка структуры шаблона:
П1 {
(?! # Опережающая проверка нулевой ширины
.* # Любое количество любых символов (быстрее .*?)
ttyp # Строка, которая не должна находиться
) # Опережающая отрицательная проверка: возврат к началу
tchrist # Пытаемся найти пользователя tchrist
}х
Неважно, что любой нормальный человек в такой ситуации дважды вызыва-
ет grep (из них один — с параметром -v, чтобы отобрать несовпадения):
% w | grep tchrist | grep -v ttyp
Главное — что логические конъюнкции и отрицания можно закодировать в од-
ном шаблоне. Однако подобные вещи следует снабжать комментариями — пожа-
лейте тех, кто займется ими после вас.
И последнее: как внедрить модификатор /sb шаблон, передаваемый програм-
ме из командной строки? По аналогии с /i, который в шаблоне превращается
в (?i). Модификаторы /s и /т также безболезненно внедряются в шаблоны в виде
/(?s) или /(?т). Их даже можно группировать, например, /(?smi). Следующие две
строки фактически эквивалентны:
% grep -i 'ШАБЛОН' ФАЙЛЫ
% minigrep '(?i)ШАБЛОН' ФАЙЛЫ
Модификатор, активизированный таким способом, распространяется на весь
шаблон. Также существует альтернативная запись, ограничивающая область дейст-
вия модификатора, — используйте несохраняющую группировку и размести-
те модификаторы между вопросительным знаком и двоеточием. Вывод регуляр-
ного выражения, обработанного оператором qr//, показывает, как это делается:
% perl -le 'print qr/pattern/i'
(?i-xsm:pattern)
Модификаторы, находящиеся до дефиса, действуют только в этом шаблоне
(а модификаторы, находящиеся после дефиса, подавлены для данного шаблона).
См. также
Описание опережающих проверок в разделе «Regular Expressions» perlre(l)] стра-
ницы руководства grep(l) и да(1) вашей системы. Работа с конфигурационными
файлами рассматривается в рецепте 8.16.
6.19. Проверка адресов электронной почты
259
6.19. Проверка адресов электронной почты
Проблема
Требуется построить шаблон для проверки адресов электронной почты.
Решение
Задача в принципе неразрешима, проверка адреса электронной почты в реальном
времени невозможна. Приходится выбирать один из возможных компромиссов.
Комментарий
При проверке почтового адреса мы рекомендуем запросить его повторно, как
это часто делается при проверке пароля. При этом обычно исключаются опечат-
ки. Если обе версии совпадут, отправьте на этот адрес личное сообщение сле-
дующего содержания:
Дорогой someuser@host.coni.
Просим подтвердить почтовый адрес, сообщенный вами в 10:29:01 29 июня 2003 года. Для этого
достаточно ответить на настоящее сообщение. Включите в ответ строку "Rumpelstl1tskln".
но в обратном порядке (то есть начиная с "Nik..."). После этого ваш подтвержденный
адрес будет занесен в нашу базу данных.
Если вы получите ответное сообщение и ваши указания будут выполнены,
можно с достаточной уверенностью предположить, что адрес правилен.
Возможна и другая стратегия, которая обеспечивает лучшую защиту от под-
делок, — присвойте своему адресату личный идентификатор (желательно слу-
чайный) и сохраните его вместе с адресом для последующей обработки. В отправ-
ленном сообщении попросите адресата включать личный идентификатор в свои
ответы. А чтобы идентификатор не мог использоваться посторонними (напри-
мер, при возврате недоставленного сообщения или при включении рассылки
в сценарий), попросите адресата слегка изменить идентификатор, например, по-
менять порядок символов, прибавить или вычесть 1 из каждой цифры и т. д.
Многие шаблоны, предлагаемые для решения этой проблемы, попросту не-
верны. Допустим, адрес this&that@somewhere.com правилен и по нему возможна
доставка почты (на момент написания книги), однако большинство шабло-
нов, претендующих на проверку почтовых адресов, бесславно споткнутся на нем.
1 while $addr =~ s/\([x()]*\)//g;
Вообще говоря, для проверки соответствия RFC можно воспользоваться 6598-
байтовым шаблоном, приведенным на последней странице первого издания книги
«Регулярные выражения: Библиотека программиста», но даже эта чудовищная
конструкция не идеальна по трем причинам.
Во-первых, не по всем адресам, соответствующим спецификации RFC, воз-
можна доставка. Например, адрес foo@foo. too. too. too теоретически правилен, но
260
Глава 6. Поиск по шаблону
на практике доставить на него почту невозможно. Некоторые программисты пы-
таются искать записи MX на серверах DNS или даже проверяют адрес на хосте,
обрабатывающем его почту. Такой подход неудачен, поскольку большинство уз-
лов не может напрямую подключиться к любому другому узлу, но даже если бы
это было возможно, получающие почту узлы обычно либо игнорируют команду
SMTP VRFY, либо откровенно врут.
Во-вторых, почта может прекрасно доставляться по адресам, не соответствую-
щим RFC. Например, сообщение по адресу postmaster почти наверняка будет дос-
тавлено, но этот адрес не соответствует канонам RFC 822 — в нем нет символа
В-третьих (самая важная причина), даже если адрес правилен и по нему воз-
можна доставка, это еще не означает, что он вам подойдет. Например, адрес
pres1dent@whitehouse.gov соответствует стандартам RFC и обеспечивает доставку.
И все же крайне мало вероятно, чтобы этот адресат стал поставлять информа-
цию для вашего сценария CGI.
Модуль Email:: Vai Id предпринимает отважную (хотя и далеко не безупреч-
ную) попытку решить задачу проверки почтовых адресов. Эта программа выки-
дывает множество фортелей, среди которых — проверка регулярного выражения
на соответствие RFC-822, просмотр записей MX DNS и стоп-списки для руга-
тельств и имен знаменитостей. Но и такой подход оказывается откровенно сла-
бым. Прием, предложенный в начале Комментария, проще реализуется и в мень-
шей степени подвержен ошибкам.
См. также
Рецепт 18.16.
6.20. Поиск сокращений
Проблема
Предположим, у вас имеется список команд, например, "send”, "abort”, "list”
и "edit". Пользователь вводит лишь часть имени команды, и вы не хотите за-
ставлять его вводить всю команду до конца.
Решение
Воспользуйтесь следующим решением, если все строки начинаются с разных
символов или если одни совпадения имеют более высокий приоритет по сравне-
нию с другими (например, если "SEND" отдается предпочтение перед "STOP"):
chomp (Sanswer = <>):
If ("SEND" =~ /x\Q$answer\i)
elslf ("STOP" =~ /x\Q$answer\i)
elslf ("ABORT" =~ r\Q$answer\1)
elslf ("LIST" =~ /x\Q$answer\i)
elslf ("EDIT" =~ /x\Q$answer\i)
{ print "Action Is send\n" }
{ print "Action is stop\n" }
{ print "Action is abort\n" }
{ print "Action is list\n" }
{ print "Action is edit\n" }
6.20. Поиск сокращений
261
Кроме того, можно воспользоваться модулем Text: :Abbrev:
use Text::Abbrev;
$href = abbrev qw(send abort list edit):
for (print "Action: ": <>; print "Action: ") {
chomp:
my $act1on = $href->{ lc($_) };
print "Action Is $act1on\n":
}
Комментарий
В первом решении изменяется стандартный порядок операндов при поиске; обыч-
но слева указывается переменная, а справа — шаблон. Мы бы также могли попы-
таться определить, какое действие выбрал пользователь, с помощью конструк-
ции $answer= =~ /^ABORT/1. Выражение будет истинным, если $answer начинается
со строки "ABORT". Однако совпадение произойдет и в случае, если после "ABORT"
в $answer следует что-то еще, скажем, для строки "ABORT LATER". Обработка со-
кращений обычно выглядит весьма уродливо: $answer =~ /^A(B(0(R(T)?)?)?)?$/1.
Сравните классическую конструкцию "переменная =~ шаблон" с "ABORT" =~
/^\Q$answer/1. \Q подавляет интерпретацию метасимволов, чтобы ваша програм-
ма не «рухнула» при вводе пользователем неверного шаблона. Когда пользова-
тель вводит что-нибудь типа "ab", после замены переменной шаблон принимает
вид "ABORT" =~ ЛаЬ/1. Происходит совпадение.
Стандартный модуль Text::Abbrev работает иначе. Вы передаете ему список
слов и получаете ссылку на хэш, ключи которого представляют собой все одно-
значные сокращения, а значения — полные строки. Если ссылка $href создается
так, как показано в Решении, $href->{"a"} вернет строку "abort".
Подобная методика часто используется для вызова функции по имени, вво-
димому пользователем. В принципе возможно решение с использованием сим-
волических ссылок:
$name = ’send':
&$name($message):
$name->($message): # Альтернативный, более простой синтаксис
Впрочем, это небезопасно — пользователь сможет выполнить любую функ-
цию нашей программы, если он знает ее имя. Кроме того, такое решение проти-
воречит директиве use strict ’refs’.
Ниже приведена часть программы, создающая хэш, в котором ключ представ-
ляет собой имя команды, а значение — ссылку на функцию, вызываемую этой
командой:
# Предполагается, что &1nvoke_ed1tor. &del1ver_message.
# $f11e и $PAGER определяются в другом месте.
use Text::Abbrev;
my($href. factions, $errors):
factions = (
"edit" => \&1nvoke_ed1tor.
"send" => \&del1ver_message,
"list" => sub { system($PAGER. $f11e) }.
"abort" => sub {
262
Глава 6. Поиск по шаблону
print "See ya!\n";
exit;
}.
=> sub {
print "Unknown command: $cmd\n":
$errors++:
}.
);
$href = abbrev(keys factions):
for (print "Action: ": my $cho1ce = <>; print "Action: ") {
Scholce =~ s/^\s+//: # Отсечение начальных пропусков
$cho1ce =~ s/\s+$//: # Отсечение конечных пропусков
next unless $cho1ce;
$act1ons->{ $href->{ lc($cho1ce) } }->():
}
Если вы не любите слишком кратких выражений или хотите приобрести на-
выки машинистки, последнюю команду можно записать так:
Sabbrevlatlon = lc($_):
$expans1on = $href->{$abbrev1at1on};
Scoderef = $act1ons->{$expans1on}:
$coderef->():
См. также
Документация по стандартному модулю Text: :Abbrev. Интерполяция рассматри-
вается в разделе «Scalar Value Constructors» perldata(V).
6.21. Программа: urlify
Программа urlify оформляет URL-адреса, найденные в файлах, в виде ссылок
HTML. Она работает не для всех возможных URL, но справляется с наиболее
распространенными. Программа старается избежать включения знаков препина-
ния, завершающих предложения, в помеченный URL.
Программа является типичным фильтром Perl и поэтому может использовать-
ся для перенаправления ввода:
% gunzip -с -/mall/archlve.gz | urlify > archive.urllfled
или с передачей файлов в командной строке:
% urlify -/mall/*.Inbox > -/allmall .urllfled
Исходный текст программы приведен в примере 6.10.
Пример 6.10. urlify
#!/usr/bln/perl
# urlify - оформление URL-подобных конструкций в виде ссылок HTML
$protos = ’(http|tel net|gopher|fl1е|wals|ftp)’:
$1trs = ’\w’:
6.22. Программа: tcgrep
263
$gunk = .?+=№!\-’:
$punc = ’. -;
$any = "${ltrs}${gunk}${piinc}";
while (<>) {
s{
\b # Начать с границы слова
( # Начать сохранение $1 {
$protos : # Искать имя ресурса и двоеточие.
[$апу] +? # за которыми следует один или более
# любых допустимых символов, но
# проявлять умеренность и брать лишь то.
# что действительно необходимо ....
) # Завершить сохранение $1 }
(?= # Опережающая проверка без смещения
[$punc]* # либо 0. либо знак препинания
[^$апу] # далее следует символ, не входящий в url
| # или
$ # конец строки
)
}{<А HREF=,,$1,,>$1</A>}1gox:
print:
}
6.22. Программа: tcgrep
Ниже приведена версия программы Unix grep, написанная на Perl. Хотя она ра-
ботает медленнее версий, написанных на С (особенно GNU-версии grep), зато
обладает многими усовершенствованиями.
Первая и самая важная особенность — эта программа работает везде, где
работает Perl. Имеется ряд дополнительных возможностей — tcgrep игнориру-
ет все файлы, кроме простых текстовых; автоматически распаковывает сжатые
или обработанные утилитой gzlp файлы; выполняет просмотр в подкаталогах;
ищет полные абзацы или записи, определенные пользователем; ищет более
свежие версии файлов, а также подчеркивает или выделяет найденные совпа-
дения. Кроме того, с ключом -с программа выводит количество найденных за-
писей, а с ключом -С — число найденных совпадений, которые могут содержать
несколько записей.
Распаковка сжатых файлов выполняется утилитами gzcat или zcat, поэто-
му данная возможность отсутствует в системах, где эти программы недоступны,
а также в системах, не позволяющих запускать внешние программы (например,
в старых системах Macintosh).
При запуске программы без аргументов на экран выводится краткая справка
по ее использованию (см. процедуру usage в программе). Следующая командная
строка рекурсивно и без учета регистра ищет во всех файлах почтового ящика
-/mall сообщения с отправителем "kate" и выводит имена найденных файлов:
% tcgrep -rll '^From: .*kate' -/mall
Исходный текст программы приведен в примере 6.11.
264
Глава 6. Поиск по шаблону
Пример 6.11. tcgrep
# !/usr/Ыn/perl -w
# tcgrep: версия grep, написанная Томом Кристиансеном
# версия 1.0: 30 сентября 1993 года
# версия 1.1: 1 октября 1993 года
# версия 1.2: 26 июля 1996 года
# версия 1.3: 30 августа 1997 года
# версия 1.4: 18 мая 1998 года
use strict:
# Глобальные переменные
our ($Ме, $Errors. $Grand_Total, $Mult, ^Compress, $Matches):
my ($matcher, $opt): # matcher - анонимная функция
# для поиска совпадений
# opt - ссылка на хэш, содержащий
# параметры командной строки
InltO: # Инициализировать глобальные переменные
($opt, $matcher) = parse_args(): # Получить параметры командной строки
# и шаблоны
matchflle($opt. $matcher, @ARGV): # Обработать файлы
ex1t(2) If $Errors;
exit(0) If $Grand_Total:
exit(l):
sub Inlt {
($Me = $0) =~ s!.*/!!:
$Errors = $Grand_Total = 0:
$Mult =
$| = 1:
^Compress = (
z => 'gzcat*.
gz => 'gzcat',
Z => 'zcat',
):
}
# Получить базовое имя программы, "tcgrep"
# Инициализировать глобальные счетчики
# Флаг для нескольких файлов в @ARGV
# Автоматическая очистка выходного буфера
# Расширения и имена программ
# для распаковки
sub usage {
die «EOF
usage: $Me [flags] [files]
Standard grep options:
1 case Insensitive
n number lines
c give count of lines matching
C 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 -)
f file with expressions
1 list filenames matching
Specials:
1 1 match per file
6.22. Программа: tcgrep
265
Н highlight matches
u underline matches
r recursive on directories or dot if none
t process directories in ’Is -t’ order
p paragraph mode (default: line mode)
P ditto, but specify separator, e.g. -P ’Ш\п’
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
}
// // // // IIIIIIIIII44- II //#### // //###### IIIIII4I4I4I-IIIIII II II
sub parse_args {
use Getopt::Std:
my (Soptstring, Szeros, Snulls, %opt, Spattern, ^patterns, $match_code);
my (SSO, $SE):
if (my Sopts = $ENV{TCGREP}) { # Получить переменную окружения TCGREP
Sopts =~ s/"(["\-])/-$l/: # Если начальный - отсутствует, добавить
unshift(@ARGV, Sopts); # Включить строку TCGREP в @ARGV
}
Soptstring = "1ncCwsxvhe:f :HHurtpP:aqT";
Szeros = 'inCwxvhelut'; # Параметры, инициализируемые О
# (для отмены предупреждений)
Snulls = ’рР': # Параметры, инициализируемые ""
# (для отмены предупреждений)
@opt{ split //, Szeros } = ( 0 ) х 1ength(Szeros):
@opt{ split //. Snulls } = ( '' ) x 1ength($nul1s):
getopts(Soptstring, Uopt) or usageO;
if ($opt{f}) { # -f файл с шаблонами
open(PATFILE, $opt{f}) or die qq($Me: Can't open '$opt{f}’: $!);
# Проверить каждый шаблон в файле
while ( defined(Spattern = <PATFILE>) ) {
chomp Spattern:
eval { 'foo' =~ /Spattern/. 1 } or
die "SMe: $opt{f}:$.: bad pattern: $0";
push ^patterns, Spattern:
}
close PATFILE:
}
else { # Проверить шаблон
Spattern = $opt{e} || shift(OARGV) || usageO;
eval { 'foo' =~ /Spattern/: 1 } or
die "SMe: bad pattern: $0";
^patterns = (Spattern):
}
# -H - выделить цветом, -u - подчеркнуть
if ($opt{H} || $opt{u}) {
my Sterm = $ENV{TERM} || 'vtlOO’:
my Sterminal:
eval { # Попытаться найти служебные
# последовательности для выделения
require POSIX: # или подчеркнуть через Term::Cap
use Term::Cap:
продолжение &
266
Глава 6. Поиск по шаблону
Пример 6.11 (продолжение)
my $termios = POSIX::Terml os->new():
$termios->getattr:
my $ospeed = $termios->getospeed:
$terminal = Tgetent Term::Cap { TERM=>undef. OSPEED=>$ospeed }
unless ($0) { # Если успешно, получить служебные
# последовательности для выделения (-Н)
local $^W =0: # или подчеркивания (-и)
($S0, $SE) = $opt{H}
? ($terminal->Tputs('so'). Sterminal->Tputs('se*))
: ($terminal->Tputs('us'). $terminal->Tputs(’ue’)):
}
else { # Если попытка использования Term::Cap
# заканчивается неудачей, получить
($50. $SE) = $opt{H} # служебные последовательности
# командой tput
? ('tput -Т $term smso'. 'tput -T $term rmso')
: ('tput -T $term smul', 'tput -T $term rmul')
}
}
# -1 - поиск без учета регистра символов
if ($opt{1}) {
(^patterns = map {"(?i)$_"} ^patterns:
}
# -p или -P - абзацный режим, добавить /m
if ($opt{p} || $opt{P}) {
^patterns = map {,,(?m)$_"} ^patterns;
}
# Стандартный абзацный режим
$opt {p} &&($/=");
# Пользовательский абзацный режим
$opt{P} && ($/ = eval(qq("$opt{Р}”))): # for -P ’И\п’
# -w - только по границам слова (XXX: всегда ли это оптимально?)
$opt{w} && (^patterns = map {*\b’ . $_ . ’\b’} ^patterns):
# -x - только для полных строк
$opt{ ’х*} && (^patterns = map {"^$_\$"} ^patterns):
# Проверить, нужно ли выводить имя файла перед каждым совпадением
if (@ARGV) {
$Mult = 1 if ($opt{r) || (@ARGV >1) || -d $ARGV[0]) && !$opt{h}:
}
# Если пользователь хочет просто получить список файлов.
# прервать поиск после первого совпадения
$opt{l} += $opt{l}: # Единица и буква 1
$opt{H} += $opt{u}:
$opt{c} += $opt{C}:
$opt{’s’} += $opt{c}:
# Прервать при первом совпадении, если ведется проверка без подсчета
$opt{l} += $opt{’s’} && !$opt{c}: # Единица
# Аргументы по умолчанию: cwd при рекурсии, stdin без нее
@ARGV = ($opt{r} ? unless @ARGV:
$opt{r} = 1 if !$opt(r} && grep(-d, @ARGV) == @ARGV:
6.22. Программа: tcgrep
267
«####
# Начинается самое трудное: построение функции в текстовом виде
# для последующей передачи eval.
#
$match_code = '';
$match_code .= 'study:' If ^patterns > 5: # Может немного
# ускорить работу
foreach (^patterns) { s(/)(\\/)g }
# Добавление начальной и конечной последовательностей для выделения
if ($opt{H}) {
foreach Spattern (^patterns) {
$match_code .= "\$Matches += s/(Spattern)/${S0}\$1${SE}/g;";
}
}
# Ключ -v - подсчет НЕСОВПАДАЮЩИХ строк
elsif ($opt{v}) {
foreach Spattern (^patterns) {
$match_code .= "Watches += !/Spattern/;":
}
}
# Полный подсчет с несколькими совпадениями в строке
elsif ($opt{C}) {
foreach Spattern (^patterns) {
$match_code .= "\$Matches++ while /$pattern/g:":
}
}
else {
foreach Spattern (^patterns) {
$match_code .= "\$Matches++ if /Spattern/:";
}
}
# Откомпилировать как замыкание и получить указатель на функцию.
Smatcher = eval "sub { $match_code }";
die if $0:
return (Uopt, Smatcher);
}
# // // // // //### // IIIIIIIIIIIIIIIIIIIIIIIIIIII44IIIIIIIIIIIIIIII //#
sub matchfile {
Sopt = shift: # Ссылка на хэш параметров
Smatcher = shift; # Ссылка на функцию поиска совпадений
my (Sfile, ©list, Stotal, Sname);
local($_);
Stotal = 0;
FILE: while (defined (Sfile = shift(@_))) {
if (-d Sfile) {
if (-1 Sfile && OARGV != 1) {
warn "SMe: \"$file\" is a symlink to a directory\n"
if $opt->{T}:
next FILE;
}
if (!$opt->{r}) {
warn "SMe: \"$file\" is a directory, but no -r given\n"
if $opt->{T};
next FILE:
}
продолжение &
268
Глава 6. Поиск по шаблону
Пример 6.11 (продолжение)
unless (opendlг(DIR, Sfile)) {
unless ($opt->{’q’}) {
warn "SMe: can't opendir Sfile; $!\n";
$Errors++:
}
next FILE;
@11 st = 0;
for (readdlr(DIR)) {
push(@11st, "Sf11e/$_") unless A\.{1,2}$/;
}
closedlr(DIR);
# Ключ -t - сортировка по времени (от новых к старым)
# Использование алгоритма из рецепта 4.16,
# "Сортировка списка по вычисляемому полю"
If ($opt->{t}) {
@11 st = map { $_->[0] }
sort { $a->[l]<=>$b->[l] }
map { [ $_. -M $_ ] } @11 st:
}
else {
@11 st = sort @11 st;
}
matchflle($opt, Smatcher, @11st); # Обработка файлов
next FILE;
}
# Предотвратить досадную ситуацию, когда grep хочет
# получить ввод с клавиатуры, а пользователь этого не понимает.
If ($f 11 е eq ' -') {
warn "SMe: reading from stdlnXn" If -t STDIN && !$opt->{'q'}:
Sname = '<STDIN>';
}
else {
Sname = Sfile:
unless (-e Sfile) {
warn qq($Me: file "Sfile" does not ex1st\n)
unless $opt->{’q’};
$Errors++;
next FILE;
}
unless (-f Sfile || $opt->{a}) {
warn qq($Me: skipping non-plaln file "Sf11e"\n)
If $opt->{T};
next FILE;
# Также можно было использовать File;:Spec
my (Sext) = Sfile =~ A.(Lx.]+)$/:
# Проверить, известно ли, как для данного расширения
# преобразовать данные в обычный текст при помощи фильтра.
If (defined Sext && exists $Compress{$ext}) {
Sfile = "$Compress{$ext} <Sf11e |";
}
elslf (! (-T Sfile || $opt->{a})) {
warn qq($Me: skipping binary file "SflleAn) If $opt->{T};
6.22. Программа: tcgrep
269
next FILE:
}
}
warn "$Me: checking $f11e\n" If $opt->{T}:
unless (open(FILE, $f11e)) {
unless ($opt->{’q’}) {
warn "$Me: $f11e: $!\n":
$Errors++:
}
next FILE:
}
$total = 0:
$Matches = 0:
LINE: while (<FILE>) {
$Matches = 0:
mmfmm
&{$matcher}(): # Поиск совпадений
###########
next LINE unless $Matches:
$total += $Matches:
If ($opt->{p} || $opt->{P}) {
s/\n{2,}$/\n/ If $opt->{p}:
chomp If $opt->{P}:
}
pr1nt("$name\n"), next FILE If $opt->{!}:
# Следующий закомментированный блок
# содержит расширенную (и более понятную)
# версию команды, следующей за ним.
# Это один из тех случаев, когда мы жертвуем
# наглядностью ради скорости: команда prlntO
# выполняется только один раз вместо четырех,
# а блок в фигурных скобках не используется
# (обратите внимание: для работы этого фрагмента
# переменная $Mult должна быть равна "", а не 0).
######
# # unless ($opt->{’s’}) {
# # print "$name:" If $Mult:
# # print "$.:" If $opt{n};
# # print:
# # print x 20) . "\n") If $opt->{p} || $opt->{P}:
## }
#######
$opt->{’s’} || print $Mult && "$name:",
$opt->{n} ?
($opt->{p} || $opt->{P}) && (’-’ x 20) . "\n":
next FILE If $opt->{l}: # Единица
}
}
continue {
print $Mult && "Sname:", $total, "\n" If $opt->{c};
}
$Grand_Total += $total:
}
270
Глава 6. Поиск по шаблону
6.23. Копилка регулярных выражений
Следующие регулярные выражения показались нам особенно полезными или
интересными.
О Перестановка двух первых слов:
s/(\S+))\s+)(\S+)/$3$2$l/
О Ключевое слово = значение:
m/(\w+)\s*=\s*(.*)\s*$/ # Ключевое слово в $1, значение - в $2
О Строка содержит не менее 80 символов:
т/.{80.}/
lengthO >=80 # А можно и без регулярного выражения...
О ММ/ДД/ГГ ЧЧ:ММ:СС:
т|(\d+)/(\d+)/\d+) (\d+):(\d+):(\d+)|
О Смена каталога:
s(/iisr/b1n)(/usr/local/b1n)g
О Расширение шестнадцатеричных кодов %7Е:
s/^([0-9A-Fa-f][0-9A-Fa-f])/chr hex 41/ge
О Удаление комментариев С (не идеальное):
s{
/* # Начальный ограничитель
.*? # Минимальное количество символов
*/ # Конечный ограничитель
}{}gsx:
О Удаление начальных и конечных пропусков:
s/'\s+//;
s/\s+$//;
О Преобразование символа \ и следующего за ним п в перевод строки:
s/\\n/\n/g:
О Удаление пакетных префиксов из полностью определенных символов:
s/\*:://
О IP-адрес:
# XXX: не работает для допустимых IP-адресов 127. 1 и 2130706433
т{
' ( \d | [01]?\d\d | 2[0-4]\d | 25L0-5] )
\. ( \d | [01]?\d\d | 2[0-4]\d | 25[0-5] )
\. ( \d | [01]?\d\d | 2[0-4]\d | 25L0-5] )
\. ( \d | [01]?\d\d | 2[0-4]\d | 25L0-5] $ )
}х
6.23. Копилка регулярных выражений
271
О Удаление пути из полного имени файла:
s(T*/)()
О Определение ширины строки с помощью TERMCAP:
Scols = ( ($ENV{TERMCAP} || " ") =~ т/:co#(\d+):/ ) ? $1 : 80:
О Удаление каталогов из имени программы и аргументов:
(Sname = join(" ". map { s.TS+/..: $_ } ($0 @ARGV));
О Проверка операционной системы:
die "This Isn’t Linux" unless ST =~m/linux/i;
О Объединение строк в многострочных последовательностях:
s/\n\s+/ /д:
О Извлечение всех чисел из строки:
@nums = m/(\d+\.?\d*|\.\d+)/g:
О Поиск всех слов, записанных символами верхнего регистра:
@capwords = m/(\b\p{ Upper-case Letter }+\b)/g;
О Поиск всех слов, записанных символами нижнего регистра:
@lowords = m/(\b\p{ Lower-case Letter }+\b)/g;
О Поиск всех слов, начинающихся с буквы верхнего регистра:
@icwords = m{
( \b
Е\р{ Upper-case Letter }\p{ Title-case Letter }]
\p{ Lower-case Letter } *
\b)
}gx:
О Поиск ссылок в простых HTML-документах:
@links = т/<АЕ^>0+?НРЕЕ\5*=\5*Е" ‘ JTC"* *’ >]+?)[1 "]?\s*>/ig:
О Поиск среднего инициала в $_:
Sinitial = m/TS+\s+(\S)\S*\s+\S/ ? $1 : ;
О Замена кавычек парными апострофами:
s/"(r"]*)'7"$l”/g # Старый способ
# Работает только в Юникоде
s/"(['"]*),7\x{201C}\x{201C}$l\x{201D}\x{201D}/g
О Выборка предложений (разделитель — два пробела):
{ local $/ = :
while (<>) {
s/\n/ /д:
s/ {3.}/ /д:
push (^sentences. m/(\S.*?[!?.])(?= {2}|\Z)/g:
}
}
272
Глава 6. Поиск по шаблону
О ГГГГ-ММ-ДД:
m/(\d{4})-(\d\d)-(\d\d)/ # ГГГГ в $1. ММ в $2 и ДД в $3
О Выборка строк независимо от терминатора (завершающего символа):
push(@1ines. $1) while (Sinput — s{
A
(
# Начало $1: любой отдельный символ (/s)
?* # но по минимуму - даже ни одного
)
(?: # Заменить сохраняющими скобками, если
# терминатор должен сохраняться.
\xOD \хОА # CRLF
| \хОА # LF
| \xOD # CR
| \хОС # FF
# (См. http://www.unicode.org/reports/trl3/trl3-9.html)
| \х{2028} # Unicode LS
| \х{2029} # Unicode PS
)
}{ }sx: # consumes $1nput
Или воспользуйтесь split:
@llnes = split m{ (?: # Заменить сохраняющими скобками, если # терминатор должен сохраняться.
\xOD \xOA | \xOA | \xOD | \xOC # CRLF # LF # CR # FF
# (См. http://www.un1code.org/reports/trl3/trl3-9.html)
| \х{2028} | \х{2029} 1 # Unicode LS # Unicode PS
}x. $1nput:
Доступ к файлам
7.0. Введение
Файлы занимают центральное место в обработке данных. Как и во всем осталь-
ном в Perl, простые операции с файлами выполняются просто, а сложные... как-
нибудь да выполняются. Стандартные задачи (открытие файлов, чтение данных,
запись данных) используют простые функции ввода/вывода и операторы, а более
экзотические функции способны даже на асинхронный ввод/вывод и блокиров-
ку (locking) файлов.
В этой главе рассматривается механика доступа к файлам: открытие файлов,
передача сведений о том, с какими файлами вы собираетесь работать, блокиров-
ка и т. д. Глава 8 «Содержимое файлов» посвящена работе с содержимым фай-
лов: чтению, записи, перестановке строк и другим операциям, которые становят-
ся возможными после получения доступа к файлу.
Следующий фрагмент выводит все строки файла /usr/1 ocal /wldgets/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, связываемое с внешним файлом (обычно при
помощи функции open). При каждом выполнении операции ввода или вывода
в программе используется внутренний манипулятор, а не внешнее имя файла.
Функция open связывает файл с манипулятором, а функция close эту связь раз-
рывает. Вообще говоря, для открытия файлов могут использоваться и другие
функции, а манипуляторы могут связываться не только с файлами; подробно-
сти приводятся в разделе 7.1.
274
Глава 7. Доступ к файлам
Если пользователи идентифицируют открытые файлы по именам, программы
Perl используют для этой цели манипуляторы. Но с точки зрения операционной
системы открытый файл представляется файловым дескриптором — маленьким
неотрицательным целым числом. Функция flleno возвращает системный дескрип-
тор для манипулятора, переданного в аргументе. Для большинства файловых
операций хватает манипуляторов Perl, а для остальных случаев в рецепте 7.9 по-
казано, как преобразовать файловый дескриптор в файловый манипулятор, ис-
пользуемый в Perl.
Имена файловых манипуляторов (как и имена меток, процедур и пакетов)
представляют собой простые последовательности символов типа INPUT, а не пе-
ременные типа $1 nput. Тем не менее, за небольшими синтаксическими исклю-
чениями, вместо именованных манипуляторов Perl также принимает скалярные
выражения, результатом которых является манипулятор или то, что может ин-
терпретироваться как манипулятор (тип-глоб, ссылка на него или объект вво-
да/вывода). Обычно в таких ситуациях тип-глоб манипулятора сохраняется
в скалярной переменной, которая затем используется в качестве косвенной ссыл-
ки на манипулятор. Программа, записанная подобным образом, может быть проще
программы с именованными манипуляторами, потому что при работе с обычны-
ми переменными вместо символических имен исчезают некоторые нетривиаль-
ные проблемы, связанные с определением строк, областью действия и пакетами.
В версии 5.6 Perl допускается использование неявно инициализированных
переменных в качестве косвенных файловых манипуляторов. Если функции, ко-
торая собирается инициализировать файловый манипулятор (например, open),
передать неопределенный скаляр, то функция автоматически создает аноним-
ный тип-глоб и сохраняет ссылку на него в ранее не определенной переменной —
эта головоломная фраза обычно сокращается до более понятной: «Perl автоматиче-
ски оживляет (autovivifies) файловые манипуляторы, передаваемые open в виде
неопределенных скаляров».
my $1nput: # Новая лексическая переменная
# изначально содержит undef
open($1nput. "/acme/widgets/data")
or die "Couldn’t open /acme/widgets/data for reading: $!\n":
while (<$1nput>) {
print If /blue/:
}
close($1nput): # Также происходит при уборке мусора
За дополнительной информацией о ссылках и автоматическом оживлении
обращайтесь к главе И. Впрочем, эта глава в большей степени посвящена обыч-
ным ссылкам на данные, а не экзотике вроде ссылок на тип-глобы.
Автоматическое оживление манипуляторов при вызове open является лишь
одним из нескольких способов получения косвенных файловых манипуляторов.
Другие способы загрузки именованных файловых манипуляторов в переменные,
а также иные эзотерические конструкции, которые могут использоваться как
косвенные файловые манипуляторы, описаны в рецепте 7.5.
В некоторых рецептах этой главы файловые манипуляторы используются со
стандартным модулем 10::Handle, в других случаях используется модуль 10::File.
7.0. Введение
275
Конструкторы объектов этих классов возвращают новые объекты, которые мо-
гут использоваться всюду, где возможно использование обычных файловых ма-
нипуляторов, например, при вызове встроенных функций print, readline, close,
<...> и т. д. С другой стороны, все методы 10::Handle могут вызываться для обыч-
ных манипуляторов, не преобразованных вызовом bless. Это относится и к авто-
матически оживленным манипуляторам, и даже к именованным вроде INPUT или
STDIN, даже если они не были превращены в объекты вызовом bless.
Синтаксис вызова методов выглядит более громоздким, чем синтаксис вы-
зова функций Perl. Кроме того, вызов методов требует дополнительных затрат
по сравнению с вызовом функции (в тех случаях, когда эквивалентная функция
существует). Обычно использование методов ограничивается теми случаями,
когда соответствующую функциональность трудно или невозможно реализовать
на «чистом» Perl без применения дополнительных модулей.
Например, метод blocking, устанавливающий или снимающий блокировку
для файловых манипуляторов, гораздо приятнее шаманства с Fcntl, с которым,
по крайней мере, один из авторов (а возможно, и большинство читателей) не
желает иметь ничего общего. Этот принцип заложен в основу рецепта 7.20.
Большинство методов находится в классе 10::Handle, от которого наследует
10::File, и может применяться непосредственно к файловым манипуляторам,
которые не являются объектами. Важно лишь то, чтобы Perl воспринимал их
как файловые манипуляторы.
Пример:
STDIN->blockirg(0): # Вызов для именованного манипулятора
open($fh, Sfilename) or die: # Автоматическое оживление, затем...
$fh->blocking(0); # вызов для манипулятора без вызова bless
Как и большинство имен Perl, включая имена процедур и глобальных пере-
менных, именованные манипуляторы размещаются в пакетах. Следовательно,
два разных пакета могут содержать манипуляторы с одинаковыми именами. Без
явного уточнения пакета именованный манипулятор интерпретируется как при-
надлежащий текущему пакету. В пакете main запись INPUT в действительности
обозначает main:: INPUT, но если текущим является некий гипотетический пакет
SomeMod, то эта же запись будет обозначать SomeMod:: INPUT.
Встроенные манипуляторы STDIN, STDOUT и STDERR занимают особое место.
Если манипулятор не уточнен, то вместо текущего пакета используется пакет
main. Аналогичное исключение из стандартных правил определения полного име-
ни встречается при использовании встроенных переменных @ARGV и %EN V (см. Вве-
дение к главе 12).
В отличие от именованных файловых манипуляторов, которые представляют
собой глобальные символические имена в пакетах, создаваемые Perl автоматиче-
ски оживленные манипуляторы анонимны (то есть не имеют имен) и не имеют
собственных пакетов. Еще интереснее другое — они, как и другие ссылки, подвер-
жены автоматической уборке мусора. Когда переменные, в которых они хранятся,
выходят из области действия, а других ссылок на переменную или ее значение
не существует, начинает действовать механизм уборки мусора, и Perl автомати-
чески закрывает манипулятор (если вы не сделали этого ранее). Это может быть
существенно в больших или долго работающих программах, поскольку операци-
276
Глава?. Доступ к файлам
онная система ограничивает количество файловых дескрипторов, которые могут
быть открыты любым процессом, а обычно и количество дескрипторов, одновре-
менно открытых во всей системе.
Как известно, системная память является ограниченным ресурсом, который
может быть исчерпан при небрежном использовании; то же самое относится
и к системным файловым дескрипторам. Если вы будете открывать множество
новых файловых манипуляторов, не закрывая их, то рано или поздно дескрипто-
ры закончатся. Если повезет, в этот момент ваша программа завершится аварийно,
а если не повезет — начнет работать с ошибками. Автоматический вызов close
при уничтожении автоматически созданных файловых манипуляторов избавит
вас от хлопот, возникающих при недостаточно аккуратном выделении ресурсов.
Например, следующие две функции автоматически оживляют файловые мани-
пуляторы в одноименных лексических переменных:
sub versive {
open(my $fh. $SOURCE)
or die "can't open $SOURCE: $!":
return $fh;
}
sub apparent {
open(my $fh, STARGET)
or die "can't open STARGET: $!":
return $fh;
}
my($from, to) = ( versIveO. apparentO );
В обычных условиях манипуляторы $fh были бы автоматически закрыты при
выходе из функции. Но поскольку обе функции возвращают их значение, мани-
пуляторы останутся открытыми в течение более долгого времени. Они остаются
открытыми до тех пор, пока не будут закрыты в программе, или переменные $from
и $to вместе со всеми копиями не выйдут из области действия — в этот момент Perl
«убирает мусор» и закрывает эти манипуляторы, если они остались открытыми.
Для буферизованных манипуляторов с внутренними буферами, содержащи-
ми незаписанные данные, проявляется еще более важное преимущество. Перед
закрытием происходит запись содержимого буферов, поэтому все данные попа-
дут туда, куда предполагалось1. Для глобальных файловых манипуляторов ав-
томатическая запись буфера и закрытие происходят при выходе из программы2.
Стандартные манипуляторы
В каждой программе изначально существуют три открытых стандартных файло-
вых манипулятора: STDIN, STDOUT и STDERR. STDIN представляет стандартный источ-
ник данных, передаваемых программе. STDOUT представляет стандартный приемник
1 Или хотя бы будет сделана такая попытка. В настоящее время Perl не сообщает об ошиб-
ке, если автоматический вызов системной функции записи на этой стадии завершается
неудачей (например, из-за того, что в файловой системе кончилось свободное место).
2 Если только выход не произошел из-за неперехваченного сигнала — либо при запуске
другой программы, либо при вызове POSIX::_exit().
7.0. Введение
277
данных, возвращаемых программой. Без перенаправления стандартный ввод
читается с клавиатуры, а стандартный вывод направляется на экран.
Однако ввод и вывод не связаны с конкретными устройствами. В следующем
примере стандартный ввод программы связывается с файлом datafile, а стан-
дартный вывод направляется в resultfl 1 е, причем это происходит еще до запус-
ка программы:
% program < datafile > resultsflle
Предположим, в программе возникли какие-то проблемы, о которых нужно
сообщить пользователю. Если стандартный вывод был перенаправлен, то скорее
всего, пользователь не заметит сообщения, направленного в выходные данные.
Именно для таких ситуаций был создан манипулятор STDERR. Как и STDOUT, он изна-
чально ассоциируется с экраном, но в случае перенаправления STDOUT в файл или
канал приемник STDERR остается неизменным. А значит, предупреждения и ошиб-
ки всегда можно направить туда, где они будут скорее замечены пользователем.
В отличие от STDERR, при перенаправлении STDIN для клавиатуры не создается
заранее открытый файловый манипулятор. Дело в том, что такая потребность
возникает гораздо реже, чем потребность в надежном, логически последователь-
ном диагностическом потоке. Программы относительно редко задают вопросы
пользователю и читают его ответы, даже в случае перенаправления. Например,
это происходит в программах more(l) и less(l), поскольку их манипуляторы STDIN
обычно связываются с выводом других программ, который должен просматривать-
ся по страницам. В системах семейства Unix для этого открывается специальный
файл /dev/tty, представляющий управляющий терминал для текущего сеанса. Если
у программы нет управляющего терминала, вызов open завершается неудачей;
тем самым система сообщает, что вашей программе попросту не с кем общаться.
Этот принцип позволяет легко связать вывод одной программы с вводом дру-
гой программы, и так далее по цепочке.
% first | second | third
Вывод первой программы подается на ввод второй, а вывод второй програм-
мы — на ввод третьей. Хотя, на первый взгляд, это и не очевидно, здесь действует
та же логика, что и при вложенных вызовах функций вида thlrd(second(f 1 rst))).
Просто конвейерные вызовы командного интерпретатора лучше воспринимают-
ся, потому что они читаются слева направо, а не от внутренней части выражения
к наружной.
Унифицированный интерфейс стандартного ввода/вывода позволяет разра-
батывать, тестировать, обновлять и запускать программы независимо друг от
друга, но с возможностью легко организовать их взаимодействие. Программы
взаимодействуют как части единого механизма или как разные стадии большо-
го технологического процесса. Все выглядит так, словно в вашем распоряжении
имеется огромный запас готовых взаимозаменяемых деталей, из которых можно
собирать блоки произвольной длины и сложности. Этим блокам можно присво-
ить имена и сохранить их в исполняемых сценариях, функционально неотличимых
от исходных деталей. В дальнейшем такие блоки могут использоваться при по-
строении еще больших блоков, словно они сами являются базовыми деталями.
278
Глава 7. Доступ к файлам
Среда, в которой каждая программа преобразования данных решает только
одну задачу, а данные передаются от одной программы к другой посредством пе-
ренаправления стандартных потоков ввода/вывода, обладает силой, гибкостью
и надежностью, которые не достигаются другими средствами. В данном случае
проявляется так называемая модель «утилит и фильтров», заложенная в основу
архитектуры не только командного интерпретатора Unix, но и всей операцион-
ной системы. Конечно, существуют предметные области, в которых эта модель
дает осечку. Более того, само существование Perl обусловлено использованием
ее недостатков, и все же эта модель доказала свою фундаментальную прочность
и масштабируемость почти за 30 лет.
Операции ввода/вывода
Основные функции для работы с файлами в Perl — open, print, <.. .> (чтение за-
писи) и close. Функции ввода/вывода Perl описаны в документацииperlfunc(V)
и perlopentut(l) в страницах руководства stdio(3S) вашей системы. В следующей
главе операции ввода/вывода — такие, как оператор <>, print, seek и tell — рас-
сматриваются более подробно, а эта глава посвящена функции open и получе-
нию доступа к данным, а не операциям с ними.
Важнейшей функцией ввода/вывода является функция open. Обычно ей пе-
редаются два или три аргумента — файловый манипулятор, строка с описани-
ем режима доступа (только для чтения, запись, присоединение и т. д.) и строка
с именем файла. При передаче двух аргументов во втором аргументе передается
как режим доступа, так и имя файла. Эта возможность эффективно использу-
ется в рецепте 7.14.
Например, открытие файла /tmp/log для записи и его связывание с манипу-
лятором LOGFILE выполняется следующей командой:
open(LOGFILE. "> /tmp/log") or die "Can't write /tmp/log: $!":
Три основных режима доступа — < (чтение), > (запись) и » (присоединение). До-
полнительные сведения о функции open приведены в рецепте 7.1. В режим доступа
могут включаться имена уровней ввода/вывода типа :raw и :encoding(iso-8859-1).
При открытии файла или вызове практически любой системной функции1
необходимо проверять возвращаемое значение. Не каждый вызов open заканчи-
вается успешно; не каждый файл удается прочитать; не каждый фрагмент дан-
ных, выводимый функцией print, достигает места назначения. Многие програм-
мисты для повышения устойчивости своих программ проверяют результаты open,
seek, tell и close. Иногда приходится проверять и другие функции.
Если в документации сказано, что в определенных условиях функция возвра-
щает признак ошибки, а вы не проверяете эти условия, будьте уверены — когда-
нибудь ваша небрежность обернется против вас. В документации Perl перечис-
лены возвращаемые значения всех функций и операторов. Как правило, при не-
удачном завершении системная функция возвращает undef (кроме функций wait,
waitpid и syscall, возвращающих -1). Чтобы получить системное сообщение
Системной функцией называется обращение к сервису операционной системы. Термин
не имеет отношения к функции system в языках С и Perl.
7.0. Введение
279
в строковом виде и соответствующий ему числовой код, воспользуйтесь пере-
менной $!. Эта информация часто используется в die или сообщениях warn.
Для чтения записей в Perl применяется оператор <МАНИПУЛЯТОР>. В отли-
чие от инфиксных операторов, он не располагается между своими операндами,
а наоборот, заключает их в себе (наподобие круглых скобок).
Обычно запись представляет собой одну строку, однако разделитель записей
можно изменить (см. главу 8). Если МАНИПУЛЯТОР не указывается, Perl откры-
вает и читает файлы, перечисленные в @ARGV, а если массив @ARGV пуст — из STDIN.
Нестандартные и просто любопытные применения этого факта описаны в ре-
цепте 7.14.
На нижнем уровне абстракции файл представляет собой обычный поток
октетов (то есть восьмибитовых байтов). Конечно, возможны и другие вариан-
ты организации, обусловленные спецификой оборудования (например, блоки
и секторы для файлов на диске или отдельные пакеты IP для сетевых подклю-
чений), но к счастью, операционная система скрывает от вас эти низкоуровне-
вые подробности.
На более высоком уровне абстракции файл представляет собой поток логиче-
ских символов, не зависящий от физического представления. Поскольку програм-
мы Perl обычно работают с текстовыми строками, содержащими символы, этот
режим выбирается по умолчанию при вызове open. О том, как изменить настрой-
ки по умолчанию, рассказано во Введении к главе 8 и в рецепте 8.11.
Каждый файловый манипулятор ассоциируется с числовым смещением, пред-
ставляющим позицию, в которой будет выполнена следующая операция ввода/вы-
вода. Если рассматривать файл как поток октетов, смещение равно количеству
октетов от начала файла (смещение начала потока равно 0). Текущая позиция
автоматически обновляется при каждой операции чтения или записи данных не-
нулевой длины. Ее также можно задать явно при помощи функции seek.
Текстовые файлы находятся на несколько более высоком уровне абстракции,
чем октетные потоки. Количество октетов не всегда совпадает с количеством
символов. Если не принять особых мер, файловые манипуляторы Perl пред-
ставляют именно логические потоки символов, а не физические потоки октетов.
Количество символов и октетов совпадает только в одном случае: если каждый
читаемый или записываемый символ помещается в одном октете (то есть все
кодовые пункты меньше 256), а для конца строки не предусмотрено особой обра-
ботки (например, преобразования между "\cJ\cM" и "\п"). Только в этом случае
позиция логического символа совпадает с текущей позицией в байтовом потоке.
Например, такая ситуация встречается при работе с текстовыми файлами
в кодировке ASCII или Latinl в системе Unix, где не существует принципиаль-
ных различий между текстовыми и двоичными файлами, что существенно об-
легчает программирование. К сожалению, 7-разрядный ASCII-текст встречается
относительно редко, и даже 8-разрядные кодировки семейства ISO 8859-п быст-
ро вытесняются многобайтовым текстом в Юникоде.
Другими словами, из-за того, что уровни кодировки типа : utf8 и уровни пре-
образований типа : crl f могут изменять количество байтов, передаваемых между
программой и внешним миром, текущая позиция в файле не может вычисляться
простым суммированием количества переданных символов. Как объяснялось
280
Глава 7. Доступ к файлам
в главе 1, символы не эквивалентны байтам — по крайней мере, нельзя на это
рассчитывать. Вместо этого для получения текущей позиции в файле следует
использовать функцию tel 1. По тем же причинам только значения, возвращае-
мые tell (и число 0) гарантированно могут использоваться при вызове seek.
В рецепте 7.17 мы читаем в память все содержимое файла, открытого в режи-
ме обновления, изменяем внутреннюю копию, а затем возвращаемся к началу
файла функцией seek и записываем данные, заменяя исходную версию.
Когда необходимость в файловом манипуляторе отпадает, закройте его функ-
цией close. Функция получает один аргумент (файловый манипулятор) и возвра-
щает true, если буфер был успешно очищен, а файл — закрыт, и false в против-
ном случае. Закрывать все манипуляторы функцией close необязательно. При
открытии файла, который был открыт ранее, Perl сначала автоматически закры-
вает его. Кроме того, все открытые файловые манипуляторы закрываются по
завершении программы.
Неявное закрытие файлов реализовано для удобства, а не для повышения на-
дежности, поскольку вы не узнаете, успешно ли завершилась системная функ-
ция. Не все попытки закрытия завершаются успешно. Даже если файл открыт
только для чтения, вызов close может завершиться неудачей, например, если
доступ к устройству был утрачен из-за сбоя сети. Еще важнее проверять резуль-
тат close, если файл был открыт для записи, иначе можно просто не заметить пе-
реполнения диска:
close(FH) or die "FH didn't close: $!":
Закрытие файловых манипуляторов сразу же после завершения работы с ними
также упрощает перенос программ на платформы, отличные от Unix, поскольку
на некоторых платформах возникают проблемы с повторным открытием фай-
ла перед закрытием, а также переименованием/удалением открытых файлов.
В POSIX-совместимых системах таких проблем не существует, но другие систе-
мы не столь либеральны.
Программист-перестраховщик даже проверяет результат вызова close для STDOUT
в конце программы на случай, если выходные данные были перенаправлены в ко-
мандной строке, а выходная файловая система оказалась переполнена. Вообще-то
об этом должна заботиться система времени выполнения, но она этого не делает.
Впрочем, проверка STDERR выглядит сомнительно. Даже если этот поток не за-
кроется, как вы собираетесь на это реагировать? Конечно, можно попытаться уз-
нать, почему это произошло и можно ли как-то исправить ситуацию. Можно даже
загрузить модуль Sys:: Sys log и вызвать функцию syslogO, как это делают систем-
ные демоны, поскольку они не обладают доступом к нормальному потоку STDERR.
Манипулятор STDOUT по умолчанию используется для вывода данных функция-
ми print, printf и write. Его можно заменить функцией select, которая получает
новый и возвращает предыдущий выходной манипулятор, используемый по умол-
чанию. Перед вызовом select должен быть открыт новый манипулятор вывода:
$old_fh = select(LOGFILE): # Переключить вывод на LOGFILE
print "Countdown Initiated . .An":
select($old_fh): # Вернуться к выводу на прежний манипулятор
print "You have 30 seconds to reach mlnumum safety distance.\n":
7.1. Открытие файла
281
Некоторые специальные переменные Perl изменяют поведение текущего фай-
лового манипулятора вывода. Особенно важна переменная $ |, которая управляет
буферизацией вывода для файловых манипуляторов. Буферизация рассматри-
вается в рецепте 7.19.
Функции ввода/вывода в Perl делятся на буферизованные и небуферизован-
ные (см. таблицу). Несмотря на отдельные исключения не следует чередовать
их вызовы в программе. Дело в том, что буферизованные функции хранят свои
данные в буферах, о чем не известно небуферизованным функциям. В следую-
щей таблице описаны два семейства функций, которые не желательно смеши-
вать. Связь между функциями, находящимися в одной строке таблицы, весьма
условна. Например, по семантике функция sysread отличается от <...>, однако
они находятся в одной строке, поскольку выполняют общую задачу — получе-
ние входных данных из файлового манипулятора. Позиционирование рассмат-
ривается в главе 8, однако мы также воспользуемся им в рецепте 7.17.
Действие Буферизованные функции Небуферизованные функции
ввод <...>, readline sysread
вывод print syswrite
позиционирование seek, tell sysseek
В Perl версии 5.8 появился механизм уровней ввода/вывода, позволяющий
совместно вызывать эти функции. Включить буферизацию для небуферизованных
функций нельзя, но зато можно отключить ее для буферизованных функций.
Теперь Perl позволяет выбрать конкретную реализацию ввода/вывода. Напри-
мер, при выборе :unix Perl вместо переносимой реализации стандартной библио-
теки ввода/вывода (perilо) использует небуферизованные системные вызовы.
Уровень небуферизованного ввода/вывода выбирается при открытии файла:
openCFH. "<:un1x", $f11ename) or die:
Открыв манипулятор с небуферизованным уровнем, далее можно спокойно
чередовать вызовы функций буферизованного и небуферизованного ввода/вы-
вода, потому что на этом уровне буферизация все равно не выполняется. При
вызове print Perl в действительности используется эквивалент syswrlte. За до-
полнительной информацией обращайтесь к рецепту 7.19.
7.1. Открытие файла
Проблема
Требуется открыть файл для чтения или записи в Perl.
Решение
Для удобства используйте функцию open с двумя аргументами, а для дополни-
тельных возможностей — с тремя аргументами. Функция sysopen открывает дос-
туп к низкоуровневым возможностям.
282
Глава 7. Доступ к файлам
В аргументах функции open передаются открываемый файловый манипуля-
тор, имя внешнего файла и специальные символы, определяющие режим откры-
тия. При вызове с двумя аргументами второй аргумент содержит как имя файла,
так и режим доступа:
open(SOURCE. "< Spath”)
or die "Couldn't open Spath for reading: $!\n":
open(SINK, "> Spath")
or die "Couldn't open Spath for writing: $!\n":
При вызове с тремя (и более) аргументами режим отделяется от имени фай-
ла (например, если между ними существует какая-то неоднозначность):
openCSOURCE. "<". Spath)
or die "Couldn't open Spath for reading: $!\n":
open(SINK. Spath)
or die "Couldn't open Spath for writing: $!\n":
Функции sysopen передаются три или четыре аргумента: файловый мани-
пулятор, имя файла, режим и необязательный параметр, определяющий пра-
ва доступа. Режим представляет собой число, конструируемое из констант мо-
дуля Fcntl:
use Fcntl:
sysopenCSOURCE. Spath. O_RDONLY)
or die "Couldn't open Spath for reading: $!\n":
sysopen(SINK, Spath. O_WRONLY)
or die "Couldn't open Spath for writing: $!\n";
Если при вызове open или sysopen передается неопределенная скалярная пере-
менная, Perl сохраняет в ней новый, анонимный файловый манипулятор:
open(my Sfh, "<". Spath)
or die "Couldn't open Spath for reading: $!\n":
Комментарий
Все операции ввода/вывода осуществляются через файловые манипуляторы,
независимо от того, упоминаются манипуляторы в программе или нет. Фай-
ловые манипуляторы не всегда связаны с конкретными файлами — они так-
же применяются для взаимодействия с другими программами (см. главу 16
«Управление процессами и межпроцессные взаимодействия») и в сетевых ком-
муникациях (см. главу 17 «Сокеты»). Функция open также применяется для
работы с файловыми дескрипторами, данная возможность рассматривается в ре-
цепте 7.9.
Функция open позволяет быстро и удобно связать файловый манипулятор
с файлом. Вместе с именем файла передаются сокращенные обозначения стан-
дартных режимов (чтение, запись, чтение/запись, присоединение). Функция не
7.1. Открытие файла
283
позволяет задать права доступа для создаваемых файлов и вообще решить, нуж-
но ли создавать файл. Если вам потребуются подобные возможности, вос-
пользуйтесь функцией sysopen, которая использует константы модуля Fcntl
для управления отдельными компонентами режима (чтение, запись, создание
и усечение).
Большинство программистов начинают работать с open задолго до первого ис-
пользования sysopen. В табл. 7.1 показано соответствие между режимами функ-
ции open («Файл»), константами sysopen («Флаги») и строками/орет?(3), переда-
ваемыми 10:: Fi 1 e->new («Символы»). Столбцы «Чтение» и «Запись» показывают,
возможно ли чтение или запись для данного файлового манипулятора. «При-
соединение» означает, что выходные данные всегда направляются в конец файла
независимо от текущей позиции (в большинстве систем). В режиме усечения
функция open уничтожает все существующие данные в открываемом файле.
Таблица 7.1. Режимы доступа к файлам
Файл Чтение Запись Присоединение Создание Усечение Флаги О_ Символы
< файл да нет нет нет нет RDONLY Hj.li
> файл нет да нет да да WRONLY TRUNC CREAT "w"
» файл нет да да да нет WRONLY APPEND CREAT "a"
+< файл да да нет нет нет RDWR "r+"
+> файл да да нет да да RDWR TRUNC CREAT "w+"
+» файл да да да да нет RDWR APPEND CREAT "a+"
Подсказка: режимы +> и +» почти никогда не используются. В первом случае
файл уничтожается еще до того, как он будет прочитан, а во втором часто возни-
кают затруднения: указатель чтения может находиться в произвольной позиции,
но при записи на многих системах почти всегда происходит переход в конец файла.
Функция sysopen получает три или четыре аргумента:
sysopen(FILEHANDLE. Sname. Sflags) or die "Can’t open Sname : $!":
sysopen(FILEHANDLE, Sname. Sflags, Sperms) or die "Can't open Sname : $!";
Здесь Sname — имя файла без «довесков» в виде < или +; Sflags — число, по-
лученное объединением констант режимов O_CREAT, O_WRONLY, O_TRUNC и т. д. опера-
цией OR. Конкретный состав доступных констант 0_* зависит от операционной
системы. Дополнительные сведения можно найти в электронной документации
(обычно ореп(2), но не всегда) или в файле /usr/include/fcntl .h. Обычно поддер-
живаются следующие константы:
284
Глава 7. Доступ к файлам
O_RDONLY Только чтение
O_WRONLY Только запись
O_RDWR Чтение и запись
O_CREAT Создание файла, если он не существует
O_EXCL Неудачное завершение, если файл уже существует
O_APPEND Присоединение к файлу
O_TRUNC Очистка содержимого файла
O NONBLOCK Асинхронный доступ
К числу менее распространенных констант принадлежат O_SHLOCK, O_EXLOCK,
O_BINARY, O_NOCTTY и O_SYNC. Обращайтесь к странице руководства ореп(2) или к ее
эквиваленту.
Если функции sysopen не передается аргумент Sperms, Perl использует восьме-
ричное число 0666. Права доступа задаются в восьмеричной системе и учиты-
вают текущее значение маски доступа (задаваемой функцией umask) процесса.
В маске доступа сброшенные биты соответствуют запрещенным правам. Напри-
мер, если маска равна 027 (группа не может записывать; прочие не могут читать,
записывать или выполнять), то вызов sysopen с параметром 066 создает файл
с правами 0640 (0666&-027 = 0640).
Если у вас возникнут затруднения с масками доступа, воспользуйтесь простым
советом: передавайте значение 0666 для обычных файлов и 0777 для каталогов
и исполняемых файлов. У пользователя появляется выбор: если ему понадобят-
ся защищенные файлы, то может выбрать маску 022, 027 или антиобщественную
маску 077. Как правило, решения из области распределения прав должны при-
ниматься не программой, а пользователем. Исключения возникают при записи
в файлы, доступ к которым ограничен: почтовые файлы, cookies в браузерах,
файлы .rhosts и т. д. Короче говоря, функция sysopen почти никогда не вызыва-
ется с аргументом 0644, так как у пользователя пропадает возможность выбрать
более либеральную маску.
Приведем примеры практического использования open и sysopen.
Открытие файла для чтения:
open(FH. "<", Spath") or die $!:
sysopen(FH, Spath, O_RDONLY) or die $!:
Открытие файла для записи (если файл не существует, он создается, а если
существует — усекается):
open(FH. ">", Spath") or die S’:
sysopen(FH, Spath, O_WRONLY|O_TRUNC|O_CREAT) or die $!:
sysopen(FH, Spath. O_WRONLY|O_TRUNC|O_CREAT, 0600) or die $!:
Открытие файла для записи с созданием нового файла (файл не должен су-
ществовать):
sysopen(FH, Spath, O_WRONLY|O_EXCL|O_CREAT) or die $!:
sysopen(FH, Spath. O_WRONLY|O_EXCL|O_CREAT. 0600) or die $!:
7.2. Открытие файлов с нестандартными именами
285
Открытие файла для присоединения (в случае необходимости файл создается):
open(FH, , Spath") or die $!;
sysopen(FH, Spath, O_WRONLY|O_APPEND|O_CREAT) or die $!;
sysopen(FH, Spath, O_WRONLY|O_APPEND|O_CREAT, 0600) or die $!:
Открытие файла для присоединения (файл должен существовать):
sysopen(FH, Spath. O_WRONLY|O_APPEND) or die S':
Открытие файла для обновления (файл должен существовать):
open(FH, "+<", Spath") or die $!:
sysopen(FH, Spath, O_RDWR) or die $!:
Открытие файла для обновления (в случае необходимости файл создается):
sysopen(FH, Spath, O_RDWR|O_CREAT) or die $!;
sysopen(FH, Spath, O_RDWR|O_CREAT, 0600) or die $!;
Открытие файла для обновления (файл не должен существовать):
sysopenCFH. Spath, O_RDWR|O_EXCL|O_CREAT) or die $!;
sysopen(FH, Spath, O_RDWR|O_EXCL|O_CREAT, 0600) or die $!;
Маска 0600 всего лишь поясняет, как создаются файлы с ограниченным дос-
тупом. Обычно этот аргумент пропускается.
См. также
Описание функций open, sysopen и umask в perlfunc(l); документация по стандарт-
ным модулям 10::File и Fcntl; страницы руководства ореп(2), fopen(3) и umask(2);
рецепт 7.2; рецепт 9.11.
7.2. Открытие файлов с нестандартными
именами
Проблема
Требуется открыть файл с нестандартным именем, например начинающимся
с символа <, > или |, содержащим начальные или конечные пробелы, заканчи-
вающимся символом |. Функция open не должна принимать эти функции за
служебные, поскольку вам нужно совершенно иное.
Решение
При вызове open с тремя (а не с двумя) аргументами передайте режим во втором
аргументе:
openCHANDLE. "<", Sfilename) or die "cannot open Sfilename : $!\n";
Или просто воспользуйтесь функцией sysopen:
sysopen(HANDLE, Sfilename, O_RDONLY) or die "cannot open Sfilename : $!\n":
286
Глава?. Доступкфайлам
Комментарий
При вызове open с тремя аргументами режим доступа и имя файла передаются
по отдельности. Но при вызове только с двумя аргументами функции open при-
ходится извлекать режим доступа и имя файла из одной строки. Если имя фай-
ла начинается с символа, обозначающего один из режимов, open вполне может
сделать что-нибудь неожиданное. Рассмотрим следующий фрагмент:
$filename = shift @ARGV:
opendNPUT. Sfilename) or die "cannot open Sfilename : $!\n":
Если пользователь указывает в командной строке файл ">/etc/passwd", про-
грамма попытается открыть /etc/passwd для записи — со всеми вытекающими
последствиями! Режим можцо задать и явно (например, для записи):
open(OUTPUT. ">$filename")
or die "Couldn’t open $filename for writing: $!\n":
но даже в этом случае пользователь может ввести имя ">data", после чего про-
грамма будет дописывать данные в конец файла data вместо того, чтобы стереть
прежнее содержимое.
Самое простое решение — передать open три аргумента. Во втором аргументе
передается режим доступа, а в третьем — путь и имя файла. В этом случае ка-
кая-либо путаница или недоразумения полностью исключаются.
open(OUTPUT, $filename)
or die "Couldn't open Sfilename for writing: $!\n":
Также можно воспользоваться функцией sysopen, у которой режим и имя
файла передаются в разных аргументах:
use Fcntl: # Для файловых констант
sysopen(OUTPUT. $filename. O_WRONLY|O_TRUNC)
or die "Couldn't open $filename for writing: $!\n":
Расширенная интерпретация файловых имен в функции open почти всегда
оказывается удобной. Вам никогда не приходится беспокоиться о том, скольки-
ми пробелами отделять режим доступа от пути — одним или двумя, или обозна-
чать стандартный ввод или вывод с помощью особой формы Если написать
фильтр и воспользоваться простой функцией open, то пользователь сможет пере-
дать вместо имени файла строку "gzip -de bible.gz|" — фильтр автоматически
запустит программу распаковки.
Вопросы безопасности open актуальны лишь для программ, работающих в осо-
бых условиях. Если программа должна работать под управлением чего-то другого,
например сценариев CGI или со сменой идентификатора пользователя, добро-
совестный программист всегда учтет возможность ввода пользователем собст-
венного имени файла, при котором вызов open для простого чтения превратится
в перезапись файла или даже запуск другой программы. Параметр командной
строки Perl -Т обеспечивает проверку таких ошибок.
В версиях Perl, не поддерживающих open с тремя аргументами (то есть пред-
шествующих версии 5.6.0), для обработки файлов с начальными или конечными
пропусками приходилось пускаться на всевозможные ухищрения:
7.3. Тильды в именах файлов
287
$f11e =~ s#A(\s)#./$l#:
open(HANDLE. "> $file\0")
or die "Could’t open Sfile for OUTPUT : $!\n":
Такая подстановка защищает исходные пропуски, но не в абсолютных име-
нах типа "/etc/passwd", а лишь в относительных (">passwd"). Функция open не
считает нуль-байт ("\0") частью имени файла, но благодаря ему не игнорируют-
ся конечные пропуски.
См. также
Описание функций open и sysopen в perlfunc(Vp рецепты 7.1, 7.14, 16.2, 19.4 и 19.5.
7.3. Тильды в именах файлов
Проблема
Имя файла начинается с тильды (например, ~username/blah или -/.mallrc), одна-
ко функция open не интерпретирует тильду как обозначение домашнего каталога
(home directory).
Решение
Либо воспользуйтесь функцией glob:
open(FH. globC'-joebob/somefile")) || die "Couldn't open file: $!":
либо выполните расширение вручную с помощью следующей подстановки:
Sfilename =~ s{ А ~ ( Е^/]* ) }
{ $1
? (getpwnam($1))Е7]
: ( $ENV{HOME} || $ENV{LOGDIR}
|| (getpwuid($>))E7]
)
}ex;
Комментарий
Тильда (~) в именах файлов представляет домашний каталог пользователя. Это
полезное условное обозначение было впервые использовано в командном интер-
претаторе csh системы Unix, а позднее получило широкое распространение в веб-
адресах вида http://www.example.com/~user/.
# Домашний каталог текущего пользователя
—user/blah # Файл blah в домашнем каталоге текущего пользователя
-user # Домашний каталог заданного пользователя
—/blah # Файл blah в домашнем каталоге заданного пользователя.
К сожалению, в Perl функция open не расширяет метасимволы, в том числе и ~.
В версии 5.6 при использовании оператора glob использовался модуль File: :Glob,
288
Глава 7. Доступ к файлам
поэтому перед вызовом open необходимо предварительно обработать результат
оператором glob:
open(MAILRC, , "-/.mailrc")
or die "can't open -/.mailrc: $!":
openCMAILRC. "<", glob("~/.mailrc"))
or die "can't open -/.mailrc: $!":
# ОШИБКА: тильда относится
# к командному интерпретатору
# Сначала нужно расширить ~.
В другом решении, основанном на подстановке, используется модифика-
тор /е, чтобы заменяющее выражение интерпретировалось как программный
код Perl. Если за тильдой следует имя пользователя, оно сохраняется в $1 и ис-
пользуется функцией getpwnam для получения домашнего каталога пользователя
из возвращаемого списка. Найденный каталог образует заменяющую строку.
Если за тильдой не указано имя пользователя, подставляется текущее значение
переменной окружения НОМЕ или LOGDIR. Если эти переменные не определены, за-
дается домашний каталог текущего пользователя.
Вообще говоря, вызов glob( '-gnat') можно записать в виде <~gnat>, но эта за-
пись слишком сильно напоминает чтение из файлового манипулятора, поэтому
делать так не рекомендуется.
См. также
Описание функции getpwnam вperlfunc(\.y, страница руководстваgetpwnam(2} ва-
шей системы; рецепт 9.6.
7.4. Имена файлов в сообщениях об ошибках
Проблема
Программа работает с файлами, однако в предупреждения и сообщения об ошиб-
ках Perl включается только последний использованный файловый манипулятор,
а не имя файла.
Решение
Воспользуйтесь именем файла вместо манипулятора:
open($path, Spath)
or die "Couldn’t open Spath for reading : $!\n":
Комментарий
Стандартное сообщение об ошибке выглядит так:
Argument "3\n" isn’t numeric in multiply at tallyweb line 16, <LOG> chunk 17.
Манипулятор LOG не несет полезной информации, поскольку вы не знаете,
с каким файлом он был связан. Если использовать имя файла в качестве косвен-
7.5. Сохранение файловых манипуляторов в переменных
289
ного файлового манипулятора, предупреждения и сообщения об ошибках Perl
становятся более содержательными:
Argument "3\n" isn't numeric in multiply at tallyweb
line 16, </usr/local/data/mylog3.dat> chunk 17.
К сожалению, этот вариант не работает при включенной директиве strict
refs, поскольку переменная Spath в действительности содержит не файловый ма-
нипулятор, а всего лишь строку, которая иногда ведет себя как манипулятор.
Фрагмент (chunk), упоминаемый в предупреждениях и сообщениях об ошибках,
представляет собой текущее значение переменной $..
См. также
Рецепт 7.1; описание функции open вperlfunc(Y).
7.5. Сохранение файловых манипуляторов
в переменных
Проблема
Требуется использовать файловый манипулятор как обычную переменную, кото-
рую можно передать или вернуть из функции, сохранить в структуре данных и т. д.
Решение
Простейший способ сохранить манипулятор в переменной — поручить эту зада-
чу open:
open(my Sfh, "<", Sfilename) or die "SO: can't open Sfilename: S’":
Чтобы сохранить именованный файловый манипулятор в переменной, пере-
дать или вернуть его из функции, воспользуйтесь синтаксисом тип-глоба (*..):
Svariable = *FILEHANDLE; # Сохранение в переменной
subroutine(*FILEHANDLE): # Передача функции
sub subroutine {
my Sfh = shift:
print Sfh "Hello, filehandle!\n":
}
Комментарий
Если при вызове open в первом аргументе передается неопределенная скаляр-
ная переменная, Perl создает анонимный тип-глоб и сохраняет ссылку на него
в этой скалярной переменной, то есть фактически создает файловый манипуля-
тор по требованию. Как и другие ссылки, автоматически оживленные файловые
290
Глава 7. Доступ к файлам
манипуляторы уничтожаются системой уборки мусора, поэтому следующий код
не создает утечки ресурсов:
{
open(my Sfh, "< /etc/motd") or die;
local $/; # Режим поглощающего ввода
Stext = <$fh>:
}
При достижении конца блока переменная $fh выходит из области действия.
Как объяснялось во Введении, из-за того, что эта переменная содержит послед-
нюю ссылку на анонимный файловый манипулятор, созданный при вызове open,
переменная уничтожается сборщиком мусора, а манипулятор автоматически за-
крывается.
Автоматически оживляемые манипуляторы анонимны и уже хранятся в пе-
ременных, поэтому они не помогут вам понять, как передать именованные фай-
ловые манипуляторы в параметрах функций или сохранять их в переменных,
в том числе и в элементах массивов или хэшей. Под «именованными файловы-
ми манипуляторами» подразумеваются манипуляторы в форме FH, включая все
стандартные манипуляторы типа STDIN или ARGV. Итак, давайте посмотрим, что
же собой представляют манипуляторы FH и как извлечь из них скалярное значе-
ние, которое можно было бы использовать для наших целей.
Во фрагментах вида
print STDERR "stuff\n";
Slnput = <STDIN>:
open(TTY, . "/dev/tty"):
If (eof(ARGV)) {....}
именованные файловые манипуляторы представляют собой символические име-
на, а не переменные. В этом отношении они ближе к процедурам, а не к пере-
менным, что усложняет их передачу или сохранение в структурах данных. Если
вы соблюдаете необходимые меры предосторожности и используете при компи-
ляции директиву use strict, то, скорее всего, откомпилировать следующий фраг-
мент вам не удастся:
Sfh = SOMEHANDLE;
somefunc(SOMEHANDLE);
Дело в том, что при отсутствии явных указаний на обратное, SOMEHANDLE в обоих
случаях является строкой, не заключенной в ограничители (unquoted), а директива
use strict это запрещает. Но даже если директива strict subs не используется,
у вас все равно возникнут проблемы с передачей манипулятора процедуре, кото-
рая была откомпилирована под действием strict subs или находится в разных
пакетах с кодом, содержащим вызов.
Четыре именованных манипулятора (STDERR, STDIN, TTY и ARGV), о которых го-
ворилось выше, не требуют специального обхождения, но не потому, что они яв-
ляются встроенными; более того, TTY таковым не является. Мы можем использо-
вать их лишь потому, что для встроенных операций, которым эти манипуляторы
передаются в качестве аргументов, определены прототипы с аргументом-мани-
пулятором.
7.5. Сохранение файловых манипуляторов в переменных
291
Следовательно, вы должны выбрать один из двух вариантов. Необходимо
либо определить для функции прототип, как объясняется в рецепте 7.6, либо
использовать нечто такое, что Perl воспринимал бы как имя файлового мани-
пулятора — строку, тип-глоб, ссылку на тип-глоб или объект ввода/вывода.
Все эти данные можно сохранять в переменных или передавать функциям
для последующего использования в качестве косвенных файловых манипуля-
торов:
somefunc( SOMEHANDLE ):
somefunc( "SOMEHANDLE" );
somefunc( ^SOMEHANDLE );
somefunc( \*SOMEHANDLE ):
somefunc( *SOMEHANDLE{10} );
# Только с прототипом somefunc(*)
# Строка в кавычках
# Тип-глоб
# Ссылка на тип-глоб
# Объект ввода/вывода
Использование строки, заключенной в кавычки, создает потенциальные пробле-
мы, хотя, как объяснялось выше, такое решение может работать, если програм-
мист будет действовать достаточно осторожно (см. следующий рецепт). Лучше
воспользоваться записью с тип-глобом либо напрямую в формате ^SOMEHANDLE,
либо по ссылке \*SOMEHANDLE:
somefunc(*SOMEHANDLE);
$fh = ^SOMEHANDLE; # или косвенно через переменную
somefunc(Sfh):
print $fh "data\n";
Запись с тип-глобом избавляет вас от необходимости заключать в ограничи-
тели или уточнять имя манипулятора. Возможно, звездочку стоит представить
как признак типа файлового манипулятора. Такое представление напоминает
модели из цветных шариков в школьном курсе химии — оно не соответствует
истине, но зато удобно и наглядно. Когда вы начинаете понимать, в чем эта мо-
дель расходится с действительностью, она вам уже не понадобится.
Если присвоить любую из четырех альтернативных форм именованного фай-
лового манипулятора скалярной переменной, вы сможете использовать эту пе-
ременную как косвенный файловый манипулятор.
Тем не менее, во встроенных операциях типа print, prlntf или оператора ввода
строк не могут использоваться сложные выражения и индексы в хэшах и масси-
вах. Так, следующие строки имеют недопустимый синтаксис и даже не компили-
руются:
@fd = (*STDIN, *STDOUT, *STDERR):
print $fd[l] "Type it: ":
$got = <$fd[O]>
print $fd[2] "What was that: $got";
# НЕВЕРНО
# НЕВЕРНО
# НЕВЕРНО
Впрочем, для print и printf можно заменить файловый манипулятор блоком,
который возвращает нужное выражение:
print { $fd[l] } "funny stuff\n";
printf { $fd[l] } "Pity the poor £x.\n", 3_735_928_559;
Pity the poor deadbeef.
292
Глава 7. Доступ к файлам
Такой блок является полноценным во всех отношениях и может содержать
более сложный код. Например, следующий фрагмент отправляет сообщение
в одно из двух мест:
$ок = -х "/bin/cat":
print { Sok ? $fd[l] : $fd[2] } "cat stat $ok\n":
print { $fd[ 1 + ($ok || 0) ] } "cat stat $ok\n":
Это пример так называемой «косвенной объектной записи» (эта тема подроб-
но рассматривается в главе 13 «Классы, объекты и связи»). Запрет на использо-
вание в косвенных объектах чего-либо, кроме простых скалярных переменных,
распространяется на все разновидности объектов. Как и в случае с пользова-
тельскими объектами, инфиксная форма -> помогает избежать всевозможных
синтаксических недоразумений. При наличии загруженного модуля 10::Handle
или производных от него воспользуйтесь выражением, для вызова методов мож-
но воспользоваться выражением, результатом которого является файловый ма-
нипулятор:
$fd[l]->print("funny stuff\n"):
(Sok ? $fd[l] : $fd[2])->print("cat stat $ok\n");
Интерпретация print и printf как вызовов методов объекта не подходит для
оператора <...>. Если предположить, что тип-глобы хранятся в структуре, как это
делалось выше, встроенная функция readline читает записи точно так же, как
это делает конструкция <...>. Для приведенной выше инициализации @fd эта ко-
манда будет работать:
Sgot = readline($fd[O]);
А если доступен модуль 10::Handle, можно воспользоваться методом getllne:
Sgot = $fd[O]->getline();
Модуль 10::Handle не заменяет readline лишь одним методом — он использу-
ет два метода для разных контекстов. Если вы предпочитаете контекстно-зави-
симое поведение readline, его всегда можно реализовать «на ходу», дополнив
класс новыми возможностями:
sub 10::Handle:deadline {
my Sfh = shift:
if (wantarray) {
return $fh->getlines( ):
} else {
return $fh->getline( );
}
}
См. также
Описание функции open в perlfunc(V); рецепт 7.1; документация по стандартно-
му модулю 10::Handle.
7.6. Написание процедуры, получающей файловые манипуляторы
293
7.6. Написание процедуры, получающей
файловые манипуляторы
Проблема
Функциям Perl (таким, как eof) при вызове можно напрямую передавать фай-
ловые манипуляторы. Вы хотите, чтобы такая возможность поддерживалась
пользовательскими функциями.
Решение
Используйте метод quailfy_to_ref модуля Symbol в сочетании с прототипом *:
use Symbol qw(qua!1fy_to_ref):
sub my_eof (*) {
my Shandie = shift:
$handle = qua!1fy_to_ref(Shandie, caller( )):
# Использовать Shandie
}
Комментарий
Прототип * сообщает Perl, что в аргументе функции должен напрямую переда-
ваться файловый манипулятор. Это позволяет вызывать функции в виде
my_eof(HANDLE):
Такое решение работает даже при активной директиве use strict 'subs'.
Впрочем, в аргументе функции передается строка. Чтобы аргумент можно было
использовать как файловый манипулятор, нужно при помощи модуля Symbol
преобразовать его в ссылку на тип-глоб. А поскольку ссылка на тип-глоб может
использоваться всюду, где допускается использование именованных файловых
манипуляторов, вы можете сохранить эту ссылку в скалярной переменной и ис-
пользовать ее в процедуре в качестве косвенного файлового манипулятора.
Если функции передается файловый манипулятор, который уже является
ссылкой на тип-глоб (например, автоматически оживленный при вызове open),
Perl и quailfy_to_ref все равно сделают то, что требуется:
open(my Sfh, , Sfilename) or die:
my_eof($fh):
Эта методика используется в рецепте 7.23.
См. также
Документация по стандартному модулю Symbol; раздел «Prototypes, страницы ру-
ководства perlsub(\y, рецепт 7.23.
294
Глава 7. Доступ к файлам
7.7. Кэширование открытых
манипуляторов вывода
Проблема
Требуется открыть для вывода больше файлов, чем разрешает ваша система.
Решение
Воспользуйтесь стандартным модулем Fl 1 eCache:
use FileCache;
cacheout (Spath); # При каждом использовании манипулятора
print Spath "output";
Комментарий
Функция cacheout модуля FileCache позволяет работать с большим количеством
выходных файлов, чем позволяет одновременно открыть ваша операционная сис-
тема. Если функция вызывается для открытия существующего файла, который
FileCache раньше не встречался, то файл без лишних слов усекается до нулевой
длины. Но при открытии и закрытии файлов в фоновом режиме cacheout отслежи-
вает ранее открывавшиеся файлы и не стирает их, а присоединяет к ним новые
данные. Каталоги при этом не создаются, поэтому если потребовать открыть файл
/usr/1 ocal/dates/merlno.ewe, а каталог /usr/1 ocal/dates не существует, то вызов
cacheout завершается по die.
Функция cacheout проверяет значение константы С NOFILE из стандартного
системного включаемого файла sys/param.h и определяет, сколько файлов может
одновременно быть открыто в системе. В некоторых системах это значение может
быть неверным, а кое-где вообще отсутствует (например, если максимальное ко-
личество открытых файловых дескрипторов ограничивается на уровне ресуров
процесса и задается командами limit/ulimit). Если cacheout не может получить
значение NOFILE, присвойте $F11 eCache: :cacheout_maxopen величину на 4 меньше
правильной или подберите разумное значение методом проб и ошибок.
В примере 7.1 файл xferlog (создаваемый большинством современных сер-
веров FTP) разбивается на несколько разных файлов, которые называются
по именам аутентифицированных пользователей. Поля в xferlog разделяются
пробелами, четвертое поле с конца содержит имя аутентифицированного поль-
зователя.
Пример 7.1. splitwulog
#! /usr/Ы n/perl
# splitwulog - разбиение журнала wuftpd по пользователям
use FileCache;
Soutdir = "/var/log/ftp/by-user";
while (<>) {
7.8. Одновременный вывод по нескольким манипуляторам
295
unless (defined ($user = (spl1t)[-4])) {
warn "Invalid line: $.\n";
next:
}
$path = "$outd1r/$user":
cacheout $path:
print $path $_:
}
См. также
Документация по стандартному модулю F11 eCache; описание функции open в perl-
func(V).
7.8. Одновременный вывод по нескольким
манипуляторам
Проблема
Требуется вывести одни и те же данные через несколько разных файловых ма-
нипуляторов.
Решение
Чтобы решить проблему без ветвления (forking), напишите цикл foreach с пере-
бором манипуляторов:
foreach $f11ehandle (@FILEHANDLES) {
print $f11 ehandle $stuff_to_pr1nt:
}
Если вы не возражаете против ветвления, откройте файловый манипулятор
для передачи данных программе tee:
open(MANY, "| tee.fl lei f11e2 f11e3 > /dev/null")
print MANY "data\n"
close(MANY)
or die $!:
or die $!:
or die $!:
Если программа tee недоступна, воспользуйтесь модулем 10: :Тее из архи-
ва CPAN:
use 10::Tee:
$tee = 10::Tee->new(@FILEHANDLES);
print $tee $stuff_to_pr1nt:
Комментарий
Файловый манипулятор позволяет передавать данные только одному файлу или
программе. Чтобы продублировать вывод в нескольких приемниках, придет-
ся многократно вызвать print или связать манипулятор с программой типа tee,
296
Глава 7. Доступ к файлам
которая передает свои входные данные в другие места. Если вы предпочитаете
первый вариант, вероятно, будет проще занести манипуляторы в список или
массив и организовать перебор элементов (см. рецепт 7.5):
for $fh (*FH1, *FH2, *FH3) { print $fh "whatever\n" }
Впрочем, если в вашей системе доступна программа tee или ее Perl-аналог из
рецепта 8.25, можно открыть канал к программе tee и поручить ей всю работу по
копированию файла по нескольким приемникам. Помните, что tee обычно так-
же копирует свои входные данные в STDOUT, поэтому если вы не хотите получить
лишнюю копию, ее стандартный вывод необходимо перенаправить в /dev/nul 1:
open (FH. "| tee filel f 11 e2 file3 >/dev/null:
print FH "whatever\n":
Вы даже можете перенаправить STDOUT своей программы на процесс tee, и то-
гда можно будет напрямую использовать обычную команду print:
# Направить STDOUT в три файла, сохранив исходный STDOUT
open (STDOUT. "| tee filel file2 file3") or die "Teeing off: $!\n":
print "whatever\n" or die "Writing: $!\n":
close(STDOUT) or die "Closing: $!\n":
Модуль CPAN 10:: Tee предоставляет в ваше распоряжение единый файло-
вый манипулятор (точнее, объект класса 10: :Тее) для вывода. Все данные, кото-
рые выводятся через него, передаются нескольким разным файловым манипуля-
торам. Манипуляторы-приемники указываются при вызове конструктора:
use 10::Тее;
$t = 10::Tee->new(*FHl, *FH2, *FH3):
print $t "Hello. world\n":
print $t "Goodbye. universe\n":
С манипулятором 10: :Tee можно выполнять любые операции ввода/вывода,
помимо вызовов print. Например, команда close $t в предыдущем примере вернет
true только в том случае, если успешно закрыты все манипуляторы FH1, FH2 и FH3.
См. также
Описание функции print в perlfunc{\\, документация по модулю CPAN 10: :Тее;
примеры использования в рецептах 8.25 и 13.15.
7.9. Открытие и закрытие файловых
дескрипторов
Проблема
Вы знаете, с какими дескрипторами должны выполняться операции ввода/вы-
вода. Однако Perl хочет работать с файловыми манипуляторами, а не числовы-
ми дескрипторами.
7.9. Открытие и закрытие файловых дескрипторов
297
Решение
Чтобы открыть файловый дескриптор, включите в строку режима доступа при
вызове open символы "<&" или
open(FH, "<&=". $FDNUM) # Открыть FH для самого дескриптора
open(FH. $FDNUM) # Открыть FH для копии дескриптора
Или воспользуйтесь методом new_from_fd модуля 10::Handle:
use 10::Handlе:
$fh = 10::Handl e->new_from_fd($FDNUM, "r"):
Чтобы закрыть файловый дескриптор по числовому значению, либо вызови-
те функцию POSIX::close, либо откройте его так, как показано выше.
Комментарий
Иногда бывает так, что вам известен файловый дескриптор, но не манипуля-
тор. В системе ввода/вывода Perl вместо дескрипторов используются мани-
пуляторы, поэтому вам приходится создавать новый манипулятор для уже
открытого дескриптора. Режимы доступа ">&" и "+<&" функции open реша-
ют эту задачу соответственно для чтения, записи и обновления. Добавление зна-
ка равенства ("<&=", ">&=" и "+<&=") приводит к более экономному расходованию
файловых манипуляторов, и почти всегда следует использовать именно этот
способ. Это объясняется тем, что в базовой реализации команды Perl open ис-
пользуется только функция fdopen(3} из библиотеки С, а не вызов системной
функции dup(2).
Метод new_from_1d объекта 10::Handle эквивалентен следующему фрагменту:
use 10::Handlе:
$fh = new 10::Handle:
$fh->fdopen($FDNUM. "r"): # Открыть fd 3 для чтения
Следующий пример показывает, как открываются файловые дескрипторы,
передаваемые почтовой системой МН своим дочерним процессам. Они идентифи-
цируются в переменной окружения MHCONTEXTFD:
$fd = $ENV{MHCONTEXTFD}:
open(MHCONTEXT, "<&=", $fd) or die "couldn't fdopen $fd: $!":
# После обработки
close(MHCONTEXT) or die "couldn't close context file: $!";
Закрытие файловых дескрипторов в числовом виде встречается еще реже.
Если вы уже открыли манипулятор для дескриптора, который нужно закрыть,
просто вызовите для этого манипулятора функцию Perl close. Если же манипу-
лятор отсутствует, то дескриптор можно закрыть функцией POSIX::close:
use POSIX:
POSIX::close(3):
# Закрыть fd 3
298
Глава 7. Доступ к файлам
См. также
Описание функции open в perlfunc(V)\ документация по стандартным модулям
POSIX и 10::Handle; страница руководства fdopen(3) для вашей системы.
7.10. Копирование файловых
манипуляторов
Проблема
Требуется создать копию файлового манипулятора.
Решение
Синонимы для файловых манипуляторов создаются конструкциями вида
*ALIAS = ^ORIGINAL:
Для создания независимой копии файлового дескриптора используется функ-
ция open с режимом доступа &:
openCOUTCOPY, ">&STDOUT") or die "Couldn't dup STDOUT: $!":
open(INCOPY, "<&STDIN") or die "Couldn't dup STDIN : $!":
Чтобы создать синоним для манипулятора или дескриптора, вызовите open
с режимом &=:
openCOUTALIAS. ">&=STDOUT") or die "Couldn't alias STDOUT: $!":
opendNALIAS, "<&=STDIN") or die "Couldn't alias STDIN : $!":
open(BYNUMBER. ">&=5") or die "Couldn't alias file descriptor 5: $!":
Для других типов манипуляторов (тип-глобы, объекты) используется анало-
гичный способ, но с трехаргументной версией open:
open(my $сору. $original) or die "Couldn't alias original: $!":
open(my $copy, "<&=", $original) or die "Couldn't alias original: $!":
Комментарий
При создании синонима для манипулятора по-прежнему используется только один
объект ввода/вывода Perl. Закрытие любого из синонимов приводит к закрытию
объекта ввода/вывода. Все последующие попытки использования копий этого ма-
нипулятора завершаются неудачей либо незаметно (по умолчанию), либо с пре-
дупреждением "print on closed filehandle" (при включенных предупреждениях).
Впрочем, при параллельном выполнении операций с несколькими манипулято-
рами-синонимами запись работает именно так, как следовало ожидать, потому
что она не сопровождается десинхронизацией дублированных структур данных.
Создавая копию файлового дескриптора командой open(COPY. ">HANDLE"), вы
в действительности вызываете системную функцию dup(2). Вы получаете два
независимых файловых дескриптора с одинаковыми текущими позициями, бло-
7.11. Создание временных файлов
299
кировками и флагами, но с независимыми буферами. Закрытие одного манипу-
лятора никак не отражается на его копии. Впрочем, одновременная работа с фай-
лом через два манипулятора — верный путь к катастрофе. Обычно эта методика
применяется только для сохранения и восстановления STDOUT и STDERR:
# Копирование файловых дескрипторов
open(OLDOUT, ">&STDOUT"):
openCOLDERR, ">&STDERR"):
# Перенаправление stdout и stderr
open(STDOUT, "> /tmp/program.out") or die "Can't redirect stdout: $!":
open(STDERR. ">&STD0UT") or die "Can't dup stdout: $!":
# Запуск программы
system($joe_random_program):
# Закрытие перенаправленных манипуляторов
close(STDOUT) or die "Can't close STDOUT: $!";
close(STDERR) or die "Can't close STDERR: $!":
# Восстановление stdout и stderr
open(STDERR. ">&OLDERR") or die "Can't restore stderr: $!":
open(STDOUT. ">&OLDOUT") or die "Can't restore stdout: $!";
# Закрытие независимых копий для предотвращения утечки ресурсов
close(OLDOUT) or die "Can't close OLDOUT: $!";
close(OLDERR) or die "Can't close OLDERR: $!":
При создании синонима для дескриптора командой ореп(ALIAS, ">=&HANDLE")
в действительности вызывается функция fdopen(3) из стандартной библиотеки
ввода/вывода или ее эквивалент. Вы получаете единый дескриптор с двумя бу-
ферами ввода/вывода, доступ к которым осуществляется через разные манипу-
ляторы. Закрытие одного манипулятора приводит к закрытию файловых де-
скрипторов всех синонимов, но не их манипуляторов — при попытке вызова print
для манипулятора, чей синоним был закрыт функцией close, Perl не выдает пре-
дупреждение "print on closed filehandle", хотя попытка завершилась неудачей.
Короче говоря, работа с файлом через два манипулятора ведет к беде. За допол-
нительной информацией по этой теме обращайтесь к рецепту 7.9.
См. также
Описание функции open в perlfunc(l); страница руководства dup(2) для. вашей
системы.
7.11. Создание временных файлов
Проблема
Требуется создать временный файл и автоматически удалить его по завершении
программы. Допустим, если вы хотите записать временный конфигурационный
файл, который будет передаваться запускаемой программе, его имя должно быть
300
Глава 7. Доступ к файлам
известно заранее. Но в других ситуациях может потребоваться временный файл
для записи и чтения промежуточных данных, причем его имя вас не интересует.
Решение
Воспользуйтесь функцией tmpflle модуля File: :Temp:
use File::Temp qw/ tempdir /:
Sfh = tempflle(): # Просто манипулятор
Возможно, наряду с временным файлом вам понадобится временный каталог:
use File::Temp qw/ tempdir /:
# или задать каталог
$d1r = tempd1r( CLEANUP => 1 ):
(Sfh, Sfilename) = tempflle( DIR => $d1r ):
Stemplate = "myprogtempXXXXXX"; # Суффикс X заменяется другими символами
(Sfh, Sfilename) = tempflleC Stemplate, DIR => Sdlr);
(Sfh, Sfilename) = tempflle( Stemplate. SUFFIX => ".data");
Комментарий
Временные файлы можно создавать разными способами, но лучше всего исполь-
зовать функции модуля File: :Temp. Во-первых, они чрезвычайно удобны; во-вто-
рых, они лучше адаптируются для других платформ, чем прямые вызовы функ-
ций операционной системы. Но, вероятно, важнее всего другое — эти функции
учитывают всевозможные нетривиальные проблемы безопасности и особенно
потенциальные возможности перехвата.
Хотя модуль содержит немало различных функций для создания временных
файлов, большинство функций нужны лишь для поддержки унаследованных ин-
терфейсов. В большинстве случаев пользователям достаточно базовой функции
tempfl 1 е(). Эта функция выполняет надежную атомарную операцию создания
и открытия нового пустого файла в режиме чтения/записи. В скалярном кон-
тексте возвращается манипулятор временного файла, а в списковом контексте —
манипулятор и полное имя:
use File::Temp qw(tempfl 1е);
# Только манипулятор
Sfh = tempfl 1е();
# Манипулятор и полное имя файла
(Sfh, Sfilename) = tempflle():
Функции tempfl 1 е могут передаваться необязательные аргументы: шаблон
и пары именованных аргументов. Именованные аргументы определяют различ-
ные параметры временного файла: каталог, который должен использоваться
вместо текущего; расширение файла, а в системах, в которых это возможно, —
признак немедленного удаления временного файла при выходе из программы
(что затрудняет поиск временных файлов злоумышленниками). Символы X в кон-
це шаблона заменяются случайными символами в имени временного файла.
7.12. Хранение данных в тексте программы
301
(Sfh, Sfilename) = tempf11e(DIR => Sdlr);
(Sfh, Sfilename) = tempflle(Stempl ate):
(Sfh, Sfilename) = tempflle(Stempl ate, DIR => Sdlr):
(Sfh, Sfilename) = tempflle(Stempl ate, SUFFIX => ".dat"):
(Sfh, Sfilename) = tempflle(Stempl ate. UNLINK => 1):
Если не задан параметр OPEN => 0, временный файл автоматически уничтожа-
ется при выходе из программы или при закрытии файла.
В последних версиях функция Perl open поддерживает простой способ созда-
ния временных файлов с неизвестными именами. Для этого вместо имени от-
крываемого файла передается undef:
open(my Sfh, "+>". undef)
or die "SO: can't create temporary file: $!\n":
См. также
Документация по стандартному модулю File: :Temp; описание функции open врег1-
func(i); рецепт 7.9.
7.12. Хранение данных в тексте программы
Проблема
Некоторые данные должны распространяться вместе с программой и интерпрети-
роваться как файл, но при этом они не должны находиться в отдельном файле.
Решение
Лексемы___DATA_и__END_после исходного текста программы отмечают начало
блока данных, который может быть прочитан программой или модулем через
файловый манипулятор DATA.
В модулях используется лексема_DATA_:
while (<DATA>) {
# Обработка строки
}
_ DATA_
# Данные
Аналогично используется_END_в главном файле программы:
while (<ma1n::DATA>) {
# Обработать строку
}
_END_
# Данные
Комментарий
Лексемы___DATA_и__END_обозначают логическое завершение модуля или про-
граммы перед физическим концом файла.
302
Глава 7. Доступ к файлам
Текст, находящийся после___DATA__или___END_, может быть прочитан через
файловый манипулятор DATA уровня пакета. Предположим, у нас имеется гипо-
тетический модуль Primes; текст после_DATA_в файле Primes .pm может быть про-
читан через файловый манипулятор Primes: :DATA.
Лексема___END_представляет собой синоним___DATA_в главном пакете. Текст,
следующий после лексем___END__в модулях, недоступен.
Появляется возможность отказаться от хранения данных в отдельном файле
и перейти к построению автономных программ. Такая возможность нередко
используется для документирования. Иногда в программах хранятся конфигу-
рационные или старые тестовые данные, использованные при разработке про-
грамм, — они могут пригодиться в процессе отладки.
Манипулятор DATA также применяется для определения даты последней мо-
дификации текущей программы или модуля. В большинстве систем перемен-
ная $0 содержит полное имя файла для работающего сценария. В тех системах,
где значение $0 оказывается неверным, можно воспользоваться манипулятором
DATA для определения размера, даты модификации и т. д. Вставьте в конец файла
специальную лексему____DATA__(и предупреждение о том, что__DATA_не следу-
ет удалять), и файловый манипулятор DATA будет доступен в файле сценария,
use POSIX qw(strftlme):
$raw_t1me = (stat(DATA))[9];
Sslze = -s DATA:
Skiloslze = 1nt($size / 1024) . ’k*:
print "<P>Scr1pt size Is $k11osize\n";
print strft1me("<P>Last script update: Ш)\п", Iocalt1me($raw_t1me)):
_DATA_
DO NOT REMOVE THE PRECEDING LINE
Everything else in this file will be ignored.
Если в программе нужно сохранить сразу несколько файлов, обращайтесь
к рецепту 7.13.
См. также
Раздел «Scalar Value Constructors» perldata(V).
7.13. Сохранение нескольких
файлов в области DATA
Проблема
Вы знаете, как при помощи____END_или___DATA___сохранить виртуальный файл
в исходном тексте программы, но вам требуется сохранить несколько виртуаль-
ных файлов в одном исходном файле.
7.13. Сохранение нескольких файлов в области DATA
303
Решение
Воспользуйтесь модулем CPAN Inline:: Fl les. Будьте внимательны!
use Inline::Fl les;
while (<SETUP>) {
# ...
}
while (<EXECUTION>) {
# ...
}
_ _SETUP_ _
everything for the SETUP filehandle goes here
_ _EXECUTION_ _
everything for the EXECUTION filehandle goes here
Комментарий
У синтаксиса_____DATA__есть одно важное ограничение: он позволяет внедрить
только один виртуальный файл данных в физический файл. Модуль CPAN
Inline::Files обходит это ограничение и позволяет создавать логические вирту-
альные файлы. Он используется примерно так:
use Inline::Fi1es:
#
# Сначала идет весь код файла, затем...
#
_ -ALPHA- _
This is the data in the first virtual file, ALPHA.
_ .BETA, _
This is the data in the next virtual file, BETA.
_ -OMEGA- _
This is the data in yet another virtual file, OMEGA.
_ _ALPHA_ _
This is more data in the second part of virtual file. ALPHA.
Предполагается, что программа читает из файловых манипуляторов, имена
которых соответствуют символическим именам в двойных подчеркиваниях, в дан-
ном случае — ALPHA, ВЕТА и OMEGA. Одна программа может содержать несколько
секций с одинаковыми именами, а разноименные секции не обязаны читаться
в каком-то определенном порядке. Эти манипуляторы имеют много общего с ма-
нипулятором ARGV. Прежде всего, они автоматически открываются при первом
использовании. Например, при выполнении фрагмента
while (<OMEGA>) {
print "omega data: :
}
304
Глава 7. Доступ к файлам
while (<ALPHA>) {
print "alpha data:
}
в указанной точке предыдущего примера будет получен следующий результат:
omega data: This is the data in yet another virtual file, OMEGA.
omega data:
alpha data: This is the data in the first virtual file, ALPHA.
alpha data:
alpha data: This is more data in the second part of virtual file, ALPHA.
alpha data:
Кроме того, по аналогии с манипулятором ARGV, при чтении из манипулятора
список доступных виртуальных файлов хранится в массиве, а текущий откры-
тый виртуальный файл — в скаляре с соответствующим именем. Также имеется
хэш с указанным именем, в котором хранится разнообразная информация о дан-
ном наборе виртуальных файлов, включая текущий файл, номер строки и сме-
щение в байтах. Если воспользоваться отладчиком Perl для приведенной выше
программы и вывести значения переменных, результат может выглядеть так:
DB2> \$ALPHA, \@ALPHA, \ШРНА
О SCALAR(Ох362е34)
-> '/home/tchrlst/inline-demo(00000000000000000291)'
1 ARRAY(0x362e40)
0 '/home/tchrlst/1nilne-demo(00000000000000000291)'
1 '/home/tchrlst/inline-demo(00000000000000000476)'
2 HASH(0x362edc)
'file' => undef
'line' => undef
'offset' => undef
'writable' => 1
О чем говорится в последней строке? О том, что виртуальный файл досту-
пен для записи. По умолчанию в сценариях, доступных для записи, виртуаль-
ные файлы тоже доступны для записи, и открываются в режиме чтения/записи!
Отсюда следует, что вы можете обновлять их и даже добавлять новые виртуаль-
ные файлы в исходный текст программы, просто запустив ее на выполнение.
Такая возможность может привести к любым бедам и катастрофам, посколь-
ку ничто не помешает уничтожению данных, полученных с огромным трудом.
По этой причине рекомендуется сначала заархивировать всю ценную инфор-
мацию. В самом модуле предусмотрен механизм автоматического решения этой
задачи. Команда
use Inline:-.Files -backup:
сохраняет оригинал в файле с суффиксом " .bak". Имя файла для резервной ко-
пии также может явно задаваться в программе:
use Inline:-.Files -backup => "/tmp/safety_net":
См. также
Документация по модулю CPAN Inline: Tiles; рецепт 7.12.
7.14. Создание фильтра
305
7.14. Создание фильтра
Проблема
Вы хотите написать программу, которая получает из командной строки список
файлов. Если файлы не заданы, входные данные читаются из STDIN. При этом
пользователь должен иметь возможность передать программе " -" для обозначе-
ния STDIN или "someprogram |" для получения выходных данных другой програм-
мы. Программа может непосредственно модифицировать файлы или выводить
результаты на основании входных данных.
Решение
Читайте строки оператором <>:
while (<>) {
# Сделать что-то со строкой
}
Комментарий
Встречая конструкцию:
while (<>) {
# ...
}
Perl преобразует ее к следующему виду1:
unshift(@ARGV. unless @ARGV:
while($ARGV = shift @ARGV) {
unless (opentARGV. $ARGV)) {
warn "Can't open $ARGV: $!\n";
next:
}
while (defined($_ = <ARGV>)) {
#...
}
}
Внутри цикла с помощью ARGV и $ARGV можно получить дополнительные дан-
ные или узнать имя текущего обрабатываемого файла. Давайте посмотрим, как
это делается.
Общие принципы
Если пользователь не передает аргументы, Perl заносит в @ARGV единственную стро-
ку, Это сокращенное обозначение соответствует STDIN при открытии для
чтения и STDOUT — для записи. Кроме того, пользователь может передать " -" в ко-
мандной строке вместо имени файла для получения входных данных из STDIN.
1 В программе показанный фрагмент не будет работать из-за внутренней специфики ARGV.
306
Глава 7. Доступ к файлам
Далее в цикле из @ARGV последовательно извлекаются аргументы, а имена
файлов копируются в глобальную переменную $ARGV. Если файл не удается от-
крыть, Perl переходит к следующему файлу. В противном случае начинается
циклическая обработка строк открытого файла. После завершения обработки
открывается следующий файл и процесс повторяется до тех пор, пока не будет
исчерпано все содержимое @ARGV.
При вызове open не используется форма open(ARGV, . $ARGV). Это позволяет
добиться интересных эффектов — например, передать в качестве аргумента стро-
ку "gzip -de file.gz |", чтобы программа получила в качестве входных данных
результаты команды "gzip -de file.gz". Такое применение open рассматривается
в рецепте 16.6.
Массив @ARGV может изменяться перед циклом или внутри него. Предполо-
жим, вы хотите, чтобы при отсутствии аргументов входные данные читались не
из STDIN, а из всех программных и заголовочных файлов С и C++. Вставьте сле-
дующую строку перед началом обработки <ARGV>:
©ARGV = globC*.[Cch]") unless @ARGV;
Перед началом цикла следует обработать аргументы командной строки — либо
с помощью библиотек Getopt (см. главу 15 «Интерактивность»), либо вручную:
# Аргументы 1: Обработка необязательного флага -с
If (@ARGV && $ARGV[O] eq '-с’) {
$chop_f1rst++;
shift;
}
# Аргументы 2: Обработка необязательного флага -NUMBER
If (OARGV && $ARGV[O] =~ /A-(\d+)$/) {
Scolumns = $1;
shift;
}
# Аргументы 3: Обработка сгруппированных флагов -а. -1 -п. и -и
while (@ARGV && $ARGV[O] =~ /А-(.+)/ & (shift. ($_ = $1). 1)) {
next If /А$/;
s/a// && (++$append. redo);
die "usage: $0 [-alnu] [filenames] . .An";
}
Если не считать неявного перебора аргументов командной строки, <> работает
так же, как обычно. Продолжают действовать все специальные переменные, управ-
ляющие процессом ввода/вывода (см. главу 8). Переменная $/ определяет раздели-
тель записей, а $. содержит номер текущей строки (записи). Если $/ присваива-
ется неопределенное значение, то при каждой операции чтения будет получено
не объединенное содержимое всех файлов, а полное содержимое одного файла:
undef $/:
while (<>) {
# Теперь в $_ находится полное содержимое файла.
# имя которого хранится в $ARGV
}
7.14. Создание фильтра
307
Если значение $/ локализовано, старое значение автоматически восстанавли-
вается при выходе из блока:
{ # Блок для local
local $/; # Разделитель записей становится неопределенным
while (<>) {
# Сделать что-то; в вызываемых функциях
# значение $/ остается неопределенным
}
} # Восстановить $/
Поскольку при обработке <ARGV> файловые манипуляторы никогда не закры-
ваются явно, номер записи $. не сбрасывается. Если вас это не устраивает, само-
стоятельно организуйте явное закрытие файлов для сброса $.:
while (<>) {
print "$ARGV:$.
close ARGV if eof:
}
Функция eof проверяет достижение конца файла при последней операции
чтения. Поскольку последнее чтение выполнялось через манипулятор ARGV, eof
сообщает, что мы находимся в конце текущего файла. В этом случае файл за-
крывается, а переменная $. сбрасывается. С другой стороны, специальная запись
eof () с круглыми скобками, но без аргументов проверяет достижение конца всех
файлов при обработке <ARGV>.
Параметры командной строки
В Perl предусмотрены специальные параметры командной строки —п, -р, -а
и -1, упрощающие написание фильтров и однострочных программ.
Параметр -п помещает исходный текст программы внутрь цикла whi 1е(<>).
Обычно он используется в фильтрах типа grep или программах, которые накап-
ливают статистику по прочитанным данным. Одна из таких программ приведена
в примере 7.2.
Пример 7.2. findloginl
# !/usr/bin/perl
# findloginl - вывести все строки, содержащие подстроку "login"
while (<>) { # Перебор файлов в командной строке
print if /login/;
}
Программу из примера 7.2 можно записать так, как показано в примере 7.3.
Пример 7.3. findlogin2
# !/usr/bin/perl -n
# findlogin2 - вывести все строки, содержащие подстроку "login"
print if /login/;
Параметр -n может объединяться с -е для выполнения кода Perl из команд-
ной строки:
% perl -ne 'print if /login/'
308
Глава?. Доступ к файлам
Параметр -р аналогичен -п, однако он добавляет команду print в конец цик-
ла. Обычно он используется в программах для преобразования входных данных.
Пример 7.4. find lowercase 1
# !/usr/Ы n/perl
# lowercase - преобразование всех строк в нижний регистр
use locale;
while (<>) { # Перебор в командной строке
s/(\р{Letter})/\1$1/д; # Перевод всех букв в нижний регистр
print;
}
Программу из примера 7.4 можно записать так, как показано в примере 7.5.
Пример 7.5. findlowercase2
# !/usr/Ыn/perl -р
# lowercase - преобразование всех строк в нижний регистр
use locale;
s/(\р{Letter})/\l$l/g; # Перевод всех букв в нижний регистр
Или непосредственно в командной строке следующего вида:
% perl -ре 's/([^\W0-9_])/\l$l/g'
При использовании -п или -р для неявного перебора входных данных для
всего цикла негласно создается специальная метка LINE:. Это означает, что из
внутреннего цикла можно перейти к следующей входной записи командой next
LINE (аналог next в awk). При закрытии ARGV происходит переход к следующе-
му файлу (аналог nextfl 1е в awk). Обе возможности продемонстрированы в при-
мере 7.6.
Пример 7.6. countchunks
# !/usr/Ыn/perl -n
# countchunks - подсчет использованных слов
# с пропуском комментариев. При обнаружении _END_ или _DATA_
# происходит переход к следующему файлу.
for (split /\W+/) {
next LINE if /"#/;
close ARGV if /_(DATA|END)_/;
$chunks++;
}
END { print "Found Schunks chunks\n" }
В файле .history, создаваемом командным интерпретатором tcsh, перед каж-
дой строкой указывается время, измеряемое в секундах с начала эпохи:
#+0894382237
less /etc/motd
#+0894382239
vi ~/.exrc
#+0894382242
date
#+0894382239
who
7.15. Непосредственная модификация файла с применением временной копии
309
#+0894382288
telnet home
Простейшая однострочная программа приводит его к удобному формату:
%perl -ре 's/^#\+(\d+)\n/localtlme(Sl) . " "/е'
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
Параметр -1 изменяет каждый файл в командной строке. Он описан в ре-
цепте 7.16 и обычно применяется в сочетании с -р.
См. также
perlrun(l)] рецепт 7.16; рецепт 16.6.
7.15. Непосредственная модификация файла
с применением временной копии
Проблема
Требуется обновить содержимое файла на месте. При этом допускается приме-
нение временного файла.
Решение
Прочитайте данные из исходного файла, запишите изменения во временный
файл и затем переименуйте временный файл в исходный:
openCOLD. $old")
open(NEW, $new")
while (<OLD>) {
# Изменить $_. затем...
print NEW $_
}
close(OLD)
close(NEW)
rename($old, "Sold.orlg")
rename($new, $old)
or die "can't open Sold: $!":
or die "can't open $new: $!":
or die "can't write $new: $!":
or die "can't close $01 d: $!":
or die "can't close $new: $!":
or die "can't rename $ol d to Sold.orlg: $
or die "can't rename $new to Sold: $!":
Такой способ лучше всего приходит для обновления файлов «на месте».
Комментарий
Этот метод требует меньше памяти, чем другие подходы, не использующие вре-
менных файлов. Есть и другие преимущества — наличие резервной копии фай-
ла, надежность и простота программирования.
310
Глава?. Доступ к файлам
Показанная методика позволяет внести в файл те же изменения, что и другие
версии, не использующие временных файлов. Например, можно вставить новые
строки перед 20-й строкой файла:
while (<OLD>) {
If ($. == 20) {
print NEW "Extra line l\n";
print NEW "Extra line 2\n";
print NEW
Или удалить строки с 20 по 30:
while (<OLD>) {
next If 20 ., 30;
print NEW
Обратите внимание: функция rename работает лишь в пределах одного каталога,
поэтому временный файл должен находиться в одном каталоге с модифицируемым.
Программист-перестраховщик непременно заблокирует файл на время об-
новления. Сложность заключается в том, что перед получением блокировки на
модификацию файл необходимо открыть для записи без уничтожения его содер-
жимого. В рецепте 7.18 показано, как это делается.
См. также
Рецепт 7.1; рецепт 7.16; рецепт 7.17; рецепт 7.18.
7.16. Непосредственная модификация файла
с помощью параметра -i
Проблема
Требуется обновить файл на месте из командной строки, но вам лень1 возиться
с файловыми операциями из рецепта 7.15.
Решение
Воспользуйтесь параметрами -1 и -р командной строки Perl. Запишите свою про-
грамму в виде строки:
% perl -l.orlg -р 'ФИЛЬТР' файл1 файл2 файлЗ ...
Или воспользуйтесь параметрами в самой программе:
#!/usr/bin/perl -l.orlg -р
# Фильтры
1 Конечно, имеется в виду лень творческая, а не греховная.
7.16. Непосредственная модификация файла с помощью параметра -i
311
Комментарий
Параметр командной строки -1 осуществляет модификацию файлов «на мес-
те». Он создает временный файл, как и в предыдущем рецепте, однако Perl
берет на себя все утомительные хлопоты с файлами. Используйте -1 в сочета-
нии с -р (см. рецепт 7.14), чтобы превратить:
while (<>) {
If ($ARGV ne $oldargv) { # Мы перешли к следующему файлу?
rename($ARGV, $ARGV . '.orig’):
open(ARGVOUT. $ARGV"): # Плюс проверка ошибок
select(ARGVOUT);
$oldargv = $ARGV:
}
s/DATE/localtime/e:
}
continue{
print:
}
select (STDOUT): # Восстановить стандартный вывод
в следующий фрагмент:
% perl -pi.orig -е 's/DATE/localtime/e'
Параметр -1 заботится о создании резервных копий (если вы не желаете со-
хранять исходное содержимое файлов, используйте -1 вместо -1 .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 2003, our records show your account
is overdue. Please settle by the end of the month.
Yours in cheerful usury.
--A. Moneylender
Параметр -1 заметно упрощает разработку и чтение программ-трансляторов.
Например, следующий фрагмент заменяет все изолированные экземпляры "hisvar"
на "hervar" во всех файлах С, C++ и уасс:
%perl -1.old -ре 's{\bhisvar\b}{hervar}g' *.[Cchy]
Действие -1 может включаться и выключаться с помощью специальной пере-
менной $Л1. Инициализируйте @ARGV и затем примените <> так, как применили
бы -1 для командной строки:
# Организовать перебор файлов *.с в текущем каталоге.
# редактирование на месте и сохранение старого файла с расширением .orig
312
Глава 7. Доступ к файлам
local .orlg’: # Эмулировать -l.orlg
local @ARGV = globC*.с"); # Инициализировать список файлов
while (<>) {
If ($. == 1) {
print "This line should appear at the top of each f11e\n";
}
s/\b(p)earl\b/{l}erl/1g: # Исправить опечатки с сохранением регистра
print:
} continue {close ARGV If eof}
Учтите, что при создании резервной копии предыдущая резервная копия
уничтожается.
См. также
perlrun(l); описание переменных $Х1 и $. в perlvar(l); описание оператора ..
в разделе «Range Operator» perlop(l).
7.17. Непосредственная модификация файла
без применения временного файла
Проблема
Требуется вставить, удалить или изменить одну или несколько строк файла.
При этом вы не хотите (или не можете) создавать временный файл.
Решение
Откройте файл в режиме обновления ("+<"), прочитайте все его содержимое
в массив строк, внесите необходимые изменения в массиве, после чего переза-
пишите файл и выполните усечение до текущей позиции.
openCFH. "+< FILE" or die "Opening: $!":
OARRAY = <FH>;
# Модификация массива ARRAY
seek(FH.O.O) or die "Seeking: $!":
print FH OARRAY or die "Printing: $!":
truncate(FH.tel1(FH)) or die "Truncating: $!";
close(FH) or die "Closing: $!":
Комментарий
Как сказано во Введении, операционная система интерпретирует файлы как не-
структурированные потоки байтов. Из-за этого вставка, непосредственная моди-
фикация или изменение отдельных битов невозможны (кроме особого случая,
рассматриваемого в рецепте 8.13 — файлов с записями фиксированной длины).
Для хранения промежуточных данных можно воспользоваться временным фай-
лом. Другой вариант — прочитать файл в память, модифицировать его и запи-
сать обратно.
7.18. Блокировка файла
313
Чтение в память всего содержимого подходит для небольших файлов, но
с большими возникают сложности. Попытка применить его для 800-мегабайтных
файлов журналов на веб-сервере приведет либо к переполнению виртуальной
памяти, либо к общему сбою системы виртуальной памяти вашего компьютера.
Однако для файлов малого размера подойдет следующее решение:
open(F, $1nf11e") or die "can't read $1nf11e: $!":
$out = '':
while (<F>) {
s/DATE/localtlme/eg:
$out .= $_;
}
seek(F, 0, 0) or die "Seeking: $!";
print F $out or die "Printing: $!":
truncate(F, tell(F)) or die "Truncating: $!";
close(F) or die "Closing: $!":
Другие примеры операций, которые могут выполняться на месте, приведены
в рецептах главы 8.
Этот вариант подходит лишь для самых решительных. Он сложен в написа-
нии, расходует больше памяти (теоретически — намного больше), не сохраняет
резервной копии и может озадачить других программистов, которые попытают-
ся читать данные из обновляемого файла. Как правило, он не оправдывает за-
траченных усилий.
Если вы особо мнительны, не забудьте заблокировать файл.
См. также
Описание функций seek, truncate, open и sysopen в perlfunc(l)\ рецепт 7.15; ре-
цепт 7.16; рецепт 7.18.
7.18. Блокировка файла
Проблема
Несколько процессов одновременно пытаются обновить один и тот же файл.
Решение
Организуйте условную блокировку с помощью функции flock:
use Fcntl qw(:flock):
openfFH, "+<", $path)
flock(FH,LOCK_EX)
# Обновить файл, затем...
close(FH)
# Ради констант LOCK_*
or die "can't open $path: $!":
or die "can't flock $path: $!":
or die "can't close $path: $!";
Комментарий
Операционные системы сильно отличаются по типу и степени надежности ис-
пользуемых механизмов блокировки. Perl старается предоставить программисту
314
Глава?. Доступ к файлам
работоспособное решение даже в том случае, если операционная система ис-
пользует другой базовый механизм. Функция flock получает два аргумента:
файловый манипулятор и число, определяющее возможные действия с данным
манипулятором. Числа обычно представлены символьными константами типа
1_ОСК_ЕХ, имена которых можно получить из модуля Fcntl или 10::File.
Блокировки делятся на две категории: совместные (LOCK_SH) и монопольные
(1_0СК_ЕХ). Термин «монопольный» может ввести вас в заблуждение, поскольку
процессы не обязаны соблюдать блокировку файлов. Иногда говорят, что flock
реализует условную блокировку, чтобы операционная система могла приостано-
вить все операции записи в файл до того момента, когда с ним закончит работу
последний процесс чтения.
Условная блокировка напоминает светофор на перекрестке. Светофор ра-
ботает лишь в том случае, если люди обращают внимание на цвет сигнала,
красный или зеленый, или желтый для условной блокировки. Красный цвет
не останавливает движение; он всего лишь сообщает, что движение следует
прекратить. Отчаянный, невежественный или просто наглый водитель проедет
через перекресток независимо от сигнала светофора. Аналогично работает и функ-
ция flock — она тоже блокирует другие вызовы flock, а не процессы, выполняю-
щие ввод/вывод. Правила должны соблюдаться всеми, иначе могут произойти
(и непременно произойдут) несчастные случаи.
Добропорядочный процесс сообщает о своем намерении прочитать данные из
файла, запрашивая блокировку LOCK_SH. Совместная блокировка файла может
быть установлена сразу несколькими процессами, поскольку они (предположи-
тельно) не будут изменять данные. Если процесс собирается произвести запись
в файл, он должен запросить монопольную блокировку с помощью 1_0СК_ЕХ. Затем
операционная система приостанавливает этот процесс до снятия блокировок
остальными процессами, после чего приостановленный процесс получает бло-
кировку и продолжает работу. Можно быть уверенным в том, что на время сохра-
нения блокировки никакой другой процесс не сможет выполнить flock(FH,LOCK_EX)
для того же файла. Это похоже на другое утверждение — «в любой момент для
файла может быть установлена лишь одна монопольная блокировка», но не со-
всем эквивалентно ему. В некоторых системах дочерние процессы, созданные
функцией fork, наследуют от своих родителей не только открытые файлы, но
и установленные блокировки. Следовательно, при наличии монопольной блоки-
ровки и вызове fork без ехес производный процесс может унаследовать моно-
польную блокировку файла.
Функция 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: $!";
}
}
7.18. Блокировка файла
315
Если при использовании LOCK_NB вам было отказано в совместной блоки-
ровке, следовательно, кто-то другой получил LOCK_EX и обновляет файл. От-
каз в монопольной блокировке означает, что другой процесс установил со-
вместную или монопольную блокировку, поэтому пытаться обновлять файл не
следует.
Блокировки исчезают с закрытием файла, что может произойти лишь после
завершения процесса. При установлении или снятии блокировки Perl автомати-
чески записывает текущее содержимое буферов.
А вот как увеличить число в файле с применением flock:
use Fcntl qw(:DEFAULT :flock):
sysopen(FH. "numfile". O_RDWR|O_CREAT) or die "can't open numfile: $!";
flock(FH. LOCK_EX) # Блокировка получена, $num = <FH> || 0 : seek(FH. 0. 0) truncate(FH, 0) print FH $num+l, "\n" close(FH) or die "can't write-lock numfile: $!" можно выполнять ввод/вывод # HE ИСПОЛЬЗУЙТЕ "or" !! or die "can't rewind numfile : $!": or die "can't truncate numfile: $!": or die "can't write numfile: $!": or die "can't close numfile: $!":
Закрытие файлового манипулятора приводит к очистке буферов и снятию
блокировки с файла. Функция truncate описана в главе 8.
С блокировкой файлов дело обстоит сложнее, чем можно подумать — и чем
нам хотелось бы. Блокировка имеет условный характер, поэтому если один про-
цесс использует ее, а другой — нет, все идет прахом. Никогда не используйте
факт существования файла в качестве признака блокировки, поскольку между
проверкой существования и созданием файла может произойти вмешательство
извне. Более того, блокировка файлов подразумевает концепцию состояния и пото-
му не соответствует моделям некоторых сетевых файловых систем, например,
NFS. Хотя некоторые разработчики утверждают, что fcntl решает эти проблемы,
практический опыт говорит об обратном. Модуль CPAN File::NFSLock использу-
ет хитроумную схему получения и снятия блокировки файлов в NSF, которая
отличается от системы flock.
Не путайте функцию Perl flock с функцией SysV lockf. В отличие от lockf,
flock блокирует сразу весь файл. Perl не обладает непосредственной поддержкой
lockf, хотя модуль CPAN File::Lock обеспечивает такую возможность при под-
держке lockf со стороны операционной системы. Блокировка части файла на
«чистом» Perl может выполняться только одним способом — при помощи функ-
ции fcntl (см. программу lockarea в конце главы).
См. также
Описание функций flock и fcntl в perlfunc(l); документация по стандартным мо-
дулям Fcntl и DB_File; документация по модулям CPAN File::Lock и File::NFSLock;
рецепт 7.24; рецепт 7.25.
316
Глава?. Доступ к файлам
7.19. Очистка буфера
Проблема
Операция вывода через файловый манипулятор выполняется не сразу. Из-за это-
го могут возникнуть проблемы в сценариях CGI на некоторых веб-серверах, враж-
дебных по отношению к программисту. Если веб-сервер получит предупрежде-
ние от Perl до того, как увидит (буферизованный) вывод вашего сценария, он
передает браузеру малосодержательное сообщение 500 Server Error. Проблемы
буферизации возникают при одновременном доступе к файлам со стороны не-
скольких программ и при взаимодействии с устройствами или сокетами.
Решение
Запретите буферизацию, присвоив истинное значение (обычно 1) переменной
$ | на уровне файлового манипулятора:
$old_fh = select(OUTPUT_HANDLE);
$| = 1;
select($old_fh):
Или, если вас не пугают затраты на загрузку модуля 10, вообще запретите бу-
феризацию вызовом метода autoflush:
use 10::Handlе:
OUTPUT_HANDLE->autof1ush(1):
Решение работает и с косвенными манипуляторами:
use 10::Handlе:
$fh->autoflush(l):
Комментарий
В большинстве реализаций стандартной библиотеки ввода/вывода буферизация
определяется типом выходного устройства. Для дисковых файлов применяется
блочная буферизация с размером буфера, превышающим 2 Кбайт. Для кана-
лов (pipes) и сокетов часто применяется буфер размером от 0,5 до 2 Кбайт.
Последовательные устройства, к числу которых относятся терминалы, моде-
мы, мыши и джойстики, обычно буферизуются построчно; stdlo передает всю
строку лишь при получении перевода строки.
Функция Perl print не поддерживает по-настоящему небуферизованного вы-
вода — физической записи каждого отдельного символа. Вместо этого поддер-
живается командная буферизация, при которой физическая запись выполняется
после каждой отдельной команды вывода. По сравнению с полным отсутствием
буферизации обеспечивается более высокое быстродействие, при этом выходные
данные получаются сразу же после вывода.
Для управления буферизацией вывода используется специальная перемен-
ная $|. Присваивая ей true, вы тем самым разрешаете командную буферизацию.
7.19. Очистка буфера
317
На ввод она не влияет (небуферизованный ввод рассматривается в рецептах 15.6
и 15.8). Если $| присваивается false, будет использоваться стандартная буфери-
зация stdio. Отличия продемонстрированы в примере 7.7.
Пример 7.7. seeme
# !/usr/Ыn/perl -w
# seeme - буферизация вывода в stdio
$| = (OARGV >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".
Если вызвать программу хотя бы с одним аргументом, для STDOUT используется
командная буферизация. Это означает, что сначала появится строка "Now you
don't see it...а еще через две секунды вы увидите "now you do".
В сомнительном стремлении к компактности кода программисты включают
возвращаемое значение select (файловый манипулятор, который был выбран
в настоящий момент) в другой вызов select:
seiect((select(OUTPUT_HANDLE). $| = l)[0]);
Существует и другое решение. Модуль 10::Handle и все модули, производные
от этого класса, поддерживают три метода: flush, autoflush и printflush. Все эти
методы вызываются для манипуляторов — как литералов, так и переменных, со-
держащих файловый манипулятор или его заменитель.
Метод flush записывает все выходные данные, ожидающие вывода в буфере,
и возвращает true в случае успеха или false в случае неудачи. Метод printFlush
представляет собой вызов print, за которым следует flush. Метод autoflush обес-
печивает более удобную запись взамен изощренно-архаичной, приведенной выше.
Он устанавливает командную буферизацию для манипулятора (или отменяет ее
при передаче false) и возвращает предыдущее значение данного свойства мани-
пулятора. Пример:
use FileHandle:
STDERR->autof1ush: # Уже не буферизован в stdio
$fi1ehandle->autof1ush(0):
Если вас не пугают странности косвенной записи (см. главу 13 «Классы, объ-
екты и связи»), можно написать нечто похожее на обычный английский текст:
use 10::Handlе:
# REMOTE_CONN - манипулятор интерактивного сокета.
# a DISK_FILE - манипулятор обычного файла.
autoflush REMOTE_CONN 1: # Отказаться от буферизации для ясности
autoflush DISK_FILE 0: # Буферизовать для повышения быстродействия
318
Глава?. Доступ к файлам
Мы избегаем жутких конструкций select, и программа становится более по-
нятной. К сожалению, при этом увеличивается время компиляции, поскольку
включение модуля 10::Handle требует открытия десятков файлов с чтением и ком-
пиляцией тысяч строк кода. Научитесь напрямую работать с $|, этого будет
вполне достаточно. Но если в более крупном приложении уже используется
класс, производный от 10::Handle, то вы уже заплатили положенную цену и мо-
жете пользоваться ее благами.
Чтобы выходные данные оказались в нужном месте в нужное время, необхо-
димо позаботиться о своевременной очистке буфера. Это особенно важно для
сокетов, каналов и устройств, поскольку они нередко участвуют в интерактив-
ном вводе/выводе, а также из-за того, что вы не сможете полагаться на построч-
ную буферизацию. Рассмотрим программу из примера 7.8.
Пример 7.8. getpcomidx
# !/usr/Ы n/perl
# getpcomidx - получить документ 1ndex.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(l):
# На Мас \п\п ^обязательно* заменяется последовательностью \015\012\015\012.
# Спецификация рекомендует зто и для других систем.
# однако в реализациях рекомендуется поддерживать и "\cJ\cJ".
# Наш опыт показывает, что именно так и делается.
$sock->pr1nt("GET /1ndex.html http/1.l\n\n"):
$document = Jo1n(”, $sock->getl1nes()):
print "DOC IS: $document\n":
В Perl версии 5.8 и выше можно воспользоваться новым механизмом уровней
ввода/вывода для обеспечения небуферизованного вывода. Этот механизм дос-
тупен на уровне :un1x. Если манипулятор уже открыт, можно сделать так:
binmode(STDOUT. ":un1x")
|| die "can't binmode STDOUT to :un1x: $!";
В другом варианте уровень ввода/вывода задается при первоначальном от-
крытии файла:
open(TTY, ">:un1x", "/dev/tty")
|| die "can't open /dev/tty: $!":
print TTY "54321":
sleep 2:
print TTY "\n":
Ни один из рассмотренных нами типов буферизации не позволяет управлять
буферизацией ввода. Для этого обращайтесь к рецептам 15.6 и 15.8.
См. также
Описание переменной $| в perlvar(V)\ документация по стандартным моду-
лям Fl 1 eHandlе и 10::Handlе; описание функции select вperlfunc(l)\ рецепты 15.6
и 15.8.
7.20. Асинхронный ввод/вывод
319
7.20. Асинхронный ввод/вывод
Проблема
Требуется прочитать или записать данные через файловый манипулятор так,
чтобы система не приостанавливала процесс до наступления готовности програм-
мы, файла, сокета или устройства на другом конце. Такая задача чаще возникает
для специальных, нежели для обычных файлов.
Решение
Откройте файл функцией sysopen с параметром O_NOCBLOCK:
use Fcntl:
sysopen(MODEM. "/dev/cuaO". O_NONBLOCK|O_RDWR)
or die "Can’t open modem: $!\n":
Если у вас уже есть открытый файловый манипулятор, вызовите метод blocking
модуля 10::Handle с аргументом 0:
use 10::Handlе:
M0DEM->blocklng(0): # Предполагается, что манипулятор MODEM уже открыт
Или воспользуйтесь низкоуровневой функцией fcntl:
use Fcntl:
$flags = ""I
fcntl(HANDLE. F_GETFL. Sflags)
or die "Couldn't get flags for HANDLE : $!\n":
Sflags |= O_NONBLOCK;
fcntl(HANDLE. F_SETFL. Sflags)
or die "Couldn't set flags for HANDLE: $!\n";
Комментарий
Когда дальнейшее чтение из файла на диске становится невозможным из-за
того, что текущая позиция находится в конце файла, операция ввода немедлен-
но завершается. Но как быть, если файловый манипулятор связан с клавиату-
рой или сетевым подключением? В таких случаях временное отсутствие данных
совсем не означает, что их не будет никогда, поэтому функция ввода обычно не
возвращает управление до получения дальнейших данных. Впрочем, в отдель-
ных случаях ждать нежелательно; вы просто хотите получить те данные, кото-
рые имеются на данный момент, и продолжить работу.
После открытия файлового манипулятора для асинхронного ввода/вывода
вызовы sysread и syswrlte, которые обычно приводят к блокировке, возвращают
undef и присваивают переменной $! значение EAGAIN:
use Errno:
$rv = syswr1te(HANDLE. $buffer. length $buffer);
If (!def1ned($rv) && $!{EAGAIN}) {
320
Глава 7. Доступ к файлам
# Ожидание
} elslf ($rv != length Sbuffer) {
# Неполная запись
} else {
# Успешная запись
}
$rv = sysread(HANDLE. $buffer, $BUFSIZ):
If ('defined(Srv) && $!{EAGAIN}) {
# Ожидание
} else {
# Успешно прочитано $rv байт из HANDLE
}
Константа O_NONBLOCK входит в стандарт POSIX и потому поддерживается
в большинстве систем. Мы используем модуль Errno для получения числового
значения ошибки EAGAIN. Проверка $! {EAGAIN} эквивалентна проверке $!==EAGAIN.
См. также
Описание функций sysopen и fcntl в perlfunc(l); документация по стандарт-
ным модулям Errno и 10::Handle; страницы руководства ореп(2) и fcntl(2); ре-
цепты 7.21 и 7.22.
7.21. Определение количества
читаемых байтов
Проблема
Требуется узнать, сколько еще байтов может быть прочитано через файловый
манипулятор.
Решение
Воспользуйтесь функцией 1 octi в режиме FIONREAD:
$s1ze = packCL", 0):
loctKFH. $FIONREAD. $size) or die "Couldn't call ioctl: $!\n":
$size = unpackU'L". $size):
# Могут быть прочитаны Ssize байт
Проследите за тем, чтобы файловый манипулятор ввода не был буферизован
(например, из-за использования уровня ввода/вывода : uni х), или используйте
только функцию sysread.
Комментарий
Функция Perl ioctl предоставляет прямой интерфейс к системной функции
ioctl(2). Если ваш компьютер не поддерживает запросы FIONREAD при вызове
7.21. Определение количества читаемых байтов
321
ioctl(2), вам не удастся использовать этот рецепт. FIONREAD и другие запросы
ioctl(2) соответствуют числовым значениям, которые обычно хранятся в заголо-
вочных файлах С.
Утилита Perl h2ph пытается преобразовать заголовочные файлы С в код Perl,
который может быть подключен директивой require. FIONREAD в конечном счете
определяется как функция в файле sys/loctl .ph:
require "sys/loctl.ph";
$s1ze = pack("L", 0);
loctKFH. FIONREADO. $s1ze) or die "Couldn’t call loctl: $!\n":
$s1ze = unpackCL", $s1ze):
Если утилита h2ph не установлена или не подходит вам, найдите нужное ме-
сто в заголовочном файле с помощью grep:
Ядгер FIONREAD /usr/lnclude/*/*
/usг11nclude/asm/1octis.h :#def 1ne FIONREAD 0x541B
Если у вас установлен модуль CPAN Inline: :С, вы можете написать функцию
С для получения нужной константы:
use Inline С;
$FIONREAD = get_FIONREAD( );
# ...
_ _END_ _
#1nclude <sys/1octl.h>
Int get_FIONREAD( ) {
return FIONREAD:
}
Также можно написать небольшую программу на С в «редакторе настоящего
программиста»:
% cat > flonread.c
#1 nclude <sys/loctl .h>
malnO {
printf("%#08x\n". FIONREAD):
}
"D
% cc -o flonread flonread
% ./flonread
0x4004667f
Затем жестко закодируйте полученное значение в программе. С переносимо-
стью пускай возится ваш преемник:
$FIONREAD = 0x4004667f: # XXX: зависит от операционной системы
$s1ze = packCL". 0):
loctKFH. $FIONREAD. $s1ze) or die "Couldn't call loctl: $!\n":
$s1ze = unpackCL". $s1ze):
322
Глава 7. Доступ к файлам
FIONREAD требует, чтобы файловый манипулятор был подключен к потоку. Сле-
довательно, сокеты, каналы и терминальные устройства будут работать, а обыч-
ные файлы — нет.
Если вам это покажется чем-то вроде системного программирования, попробуй-
те взглянуть на проблему под другим углом. Выполните асинхронное чтение дан-
ных из манипулятора (см. рецепт 7.20). Если вам удастся что-нибудь прочитать, вы
узнаете, столько байтов ожидало чтения, а если не удастся — значит, и читать нечего.
Впрочем, это может вызвать проблемы с другими пользователями (или другими
процессами), использующими ту же систему, — ввод/вывод с ожиданием в состоя-
нии занятости приводит к более интенсивному расходованию системных ресурсов.
См. также
Рецепт 7.20; страница руководства ioctl(2) вашей системы; описание функции
ioctl в perlfunc(l); документация по модулю CPAN Inline: :С.
7.22. Асинхронное чтение из нескольких
манипуляторов
Проблема
Вы хотите узнавать о наличии данных для чтения вместо того, чтобы приостанав-
ливать процесс в ожидании ввода, как это делает <...>. Такая возможность приго-
дится при получении данных от каналов, сокетов, устройств и других программ.
Решение
Если вас не смущают операции с битовыми векторами, представляющими наборы
файловых дескрипторов, воспользуйтесь функцией select с нулевым тайм-аутом:
$Г1П = ’’;
# Следующая строка повторяется для всех опрашиваемых манипуляторов
vec($rin, flleno(FHl), 1) = 1;
vec($rin, fileno(FH2), 1) = 1:
vec($rin, fileno(FH3). 1) = 1;
$nfound = select($rout=$rin, undef, undef, 0);
If ($nfound) {
# На одном или нескольких манипуляторах имеются входные данные
if (vec($r,fileno(FHl),1)) {
# Сделать что-то с FH1
if (vec($r,f11eno(FH2),1)) {
# Сделать что-то с FH2
}
if (vec($r.flleno(FH3).1)) {
# Сделать что-то с FH3
7.22. Асинхронное чтение из нескольких манипуляторов
323
Модуль 10::Select позволяет абстрагироваться от операций с битовыми век-
торами:
use 10::Select:
$select = 10::Select->new():
# Следующая строка повторяется для всех опрашиваемых манипуляторов
$select->add(*FILEHANDLE):
if (Oready = $select->can_read(O)) {
# Имеются данные на манипуляторах из массива Oready
}
Комментарий
Функция select в действительности объединяет сразу две функции. Вызванная
с одним аргументом, она изменяет текущий манипулятор вывода по умолчанию
(см. рецепт 7.19). При вызове с четырьмя аргументами она сообщает, какие фай-
ловые манипуляторы имеют входные данные или готовы получить вывод. В дан-
ном рецепте рассматривается только четырехаргументный вариант select.
Первые три аргумента select представляют собой строки, содержащие бито-
вые векторы. Они определяют состояние файловых дескрипторов, ожидающих
ввода, вывода или данных для неотложной передачи (например, внеполосных
или срочных данных для передачи сокету). Четвертый аргумент определяет
тайм-аут — интервал, в течение которого select ожидает изменения состояния.
Нулевой тайм-аут означает немедленный опрос. Тайм-аут также может быть
равен вещественному числу секунд или undef. В последнем варианте select ждет
(синхронно), пока состояние изменится:
$г1п =
vec($rin, fileno(FILEHANDLE). 1) = 1;
$nfound = select($rin, undef. undef. 0); # Обычная проверка
if ($nfound) {
# Прочитать 10 байт из FILEHANDLE
sysreadCHANDLE, $data. 10):
print "I read $data":
Модуль 10::Select скрывает от вас операции с битовыми векторами. Метод
10: :Select->new() возвращает новый объект, для которого можно вызвать метод
add, чтобы дополнить набор новыми файловыми манипуляторами. После вклю-
чения всех интересующих вас манипуляторов вызываются функции can_read,
can_write и can_exception. Функции возвращают список манипуляторов, ожидаю-
щих чтения, записи или непрочитанных срочных данных (например, внеполос-
ных данных TCP).
Для чтения полной строки данных нельзя использовать функцию readline
или оператор ввода строк <FH> (если только вы не используете небуферизован-
ный уровень ввода/вывода). В противном случае буферизованная функция вво-
да/вывода смешается с проверкой, которая игнорирует буферы в пользователь-
ском пространстве и обращает внимание только на буферизацию в пространстве
ядра, что категорически недопустимо. Подробности и рекомендации относитель-
324
Глава 7. Доступ к файлам
но вызова sysread для данных, доступных в сокете или канале, с немедленным
возвратом, приведены в рецепте 7.23. Если вы пытаетесь выполнить неблоки-
рующее чтение с клавиатуры или другого последовательного устройства, обра-
щайтесь к рецептам 15.6 и 15.8.
См. также
Описание функции select в perlfunc(]y, документация по стандартному модулю
10:: Sei ect; рецепты 7.20 и 7.23.
7.23. Асинхронное чтение полной строки
Проблема
Требуется прочитать строку данных из манипулятора, который, как сообщает
select, готов к чтению. Однако нормальные средства Perl (readline) не могут ис-
пользоваться в сочетании с select, потому что <...> может буферизовать допол-
нительные данные, а функции select не известно о существовании этих буферов.
Решение
Воспользуйтесь функцией sysreadl ine, определение которой приводится ниже:
$11ne = sysreadl1ne(S0ME_HANDLE):
Если была получена только часть строки, передайте при вызове продолжи-
тельность ожидания в секундах:
$11ne = sysreadl1ne(S0ME_HANDLE, TIMEOUT):
Вот как выглядит функция sysreadlIne:
use 10::Handlе;
use 10::Seiect:
use Symbol qw(qual1fy_to_ref):
sub sysread!1ne(*:$) {
my($handle, $t1meout) =
$handle = qual1fy_to_ref($handle, caller( ));
my $1nf1n1tely_pat1ent = (@_ = = 1 || $t1meout < 0):
my $start_t1me = t1me( ):
my $selector = 10::Select->new( ):
$selector->add($handle);
my $11ne =
SLEEP:
until (at_eol($11ne)) {
unless ($1nf1n1tely_pat1ent) {
return $11ne If t1me( ) > ($start_t1me + $t1meout):
# Выждать 1 секунду перед повторной проверкой
next SLEEP unless $selector->can_read(1.0):
7.23. Асинхронное чтение полной строки
325
INPUT_READY:
while ($selector->can_read(0.0)) {
my $was_blocking = $handle->blocklng(0);
CHAR: while (sysread($handle. my $nextbyte. D) {
$11ne .= $nextbyte:
last CHAR If $nextbyte eq "\n":
}
$handl e->bl ockl ng( $was_bl ockl ng);
# Если строка не завершена, продолжать попытки
next SLEEP unless at_eol($11ne):
last INPUT_READY:
}
}
return $11ne:
}
sub at_eol($) { $_[0] =~ /\n\zZ }
Комментарий
Как упоминается в рецепте 7.22, чтобы узнать, имеются ли у операционной сис-
темы данные для некоторого манипулятора, которые могут быть прочитаны ва-
шим процессом, можно воспользоваться встроенной функцией Perl can_read или
методом can_read стандартного модуля 10::Select.
Для получения данных можно использовать функции типа sysread и recv,
буферизованные функции вроде readline (то есть <...>), read или getc. Кроме того,
даже небуферизованные функции ввода все равно могут приводить к ожиданию.
Если некто устанавливает связь и передает символы, не включающие символ
перевода строки, работа программы останавливается на вызове <...>, предпола-
гающем, что входные данные завершаются переводом строки (или другим завер-
шителем, присвоенным переменной $/).
Чтобы обойти это ограничение, мы переводим манипулятор в асинхронный
режим и читаем символы до тех пор, пока не обнаружим "\п". Так снимается необ-
ходимость в синхронном вызове <...>. Приведенная в решении функция sysreadline
получает необязательный второй аргумент — продолжительность тайм-аута, чтобы
при передаче неполной строки вам не пришлось ждать вечно.
Другая, гораздо более серьезная проблема состоит в следующем: select сообща-
ет лишь о доступности низкоуровневого файлового дескриптора операционной
системы для ввода/вывода. В общем случае небезопасно смешивать вызовы четы-
рехаргументной версии select с вызовами любых буферизованных функций, пе-
речисленных во Введении (read, <...>, seek, tell и т. д.). Вместо них необходимо ис-
пользовать sysread — и sysseek для позиционирования манипулятора внутри файла.
Дело в том, что в ответе select не отражена буферизация пользовательского
уровня в адресном пространстве процесса после того, как ядро передало данные.
Однако <...> (а в действительности функция Perl readllneO) продолжает ис-
пользовать буферизованную систему ввода/вывода. Если бы приема ожидали
две строки, функция select вернула бы true только один раз. В итоге вы прочита-
ли бы первую строку, а вторая осталась бы в буфере. Но следующий вызов select
переходит в состояние ожидания, поскольку с точки зрения ядра все данные уже
326
Глава 7. Доступ к файлам
переданы. Вторая строка, теперь скрытая от ядра, остается непрочитанной во
входном буфере, который находится полностью в пользовательском адресном
пространстве.
См. также
Описание функции sysread в perlfunc(\y документация по стандартным моду-
лям Symbol, 10::Handle и 10::Select; рецепт 7.22.
7.24. Программа: netlock
При блокировке файлов мы рекомендуем по возможности использовать функ-
цию flock. К сожалению, в некоторых системах блокировка через flock ненадеж-
на. Допустим, функция fl ock может быть настроена на вариант блокировки без
поддержки сети, или вы работаете в одной из редких систем, в которой flock
вообще не эмулируется (впрочем, число таких систем неуклонно сокращается).
Приведенная ниже программа и модуль содержат базовую реализацию меха-
низма блокировки файлов. В отличие от обычной функции flock, данный мо-
дуль блокирует файлы по именам, а не по дескрипторам.
Следовательно, он может применяться для блокировки каталогов, сокетов
и других нестандартных файлов. Более того, вы даже сможете блокировать несу-
ществующие файлы. Программа использует каталог, созданный в иерархии
на одном уровне с блокируемым файлом, поэтому вы должны иметь право записи
в каталог, содержащий его. Файл в каталоге блокировки содержит сведения
о владельце блокировки. Это обстоятельство используется в рецепте 7.15, по-
скольку блокировка сохраняется несмотря на изменение файла, которому при-
надлежит данное имя.
Функция nflock вызывается с одним или двумя аргументами. Первый опре-
деляет имя блокируемого файла; второй, необязательный, — промежуток време-
ни, в течение которого происходит ожидание. Функция возвращает true при ус-
пешном предоставлении блокировки и false по истечении времени ожидания.
При возникновении различных маловероятных событий (например, при невоз-
можности записи в каталог) инициируется исключение.
Присвойте true переменной $File::LockDiг::Debug, чтобы модуль выдавал со-
общения при неудачном ожидании. Если вы забудете снять блокировку, при вы-
ходе из программы модуль снимет ее за вас. Этого не произойдет, если ваша
программа получит неперехваченный сигнал.
Вспомогательная программа из примера 7.9 демонстрирует применение мо-
дуля File::LockDiг.
Пример 7.9. drivelock
#!/usr/Ыn/perl -w
# drivelock - демонстрация модуля File::LockDir
use strict:
use File::LockDir;
1.2А. Программа: netlock
327
$SIG{INT} = sub { die "outta here\n” }:
$F11e::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::LockD1r:
# Модуль, обеспечивающий простейшую блокировку
# на уровне имен файлов без применения хитрых системных функций.
# Теоретически информация о каталогах синхронизируется через NFS.
# Испытания на прочность не проводились,
use strict:
use Exporter:
our (@ISA, (^EXPORT):
@ISA = qw(Exporter):
@EXPORT = qwtnflock nunflock):
our ($Debug, $Check):
$Debug ||= 0: # Может определяться заранее
$Check ||= 5: # Может определяться заранее
use Cwd:
use Fcntl;
use Sys::Hostname:
use File::Basename:
use File::stat;
use Carp:
my £Locked_F11es = ();
# Применение: пНоск(ФАЙЛ; ТАЙМАУТ)
sub nflock($;$) {
my $pathname = shift:
my $napt1me = shift || 0:
my $lockname = name21ock($pathname):
my $whosegot = "$lockname/owner":
my $start = tlmeO:
my Smlssed = 0:
my $owner:
# Если блокировка уже установлена, вернуться
If ($Locked_F11es{$pathname}) {
carp "$pathname already locked":
return 1
}
If (!-w d1rname($pathname)) {
croak "can’t write to directory of $pathname":
}
while (1) {
last If mkd1r($lockname, 0777): _
продолжение &
328
Глава 7. Доступ к файлам
Пример 7.10 (продолжение)
confess "can't get Slockname: $!" If Sm1ssed++ > 10
&& !-d Slockname:
If (SDebug) {{
open($owner, "< Swhosegot") || last: # exit "If"!
my $lockee = <$owner>:
chomp($lockee):
prlntf STDERR '7s $0\[$$]: lock on £s held by £s\n",
scalar(localtlme), Spathname, Slockee:
close Sowner:
}}
sleep SCheck:
return If $napt1me && time > $start+$napt1me:
}
sysopen(Sowner, Swhosegot. O_WRONLY|O_CREAT|O_EXCL)
or croak "can't create Swhosegot: $!":
prlntf Sowner ”$0\[$$] on £s since £s\n",
hostnameO, scalar(localtlme):
close(Sowner)
or croak "close Swhosegot: $!";
$Locked_F11es{$pathname}++:
return 1;
}
# Освободить заблокированный файл
sub nunflock($) {
my Spathname = shift:
my Slockname = name21ock(Spathname):
my Swhosegot = "Slockname/owner":
uni1nk(Swhosegot):
carp "releasing lock on Slockname" If SDebug:
delete $Locked_F11es{$pathname}:
return rmdlr(Slockname):
# Вспомогательная функция
sub name21ock($) {
my Spathname = shift:
my Sdlr = dirnametSpathname);
my Sflle = basename(Spathname):
Sdlr = getcwdO If Sdlr eq
my Slockname = "Sdlr/Sflle.LOCKDIR":
return Slockname:
}
# Ничего не забыли?
END {
for my Spathname (keys £Locked_F11es) {
my Slockname = name21ock(Spathname):
my Swhosegot = "Slockname/owner":
carp "releasing forgotten Slockname":
uni Ink(Swhosegot):
return rmdlr(Slockname):
}
}
1;
7.25. Программа: lockarea
329
7.25. Программа: lockarea
Функция 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 —
шестнадцать и т. д. С увеличением числа потомков возрастает конкуренция за
блокировку участков файла.
Каждый процесс выбирает из файла случайную строку, блокирует и обнов-
ляет ее. Он записывает в строку свой идентификатор процесса с префиксом —
количеством обновлений данной строки:
4: 18584 was just here
Если в момент запроса блокировки строка уже была заблокирована, то после
предоставления блокировки в сообщение включается идентификатор предыду-
щего процесса:
29: 24652 ZAPPED 24656
Попробуйте запустить программу lockarea в фоновом режиме и отображайте
изменения файла с помощью программы гер из главы 15. Получается видеоигра
для системных программистов.
Elockarea 5 &
Е rep -1 ’cat /tmp/1kscreen'
Если работа основной программы прерывается клавишами Ctrl+C или сигна-
лом SIGINT из командной строки, она уничтожает всех своих потомков, посы-
лая сигнал всей группе процессов.
330
Глава 7. Доступ к файлам
Пример 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);
my $COLS = 80:
my $ROWS = 23;
# Когда вы в последний раз видели *этот* режим правильно работающим?
open(FH, "+> /tmp/lkscreen”) or die $';
select(FH);
$| = 1;
select STDOUT;
# Очистить экран
for (1 .. $ROWS) {
print FH " ” x $COLS, "\n";
}
my $progenitor = $$;
fork while $FORKS-- > 0;
print "hello from $$\n";
if ($progenitor == $$) {
$SIG{INT} = \&infanticide;
} else {
$SIG{INT} = sub { die "goodbye from $$" }:
while (1) {
my $line_num = int rand($R0WS);
my $1ine:
my $n:
# Перейти к строке
seek(FH, $n = $line_num * ($COLS+1), SEEK_SET) or next:
# Получить блокировку
my $place = tell(FH);
my $him:
next unless defined($him = lock(*FH, $place, $COLS)):
# Прочитать строку
read(FH, $1ine. $COLS) == $COLS or next:
7.25. Программа: lockarea
331
my Scount = (Sline =~ /(\d+)/) ? $1 : 0:
$count++;
# Обновить строку
seek(FH, Splace. 0) or die $!:
my Supdate = sprintf(Shim
? ’16d: £d ZAPPED %d"
: *76d: %d was just here".
Scount. $$. Shim):
my Sstart = int(rand($COLS - length(Supdate))):
die "XXX" if Sstart + length(Supdate) > SCOLS:
printf FH "r.*s\n", -SCOLS, SCOLS. " " x Sstart . Supdate:
# Снять блокировку и сделать паузу
unlockplace(*FH, Splace. SCOLS):
sleep SSLEEP if SSLEEP;
}
die "NOT REACHED": # На всякий случай
# lock($handle. Soffset. Stimeout) - получение блокировки fcntl
sub lock {
my (Sfh. Sstart. Still) =
##print "SS: Locking Sstart. $till\n":
my Slock = struct_flock(F_WRLCK, SEEK_SET. Sstart. Still. 0):
my Sblocker = 0;
unless (fcntl(Sfh. F_SETLK, Slock)) {
die "F_SETLK $$ $!" unless $! == EAGAIN || $! == EDEADLK:
fcntl($fh. F_GETLK. Slock) or die "F_GETLK $$ $!";
Sblocker = (struct_flock(Slock))[-l]:
##print "lock $$ waiting for $blocker\n":
Slock = struct_flock(F_WRLCK. SEEK_SET, Sstart. Still. 0);
unless (fcntl(Sfh. F_SETLKW, Slock)) {
warn "F_SETLKW $$ $!\n";
return: # undef
}
}
return Sblocker;
}
# unlock($handle. Soffset. Stimeout) - снять блокировку fcntl
sub unlockplace {
my (Sfh. Sstart. Still) =
##print "SS: Unlocking Sstart. $till\n":
my Slock = struct_flock(F_UNLCK. SEEK_SET. Sstart. Still. 0):
fcntl (Sfh. F_SETLK. Slock) or die "FJJNLCK $$ $!":
}
# Структуры flock для разных ОС
# Структура flock для Linux
# short l_type:
# short l_whence:
# off_t 1_start:
# off_t l_len:
# pid_t l_pid:
продолжение &
332
Глава 7. Доступ к файлам
Пример 7.11 (продолжение)
BEGIN {
# По данным c2ph: typedef='s2 12 1'. sizeof=16
my $FLOCK_STRUCT = ' s s 1 1 i';
sub linux_flock {
if (wantarray) {
my ($type, $whence, $start, $len, $pid) =
unpack($FLOCK_STRUCT,
return ($type, $whence, $start, $len, $pid):
} else {
my ($type, Swhence, $start, $len, $pid) =
return pack($FLOCK_STRUCT,
$type, $whence, $start, $len. $p1d):
}
}
}
# Структура flock для SunOS
# short l_type: /* F-RDLCK, F-WRLCK или FJJNLCK */
# short 1_whence; /* Флаг выбора начального смещения */
# long 1_start; /* Относительное смещение в байтах */
# long l_len; /* Длина в байтах;
0 - блокировка до EOF */
# short l_pid; /* Возвращается F_GETLK */
# short l-Xxx; /* Зарезервировано на будущее */
BEGIN {
# По данным c2ph: typedef='s2 12 s2’, sizeof=16
my $FLOCK_STRUCT = 's s 1 1 s s’:
sub sunos_flock {
if (wantarray) {
my ($type, $whence, $start, $len, $pid, $xxx) =
unpack($FLOCK_STRUCT, $_[0]):
return ($type, Swhence, Sstart. $len, $pid):
} else {
my ($type, $whence, $start, $len, $pid) =
return pack($FLOCK_STRUCT,
$type, $whence, $start, $len, $pid, 0):
}
}
# Структура flock для (Free)BSD:
# off_t 1_start; /* Начальное смещение */
# off_t l_len; /* len = 0 означает блокировку до конца файла */
# pid_t l_pid; /* Владелец блокировки */
# short l_type; /* Тип блокировки: чтение/запись и т. д. */
# short 1 whence; /* Тип 1 start */
BEGIN {
# По данным c2ph: typedef="q2 i s2", size=24
my $FLOCK_STRUCT = ’ll 11 i s s’:
sub bsd_flock {
if (wantarray) {
7.25. Программа: lockarea
333
my ($xxstart, $start, $xxlen, $len, $p1d, $type, $whence) =
unpack($FLOCK_STRUCT, $_[0]):
return ($type, $whence, $start. $len, $p1d):
} else {
my ($type, $whence, $start, $len. $p1d) =
my ($xxstart, $xxlen) = (0,0):
return pack($FLOCK_STRUCT,
$xxstart. $start. $xxlen, $len, $p1d, $type, $whence):
}
}
}
# Синоним структуры fcntl на стадии компиляции
BEGIN {
for ($A0) {
*struct_flock = do {
/bsd/ && \&bsd_flock
II
/linux/ && \&11nux_flock
II
/sunos/ && \&sunos_flock
II
die "unknown operating system $A0. balling out";
}:
}
)
# Установить обработчик сигнала для потомков
BEGIN {
my $called = 0;
sub Infanticide {
exit If $cal1ed++:
print ”$$: Time to die, kiddles.\n” If $$ == $progen1tor;
my $job = getpgrpO:
$SIG{INT} = ’IGNORE’:
kill -2, $job If $job: # k111pg(SIGINT, job)
1 while wait > 0:
print "$$: My turn\n" If $$ == $progen1tor:
exit:
}
}
END { &1nfant1c1de }
g Содержимое файлов
«Из всех решений UNIX самым гениальным был
выбор одного символа для перевода строки».
Майк О'Делл, лишь с долей шутки
8.0. Введение
До революции Unix всевозможные источники и приемники данных не имели
ничего общего. Чтобы две программы пообщались друг с другом, приходилось
идти на невероятные ухищрения и отправлять в мусор целые горы перфокарт.
При виде этой компьютерной вавилонской башни порой хотелось бросить про-
граммирование и подыскать себе менее болезненное хобби, например, податься
в секту ф л аггел антов.
В наши дни этот жестокий и нестандартный стиль программирования в ос-
новном ушел в прошлое. Современные операционные системы всячески стара-
ются создать иллюзию, будто устройства ввода/вывода, сетевые подключения,
управляющие данные процессов, другие программы, системные консоли и даже
терминалы пользователей представляют собой абстрактные потоки байтов,
именуемые файлами. Теперь можно легко написать программу, которая ни-
сколько не заботится о том, откуда взялись ее входные данные и куда отправятся
результаты.
Поскольку чтение и запись данных осуществляется через простые байтовые
потоки, любая программа может общаться с любой другой программой. Трудно
переоценить всю элегантность и мощь такого подхода. Пользователи перестают
зависеть от сборников магических заклинаний JCL (или СОМ) и могут соби-
рать собственные нестандартные инструменты, используя простейшее перена-
правление ввода/вывода и конвейерную обработку.
Основные операции
Интерпретация файлов как неструктурированных байтовых потоков однознач-
но определяет круг возможных операций. Вы можете читать и записывать по-
следовательные блоки данных фиксированного размера в любом месте файла,
увеличивая его размер по достижении конца. Чтение/запись блоков переменной
длины (например, строк, абзацев и слов) реализуется в Perl на базе библиотеки
ввода/вывода, эмулирующей стандартную библиотеку С stdio (3).
8.0. Введение
335
Что нельзя сделать с неструктурированным файлом? Поскольку вставка и уда-
ление байтов возможны лишь в конце файла, вы не сможете вставить или удалить
записи, а также изменить их длину. Исключение составляет последняя запись,
которая удаляется простым усечением файла до конца предыдущей записи.
В остальных случаях приходится использовать временный файл или копию файла
в памяти. Если вам приходится часто заниматься этим, вместо обычных файлов
лучше подойдет база данных (см. главу 14 «Базы данных»). Модуль Tie: :File,
который стал стандартным в Perl версии 5.8, предоставляет интерфейс для рабо-
ты с файлами через массивы. Этот модуль используется в рецепте 8.4.
Самый распространенный тип файлов — текстовые файлы, а самый распро-
страненный тип операций с ними — построчное чтение и запись. Для чтения
строк используется оператор <> (или его внутренняя реализация, readline), а для
записи — функция print. Эти способы также могут применяться для чтения или
записи любых блоков с конкретным разделителем. Строки представляют собой
записи переменной длины, заканчивающиеся символом "\п".
По достижении конца файла оператор <> возвращает undef или ошибку, по-
этому его следует использовать в цикле следующего вида:
while (defined ($line = <DATAFILE>)) {
chomp $line;
$s1ze = length($line);
print "$s1ze\n": # Вывести длину строки
}
Поскольку эта операция встречается довольно часто, в Perl для нее преду-
смотрены различные варианты сокращенной записи. При использовании всех со-
кращений запись может получиться слишком абстрактной, и непосвященный не
сразу поймет, что же происходит в действительности. Однако эта идиома встре-
чается в тысячах программ Perl, поэтому вскоре вы к ней привыкнете. Ниже
в первой строке приведена полная версия, а за ней следуют сокращенные формы:
while (defined ($line = <DATAFILE>)) {...}
while ($1ine = <DATAFILE>) {...}
while (<DATAFILE>) {...}
Во второй строке исключена явная проверка defined, необходимая для про-
верки конца файла. Вы можете смело отказаться от этой проверки — чтобы уп-
ростить работу программиста, компилятор Perl обнаруживает такие ситуации
и вставляет код, обеспечивающий правильную работу программы в особых случа-
ях. Неявное включение defined происходит во всех условиях циклов while, в ко-
торых скалярной переменной присваивается результат вызова readline, readdir
или readlink. Поскольку запись <FH> всего лишь является сокращением для
readl 1ne<FH>, это относится и к ней.
Но возможности сокращения на этом не исчерпаны. Как видно из третьей
строки, присваивание можно полностью исключить, и оставить в условии while
только оператор чтения строки. Если это происходит в условии while, прочитан-
ная строка не игнорируется, как бы это произошло в другом месте, — она читает-
ся в специальную глобальную переменную $_. Переменная $_ используется по
336
Глава 8. Содержимое файлов
умолчанию и в других строковых операциях, и вообще она гораздо удобнее, чем
может показаться на первый взгляд:
while (<DATAFILE>) {
chomp:
print length, "\n": # Вывести длину строки
}
В скалярном контексте оператор <> читает следующую строку. В списковом
контексте он читает все оставшиеся строки:
Ines = <DATAFILE>:
При чтении очередной записи через файловый манипулятор оператор <> уве-
личивает значение специальной переменной $. (текущий номер входной запи-
си). Переменная сбрасывается лишь при явном вызове close и сохраняет значе-
ние при повторном открытии уже открытого манипулятора.
Заслуживает внимания и другая специальная переменная — $/, разделитель
входных записей. По умолчанию ей присваивается "\п", маркер конца строки.
Ей можно присвоить любое желаемое значение, например, "\0" для чтения за-
писей, разделяемых нуль-байтами. Для чтения целых абзацев следует присвоить
$/ пустую строку, "". Это похоже на присваивание "\п\п", поскольку для разделе-
ния записей используются пустые строки, однако "" интерпретирует две и более
смежных пустых строки как один разделитель, а ”\п\п" в таких случаях возвра-
щает пустые записи. Присвойте $/ неопределенное значение, чтобы прочитать
остаток файла как одну скалярную величину:
undef $/:
$whole_file = <FILE>: # Режим поглощения
Запуск Perl с флагом -0 позволяет задать $/ из командной строки:
% perl -040 -е '$word = <>: print "First word is $word\n":'
Цифры после -0 определяют восьмеричное значение отдельного символа, ко-
торый будет присвоен $/. Если задать недопустимое значение (например, -0777),
Perl присваивает $/ неопределенное значение undef. Если задать -00, $/ присваи-
вается "". Ограничение в один восьмеричный символ означает, что вы не сможе-
те присвоить $/ многобайтовую строку, например, "П\п" для чтения файлов
программы fortune. Вместо этого следует воспользоваться блоком BEGIN:
% perl -ne 'BEGIN { $7="Шп" } 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
«Доступ к файлам»).
8.0. Введение
337
Перевод строки
Во всех системах строки разделяются виртуальным разделителем ”\п”, который
называется переводом строки (newline). Не существует такого понятия, как
символ перевода строки — это всего лишь платформо-независимое выражение
понятия «то, что используется в вашей строковой библиотеке для представ-
ления завершителя строк». В Unix, VMS и Windows строки завершаются сим-
волом ”\cJ” (Ctrl+J). В старых операционных системах семейства Macintosh,
предшествующих Mac OS X, использовался символ ”\сМ”. Система Mac OS X
является разновидностью Unix, поэтому в ней используется "\cJ".
Операционные системы также различаются по способу хранения переводов
строк в файлах. В Unix для этой цели также используется "\cJ", но в Windows
строки текстовых файлов завершаются последовательностью "\cM\cJ". Если биб-
лиотека ввода/вывода знает, что данные читаются или записываются в текстовый
файл, она автоматически преобразует логические завершители строк в физические
(и наоборот). Таким образом, в системе Windows можно прочитать с диска четы-
ре байта ("Hi\cM\cJ”), а в памяти окажется всего три байта ("Hi\cJ”, где ”\cJ” —
физическое представление перевода строки). В Unix это не вызывает проблем,
поскольку физические переводы строк ("\cJ") совпадают с логическими ("\cJ").
Конечно, с терминалами дело обстоит совершенно иначе. За исключением
режима прямой передачи данных (как при вызове systemC’stty raw")), клавиша
Enter генерирует символ "\сМ". Затем этот символ преобразуется драйвером тер-
минала в "\п" для вашей программы. При выводе строки на терминал драйвер
терминала обнаруживает символ "\п" (как бы он ни представлялся на вашей
конкретной платформе) и превращает его в последовательность "\cM\cJ", кото-
рая перемещает курсор в начало строки и переводит его на одну строку вниз.
Даже у сетевых протоколов есть свои представления на этот счет. Большинство
протоколов предпочитают получать и передавать строки, завершаемые "\cM\cJ",
но многие серверы также принимают простые символы "\cJ". Все зависит от про-
токола и сервера, поэтому внимательно проверяйте документацию!
И еще одно важное обстоятельство: если библиотека ввода/вывода считает,
что вы работаете с текстовым файлом, она может автоматически преобразовы-
вать некоторые последовательности байтов. Проблемы возникают в двух случа-
ях: для двоичных, то есть нетекстовых файлов (например, при чтении файла
JPEG), и если файл является текстовым, но не представлен в байтово-ориенти-
рованной кодировке типа ASCII (а скажем, в кодировке UTF-8 или одной из
множества других кодировок, используемых для представления символов). А если
этого недостаточно, некоторые системы (как уже упоминавшаяся MS-DOS) ис-
пользуют определенные последовательности байтов в текстовых файлах для
представления конца файла. При чтении такой последовательности библиотека
ввода/вывода, поддерживающая работу с текстовыми файлами на такой плат-
форме, выдаст признак конца файла.
В рецепте 8.11 показано, как запретить автоматические преобразования со
стороны библиотеки ввода/вывода.
Уровни ввода/вывода
Начиная с версии 5.8 операции ввода/вывода в Perl перестали быть просты-
ми «обертками» для функций stdio. Теперь в Perl появилась гибкая система
уровней ввода/вывода, обеспечивающих прозрачную фильтрацию различных ко-
338
Глава 8. Содержимое файлов
дировок внешних данных. В главе 7 мы встречали уровень :unix, реализующий
небуферизованный ввод/вывод. Также существуют уровни для работы с функ-
циями stdio вашей платформы (:stdio) и переносимой реализацией stdio для
Perl (: peril о). Оба уровня буферизуют операции ввода и вывода. В этой главе
нас интересуют не столько уровни реализации, сколько расположенные поверх
них уровни работы с кодировками.
Уровень :crlf преобразует последовательность CRLF ("\cM\cJ") в "\п" при чте-
нии из файла и преобразует "\п" в CRLF при записи. Антиподом :crlf является
уровень : raw, обеспечивающий безопасное чтение или запись двоичных данных
через файловый манипулятор. Кроме того, можно указать, что файловый мани-
пулятор содержит данные UTF-8, при помощи уровня : utf или же задать коди-
ровку при помощи :encod1ng(...Вы даже можете написать на Perl собственный
фильтр, который обрабатывает прочитанные данные перед их передачей програм-
ме, или записываемые данные — перед их отправкой на устройство.
Стоит особо подчеркнуть: чтобы заблокировать преобразования :crl f, задайте
уровень :raw. Уровень :bytes иногда ошибочно принимают за противоположный
по смыслу к : crl f, но они решают совершенно разные задачи. Первый связан
с кодировкой данных в UTF-8, а второй — с автоматическими преобразования-
ми последовательностей CRLF.
Уровни ввода/вывода задаются при открытии файла:
open($fh, "<:raw:utf8", $filename); # Читать UTF-8 из файла
open($fh. "<:encod1ng(shiftj1s)". $f11ename): # Японская кодировка shlftjls
open(FH, "+<:crlf", Sfilename): # Преобразование CRLF и \n
Переключение уровней для существующих манипуляторов производится
функцией binmode:
b1nmode($fh, ":raw:utf8"):
binmode($fh, ":raw:encod1ng(sh1ftj1s)");
b1nmode(FH, "<:raw:crlf"):
Функция binmode заносит данные в стек уровней ввода/вывода, а средства
удаления уровней из стека все еще развиваются, поэтому всегда задавайте пол-
ный набор уровней, начинающийся с : raw:
blnmode(HANDLE, ":raw"): # Двоичный ввод/вывод
blnmode(HANDLE): # To же. что и :raw
b1nmode(HANDLE. ":raw :utf8"); # Чтение/запись в UTF-8
b1nmode(HANDLE. ":raw :encod1ng(sh1ftj1s)"); # Чтение/запись в shlftjls
Операции с уровнями ввода/вывода продемонстрированы в рецептах 8.18,
8.19 и 8.20.
Операции ввода/вывода
Записи фиксированной длины читаются функцией read. Функция получает
три аргумента: файловый манипулятор, скалярную переменную и количество
читаемых байтов. Возвращается количество прочитанных байтов, а в случае
ошибки — undef.
$rv = read(HANDLE, $buffer, 4096)
or die "Couldn't read from HANDLE : $!\n":
# $rv - количество прочитанных байтов,
# $buffer содержит прочитанные данные
8.0. Введение
339
Вывод записей фиксированной длины осуществляется функцией print.
Функция truncate изменяет длину (в байтах) файла, заданного при помощи
манипулятора или по имени. Функция возвращает true, если усечение прошло
успешно, и false в противном случае:
truncate(HANDLE, $length) or die "Couldn't truncate: $!\n":
truncate(’7tmp/$$.p1d". Slength) or die "Couldn't truncate: $!\n";
Для каждого файлового манипулятора отслеживается текущая позиция в фай-
ле. Операции чтения/записи выполняются именно в этой позиции, если при
открытии не был указан флаг O_APPEND (см. рецепт 7.1). Чтобы узнать текущую
позицию файлового манипулятора, воспользуйтесь функцией tell, а чтобы за-
дать ее — функцией seek. Поскольку библиотека стремится сохранить иллюзию
того, что "\п" является разделителем строк, а также из-за возможного использова-
ния символов с кодами больше 255 (что потребует многобайтовой кодировки),
вы не сможете обеспечить переносимый вызов seek для смещений, вычисляемых
простым подсчетом символов. Если вы не уверены в том, что в файле каждый
символ представляется только одним байтом, вызывайте seek только для смеще-
ний, возвращаемых tell:
Spos = tell(DATAFILE):
print "I'm $pos bytes from the start of DATAFILE.\n":
Функция seek получает три аргумента: файловый манипулятор, новое смеще-
ние (в байтах) и число, определяющее интерпретацию смещения. Если оно рав-
но 0, смещение отсчитывается от начала файла (в соответствии со значениями,
возвращаемыми tell); 1 — от текущей позиции (положительное число означает
прямое перемещение в файле, а отрицательное — обратное); 2 — от конца файла.
seek(LOGFILE. 0. 2)
seekCDATAFILE. Spos. 0)
seek(OUT, -20. 1)
or die "Couldn't seek to the end: $!\n":
or die "Couldn’t seek to Spos: S!\n";
or die "Couldn't seek back 20 bytes: $!\n":
Все сказанное выше относится к буферизованному вводу/выводу. Другими
словами, операции readline или <..>, print, read, seek и tell используют буферы
для повышения скорости и эффективности. Так они ведут себя по умолчанию,
хотя если задать для манипуляторов уровень небуферизованного ввода/вывода,
буферизация выполняться не будет. В Perl также предусмотрены альтернативные
операции ввода/вывода, которые выполняются без буферизации независимо от
того, с каким уровнем ввода/вывода связан манипулятор: речь идет о функциях
sysread, syswrlte и sysseek, описанных в главе 7.
Функции sysread и syswrlte отличаются от своих аналогов, <...> и print. Они
получают одинаковые аргументы — файловый манипулятор; скалярную пере-
менную, с которой выполняется чтение или запись; и количество читаемых или
записываемых символов (при работе с двоичными данными задается количество
байтов, а не символов). Кроме того, они могут получать необязательный четвер-
тый аргумент — смещение внутри скалярной переменной, с которого начинается
чтение или запись:
Swrltten = syswrlte(DATAFILE, Smystrlng. length(Smystrlng)):
die "syswrlte failed: $!\n" unless Swrltten == length(Smystrlng);
Sread = sysreadUNFILE. Sblock, 256, 5):
warn "only read Sread bytes, not 256" If 256 ! = Sread:
340
Глава 8. Содержимое файлов
Функция syswrite посылает содержимое $mystring в DATAFILE. При вызове sysread
из INFILE читаются 256 символов, которые сохраняются в $blоск, начиная с шестого
символа, при этом первые пять символов не используются. И 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 (def1ned($1ine = <FH>) ) {
chomp $line:
if ($1ine =- s/\\$//) {
$11ne .= <FH>:
redo unless eof(FH):
}
# Обработать полную запись в $1ine
}
8.2. Подсчет строк (абзацев, записей) в файле
341
Комментарий
Рассмотрим пример входного файла:
DISTFILES = $(DIST_COMMON) S(SOURCES) S(HEADERS) \
$(TEXINFOS) $(INFOS) $(MANS) $(DATA)
DEPJHSTFILES = $(DIST_COMMON) S(SOURCES) S(HEADERS) \
S(TEXINFOS) $(INFO_DEPS) $(MANS) $(DATA) \
$(EXTRA_DIST)
Вы хотите обработать текст, игнорируя внутренние разрывы строк. В приве-
денном примере первая запись занимает две строки, вторая — три строки и т. д.
Алгоритм работает следующим образом. Цикл while последовательно читает
строки. Оператор подстановки s/// пытается удалить \ в конце строки. Если
подстановка заканчивается неудачей, значит, мы нашли строку без \. В про-
тивном случае мы читаем следующую запись, приписываем ее к накапливаемой
переменной $11 пе и возвращаемся к началу цикла while с помощью redo. Затем
выполняется команда chomp.
У файлов такого формата имеется одна распространенная проблема — неви-
димые пробелы между \ и концом строки. Менее строгий вариант подстановки
выглядит так:
If ($1ine =- s/\\\s*$//) {
# Как и прежде
}
К сожалению, даже если ваша программа прощает мелкие погрешности, суще-
ствуют и другие, которые этого не делают. Будьте снисходительны к входным
данным и строги — к выходным.
См. также
Описание функции chomp в perlfunc(iy описание ключевого слова redo в разделе
«Loop Control» perlsyn(V).
8.2. Подсчет строк (абзацев, записей)
в файле
Проблема
Требуется подсчитать количество строк в файле.
Решение
Во многих системах существует программа wc, подсчитывающая строки в файле:
Scount = 'wc -1 < $f11е’:
die "wc failed: $?" If $?:
chomp(Scount):
342
Глава 8. Содержимое файлов
Кроме того, можно открыть файл и последовательно читать строки до конца,
увеличивая значение счетчика:
open(FILE, "< Sfile") or die "can’t open Sfile: $!";
$count++ while <FILE>:
# Scount содержит число прочитанных строк
Самое быстрое решение предполагает, что строки действительно заверша-
ются "\п":
Scount += tr/\n/\n/ while sysread(FILE, $_. 2 ** 20);
Комментарий
Хотя размер файла в байтах можно определить с помощью -s Sfile, обычно по-
лученная цифра никак не связана с количеством строк. Оператор -s рассматри-
вается в главе 9 «Каталоги».
Если вы не хотите или не можете перепоручить черную работу другой про-
грамме, имитируйте работу wc — самостоятельно откройте и прочитайте файл:
open(FILE, "< Sfile") or die "can’t open Sfile: $!’’:
$count++ while <FILE>:
# Scount содержит число прочитанных строк
Другой вариант выглядит так:
open(FILE. ’’< Sfile") or die "can’t open Sfile: $!";
for ($count=0: <FILE>: $count++) { }
Если вы не читаете из других файлов, можно обойтись без переменной Scount.
Специальная переменная $. содержит количество прочитанных строк с момента
последнего явного вызова close для файлового манипулятора:
1 while <FILE>:
Scount = $.;
В этом варианте происходит последовательное чтение всех записей файла,
которые затем отбрасываются.
Чтобы подсчитать абзацы, присвойте перед чтением глобальному разделите-
лю входных записей $/ пустую строку (""), и тогда оператор <> будет считывать
не строки, а целые абзацы:
$,7 = '': # Включить режим чтения абзацев
open(FILE. "<". Sfile) or die "can’t open Sfile: $!’’:
1 while <FILE>:
$para_count = $.:
Решение c sysread читает файл мегабайтными «кусками». По достижении
конца файла sysread возвращает 0. Это значение завершает цикл, как и undef
(признак ошибки). Операция tr не производит фактической замены \п на \п, это
старая идиома для подсчета вхождений символа в строку.
См. также
Описание оператора tr в perlop{\\, страница руководства wc(l); описание специ-
альной переменной $/ врег/шг(1); Введение главы 9.
8.3. Обработка каждого слова в файле
343
8.3. Обработка каждого слова в файле
Проблема
Требуется выполнить некоторую операцию с каждым словом файла, по анало-
гии с функцией foreach интерпретатора csh.
Решение
Разделите каждую строку по пропускам с помощью функции split:
while (<>) {
for $chunk (split) {
# Сделать что-то с $chunk
} }
Или воспользуйтесь оператором m//g для последовательного извлечения фраг-
ментов строки:
while (<>) {
while ( /(\w[\w’-]*)/g ) {
# Сделать что-то с $1
} }
Комментарий
Сначала необходимо решить, что же подразумевается под «словом». Иногда это
любые последовательности символов, кроме пропусков, иногда — идентифика-
торы программ, а иногда — слова английского языка. От определения зависит
и используемое регулярное выражение.
Два варианта решения, приведенные выше, работают по-разному. В первом
варианте шаблон определяет, что не является словом. Во втором варианте все
наоборот — шаблон решает, что им является.
На основе этой методики нетрудно подсчитать относительные частоты всех
слов в файле. Количество экземпляров каждого слова сохраняется в хэше:
# Подсчет экземпляров слов в файле
£seen =():
while (<>) {
while ( /(\w['\w-]*)/g ) {
$seen{lc $1}++;
} }
# Отсортировать выходной хэш по убыванию значений
foreach $word ( sort { $seen{$b} <=> $seen{$a} } keys £seen) {
printf ”%5d £s\n". $seen{$word}, $word:
344
Глава 8. Содержимое файлов
Чтобы программа подсчитывала количество строк вместо слов, уберите вто-
рой цикл while и замените тело цикла на $seen{ 1 с $_}++:
# Подсчет экземпляров строк в файле
£seen =();
while (<>) {
$seen{lc $_}++:
}
foreach Sllne ( sort { $seen{$b} <=> $seen{$a} } keys £seen ) {
printf "£5d %s". $seen{$11ne}, $11ne:
}
Порой слова могут выглядеть довольно странно, например, «М.1.Т», «Micro-
Soft», «o’clock», «49ers», «street-wise», «and/or», «&», «с/о», «St.», «TschiiB» или
«Nino». Помните об этом при выборе шаблона. В двух последних примерах вам
придется либо включить в программу директиву use locale и использовать мета-
символ \w в текущем локальном контексте, либо воспользоваться свойствами
Юникода, если вы работаете с текстом в этой кодировке:
/(\р{Letter}[\р{Letter}'-]*)/
См. также
perlre(l); описание функции split вperlfunc(l); рецепт 6.3; рецепт 6.23.
8.4. Чтение файла по строкам или абзацам
в обратном направлении
Проблема
Требуется обработать каждую строку или абзац файла в обратном направлении.
Решение
Прочитайте все строки в массив и организуйте обработку элементов массива от
конца к началу:
@1ines = <FILE>;
while ($1Ine = pop @1 Ines) {
# Сделать что-то с $1Ine
}
Или занесите строки в массив в обратном порядке:
@1 Ines = reverse <FILE>;
foreach $11ne (@lines) {
# Сделать что-то с $1Ine
}
Или воспользуйтесь модулем Tie::File (стандартным, начиная с версии 5.8):
use Tie::Fl 1е:
t1e(@11nes, "T1e::F11e", SFILENAME, mode => 0)
or die "Can't tie SFILENAME: $!":
8.4. Чтение файла по строкам или абзацам в обратном направлении
345
$max_11nes = $#1Ines:
for ($1 = $max_11nes; $1; $1--) {
# Сделать что-то с $11nes[$1] - например, пронумеровать строки:
printf ”%5d %s\n", $1+1. $Hnes[$1 ],
}
Комментарий
Ограничения, связанные с доступом к файлам (см. Введение), не позволяют по-
следовательно читать строки с конца файла. Приходится читать строки в память
и обрабатывать их в обратном порядке. Конечно, расходы памяти при этом будут
по крайней мере не меньше размера файла — если не использовать фокусы вро-
де тех, которые использует Tie::File.
В первом варианте массив строк перебирается в обратном порядке. Такая
обработка является деструктивной, поскольку при каждой итерации из масси-
ва выталкивается последний элемент. Впрочем, то же самое можно сделать и не-
деструктивно:
for ($1 = $#11nes: $1 != -1: $1--) {
$1Ine = $11nes[$1]:
}
Во втором варианте генерируется массив строк, изначально расположенных
в обратном порядке. Его тоже можно обработать недеструктивно. Мы получаем
массив с обратным порядком строк, поскольку присваивание @11nes приводит
к вызову reverse в списковом контексте, что, в свою очередь, обеспечивает спи-
сковый контекст для оператора <FILE>. В списковом контексте <> возвращает
список всех строк файла.
Показанные решения легко распространяются на чтение абзацев, достаточно
изменить значение $/:
# Внешний блок обеспечивает существование временной локальной копии $/
{
local $/ = ' ’:
^paragraphs = reverse <FILE>:
}
foreach $paragraph (^paragraphs) {
# Сделать что-то
}
Модуль Tie::File позволяет работать с файлом как с массивом строк. Далее
остается лишь организовать простой перебор элементов массива от конца к началу.
Такое решение работает гораздо медленнее, чем загрузка всех данных в память
с последующей перестановкой, но зато оно лучше подходит для очень больших
файлов, которые не могут одновременно находиться в памяти. Будьте внима-
тельны: при изменении содержимого связанного массива @11nes модуль Tie::File
перезаписывает файл. В нашем примере присваивание @1 Ines = reverse(@11nes)
запишет файл на диск в обратном порядке! Чтобы этого не произошло, откройте
файл в режиме O_RDONLY (0). По умолчанию файл открывается в режиме O_RDWR |
O-CREAT. Кроме того, модуль Tie::File не позволяет решить задачу для абзацев
простым присваиванием $/ пустой строки ("")•
346
Глава 8. Содержимое файлов
См. также
Описание функции reverse в perlfunc(iy описание специальной переменной $/
в perlvar(Vp документация по стандартному модулю Tie::File; рецепт 4.11; ре-
цепт 1.7.
8.5. Чтение из дополняемого файла
Проблема
Требуется читать данные из непрерывно растущего файла, однако по достиже-
нии конца файла (текущего) следующие попытки чтения завершаются неудачей.
Решение
Читайте данные, пока не будет достигнут конец файла. Сделайте паузу, сбрось-
те флаг EOF и прочитайте новую порцию данных. Повторяйте, пока процесс не
прервется. Флаг EOF сбрасывается либо функцией seek:
for (;:) {
while (<FH>) { .... }
sleep $SOMETIME;
seek(FH, 0. 1):
}
либо методом clearerr модуля 10::Handle:
use 10::Seekable:
for (;;) {
while (<FH>) { .... }
sleep SSOMETIME;
FH->clearerr();
}
Комментарий
Во время чтения устанавливается внутренний флаг, который препятствует даль-
нейшему чтению при достижении конца файла. Для сброса этого флага проще
всего воспользоваться методом clearerr, если он поддерживается (присутствует
в модуле 10::Handle):
Snaptime = 1:
use 10: -.Handle:
open (LOGFILE, "/tmp/logfile") or die "can’t open /tmp/1ogf11e: $!";
for (:;) {
while (<LOGFILE>) { print } # Или другая операция
sleep Snaptime:
LOGFILE->clearerr(): # Сбросить флаг ошибки ввода/вывода
}
8.5. Чтение из дополняемого файла
347
Начиная с версии 5.8 Perl содержит собственную реализацию стандартной
библиотеки ввода/вывода, поэтому этот простой вариант почти всегда работает.
В редких случаях, когда он оказывается неработоспособным, приходится исполь-
зовать функцию seek. Приведенный в решении фрагмент с seek пытается пере-
меститься на 0 байт от текущей позиции, что почти всегда завершается успехом.
Текущая позиция при этом не изменяется, но зато для манипулятора сбрасыва-
ется признак конца файла, благодаря чему при следующем вызове <LOGFILE> будут
прочитаны новые данные.
Если и этот вариант не работает (например, из-за того, что он полагается на
особенности реализации системы ввода/вывода), попробуйте следующий фраг-
мент, который явно запоминает старую позицию в файле и напрямую возвраща-
ется к ней:
for (;;) {
for ($curpos = tell(LOGFILE): <LOGFILE>: $curpos = tell(LOGFILE)) {
# Обработать $_
}
sleep $naptime:
seek(LOGFILE. $curpos, 0): # Вернуться к прежней позиции
Некоторые файловые системы позволяют удалить файл во время чтения из
него. Вероятно, в таких случаях нет смысла продолжать работу с файлом. Чтобы
программа в подобных ситуациях завершалась, вызовите stat для манипулятора
и убедитесь в том, что количество ссылок на него (третье поле возвращаемого
списка) не стало равным нулю:
exit If (stat(LOGFILE))[3] == 0
Модуль File: :stat позволяет записать то же самое в более понятном виде:
use File::stat:
exit If stat(*LOGFILE)->nlink == 0:
Модуль CPAN F11e::Ta11 связывает файловый манипулятор так, что опера-
ция чтения блокируется в конце файла до поступления новых данных:
use File::Tai 1:
tie *FH, "File::Tail", (name => SFILENAME);
while (<FH>) {
# do something with line read
}
В этом случае оператор <FH> никогда не возвращает undef как признак конца
файла.
См. также
Описание функций seek и tell в perlfunc(l)\ страницы руководства to7(l) и
stdio(3); документация по стандартному модулю File::stat; документация по
модулю CPAN File::Tai 1.
348
Глава 8. Содержимое файлов
8.6. Выбор случайной строки из файла
Проблема
Требуется прочитать из файла случайную строку.
Решение
Воспользуйтесь функцией rand и переменной $. (текущим номером строки):
srand;
rand($.) < 1 && ($line = $_) while <>;
# $1Ine - случайно выбранная строка
Комментарий
Перед вами — изящный и красивый пример неочевидного решения. Мы читаем
все строки файла, но не сохраняем их в памяти. Это особенно важно для боль-
ших файлов. Вероятность выбора каждой строки равна 1/N (где N — количест-
во прочитанных строк).
Следующий фрагмент заменяет хорошо известную программу fortune:
$/ = "Ши":
@ARGV = ("/usr/share/games/fortunes") unless @ARGV;
srand;
rand($.) < 1 && ($adage = $_) while <>;
print $adage;
Если вам известны смещения строк (например, при наличии индекса) и их
общее количество, можно выбрать случайную строку и перейти непосредствен-
но к ее смещению в файле. Впрочем, индекс доступен далеко не всегда.
Приведем более формальное пояснение работы данного алгоритма. Вызов
rand($.) выбирает случайное число от 0 до текущего номера строки. Строка с но-
мером N сохраняется в возвращаемой переменной с вероятностью 1/N. Таким
образом, первая строка сохраняется с вероятностью 100 %, вторая — с вероятно-
стью 50 %, третья — 33 % и т. д. Вопрос лишь в том, насколько это честно для
любого положительного целого N.
Начнем с конкретных примеров, а затем перейдем к абстрактным.
Разумеется, для файла из одной строки (N=l) все предельно честно: первая
строка сохраняется всегда, поскольку 1/1 = 100 %. Для файла из двух строк N = 2.
Первая строка сохраняется всегда; когда вы достигаете второй строки, она с веро-
ятностью 50 % заменяет первую. Следовательно, обе строки выбираются с одина-
ковой вероятностью, и для N = 2 алгоритм тоже работает корректно. Для файла
из трех строк N = 3. Третья строка сохраняется с вероятностью 1/3 (33 %). Вероят-
ность выбора одной из двух первых строк равна 2/3 (66 %). Но как показано выше,
две строки имеют одинаковую вероятность выбора (50 %). 50 % от 2/3 равны 1/3.
Таким образом, каждая из трех строк файла выбирается с вероятностью 1/3.
В общем случае для файла из N+1 строк последняя строка выбирается с ве-
роятностью 1/(N+1), а одна из предыдущих строк — N/(N+1). Деление N/(N+1)
8.7. Случайная перестановка строк
349
на N дает вероятность 1/(N+1) для каждой из N первых строк и те же 1/(N+1)
для строки с номером N+1. Следовательно, алгоритм корректно работает для
любого положительного целого N.
Нам удалось случайным образом выбрать из файла строку со скоростью, про-
порциональной количеству строк в файле. При этом максимальный объем ис-
пользуемой памяти даже в худшем случае равен размеру самой длинной строки.
См. также
Описание специальной переменной $. врег/шг(1); рецепт 2.6; рецепт 2.7.
8.7. Случайная перестановка строк
Проблема
Требуется скопировать файл и случайным образом переставить строки копии.
Решение
Прочитайте все строки в массив, перетасуйте элементы массива функцией shuffle
модуля List::Uti 1 и запишите полученную перестановку:
use List::Ut11 qw(shuffle)
while (<INPUT>) {
push(@11nes, $_):
}
@lines = shuffle(@lInes);
foreach (^reordered) {
print OUTPUT $_:
}
Комментарий
Самое простое решение — прочитать все строки файла и переставить их в памя-
ти. Смещения строк в файле неизвестны, поэтому нельзя перетасовать список
с номерами строк и затем извлечь строки в порядке их появления в файле.
Впрочем, даже при известных смещениях такое решение, вероятно, будет рабо-
тать медленнее, поскольку придется многократно перемещаться по файлу функ-
цией seek вместо простого последовательного чтения от начала к концу.
Если вы еще не перешли на Perl версии 5.8, загрузите модуль List::Uti 1 из
архива CPAN.
См. также
Документация по стандартному модулю List::Uti 1; рецепт 2.6; рецепт 2.7; ре-
цепт 4.18.
350
Глава 8. Содержимое файлов
8.8. Чтение строки с конкретным номером
Проблема
Требуется извлечь из файла строку с известным номером.
Решение
Простейший выход — читать строки до обнаружения нужной:
# Выборка строки с номером $DESIRED_LINE_NUMBER
$. = 0:
do { $LINE = <HANDLE> } until $. == $DESIRED_LINE_NUMBER || eof;
Если подобная операция должна выполняться многократно, а файл занимает
не слишком много места в памяти, прочитайте его в массив:
@lines = <HANDLE>:
$LINE = $lines[$DESIRED_LINE_NUMBER]:
Стандартный (начиная с версии 5.8) модуль Tie::File привязывает файл к мас-
сиву; каждый элемент массива соответствует одной строке файла:
use Tie:;Fl 1е:
use Fcntl:
tie(@lines, Tie::File, SFILE, mode => O_RDWR)
or die "Cannot tie file SFILE: $!\n":
Sline = $1ines[$sought - 1]:
При наличии модуля DB_File можно воспользоваться методом DB_RECNO, кото-
рый связывает массив с файлом (по строке на элемент массива):
use DB_File;
use Fcntl;
Stie = tie(@lines, DB_File. SFILE, O_RDWR, 0666, $DB_RECNO) or die
"Cannot open file SFILE: $!\n":
# Извлечь строку
Sline = $1ines[$sought-l]:
Комментарий
Каждый вариант имеет свои особенности и может пригодиться в конкретной
ситуации. Линейное чтение легко программируется и идеально подходит для
коротких файлов. Модуль Tie::File обеспечивает хорошее быстродействие неза-
висимо от размера файла, из которого читаются строки (к тому же он реализу-
ется базовыми средствами Perl и не требует применения внешних библиотек).
Механизму DB_File присущи некоторые начальные издержки, зато последующая
выборка строк выполняется намного быстрее, чем при линейном чтении. Обыч-
но он применяется для многократных обращений к большим файлам.
Необходимо знать, с какого числа начинается нумерация строк — с 0 или 1.
Переменной $. присваивается 1 после чтения первой строки, поэтому при ли-
8.8. Чтение строки с конкретным номером
351
нейном чтении нумерацию желательно начинать с 1. DB_File интерпретирует за-
писи файла как элементы массива, индексируемого с 0, поэтому строки также
следует нумеровать с 0.
Ниже показаны три реализации одной и той же программы, printjine. Про-
грамма получает два аргумента — имя файла и номер извлекаемой строки.
Версия prjnt_ljne из примера 8.1 просто читает строки файла до тех пор,
пока не найдет нужную.
Пример 8.1. printjine-vl
#!/usr/Ыn/perl -w
# print_line-vl - линейное чтение
@ARGV == 2 or die "usage: printjine FILENAME LINE_NUMBER\n":
(Sfilename. $1ine_number) = @ARGV;
opendNFILE, "< Sfilename")
or die "Can't open Sfilename for reading: $!\n";
while (<INFILE>) {
Sline = $_:
last if S. == Sline_number;
}
if ($. != $1inejiumber) {
die "Didn’t find line $line_number in Sfilename\n":
print:
В примере 8.2 приведена версия с использованием Tie::File.
Пример 8.2. printJine-v2
#!/usr/Ыn/perl -w
# print_line-v2 - решение с использованием Tie: Tile
use Tie:Tile:
use Fcntl:
@ARGV = = 2 or die "usage: printjine FILENAME LINE_NUMBER\n":
(Sfilename. Slinejiumber) = @ARGV:
tie @lines. Tie:Tile. Sfilename. mode => O_RDWR
or die "Can’t open Sfilename for reading: $!\n":
if (@lines > $1ine_number) {
die "Didn’t find line Slinejiumber in $filename\n":
}
print "SlinesLSline_number-l]\n":
Версия с модулем DB_Fi le из примера 8.3 построена по тому же принципу, что
и версия с Tie: Tile.
Пример 8.3. printjine-v3
#!/usr/Ыn/perl -w
# printjine-v3 - решение с применением DB_File
use DB_File;
use Fcntl:
@ARGV == 2 or
die "usage: print line FILENAME LINE NUMBER\n"; .
продолжение &
352
Глава 8. Содержимое файлов
Пример 8.3 (продолжение)
(Sfilename, $11ne_number) = @ARGV:
Stie = tie(@11nes, DB_F11e, Sfilename, O_RDWR, 0666, $DB_RECNO)
or die "Cannot open file Sfilename: $!\n":
unless (S11ne_number < St1e->length) {
die "Didn't find line $11ne_number In Sf11ename\n"
}
print $11nes[S11ne_number-l]: # Легко, правда?
Если вы собираетесь часто производить выборку строк по номерам, а файл
не помещается в памяти, постройте индекс для определения начального смеще-
ния строки и позиционирования вызовом seek. В рецепте 8.27 показано, как это
делается.
См. также
Документация по стандартным модулям Tie::File и DB_F11e; описание функции
tie в perlfunc(l); описание специальной переменной $. в perlvar(l)', рецепт 8.27.
8.9. Обработка текстовых полей
переменной длины
Проблема
Требуется извлечь из входных данных поля переменной длины.
Решение
Воспользуйтесь функцией split с шаблоном, совпадающим с разделителями полей:
# Имеется $ЗАПИСЬ с полями, разделенными шаблоном ШАБЛОН.
# Из записи извлекаются @ПОЛЯ.
ШЛЯ = sp!1t(/ ШАБЛОН/, ^ЗАПИСЬ):
Комментарий
Функция split вызывается с тремя аргументами: шаблон, выражение и лимит
(максимальное количество извлекаемых полей). Если количество полей во вход-
ных данных превышает лимит, лишние поля возвращаются неразделенными
в последнем элементе списка. Если лимит не указан, возвращаются все поля
(кроме завершающих пустых полей). Выражение содержит разделяемую строко-
вую величину. Если выражение не указано, разделяется переменная $_. Шаблон
совпадает с разделителем полей. Если шаблон не указан, в качестве разделите-
лей используются смежные последовательности пропусков, а начальные пустые
поля отбрасываются.
8.10. Удаление последней строки файла
353
Если разделитель входных полей не является фиксированной строкой, мож-
но вызвать split так, чтобы функция возвращала разделители полей вместе с дан-
ными — для этого в шаблон включаются круглые скобки. Например:
split(/([+-])/. "3+5-2");
возвращает список:
(3. ' + ’. 5, 2)
Поля, разделенные двоеточиями (в стиле файла /etc/passwd), извлекаются
следующим образом:
^fields = split(/:/, Srecord):
Классическое применение функции split — извлечение данных, разделенных
пропусками:
©fields = split(/\s+/. Srecord);
Если $ЗАПИСЬ начинается с пропуска, в последнем варианте первому эле-
менту списка будет присвоена пустая строка, поскольку split сочтет, что за-
пись имеет начальное пустое поле. Если это не подходит, используйте особую
форму split:
©fields = splitC ". $ЗАПИСЬ);
В этом случае split ведет себя так же, как и с шаблоном /\s+/, но игнорирует
начальный пропуск.
Если разделитель может присутствовать внутри самих полей, возникает про-
блема. Она стандартно решается посредством экранирования разделителей в по-
лях префиксом \. См. рецепт 1.18.
См. также
Описание функции split вperlfunc(V)\ рецепт 1.18.
8.10. Удаление последней строки файла
Проблема
Требуется удалить из файла последнюю строку.
Решение
Воспользуйтесь стандартным (начиная с версии 5.8) модулем Tie::File и удали-
те последний элемент из связанного массива:
use Tie::Fi1е:
tie ©lines. Tie: Tile, $file or die "can't update $file: $!":
delete $11nes[-l];
354
Глава 8. Содержимое файлов
Комментарий
Решение с Tie::File эффективнее всех остальных решений (по крайней мере для
больших файлов), потому что оно не требует ни чтения всего файла для получения
последней строки, ни загрузки всего файла в память. Тем не менее, для небольших
файлов оно работает существенно медленнее реализации, написанной вручную.
Это не означает, что вам не следует использовать Tie::File; просто в данном случае
оптимизировалось время программирования, а не время выполнения программы.
Если у вас нет модуля Tie::File и вы не можете установить его из CPAN, чи-
тайте файл по одной строке и запоминайте байтовое смещение последней про-
читанной строки. Когда файл будет исчерпан, обрежьте файл по последнему со-
храненному смещению:
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: $!":
Такое решение намного эффективнее загрузки всего файла, поскольку в лю-
бой момент времени в памяти хранится всего одна строка. Хотя вам все равно
приходится читать весь файл, программу можно использовать и для больших
файлов, размер которых превышает объем доступной памяти.
См. также
Документация по стандартному модулю Tie::Fi 1 е; описание функций truncate
и tell в perlfunc(l); страницы руководства ореп(2) и fopen(3) вашей системы;
рецепт 8.18.
8.11. Обработка двоичных файлов
Проблема
Требуется прочитать 8-разрядные двоичные данные «как есть» (то есть не как текст,
относящийся к определенной кодировке, и без преобразований переводов строк
и конца файла, выполняемых библиотекой ввода/вывода для текстовых файлов).
Решение
Вызовите функцию Ы nmode для файлового манипулятора:
Мгтоде(МАНИПУЛЯТОР):
Комментарий
Функция binmode позволяет назначать файловым манипуляторам новые уровни
ввода/вывода. По умолчанию она использует уровень : raw, на котором исключа-
8.12. Ввод/вывод с произвольным доступом
355
ются любые преобразования двоичных данных. Следовательно, приведенная
в решении команда эквивалентна следующей:
binmode(МАНИПУЛЯТОР. ":raw");
Впрочем, команда с : raw работает только в Perl версии 5.8 и выше. Одноаргу-
ментная форма bl nmode работает во всех версиях Perl.
Поскольку Perl по умолчанию выбирает уровень :crl f в тех операционных
системах, в которых это необходимо, вам практически не придется выбирать
: crl f в своих программах. Более того, обычно не рекомендуется добавлять или
удалять уровень :crl f после начала чтения из файла, поскольку в буферы уже
могут быть прочитаны данные, которые нельзя вернуть обратно. С другой сторо-
ны, уровень :encoding можно изменять «на ходу» (например, при разборе XML).
Вызов bl nmode при открытии двоичных файлов должен войти у вас в привыч-
ку. Благодаря ему ваша программа будет нормально работать в системах, кото-
рые из лучших побуждений преобразуют двоичные файлы в нечто совершенно
бесполезное.
Уровни ввода/вывода также могут задаваться при открытии файловых мани-
пуляторов, не только при последующем вызове bl nmode:
open(FH, "< :raw". Sfilename): # Двоичный режим
Набор уровней, которые должны в дальнейшем использоваться по умол-
чанию для всех файловых манипуляторов ввода/вывода, задается директивой
open:
use open IN => ":raw"; # Двоичные файлы
См. также
Страница руководства PerlIO(3y описания функций open и binmode в perlfunc(V);
страницы руководства ореп(2) и fopen(3).
8.12. Ввод/вывод с произвольным доступом
Проблема
Нужно прочитать двоичную запись из середины большого файла, но вам не хо-
чется добираться до нее, последовательно читая все предыдущие записи.
Решение
Определите размер записи и умножьте его на номер записи, чтобы получить
смещение в байтах. Затем вызовите seek для полученного смещения и прочитай-
те запись:
$АДРЕС = ^РАЗМЕР * SHOMEP;
seek(FH. $АДРЕС, 0) or die "seek:$!";
read(FH, $БУФЕР, ^РАЗМЕР);
356
Глава 8. Содержимое файлов
Комментарий
В Решении предполагается, что АНОМЕР первой записи равен нулю. Если нуме-
рация начинается с единицы, измените первую строку фрагмента:
$АДРЕС = ^РАЗМЕР * (ЛНОМЕР-1');
Представленное решение предназначено в основном для двоичных данных.
Его применение для текстовых файлов осложняется тем, что оно требует одина-
ковой длины строк и постоянной ширины символов. Это требование исключа-
ет большинство расширенных кодировок, текстовые файлы Windows, а также
любые текстовые файлы с разной длиной строк.
См. также
Описание функции 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. SRECSIZE) == SRECSIZE
or die "Reading: $!";
©FIELDS = unpack(SFORMAT, SBUFFER):
# Обновить содержимое, затем
SBUFFER = pack($FORMAT, ©FIELDS):
seek(FH, -SRECSIZE, SEEK_CUR) or die "Seeking: $!":
print FH $BUFFER:
close FH or die "Closing: $!":
Комментарий
Для вывода записей в Perl не потребуется ничего, кроме функции print. Помни-
те, что антиподом read является print, а не write, хотя как ни странно, антипо-
дом sysread все же является syswrite.
8.14. Чтение строки из двоичного файла
357
В примере 8.4 приведен исходный текст программы weekearly, которой пере-
дается один аргумент — имя пользователя. Программа смещает дату регистра-
ции этого пользователя на неделю в прошлое. (Конечно, на практике с систем-
ными файлами экспериментировать не рекомендуется — впрочем, из этого все
равно ничего не выйдет!) Программа должна иметь право записи для файла,
поскольку тот открывается в режиме обновления. После выборки и изменения
записи программа упаковывает данные, возвращается на одну запись назад и за-
писывает буфер.
Пример 8.4. weekearly
# !/usr/bi n/perl
# weekearly - смещение даты регистрации на неделю назад
use User::pwent:
use 10::Seekable:
Stypedef = 'L A12 A16’: # Формат linux : в sunos - "L A8 A16"
Ssizeof = length(pack($typedef. ())):
$user = shift(OARGV) || $ENV{USER} || $ENV{LOGNAME};
Saddress = getpwnam($user)->uid * Ssizeof:
open (LASTLOG. "+</var/log/lastlog")
or die "can’t update /usr/adm/lastlog: $!":
seek(LASTLOG. Saddress. SEEK_SET)
or die "seek failed: $!":
read(LASTLOG. Sbuffer. Ssizeof) == Ssizeof
or die "read failed: $!";
($time. $line. $host) = unpack(Stypedef, Sbuffer):
$time -= 24 * 7 * 60 * 60: # На неделю назад
Sbuffer = pack($typedef. $time. $line. $time):
seek(LASTLOG. -Ssizeof. SEEK_CUR) # Вернуться на одну запись
or die "seek failed: $!":
print LASTLOG Srecord;
close(LASTLOG)
or die "close failed: $!":
См. также
Страница руководства PerlIO(3)\ описание функций open, seek, read, pack и unpack
в perlfunc(V)-, рецепт 8.12; рецепт 8.14.
8.14. Чтение строки из двоичного файла
Проблема
Требуется прочитать из файла строку, завершенную нуль-символом, начиная
с определенного смещения.
358
Глава 8. Содержимое файлов
Решение
Убедитесь, что вы работаете именно с двоичным файлом, присвойте $/ нуль-сим-
вол ASCII и прочитайте строку с помощью <>:
binmode(FH):
$old_rs = $/:
$/ = "\0":
seek(FH, $addr. SEEK_SET)
Sstrlng = <FH>:
chomp Sstrlng:
$/ = Sold rs:
# Двоичный режим
# Сохранить старое значение $/
# Нуль-символ
or die "Seek error: $!\n";
# Прочитать строку
# Удалить нуль-символ
# Восстановить старое значение $/
При желании сохранение и восстановление $/ можно реализовать с помощью
local:
{
local $/ = "\0":
# ...
} # $/ восстанавливается автоматически
Комментарий
Программа bgets из примера 8.5 получает в аргументах имя файла и одно или
несколько байтовых смещений. Смещения могут задаваться в десятичном, восьме-
ричном или шестнадцатеричном виде. Для каждого смещения программа читает
и выводит строку, которая начинается в данной позиции и завершается нуль-
символом или концом файла.
Пример 8.5. bgets
#!/usr/bi n/perl
# bgets - вывод строк по смещениям в двоичном файле
use 10::Seekablе;
use open I0=>":raw": # Двоичный режим для всех открываемых манипуляторов
(Sfile, @addrs) = @ARGV or die "usage: $0 addr :
open(FH, Sfile) or die "cannot open Sfile: $!":
$/ = "\000":
foreach Saddr (@addrs) {
Saddr = oct Saddr if Saddr =~ /^0/:
seek(FH. Saddr, SEEK_SET)
or die "can't seek to Saddr in Sfile: $!":
printf qq{%#x %#o %d "%s"\n}, Saddr. Saddr, Saddr. scalar <>;
В примере 8.6 приведена простейшая реализация программы UNIX strings:
Пример 8.6. strings
#!/usr/bin/perl
# strings - извлечение строк из двоичного файла
$/ = "\0":
while (<>) {
while (/([\040-\176\s]{4,})/g) {
print $1. "\n";
8.15. Чтение записей фиксированной длины
359
См. также
Страница руководства PerlI0(3y, описание функций seek, getc и ord в perlfunc(l);
описание qq// в разделе «Quote and Quote-like Operators» страницы руково-
дства perlop(V).
8.15. Чтение записей фиксированной длины
Проблема
Требуется прочитать файл с записями фиксированной длины.
Решение
Воспользуйтесь функциями pack и unpack:
# $RECORDSIZE - длина записи в байтах.
# $TEMPLATE - шаблон распаковки для записи
# FILE - файл, из которого читаются данные
# ^FIELDS - массив для хранения полей
until ( eof(FILE) ) {
readCFILE. $record. SRECORDSIZE) == SRECORDSIZE
or die "short read\n":
^FIELDS = unpack($TEMPLATE. Srecord);
}
Комментарий
Поскольку мы работаем не с текстовым, а с двоичным файлом, для чтения записей
нельзя воспользоваться оператором < . > или методом getl 1 ne модуля 10::Handle.
Вместо этого приходится считывать конкретное количество байтов в буфер
функцией read. После этого буфер содержит данные одной записи, которые де-
кодируются функцией unpack с правильным форматом.
При работе с двоичными данными трудности часто начинаются как раз с пра-
вильного выбора формата. Если данные были записаны программой на С, прихо-
дится просматривать заголовочные файлы С или страницы руководства с опи-
санием структур, для чего необходимо знание языка С. Заодно вы должны близко
подружиться с компилятором С, поскольку без этого вам будет трудно разобрать-
ся с выравниванием полей (например, х2 в формате из рецепта 8.18). Если вам
посчастливилось работать в Berkeley Unix или в системе с поддержкой дсс, вы
сможете воспользоваться утилитой c2ph, распространяемой с Perl, и заставить
компилятор С помочь вам в этом.
Программа tailwtmp в конце этой главы использует формат, описанный
в utmp(5) системы Linux, и работает с файлами /vaг/1 og/wtmp и /var/run/utmp.
Но стоит вам привыкнуть к работе с двоичными данными, как возникает дру-
гая напасть — особенности конкретных платформ. Вероятно, программа не будет
360
Глава 8. Содержимое файлов
работать в вашей системе без изменений, но выглядит она поучительно. Приве-
дем соответствующую структуру из заголовочного файла С для Linux:
#define UT_LINESIZE
#define UT_NAMESIZE
#define UT_HOSTSIZE
12
8
16
struct utmp { /* Коды для шаблона распаковки */
short ut_type: /* s - short, должно быть дополнено */
pid_t ut_pid: /* 1 для integer */
char ut_line[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 х2 1 А12 А2 х2 1 А8
А16 1") передается pack с пустым списком полей для определения размера запи-
си. Не забудьте проверить код возврата read при чтении записи, чтобы убедиться
в том, что вы получили запрошенное количество байтов.
Если записи представляют собой текстовые строки, используйте шаблон рас-
паковки "а" или "А".
Записи фиксированной длины удобны тем, что п-я запись заведомо начина-
ется в файле со смещения SIZE*(n-l), где SIZE — размер одной записи. Пример
приведен в программе с построением индекса из рецепта 8.8.
См. также
Описание функций unpack, pack и read в perlfunc(l); рецепт 1.1.
8.16. Чтение конфигурационных файлов
Проблема
Вы хотите, чтобы пользователи вашей программы могли изменить ее поведение
с помощью конфигурационного файла.
Решение
Организуйте обработку файла в тривиальном формате ПЕРЕМЕННАЯ=ЗНАЧЕНИЕ, соз-
давая для каждого параметра элемент хэша «ключ/значение»:
while (<CONFIG>) {
chomp: # Убрать перевод строки
s/#.*//: # Убрать комментарии
s/^\s+//: # Убрать начальные пропуски
8.16. Чтение конфигурационных файлов
361
s/\s+$//; # Убрать конечные пропуски
next unless length; # Что-нибудь осталось?
my ($var, Svalue) = split(/\s*=\s*/. $_. 2);
$User_Preferences{$var} = Svalue;
}
Существует другой, более изящный вариант — интерпретировать конфигура-
ционный файл как полноценный код Perl:
do "$ENV{HOME}/.progrc";
Комментарий
В первом решении конфигурационный файл интерпретируется в тривиальном
формате следующего вида (допускаются комментарии и пустые строки):
# Сеть класса С
NETMASK = 255.255.255.0
MTU = 296
DEVICE = cual
RATE = 115200
MODE = adaptive
После этого можно легко получить значение нужных параметров, например,
$User_Preferences{"RATE"} дает значение 115200. Если вы хотите, чтобы конфигу-
рационный файл непосредственно устанавливал значения переменных в програм-
ме вместо заполнения хэша, включите в программу следующий фрагмент:
no strict 'refs';
$$var = Svalue;
и переменная $RATE будет содержать значение 115 200.
Во втором решении do организует непосредственное выполнение кода Perl.
Если вместо блока используется выражение, do интерпретирует его как имя
файла. Это практически идентично применению require, но без риска фатальных
исключений. В формате второго решения конфигурационный файл принимает
следующий вид:
# Сеть класса С
SNETMASK = "255.255.255.0";
$MTU = 0x128;
$DEVICE = "cual";
$RATE = 115_200;
$MODE = "adaptive";
Если вам непонятно, зачем включать в файл лишние знаки препинания, заду-
майтесь — в вашем распоряжении оказывается весь синтаксис Perl. Теперь про-
стые присваивания можно дополнить логикой и проверкой условий:
if (SDEVICE =~ /1$/) {
SRATE = 28_800;
} else {
SRATE = 115_200:
}
362
Глава 8. Содержимое файлов
Во многих программах предусмотрены системные и личные конфигурацион-
ные файлы. Если вы хотите, чтобы предпочтения пользователя отменяли дейст-
вия системных параметров, загрузите личный файл после системного:
$APPDFLT = "/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 (а также requl re и use), представляет собой
отдельную, самостоятельную лексическую область действия. Это означает как
то, что конфигурационный файл не может обратиться к лексическим (ту) пере-
менным вызывающей стороны, так и то, что вызывающая сторона не сможет
найти такие переменные, заданные в файле. Кроме того, пользовательский код
не подчиняется директивам типа use strict или use Integer, которые могут дей-
ствовать на вызывающей стороне.
Если столь четкое разграничение видимости переменных нежелательно, вы
можете заставить код конфигурационного файла выполняться в вашей лексиче-
ской области действия. Имея под рукой программу cat или ее эквивалент, мож-
но написать доморощенный аналог do:
eval 'cat $ENV{HOME}/.myprogrc':
Мы еще не видели, чтобы кто-нибудь (кроме Ларри Уолла) использовал
такой подход в рабочем коде.
Прежде всего, do проще вводится. Кроме того, do учитывает путь @INC, ко-
торый обычно просматривается при отсутствии полностью указанного пути, но
в отличие от require, в do не выполняется неявная проверка ошибок. Следова-
тельно, вам не придется заворачивать do в eval для перехвата исключений, от ко-
торых ваша программа может скончаться, поскольку do уже работает как eval.
При желании можно организовать собственную проверку ошибок:
$f11е = "someprog.pl":
unless ($return = do $f11e) {
warn "couldn't parse $f11e:
warn "couldn't do $f11e: $!"
warn "couldn't run $f11e"
}
If $0:
unless defined Sreturn:
unless Sreturn;
8.17. Проверка достоверности файла
363
Программисту намного проще отследить это в исходном тексте, чем изо-
бретать новый, сложный синтаксис. Проще будет и пользователю, которому не
придется изучать правила синтаксиса очередного конфигурационного файла.
Приятно и то, что пользователь получает доступ к мощному алгоритмическому
языку программирования.
Однако не следует забывать о безопасности. Как убедиться в том, что файл
не модифицировался никем, кроме пользователя? Традиционный подход — не
делать ничего, полагаясь на права доступа каталогов и файлов. В девяти случаях
из десяти такое решение оказывается правильным, поскольку большинство про-
ектов попросту не оправдывает подобной паранойи. А если все же оправдывает,
загляните в следующий рецепт.
См. также
Описание функций eval и require в perlfunc(l); рецепт 8.17.
8.17. Проверка достоверности файла
Проблема
Требуется прочитать файл (например, содержащий данные о конфигурации).
Вы хотите использовать файл лишь в том случае, если правом записи в него
(а возможно, даже правом чтения) не обладает никто, кроме его владельца.
Решение
Получите данные о владельце и правах доступа с помощью функции stat. Для
этого можно воспользоваться встроенной версией, которая возвращает список:
( $dev. Si no, $mode, Snlink,
Suid, Sgid, $rdev, Ssize,
Satime. Smtime, Sctime,
Sblksize, $blocks ) = stat(Sfilename)
or die "no Sfilename: $!":
Smode &= 07777: # Отбросить информацию о типе файла
Или воспользуйтесь интерфейсом с именованными полями:
use File::stat;
Sinfo = stat(Sfilename) or die "no Sfilename: $!";
if ($info->uid == 0) {
print "Superuser owns $filename\n";
}
if ($info->atime > $info->mtime) {
print "Sfilename has been read since it was written.\n":
364
Глава 8. Содержимое файлов
Комментарий
Обычно мы доверяем пользователям и позволяем им устанавливать права дос-
тупа по своему усмотрению. Если они захотят, чтобы другие могли читать или
даже записывать данные в их личные файлы — это их дело. Однако многие при-
ложения (редакторы, почтовые программы, интерпретаторы) часто отказывают-
ся выполнять код конфигурационных файлов, если запись в них осуществлялась
кем-то, кроме владельца. Это помогает избежать нападений «троянских» про-
грамм. Программы, особенно внимательно следящие за безопасностью, напри-
мер, ftp или ssh — могут даже отвергнуть конфигурационные файлы, прочитан-
ные кем-то, кроме владельца.
Если файл может быть записан кем-то, кроме владельца, или принадлежит
кому-то отличному от текущего или привилегированного пользователя, он не
признается достоверным. Информация о владельце и правах доступа может
быть получена с помощью функции stat. Следующая функция возвращает true
для достоверных файлов и false для всех остальных. Если вызов stat завершает-
ся неудачей, возвращается undef.
use File::stat:
sub 1s_safe {
my $path = shift:
my $1nfo = stat(Spath);
return unless Slnfo:
# Проверить владельца (привилегированный или текущий пользователь)
# Настоящий идентификатор пользователя хранится в переменной $<.
If (($1nfo->u1d != 0) && ($1nfo->uid != $<)) {
return 0:
}
# Проверить, может ли группа или остальные пользователи
# записывать в файл.
# Для проверки чтения/записи используйте константу 066
If ($1nfo->mode & 022) { # Если другие имеют право записи
return 0 unless -d _: # He-каталоги недостоверны
# но каталоги с битом запрета (01000) - достоверны
return 0 unless $1nfo->mode & 01000:
}
return 1;
}
Каталог считается достоверным даже в том случае, если другие имеют право
записи в него — при условии, что для него установлен бит 01000 (разрешающий
удаление только владельцу каталога).
Осторожный программист также проследит, чтобы запись была запрещена
и для всех каталогов верхнего уровня. Это связано с известной «проблемой chown»,
при которой любой пользователь может передать принадлежащий ему файл и сде-
лать его владельцем кого-то другого. Приведенная ниже функция 1s_very_safe
обращается к функции POSIX: :sysconf, чтобы выяснить, существует ли «проблема
8.18. Интерпретация файла как массива
365
chown» в системе. Если проблема существует, далее функцией is_safe проверяются
все каталоги верхнего уровня вплоть до корневого. Если в вашей системе уста-
новлена ограниченная версия chown, функция is_very_safe ограничивается про-
стым вызовом 1s_safe.
use Cwd:
use POSIX qw(sysconf _PC_CHOWN_RESTRICTED):
sub is_verysafe {
my $path = shift:
return 1s_safe($path) if sysconf(_PC_CHOWN_RESTRICTED);
Spath = getcwdO . V . Spath if Spath !~ m{x/}:
do {
return unless is_safe($path);
Spath =~ s#(Ex/]+|/)S##: # Имя каталога
Spath =~ s#/$## if length(Spath) >1: # Последний символ /
} while length Spath:
return 1:
}
В программе эта функция используется примерно так:
Sfile = ”SENV{НОМЕ}/.myprogrc":
readconfig(Sfi1e) if is_safe($file):
При этом возникает потенциальная опасность «состояния перехвата», посколь-
ку предполагается, что файл открывается гипотетической функцией readconfig.
Между получением сведений о файле (is_safe) и его открытием функцией
readconfig теоретически может случиться что-нибудь плохое. Чтобы избежать
опасности перехвата, передавайте is_safe уже открытый файловый манипулятор:
Sfile « **$ENV{HOME}/.myprogrc":
if (open(FILE. "< Sfile")) {
readconfig(*FILE) if is_safe(*FILE):
}
Впрочем, вам также придется позаботиться о том, чтобы функция readconfig
принимала файловый манипулятор вместо имени файла.
См. также
Описание функции stat в perlfunc(l); документация по стандартным модулям
POSIX и File::stat; рецепт 8.16.
8.18. Интерпретация файла как массива
Проблема
Файл содержит список строк или записей. Для обращения к содержимому фай-
ла и его модификации вам хотелось бы использовать мощные средства Perl для
работы с массивами.
366
Глава 8. Содержимое файлов
Решение
Воспользуйтесь модулем Tie::File (начиная с версии 5.8 этот модуль является
стандартным):
use Tie::F11e:
use Fcntl:
tie @data, Tie::F11e. SFILENAME or die "Can’t tie to Sfilename : $!\n":
# Далее операции с файлом выполняются через массив @data
Комментарий
Модуль Tie::File представляет файл в виде массива, в котором каждый элемент
соответствует одной записи. Далее вы можете читать элементы массива и при-
сваивать им новые значения, вызывать функции типа push и splice, использо-
вать отрицательные индексы, обращать массив функцией reverse — и во всех
этих случаях операции будут выполняться с данными на диске.
Если для модуля Tie::File не указан режим открытия файла, то файл откры-
вается для чтения и записи; если файл не существует, он создается автоматиче-
ски. Нужный режим доступа (см. рецепт 7.1) выбирается при помощи параметра
mode режима Fcntl при вызове tie. Пример:
use Fcntl:
t1e(@data. Tie::File. Sfilename. mode => O_RDONLY)
or die "Can't open Sfilename for reading: $!\n":
При изменении массива файл заново записывается на диске. Например, если
вы изменяете длину элемента, то все последующие записи должны быть скопи-
рованы. Возьмем следующий фрагмент:
foreach (@data) {
s/Perl Cookbook/Perl Cookbook (2nd ed1t1on)/g:
Изменение длины записи 0 приводит к копированию записей 1..N. Затем
изменяется длина записи, что приводит к копированию записей 2..N, и т. д. Об-
новление лучше отложить до момента внесения всех изменений, чтобы модуль
Tie::File обновил весь файл одной операцией записи. Для этого вызывается ме-
тод объекта, обеспечивающего работу с массивом:
(tied @data)->defer; # Отложить обновления
foreach (@data) {
s/Perl Cookbook/Perl Cookbook (2nd editlonVg:
(tied @data)->flush:
До какой степени можно откладывать обновление? Ответ на этот вопрос
зависит от того, какой объем памяти вы разрешите использовать Tie::File,
потому что возможен только один способ отслеживания изменений без об-
новления файла — хранение всех изменений в памяти. За информацией о том,
8.19. Назначение уровней ввода/вывода
367
как изменить параметры использования памяти, обращайтесь к документации
по модулю Tie::File.
См. также
Рецепт 8.4; рецепт 8.8; рецепт 8.10.
8.19. Назначение уровней ввода/вывода
Проблема
Требуется сделать так, чтобы все файлы, открываемые вашей программой, ис-
пользовали определенный набор уровней ввода/вывода. Например, вы точно
знаете, что все файлы содержат данные в кодировке UTF-8.
Решение
Воспользуйтесь директивой open:
use open 10 => ":raw:utf8"
Комментарий
Уровни ввода/вывода удобно назначать при открытии файлового манипулято-
ра, но это не поможет в том случае, если манипулятор уже был открыт внешним
кодом (возможно — даже ядром Perl). Директива use open определяет уровни,
используемые в каждом вызове функции open, при котором не указаны собст-
венные уровни.
Модуль open также позволяет раздельно управлять манипуляторами ввода
и вывода. Например, в следующей директиве включается режим чтения байто-
вых данных и вывода UTF-8:
use open "IN" => ":bytes", "OUT" => ":utf8":
Параметр : std означает, что уровни, заданные для ввода и вывода, долж-
ны применяться к STDIN и STDOUT/STDERR. Например, следующая директива оз-
начает, что манипуляторы ввода должны читать текст в греческой кодировке
(ISO 8859-7), манипуляторы вывода должны записывать его в Юникоде UTF-8,
а затем те же уровни ассоциируются с STDIN, STDOUT и STDERR:
use open "IN" => ":encod1ng(Greek)". # Ввод в кодировке Greek
"OUT" => ":utf8". # Вывод 8-разрядных данных
# в Юникоде UTF-8.
":std": # Использовать Greek для STDIN.
См. также
Документация по стандартной директиве use open; рецепты 8.12 и 8.19.
368
Глава 8. Содержимое файлов
8.20. Чтение и запись Юникода через
файловый манипулятор
Проблема
Имеется файл, содержащий текст в определенной кодировке. При чтении данных
из файла в строку Perl интерпретирует данные как последовательность 8-раз-
рядных байтов. Но вы хотите работать с символами вместо байтов, потому что
в данной кодировке символы могут занимать более 1 байта. Кроме того, если
Perl не поддерживает эту кодировку, он может не опознать некоторые символы
как буквы. Обратная задача — вывод текста в определенной кодировке.
Решение
При помощи уровней ввода/вывода сообщите Perl, что данные этого манипуля-
тора относятся к конкретной кодировке:
open(my Sifh, ”<:encoding(ENCODING_NAME)". Sfilename):
open(my Sofh, ">:encoding(ENCODING_NAME)". Sfilename):
Комментарий
Текстовые функции Perl работают не только с 8-разрядными данными, но и со
строками UTF-8 — просто им нужно сообщить, с каким типом данных они
работают. Во внутреннее представление каждой строки Perl включается при-
знак типа данных (UTF-8 или 8-разрядные символы). Уровень encodingC..) пре-
образует данные между различными внешними кодировками и кодировкой
UTF-8, используемой во внутренней работе Perl. Задача решается при помощи
модуля Encode.
Как объясняется в разделе «Поддержка Юникода в Perl» (см. Введение к гла-
ве 1), в Юникоде разным символам соответствуют разные кодовые пункты.
Уникальность кодовых пунктов решает множество проблем. Теперь одно число
(например, 0хС4) не может представлять разные символы в разных контекстах
(например, А в кодировке ISO-8859-1 или А в кодировке ISO-8859-7).
Однако при этом остается одна важная проблема: формат представления
кодовых пунктов в памяти или на диске. Если большинство кодовых пунктов
использует всего 8 бит, было бы слишком расточительно представлять каждый
символ всеми 32 битами. Тем не менее, при равных размерах всех символов про-
грамма проще читается, а возможно — быстрее работает.
Так появились различные системы хранения данных Юникода, каждая из ко-
торых обладает своими достоинствами и недостатками. В кодировках с фикси-
рованной шириной символов кодовые пункты всегда представляются одним
и тем же количеством битов. Такое представление упрощает программирование,
но за счет неэффективного использования памяти. В кодировках с переменной
шириной символов каждый символ занимает столько места, сколько необходи-
8.20. Чтение и запись Юникода через файловый манипулятор
369
мо для его хранения, но за экономию приходится расплачиваться усложнением
программирования.
Ситуацию дополнительно усложняют комбинированные символы, которые
на бумаге выглядят как один символ, но представляются несколькими кодовы-
ми пунктами. Например, если вы видите на экране прописную букву А с двумя
точками наверху (трема), это вовсе не значит, что она представляется символом
U+00C4. Как объяснялось в рецепте 1.8, в Юникоде поддерживается принцип
комбинирования символов: к базовому символу добавляются элементы нулевой
ширины. Например, символ U+0308 представляет комбинированную трему.
Следовательно, символ А также может быть представлен в виде прописной бук-
вы A (U+0041), за которой следует символ U+0308, или А\х{308}.
В следующей таблице продемонстрированы разные способы записи А — ста-
рый (ISO 8859-1), с одинаковым логическим и физическим представлением,
и новый (Юникод). В таблице приводятся оба варианта записи символа: как
в виде одного кодового пункта, так и с построением комбинированного символа
из двух кодовых пунктов.
Старый способ А Новый способ
А А А
Символ(ы) 0хС4 U+0041 U+00C4 U+0041 U+0308
Набор символов ISO 8859-1 Юникод Юникод Юникод
Код(ы) 0хС4 0x0041 0х00С4 0x0041 0x0308
Кодировка — UTF-8 UTF-8 UTF-8
Байт(ы) 0хС4 0x41 ОхСЗ 0x84 0x41 ОхСС 0x88
Во внутренней работе Perl используется кодировка UTF-8 с переменной ши-
риной символов. Отчасти этот выбор обусловлен тем, что старая кодировка
ASCII не требует дополнительного преобразования в UTF-8 и выглядит в памя-
ти точно так же, как раньше — каждый символ представляется одним байтом.
Символу U+0041 в памяти соответствует значение 0x41. Старые данные вообще
не увеличиваются в размерах, но даже данные в расширенных кодировках типа
ISO 8859-/? увеличиваются незначительно (на практике обычные ASCII-симво-
лы встречаются гораздо чаще символов с диакритическими знаками).
Использование UTF-8 во внутренней работе Perl не мешает внешней под-
держке других форматов. Perl автоматически преобразует данные между UTF-8
и кодировкой, заданной для манипулятора. При назначении уровня ввода/выво-
да в форме :encod1ng(...) автоматически используется модуль Encode. Например:
binmode(FH, ":encoding(UTF-16BE)")
or die "can't binmode to utf-16be: $!":
Также уровень можно задать непосредственно при вызове open:
open(FH, "< :encoding(UTF-32)". Spathname)
or die "can't open $pathname: $!";
370
Глава 8. Содержимое файлов
В следующей таблице приведены байтовые структуры двух последовательно-
стей, представляющих прописную букву А с тремой, в нескольких распростра-
ненных форматах.
U+00C4 U+0041 U+0308
UTF-8 сЗ 84 41 сс 88
UTF-16BE 00 с4 00 41 03 08
UTF-16LE с4 00 41 00 08 03
UTF-16 fe ff 00 с4 fe ff 00 41 03 08
UTF-32LE с4 00 00 00 41 00 00 00 08 03 00 00
UTF-16BE 00 00 00 с4 00 00 00 41 00 00 03 08
UTF-32 00 00 fe ff 00 00 00 с4 00 00 fe ff 00 00 00 41 00 00 03 08
Разрастание данных быстро расходует свободную память. Вдобавок ситуация
осложняется тем, что на одних компьютерах используется прямой порядок байтов,
а на других — обратный. Таким образом, для кодировок с фиксированной шириной,
для которых порядок байтов не задан, должен использоваться специальный признак
порядка байтов (FF EF, или EF FF). Обычно он необходим только в начале потока.
При чтении или записи данных UTF-8 используйте уровень : utf8. Так как
UTF-8 используется во внутренней работе Perl, уровень : utf8 для повышения
эффективности не обращается к модулю Encode.
В модуле Encode для кодировок определены многочисленные синонимы; так,
имена ascii, US-ascii и IS0-646-US обозначают одну и ту же кодировку. Полный
список кодировок приведен на странице руководства Encode: Supported. Perl поддер-
живает не только имена, стандартные для Юникода, но и другие имена, выбран-
ные фирмами-производителями: например, для iso-8859-l в DOS используется
имя ср850, в Windows — ср1252, на Мас — MacRoman, а на NeXTStep — hp-roman8.
Модуль Encode воспринимает все эти имена как синонимы одной кодировки.
См. также
Документация по стандартному модулю Encode; страница руководства Encode::
Supported; рецепты 8.12 и 8.19.
8.21. Преобразование текстовых
файлов Microsoft в Юникод
Проблема
Имеется текстовый файл, созданный на компьютере с операционной системой
фирмы Microsoft. Вместо осмысленного текста выводится «мусор». Как испра-
вить ситуацию?
8.21. Преобразование текстовых файлов Microsoft в Юникод
371
Решение
Назначьте соответствующий уровень при чтении файла, чтобы преобразовать
его в Юникод:
b1nmode(IFH. ":encod1ng(cpl252)")
|| die "can’t binmode to cpl252 encoding: $!":
Комментарий
Допустим, кто-то прислал вам файл в формате ср 1252 (стандартной 8-разряд-
ной кодировке, используемой в продуктах Microsoft). Хотя файлы в этом фор-
мате якобы используют кодировку Latinl, на самом деле это не так, и при про-
смотре их с загруженными шрифтами Latinl на экране отображается «мусор».
Простое решение выглядит так:
open(MSMESS, "< :crlf :encod1ng(cpl252)". $inputfile)
|| die "can't open $1nputf11e: $!":
Новые данные, прочитанные из манипулятора, автоматически преобразуют-
ся в Юникод. Кроме того, они автоматически обрабатываются в режиме CRLF;
это необходимо в системах с другим обозначением конца строки.
Вероятно, записать этот текст в Latinl вам не удастся. Дело в том, что кодиров-
ка СР 1252 содержит символы, отсутствующие в Latinl. Придется оставить текст
в Юникоде. К сожалению, правильное отображение Юникода — более сложная за-
дача, чем хотелось бы, потому что программы, корректно работающие с Юникодом,
встречаются довольно редко. Большинство веб-браузеров поддерживает шрифты
ISO 10646, то есть шрифты Юникода (см. http://www.cl.cam.ac.uk/ ~mgk25/ucs-
fonts.html). Другой вопрос, поддерживается ли Юникод вашим текстовым редак-
тором? Emacs и vl (а точнее, vim, но не nvi) обладают средствами для работы с Юни-
кодом. Для просмотра текста авторы использовали следующую команду xterm(l):
xterm -n unicode -u8 -fn -mlsc-flxed-medlum-r-normal--20-200-75-75-С-100-1SO10646-1
Впрочем, многие вопросы остаются открытыми (в частности, копирование
и вставка данных Юникода между окнами).
На сайте www.un1code.org имеется справочная информация по поиску и установ-
ке нужных программ для различных платформ, включая Unix и системы Microsoft.
Также нужно разрешить Perl выдавать данные в Юникоде. Если этого не сде-
лать, при каждой попытке будет выдаваться предупреждение "Wide character In
print". Если предположить, что вы запустили сеанс xterm наподобие приведен-
ного выше (или его эквивалент для вашей системы) и в нем доступны шрифты
Юникода, это можно сделать так:
binmode(STDOUT. ":utf8"):
Но тогда остальным частям программы тоже придется выдавать Юникод, а это
может оказаться неудобно. Впрочем, при написании новых программ, специально
спроектированных с учетом этой возможности, особых хлопот быть не должно.
Начиная с версии 5.8.1 в Perl появилась пара других способов для достижения
этой цели. Параметр командной строки -С управляет некоторыми аспектами под-
держки Юникода, относящимися к среде выполнения. Он позволяет задавать пара-
метры на уровне командной строки, без.изменения исходного текста программы.
372
Глава 8. Содержимое файлов
За параметром -С следует либо число, либо последовательность символов.
Ниже перечислены некоторые символы, их числовые коды, а также краткие
описания результата.
Символ Код Описание
I 1 Ввод из STDIN в кодировке UTF-8
О 2 Вывод в STDOUT в кодировке UTF-8
Е 4 Вывод в STDERR в кодировке UTF-8
S 7 I + О + Е
i 8 Уровень UTF-8 по умолчанию используется для потоков ввода PerllO
о 16 Уровень UTF-8 по умолчанию используется для потоков вывода PerllO
D 24 i + о
А 32 Аргументы @ARGV представляют собой строки в кодировке UTF-8
В программе можно использовать как символы, так и числовые коды. Если вы
предпочитаете числа, они должны суммироваться. Например, параметры -СОЕ и -С6
являются синонимами для назначения кодировки UTF-8 потокам STDOUT и STDERR.
Другой подход основан на использовании переменной окружения PERL_UNICODE.
В этой переменной (если она задана) хранятся те же значения, которые передаются
с параметром -С. Например, в сеансе xterm с загруженными шрифтами Юникода
в командном интерпретаторе POSIX можно выполнить следующую команду:
sh£ export PERL_UNICODE=6
Аналогичная команда для csh выглядит так:
csh£ setenv PERL_UNICODE 6
Этот вариант хорош тем, что вам не придется редактировать исходный текст
программы, как при использовании директивы, и даже изменять формат вызова
команды, как при использовании параметра -С.
См. также
Страницы руководства perlrun(\), encoding^), PerlIO(3) и Encode(3).
8.22. Сравнение содержимого двух файлов
Проблема
Имеются два файла. Нужно узнать, совпадает ли их содержимое.
Решение
Воспользуйтесь стандартным модулем File::Compare и сравните файлы по име-
нам, тип-глобам или косвенным манипуляторам:
8.22. Сравнение содержимого двух файлов
373
use File::Compare:
if (compare($FILENAME_l, $FILENAME_2) = = 0) {
# Содержимое файлов совпадает
}
if (compare(*FHl, *FH2) = = 0) {
# Содержимое файлов совпадает
}
if (compare($fhl. $fh2) = = 0) {
# Содержимое файлов совпадает
}
Комментарий
Модуль File::Compare (стандартный, начиная с версии 5.8, и доступный через
CPAN в предыдущих версиях) сравнивает два файла на эквивалентность со-
держимого. Экспортируемая по умолчанию функция compare возвращает 0, если
файлы совпадают, 1, если они различаются, и -1 при возникновении каких-ли-
бо ошибок чтения.
Если потребуется сравнить несколько манипуляторов, организуйте цикл со
сравнением пар файлов:
# Убедиться в том, что все манипуляторы в @fh содержат одинаковые данные
foreach $fh (@fh[l.,$#fh]) {
if (compare($fh[0J, $fh)) {
# $fh содержит другие данные
} }
Чтобы узнать подробности о различиях между файлами, воспользуйтесь мо-
дулем Text::Diff из архива CPAN:
use Text::Diff:
$diff = diff(*FHl, *FH2):
$diff = diff($FILENAME_1, $FILENAME_2, { STYLE => "Context" }):
Кроме манипуляторов, diff также может получать имена файлов, строки
и даже массивы записей. В третьем аргументе передается хэш параметров. Пара-
метр STYLE определяет тип возвращаемых данных — "Unified" (по умолчанию),
"Context" или "OldStyle”. Вы даже можете написать свой собственный класс для
нестандартного формата diff.
Функция diff возвращает строку, аналогичную результату программы diff(l).
Строка имеет совместимый формат, что позволяет передать ее patch(l). Хотя ре-
зультат Text::Diff не всегда совпадает с выходными данными GNU diff с точно-
стью до байта, он содержит правильную информацию.
См. также
Документация по стандартному модулю File::Compare; документация по модулю
CPAN Text::Diff; страницы руководства diff(l) и patch(l).
374
Глава 8. Содержимое файлов
8.23. Интерпретация строки как файла
Проблема
Имеется строка с данными; нужно интерпретировать ее как файл. Предположим,
у вас имеется процедура, в аргументе которой передается файловый манипуля-
тор; вы хотите, чтобы эта процедура работала с данными строки, но при этом
обходилась бы без записи данных во временный файл.
Решение
Воспользуйтесь средствами скалярного ввода/вывода Perl версии 5.8:
open($fh, "+<". \$string): # Чтение и запись содержимого Sstring
Комментарий
Механизм уровней ввода/вывода Perl включает поддержку операций ввода и вы-
вода со скалярными переменными. При чтении записи конструкцией <$fh> из
$string читается следующая логическая строка, а при выводе командой print из-
меняется содержимое $string. Вы можете передать $fh функции, получающей
файловый манипулятор, и эта функция не узнает, что в действительности она
работает не с файлом, а со строкой.
При вызове open для строк Perl учитывает режим доступа, поэтому вы може-
те указать, что строка должна открываться только для чтения, с усечением, в ре-
жиме присоединения и т. д.:
open($fh, \Sstr1ng):
open($fh. \$string):
open($fh. \Sstring);
open($fh. "+<". \Sstring);
# Только для чтения
# Только для записи.
# стирание исходного содержимого
# Чтение и запись.
# стирание исходного содержимого
# Чтение и запись.
# сохранение исходного содержимого
Эти манипуляторы ничем не отличаются от обычных файловых манипуля-
торов и могут использоваться во всех функциях ввода/вывода — seek, truncate,
sysread и т. д.
См. также
Описание функции open в perlfunc(\y, рецепты 8.12 и 8.19.
8.24. Программа: tailwtmp
В начале и в конце рабочего сеанса пользователя в системе Unix в файл wtmp до-
бавляется новая запись. Вам не удастся получить ее с помощью обычной про-
граммы tail, поскольку файл хранится в двоичном формате. Программа tailwtmp
8.25. Программа: tctee
375
из примера 8.7 умеет работать с двоичными файлами и выводит новые записи по
мере их появления. Вам придется изменить формат pack для конкретной системы.
Пример 8.7. tailwtmp
# !/usr/Ы n/perl
# tailwtmp - отслеживание начала/конца сеанса
# Использует структуру llnux utmp. см. utmp(5)
Stypedef = ’ s x2 1 A12 A4 1 A8 A16 Г :
Sslzeof = length pack($typedef. () );
use 10::Fl 1e:
open(WTMP, "< :raw". "/var/log/wtmp") or die "can't open /var/log/wtmp: $!":
seek(WTMP. 0. SEEK_END):
for (;;) {
while (read(WTMP, $buffer. Sslzeof) == Sslzeof) {
(Stype. Spld. Sline. Sid. Stlme. Suser. Shost. Saddr)
= unpack(Stypedef. Sbuffer):
next unless Suser && ord(Suser) && Stlme:
printf "Hd £-8s %-12s %2s %-24s V16s %5d £08x\n".
Stype.Suser.Sline.Sid,seal ar(1ocaltlme(Stlme)).
Shost.Spld.Saddr:
}
for (Sslze = -s WTMP; Sslze == -s WTMP; sleep 1) {}
WTMP->clearerr():
}
8.25. Программа: tctee
Во многих системах существует классическая программа tee для направления
выходных данных в несколько приемников. Например, следующая команда пе-
редает выходные данные someprog в файл /tmp/output и через конвейер — в поч-
товую систему:
% someprog | tee /tmp/output | Mall -s 'check this' userOhost.org
Программа tctee пригодится не только тем пользователям, которые работают
вне Unix и не имеют tee. Она обладает некоторыми возможностями, отсутствую-
щими в стандартной версии tee.
При запуске программа может получать четыре флага:
О -1 — игнорировать прерывания,
О -а — дописывать данные в конец выходных файлов,
О -и — выполнять небуферизованный вывод,
О -п — отменить копирование выходных данных в стандартный вывод.
Поскольку в программе используется «волшебная» функция open, вместо фай-
лов ей можно передавать каналы:
% someprog | tctee fl "|cat -n" f2 "»f3"
В примере 8.8 приведена программа-ветеран, написанная на Perl более 10 лет
назад и работающая до сих пор. Если бы нам пришлось писать ее заново, вероятно,
376
Глава 8. Содержимое файлов
мы бы использовали strict, предупреждения и модули с десятками тысяч строк.
Но как известно, «лучшее — враг хорошего».
Пример 8.8. tctee
# !/usr/Ы n/perl
# tctee - клон tee
# Программа совместима с perl версии 3 и выше.
while (SARGVEOJ =~ /"-(.+)/ && (shift. ($_ = $1). D) {
next If US/;
s/1// && (++$1gnore_1nts. redo);
s/a// && (++$append. redo);
s/u// && (++$unbuffer. redo);
s/n// && (++$nostdout. redo);
die "usage [-alun] [filenames] ...\n";
}
If ($1gnore_1nts) {
for Sslg (' INT'. 'TERM'. 'HUP'. 'QUIT') { $SIG{$s1g} = 'IGNORE'; }
}
$SIG{'PIPE'} = 'PLUMBER';
$mode = Sappend ? '»' : '>';
Sfh = 'FH000';
unless (Snostdout) {
Uh = ('STDOUT', 'standard output’); # Направить в STDOUT
}
$| = 1 If Sunbuffer;
for (OARGV) {
If (!open($fh. (ГГ>|1/ && Smode) . $_)) {
warn "SO: cannot open $_; $!\n"; # Как в sun; я предпочитаю die
$status++;
next;
select ((select (Sfh). $| = DEO]) If Sunbuffer:
$fh{$fh++} = $_:
}
while (<STDIN>) {
for Sfh (keys Uh) {
print Sfh $_;
}
for Sfh (keys Uh) {
next If close(Sfh) || 'defined $fh{$fh};
warn "SO: couldnt close $fh{$fh}: $!\n";
$status++:
}
8.26. Программа: laston
377
exit Sstatus:
sub PLUMBER {
warn "SO: pipe to \"$fh{$fh}\" broke!\n":
$status++;
delete $fh{$fh};
}
8.26. Программа: 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/Ы n/perl
# laston - определение времени последней регистрации пользователя
use User::pwent:
use 10::Seekable qw(SEEK_SET):
open (LASTLOG. "/var/log/lastlog")
or die "can't open /var/log/lastlog: $!":
Stypedef = ’L A12 A16': # Формат llnux; для SunOS - "L A8 A16"
Sslzeof = length(pack($typedef. ())):
for Suser (OARGV) {
$U = (Suser =~ /x\d+$/) ? getpwuld(Suser) : getpwnam($user);
unless ($U) { warn "no such uid $user\n": next: }
seek(LASTLOG. $U->u1d * Sslzeof. SEEK_SET) or die "seek failed: $!":
read(LASTLOG. Sbuffer. Sslzeof) == Sslzeofor next:
(Stlme. SHne. Shost) = unpack(Stypedef. Sbuffer):
prlntf "£-8s UID £5d Ms^s\n", $U->name. $U->u1d.
Stlme ? ("at " . localtlme(Stlme)) : "never logged In".
SHne && " on SHne",
Shost && " from Shost":
378
Глава 8. Содержимое файлов
8.27. Программа: индексация файла
Если требуется перейти к строке с заданным номером, но строки файла имеют
разную длину, применить рецепт 8.12 не удастся. Конечно, можно читать все
строки подряд от начала файла, но при нескольких выборках этот вариант не-
эффективен.
Проблема решается построением индекса, по одному элементу на каждую
строку. Каждая запись содержит смещение соответствующей строки в файле
данных. Процедура, приведенная в примере 8.10, получает файл данных и мани-
пулятор для вывода индекса. Процедура последовательно читает записи и выводит
в манипулятор индекса текущее смещение в файле, упакованное в беззнаковое
32-разрядное целое; за информацией о других форматах обращайтесь к описа-
нию функции pack в perlfunc(V).
Пример 8.10. buildjndex
# Применение : Ьи11Ь_1пЬех(*МАНИПУЛЯТ0Р_ДАННЫХ. *МАНИПУЛЯТОР_ИНДЕКСА)
sub buildjndex {
my Sdata_f11e = shift:
my $1ndex_f11e = shift:
my Soffset = 0:
while (<Sdata_f11e>) {
print $1ndex_f11e packC'N". Soffset):
Soffset = tell($data_f11e):
}
}
После того как индекс будет построен, задача чтения строки с заданным но-
мером из файла данных решается легко. Найдите нужную запись в индексе, про-
читайте смещение и перейдите к соответствующей позиции в файле данных.
Следующая прочитанная строка будет именно той, которая вам нужна. Проце-
дура из примера 8.11 возвращает строку по ее номеру и двум манипуляторам:
индекса и файла данных.
Пример 8.11. Iine_with_index
# Применение : 11ne_w1th_1ndex(*MAHИПУЛЯT0P_ДAHHЫX.
# *МАНИПУЛЯТОР_ИНДЕКСА.
# $НОМЕР_СТРОКИ)
# Возвращает строку или undef. если НОМЕР_СТРОКИ выходит за пределы файла
sub 11ne_w1th_1ndex {
my Sdata_f11e = shift:
my $1ndex_f11e = shift:
my $11ne_number = shift:
my Sslze; # Размер элемента индекса
my $1_offset: # Смещение элемента в индексе
my Sentry; # Элемент индекса
my $d_offset; # Смещение в файле данных
Sslze = length(pack("N", 0));
$1_offset = Sslze * ($11ne_number-l):
seek($1ndex_f11e, $1_offset, 0) or return:
8.27. Программа: индексация файла
379
read($1ndexJMle, Sentry, Ssize);
$d_offset = unpack("N", Sentry);
seek($data_f11e, $d_offset, 0);
return scalar(<$data_file>);
}
Пример использования этих процедур:
open(FILE, "< Sfile") or die "Can’t open Sfile for reading: $!\n";
open(INDEX. "+>Sf11e.1dx")
or die "Can’t open Sflle.ldx for read/wrlte: $!\n";
bu11dJndex(*FILE. *INDEX):
Sline = 11ne_w1th_1ndex(*FILE, *INDEX, Sseeklng);
Следующим логичным шагом должно стать кэширование индексных файлов
между запусками программы, чтобы индекс не приходилось каждый раз строить
заново. В примере 8.12 показано, как организовать простейшее кэширование.
Далее следует добавить блокировку для организации параллельного доступа
и проверку временных пометок файлов, чтобы узнать об изменении файлов дан-
ных и о необходимости повторного построения индекса.
Пример 8.12. cachejinejndex
# !/usr/Ы n/perl -w
# cachejinejndex - кэширование индекса
# Использует процедуры bulldjndex и 11 ne_w1 th J ndex (см. выше)
@ARGV = = 2 or
die "usage: printjine FILENAME LINE_NUMBER";
(Sfilename, $11ne_number) = @ARGV:
open(my Sorlg, "<", Sfilename)
or die "Can't open Sfilename for reading: $!";
# Открыть индекс и построить его при необходимости.
# Здесь возникает потенциальная опасность перехвата: две копии
# программы могут одновременно определить, что индекс для данного
# файла не существует, и попытаться построить его.
# Проблема легко решается блокировкой.
Slndexname = "Sfl1 ename.1ndex";
sysopen(my Sidx, Slndexname, O_CREAT|O_RDWR)
or die "Can’t open Slndexname for read/wrlte: $!";
bulldjndex( Sorlg, Sidx) If -z Slndexname; # XXX: race unless lock
Sline = 11ne_w1th_1ndex(Sorlg, Sidx, $11ne_number):
die "Didn't find line $11ne_number In Sfilename" unless defined Sline;
print Sline:
Каталоги
«У UNIX есть свои недостатки, но фай-
ловая система к ним не относится».
Крис Торек
9.0. Введение
Для полноценного понимания работы с каталогами необходимо понимать меха-
низмы, заложенные в ее основу. Наш материал ориентирован на файловую сис-
тему UNIX, поскольку функции каталогов Perl разрабатывались для системных
функций и особенностей именно этой системы, однако в определенной степени
он относится и к большинству других платформ.
Файловая система состоит из двух компонентов: набора блоков данных, где
хранится содержимое файлов и каталогов, и индекса к этим блокам. Каждому
объекту файловой системы, будь то обычный файл, каталог, ссылка или специаль-
ный файл (типа файлов из каталога /dev), соответствует определенный элемент
индекса. Элементы индекса называются индексными узлами (inode). Поскольку
индекс является одномерным, индексные узлы определяются по номерам.
Каталог представляет собой файл специального формата, помеченный в ин-
дексном узле как каталог. Блоки данных каталога содержат множество пар. Ка-
ждая пара содержит имя объекта каталога и соответствующий ему индексный
узел. Блоки данных каталога /usr/biп могут выглядеть примерно так:
Имя Индексный узел
Ьс 17
du 29
nvi 8
pine 55
vi 8
Подобную структуру имеют все каталоги, включая корневой (/). Чтобы прочи-
тать файл /usr/Ыn/vi, операционная система читает индексный узел /, находит
в его блоках данных информацию о /usr, читает индексный узел / us г, находит
в его блоках данных информацию о /usr/biп, читает индексный узел /usr/biп,
9.0. Введение
381
находит в его блоках данных информацию о /usr/Ыn/vi, читает индексный узел
/usr/bin/vi, после чего читает данные из блока данных.
Имена, хранящиеся в каталогах, не являются полными. Так, файл /usr/Ы n/vi
хранится в каталоге /usr/biп под именем vi. Если открыть каталог /usr/biп и по-
следовательно читать его элементы, вы увидите имена файлов (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/Ыn/vi
может быть получен следующим образом:
Gentry = stat("/usr/bin/v1") or die "Couldn’t stat /usr/bln/vl : $!":
Следующий фрагмент получает индексный узел для каталога /usr/biп:
Gentry = stat(7usr/bin") or die "Couldn’t stat /usr/bln : $!":
Функция stat также может вызываться и для файловых манипуляторов:
Gentry = stat(INFILE) or die "Couldn’t stat INFILE : $!";
Функция stat возвращает список значений, хранящихся в полях элемента ката-
лога. Если получить информацию не удалось (например, если файл не существу-
ет), функция возвращает пустой список. В приведенных примерах пустой список
проверялся конструкцией or die. Не путайте с конструкцией 11 die, поскольку
выражение будет преобразовано в скалярный контекст, и функция stat сообщит
лишь о том, успешно ли она была вызвана. Список при этом не возвращается.
Впрочем, кэш _ (см. ниже) все же будет обновлен.
Элементы списка, возвращаемые функцией stat, перечислены в табл. 9.1.
382
Глава 9. Каталоги
Таблица 9.1. Элементы списка, возвращаемого функцией stat
Элемент Сокращенное обозначение Описание
0 dev Номер устройства в файловой системе
1 ino Номер индексного узла
2 mode Режим файла (тип и права доступа)
3 nlink Количество (прямых) ссылок на файл
4 uid Числовой идентификатор пользователя владельца файла
5 gid Числовой идентификатор группы владельца файла
6 rdev Идентификатор устройства (только для специальных файлов)
7 size Общий размер файла в байтах
8 atime Время последнего обращения (в секундах с начала эпохи)
9 mtime Время последней модификации (в секундах с начала эпохи)
10 ctime Время изменения индексного узла (в секундах с начала эпохи)
И blksize Предпочтительный размер блока для операций ввода/вывода в файловой системе
12 blocks Фактическое количество выделенных блоков
Стандартный модуль File: :stat предоставляет именованный интерфейс к этим
значениям. Он переопределяет функцию stat, поэтому вместо массива, опи-
санного выше, функция возвращает объект с методами для получения каждого
атрибута:
use File::stat:
$inode = statC/usr/bin/vi"):
$ctime = $1node->ctime;
$size = $inode->size.
Кроме того, в Perl предусмотрен набор операторов, вызывающих функцию
stat и возвращающих лишь один атрибут (табл. 9.2). Эти операторы совокупно
называются «операторами -X», поскольку их имена состоят из дефиса, за кото-
рым следует один символ. Они построены по образцу операторов test командно-
го интерпретатора.
Таблица 9.2. Операторы получения атрибутов файлов
-X Поле stat Значение
-г mode Файл может читаться текущими UID/GID
-W mode Файл может записываться текущими UID/GID
-х mode Файл может исполняться текущими UID/GID
-о mode Владельцем файла является текущий UID
9.0. Введение
383
-X Поле stat Значение
-R mode Файл может читаться фактическими UID/GID
-W mode Файл может записываться фактическими UID/GID
-X mode Файл может исполняться фактическими UID/GID
-0 mode Владельцем файла является фактический UID
-e Файл существует
-z size Размер файла равен нулю
-s size Размер файла отличен от нуля (возвращает размер)
-f mode, rdev Файл является обычным файлом
-d mode, rdev Файл является каталогом
-1 mode Файл является символической ссылкой
-p mode -S mode Файл является именованным каналом (FIFO) Файл является сокетом
-b rdev Файл является блочным специальным файлом
-c rdev Файл является символьным специальным файлом
-t rdev Файловый манипулятор открыт для терминала
-u mode У файла установлен бит setuid
-g mode -k mode У файла установлен бит setgid У файла установлен бит запрета
-T — Файл является текстовым
-B - Файл является двоичным (противоположность -Т)
-M mtime Возраст файла в днях на момент запуска сценария
-A atime То же для времени последнего обращения
-C ctime То же для времени изменения индексного узла (не путать с временем создания!)
Функция stat и операторы -X кэшируют значения, полученные при вызове
системной функции stat (2). Если stat или оператор -X вызывается для специаль-
ного файлового манипулятора _ (один символ подчеркивания), то вместо по-
вторного вызова stat будет использована информация, хранящаяся в кэше. Это
позволяет проверять различные атрибуты файла без многократного вызова stat(2)
или возникновения опасности «состояния перехвата»:
open( F. "< Sfilename" )
or die "Opening Sfilename: $!\n":
unless (-s F && -T _) {
die "Sfilename doesn't have text in it.\n";
384
Глава 9. Каталоги
Однако отдельный вызов stat возвращает информацию лишь об одном ин-
дексном узле. Как же получить список содержимого каталога? Для этой цели в
Perl предусмотрены функции opendir, readdir и closedir:
opendiг(DIRHANDLE. "/usr/bin") or die "couldn't open /usr/bin : $!":
while ( defined (Sfilename = readdir(DIRHANDLE)) ) {
print "Inside /usr/bin is something called $filename\n";
closed!r(DIRHANDLE):
Функции чтения каталога намеренно разрабатывались по аналогии с функ-
циями открытия и закрытия файлов. Однако если функция open вызывается для
манипулятора файла, то opendi г получает манипулятор каталога. Внешне они похо-
жи, но работают по-разному: в программе могут соседствовать вызовы open (BIN,
"/a/file") и opendir(BIN, "/a/dir"), и Perl не запутается. Вы — возможно, но Perl
точно не запутается. Поскольку манипуляторы файлов отличаются от манипу-
ляторов каталогов, вы не сможете использовать оператор <> для чтения из мани-
пулятора каталога (<> вызывает readline для файлового манипулятора).
Как и в случае с функцией open и другими функциями, инициализирующими
файловые манипуляторы, вместо манипулятора каталога функции opendi г мож-
но передать неопределенную скалярную переменную. Если вызов функции за-
вершается успешно, Perl инициализирует переменную ссылкой на новый, ано-
нимный манипулятор каталога.
opendir(my $dh, "/usr/bin") or die:
while (defined (Sfilename = readdir($dh))) {
# ...
}
closedir(Sdh);
Perl автоматически освобождает эту ссылку, когда она перестает использо-
ваться (например, при выходе из области действия и при отсутствии других
ссылок на нее); то же самое происходит и с другими автоматически оживляемы-
ми ссылками. И если для манипуляторов, оживленных при вызове open, в этот
момент вызывается функция close, то для манипуляторов каталогов, оживлен-
ных при вызове opendir, будет вызвана функция closedir.
Имена файлов в каталоге не обязательно хранятся в алфавитном порядке.
Чтобы получить алфавитный список файлов, прочитайте все содержимое ката-
лога и отсортируйте его самостоятельно.
Отделение информации каталога от информации индексного узла может быть
связано с некоторыми странностями. Операции, изменяющие каталог (создание
и уничтожение, переименование файлов), требуют права записи для каталога, но
не для файла. Дело в том, что имя файла не является свойством, присущим са-
мому файлу. Имена файлов хранятся в каталогах; сам файл не знает своего име-
ни. Только операции, изменяющие содержимое файла, требуют права записи
в файл. Наконец, операции, изменяющие права доступа к файлу или другие ме-
таданные, могут осуществляться только владельцем файла или привилегирован-
ным пользователем. Могут возникнуть странные ситуации, например, появляет-
ся возможность удаления файла, который нельзя прочитать, или записи в файл,
который нельзя удалить.
9.1. Получение и установка атрибутов времени
385
Хотя из-за подобных ситуаций файловая система на первый взгляд кажется
нелогичной, в действительности они способствуют широте возможностей Unix.
Реализация ссылок (два имени, ссылающиеся на один файл) становится чрезвы-
чайно простой — в двух элементах каталога просто указывается один номер индекс-
ного узла. Структура индексного узла содержит количество элементов каталога,
ссылающихся на данный файл (nlink в списке данных, возвращаемых stat), что
позволяет операционной системе хранить и поддерживать лишь одну копию време-
ни модификации, размера и других атрибутов файла. При уничтожении ссылки на
элемент каталога блоки данных удаляются лишь в том случае, если это была послед-
няя ссылка для индексного узла данного файла, а сам файл не остается открытым
ни в одном процессе. Можно вызвать unlink и для открытого файла, но дисковое
пространство будет освобождено лишь после его закрытия последним процессом.
Ссылки делятся на два типа. Тип, описанный выше (два элемента каталога, в ко-
торых указан один номер индексного узла), называется прямой (или жесткой)
ссылкой (hard link). Операционная система не может отличить первый элемент
каталога, соответствующий файлу (созданный при создании файла) от всех после-
дующих ссылок на него. Со ссылками другого типа — мягкими, или символически-
ми, ссылками — дело обстоит совершенно иначе. Символические ссылки пред-
ставляют собой файлы особого типа: в блоке данных хранится имя файла, на ко-
торый указывает ссылка. Символические ссылки имеют особое значение mode,
отличающее их от обычных файлов. При вызове open для символической ссылки
операционная система открывает файл, имя которого указано в блоке данных.
Резюме
Имена файлов хранятся в каталогах отдельно от размера, атрибутов защиты и про-
чих метаданных, хранящихся в индексном узле.
Функция stat возвращает информацию индексного узла (метаданные).
Функции opendir, readdir и их спутники обеспечивают доступ к именам фай-
лов в каталоге через манипулятор каталога.
Манипулятор каталога похож на файловый манипулятор, но не идентичен
ему. В частности, для манипулятора каталога нельзя вызвать <>.
Права доступа к каталогу определяют, можете ли вы прочитать или записать
список имен файлов. Права доступа к файлу определяют, можете ли вы изме-
нить метаданные или содержимое файла.
В индексном узле хранятся три атрибута времени. Ни один из них не опреде-
ляет время создания файла.
9.1. Получение и установка
атрибутов времени
Проблема
Требуется получить или изменить время последней модификации (записи или
изменения) или обращения (чтения) для файла.
386
Глава 9. Каталоги
Решение
Функция stat получает атрибуты времени, а функция utiте устанавливает их
значения. Обе относятся к числу встроенных функций Perl:
(SREADTIME. SWRITETIME) = (stat(Sfllename))[8.9];
utime(SNEWREADTIME. SNEWWRITETIME, Sfilename);
Комментарий
Как говорилось во Введении, в традиционной файловой системе Unix с каждым
индексным узлом связывается три атрибута времени. Любой пользователь может
установить значения atlme и mtlme функцией utiте, если он имеет право записи
в каталог, содержащий файл. Изменить ctlme практически невозможно. Следую-
щий пример демонстрирует вызов функции utiте:
SSECONDS_PER_DAY = 60 * 60 * 24;
(Satime, Smtime) = (stat(Sflle))[8,9];
Satime -= 7 * $SECONDS_PER_DAY;
Smtime -= 7 * $SECONDS_PER_DAY:
ut1me(Sat1me. Smtime, Sfile)
or die "couldn't backdate Sfile by a week w/ utlme: S’";
Функция utlme должна вызываться для обоих атрибутов, atlme и mtlme. Если
вы хотите задать лишь одно из этих значений, необходимо предварительно по-
лучить другое с помощью функции stat:
Smtime = (stat Sf11e)[9];
ut1me(t1me, Smtime. Sfile);
Применение модуля File: :stat упрощает этот фрагмент:
use File::stat;
ut1me(t1me. stat($f11e)->mt1me. Sfile);
Функция utlme позволяет сделать вид, будто к файлу вообще никто не при-
трагивался (если не считать обновления ctlme). Например, для редактирования
файла можно воспользоваться программой из примера 9.1.
Пример 9.1. uvi
#1/usr/Ыn/perl -w
# uvi - редактирование файла в vl без изменения атрибутов времени
Sfile = shift or die "usage: uvi f11ename\n":
(Satime. Smtime) = (stat(Sf11e))[8.9];
system(SENV{EDITOR} || "vl". Sfile);
ut1me(Sat1me, Smtime. Sfile)
or die "couldn't restore Sfile to orig times: S’":
См. также
Описание функций stat и utlme в perlfunc(l); стандартный модуль File::stat
и страница руководства utime(3).
9.2. Удаление файла
387
9.2. Удаление файла
Проблема
Требуется удалить файл. Функция Perl delete вам не подходит.
Решение
Воспользуйтесь функцией Perl unlink:
uni 1nk(SFILENAME) or die "Can't delete SFILENAME: $!\n";
uni1nk(@FILENAMES) == ^FILENAMES or die
"Couldn't unlink all of ^FILENAMES: S!\n":
Комментарий
Функция unlink была названа по имени системной функции Unix. В Perl она
получает список имен файлов и возвращает количество успешно удаленных
файлов. Возвращаемое значение проверяется с помощью 11 или or:
uni 1nk($f11e) or die "Can't unlink Sflle: $!":
Функция unlink не сообщает, какие файлы не были удалены, — лишь об-
щее количество удаленных файлов. Следующий фрагмент проверяет, успешно
ли состоялось удаление нескольких файлов, и выводит количество удаленных
файлов:
unless ((Scount = uni 1nk(Of11 el 1 st)) == @f11el1st) {
warn "could only delete Scount of "
. (@f11e!1st) . " files":
}
Перебор Of 11 el 1 st в цикле foreach позволяет выводить отдельные сообщения
об ошибках.
В Unix удаление файла из каталога требует права записи для каталога1, а не
для файла, поскольку изменяется именно каталог. В некоторых ситуациях по-
является возможность удаления файла, в который запрещена запись, или записи
в файл, который нельзя удалить.
Если удаляемый файл открыт некоторым процессом, операционная систе-
ма удаляет элемент каталога, но не освобождает блоки данных до закрытия фай-
ла во всех процессах. Именно так работает функция tmpf 11 е в File: :Temp (см. ре-
цепт 7.11).
См. также
Описание функции unlink в perlfunc(Y)\ страница руководства unlirik(2)\ рецепт 7.11.
1 Если для каталога не был установлен бит запрета 01000, который разрешает удаление
только владельцу. В общих каталогах типа /tmp по соображениям безопасности обычно
используется режим 01777.
388
Глава 9. Каталоги
9.3. Копирование или перемещение файла
Проблема
Необходимо скопировать файл, однако в Perl не существует встроенной коман-
ды копирования.
Решение
Воспользуйтесь функцией сору стандартного модуля File: :Сору:
use File::Copy;
copy($oldfi1e, Snewfile):
To же самое делается и вручную:
openUN. "< Soldfile") or die "can't open Soldfile: S’":
open(OUT, "> Snewfile") or die "can't open Snewfile: $!":
Sblksize = (stat IN)[11] || 16384: # Желательный размер блока?
while (1) {
Slen = sysread (IN. Sbuf. Sblksize):
if ('defined Slen) {
next if S! =~ /^Interrupted/:
die "System read error: S!\n";
}
last unless Slen:
Soffset = 0;
while (Slen) { # Частичные операции записи
defined(Swritten = syswrite OUT. Sbuf. Slen. Soffset)
or die "System write error: S!\en":
Slen -= Swritten;
Soffset += Swritten:
};
}
close(IN):
close(OUT);
Также можно воспользоваться программой сору вашей системы:
systemCcp Soldfile Snewfile"): # unix
systemCcopy Soldfile Snewfile"): # dos. vms
Комментарий
Модуль File: :Copy содержит функции copy и move. Они удобнее низкоуровневых
функций ввода/вывода и обладают большей переносимостью по сравнению с вы-
зовом system. Функция move допускает перемещение между каталогами, а стан-
дартная функция Perl rename — нет (обычно).
use File::Сору:
сору("datafile.dat". "datafile.bak")
9.4. Распознавание двух имен одного файла
389
or die "copy failed: $!";
move("datafile.dat". "datafile.new")
or die "move failed: $!":
Поскольку обе функции возвращают лишь простой признак успешного завер-
шения, вы не сможете легко определить, какой файл помешал успешному копи-
рованию или перемещению. При ручном копировании файлов можно узнать, ка-
кие файлы не были скопированы, но в этом случае ваша программа забивается
сложными вызовами sysread и syswrite.
См. также
Документация по стандартному модулю File: :Сору; описание функций rename,
read и syswrite в perlfunc(l).
9.4. Распознавание двух имен одного файла
Проблема
Требуется узнать, соответствуют ли два имени файла из списка одному и тому
же файлу на диске (благодаря жестким и символическим ссылкам два имени
могут ссылаться на один файл). Такая информация поможет предотвратить мо-
дификацию файла, с которым вы уже работаете.
Решение
Создайте хэш, индексируемый по номерам устройства и индексного узла для
уже встречавшихся файлов. В качестве значений хэша используются имена
файлов:
^seen = О:
sub do_my_thing {
my Sfilename = shift:
my (Sdev, Sino) = stat Sfilename;
unless ($seen{$dev. $1no}++) {
# Сделать что-то c Sfilename, поскольку это имя
# нам еще не встречалось
}
}
Комментарий
Ключ %seen образуется объединением номеров устройства (Sdev) и индексного
узла ($1 по) каждого файла. Для одного файла номера устройства и индексного
узла совпадут, поэтому им будут соответствовать одинаковые ключи.
390
Глава 9. Каталоги
Если вы хотите вести список всех файлов с одинаковыми именами, то вместо
подсчета экземпляров сохраните имя файла в анонимном массиве:
foreach Sfilename (©files) {
(Sdev, Slno) = stat Sfilename;
push( @{ $seen{Sdev,S1no} }, Sfilename):
foreach Sdevlno (sort keys ^seen) {
(Sdev, Slno) = sp!1t(/$:/o, Sdevlno):
If (@{$seen{Sdevlno}} > 1) {
# @{$seen{Sdevlno}} - список имен одного файла
}
Переменная $: содержит строку-разделитель и использует старый синтаксис
эмуляции многомерных массивов, $hash{$x,$y,$z}. Хэш остается одномерным,
однако он имеет составной ключ. В действительности ключ представляет собой
jo1n($;=>$x,$y,$z). Функция split снова разделяет составляющие. Хотя много-
уровневый хэш можно использовать и напрямую, здесь в этом нет необходимо-
сти, и дешевле будет обойтись без него.
См. также
Описание переменной $; в perlvar(\y, описание функции stat в perlfunc(V).
9.5. Обработка всех файлов каталога
Проблема
Требуется выполнить некоторые действия с каждым файлом данного каталога.
Решение
Откройте каталог функцией opendir и последовательно читайте имена файлов
функцией readd 1 г:
opend1r(DIR, Sdlrname) or die "can’t opendir Sdlrname: S’":
while (def1ned(Sfl1e = readdlr(DIR))) {
# Сделать что-то c "Sdlrname/Sflle"
closedlr(DIR):
Комментарий
Функции opendir, readdir и closedir работают с каталогами по аналогии с функ-
циями open, read и close, работающими с файлами. В обоих случаях используются
манипуляторы, однако манипуляторы каталогов, используемые opendl г и другими
функциями этого семейства, отличаются от файловых манипуляторов функции
9.5. Обработка всех файлов каталога
391
open и других. В частности, для манипулятора каталога нельзя использовать
оператор <>.
В скалярном контексте г eadd 1 г возвращает следующее имя файла в каталоге,
пока не будет достигнут конец каталога — в этом случае возвращается undef.
В списковом контексте возвращаются остальные имена файлов каталога или
пустой список, если файлов больше нет. Как объяснялось во Введении, имена
файлов, возвращаемые readd 1 г, не содержат имя каталога. При работе с именами,
полученными от readdir, необходимо либо заранее перейти в нужный каталог,
либо вручную присоединить его к имени.
Ручное присоединение может выглядеть так:
Sdlr = "/usr/local/bln":
print "Text files In Sdlr are:\n":
opendir(BIN. Sdlr) or die "Can’t open Sdlr: $!":
wh11e( defined (Sfile = readdir BIN) ) {
print "$f11e\n" If -T "Sdlr/Sflle":
}
closedlr(BIN):
Функция readdl г также возвращает специальные каталоги "." (текущий ката-
лог) и ".." (родительский каталог). Обычно они пропускаются фрагментом сле-
дующего вида:
while ( defined (Sfile = readdir BIN) ) {
next If Sfile =~ /х\.\.?$/: # Пропустить . и ..
# ...
}
Манипуляторы каталогов, как и файловые манипуляторы, существуют на
уровне пакетов. Локальный манипулятор каталога можно получить с помощью
синтаксиса local *DIRHANDLE модуля. Возможен и другой вариант — передать в пер-
вом аргументе opendir неопределенный скаляр, в котором Perl сохраняет новый
анонимный манипулятор каталога.
opendir(my Sdh. "/usr/bin") or die:
while (defined (Sfilename = readdlr(Sdh))) {
# ...
}
Наконец, существует третий вариант — получение объектно-ориентированно-
го представления манипулятора каталога с применением модуля DlrHandle. Сле-
дующий фрагмент использует DlrHandle для получения отсортированного списка
«обычных» файлов (имена которых не начинаются с "."):
use DlrHandle:
sub plainfiles {
my Sdlr = shift:
my Sdh = DIrHandle->new($d1r)
return sort
grep { -f }
map { "Sd1r/$_" }
grep { !/ж\./ }
Sdh->read():
or die "can't opendir Sdlr: $!":
# Отсортировать имена
# Выбрать "обычные" файлы
# Построить полные пути
# Отфильтровать скрытые файлы
# Прочитать все элементы
392
Глава 9. Каталоги
Метод read модуля DirHandle работает так же, как и readdir, и возвращает ос-
тальные имена файлов. Нижний вызов grep оставляет лишь те имена, которые
не начинаются с точки. Вызов тар преобразует имена файлов, полученные от
read, в полные, а верхний вызов grep отфильтровывает каталоги, ссылки и т. д.
Процедура сортирует и возвращает полученный список.
В дополнение к readdir также существуют функции rewinddir (перемещает
манипулятор каталога к началу списка файлов), seekdl г (переходит к конкретно-
му смещению в списке) и tell di г (определяет смещение от начала списка).
См. также
Описание функций closedir, opendir, readdir, rewinddir, seekdir и tell di г в perlfunc(Yy
документация по стандартному модулю DirHandle.
9.6. Получение списка файлов по шаблону
Проблема
Требуется получить список файлов по шаблону, аналогичному конструкциям *. *
(MS-DOS) и * h (Unix).
Решение
Семантика командного интерпретатора С shell системы Unix поддерживается
в Perl с помощью ключевого слова glob и оператора <>:
©list = <*.с>:
©list = globC*.с"):
Для ручного извлечения имен файлов можно воспользоваться функцией readdl г:
opend1r(DIR, $path):
©files = grep { /\.с$/ } readdlr(DIR):
closedlr(DIR):
Комментарий
До выхода Perl версии 5.6 встроенная функция Perl glob и запись <ШАБЛОН> (не
путать с записью <МАНИПУЛЯТОР>\) использовали внешнюю программу для получе-
ния списка файлов. В результате операция получения списка файлов осложня-
лась проблемами безопасности и быстродействия. Начиная с версии 5.6 эта за-
дача решается при помощи модуля File: :Glob, лишенного недостатков старой
реализации. Шаблоны обеспечивают семантику С shell во всех системах, отлич-
ных от Unix, что способствует улучшению переносимости. В частности, синтак-
сис файловых шаблонов отличен от синтаксиса регулярных выражений — знак
? обозначает «один произвольный символ», а знак * — «ноль и более символов»,
поэтому glob(’’f?o*") совпадет с fl о и flood, но не с fo.
9.7. Рекурсивная обработка всех файлов каталога
393
Если потребуется сформулировать более сложное правило, реализуйте свой
собственный механизм отбора с использованием readdl г и регулярных выражений.
В простейшем решении с opendir список, возвращаемый readdir, фильтруется
с помощью grep:
©files = grep { /\.[ch]$/1 } readdlr(DH);
Как обычно, возвращаемые имена файлов не содержат каталога. При исполь-
зовании имени каталог приходится присоединять вручную:
opend1r(DH, $d1r) or die "Couldn't open $d1r for reading: $!":
©files = ();
wh11e( defined ($f1le = readdlr(DH)) ) {
next unless A.[ch]$/1;
my $f11ename = "$d1r/$f11e":
push(@f11es, $f11ename) If -T $f11ename;
В следующем примере чтение каталога и фильтрация для повышения эффек-
тивности объединяются с эффективной сортировкой из рецепта 4.16. В массив
@d1 rs заносится отсортированный список подкаталогов, имена которых состоят
только из цифр:
©dlrs = map { $_->[!] }
sort { $а->[0] <=> $b->[0] }
grep { -d $_->[!] }
map { [ $_, "$path/$_" J }
grep { /A\d+$/ }
readdlr(DIR);
# Извлечение имен
# Числовая сортировка имен
# Каталоги
# Сформировать (имя, путь)
# Только числа
# Все файлы
В рецепте 4.16 показано, как читать подобные странные конструкции. Как
обычно, форматирование и документирование кода заметно упрощает его чте-
ние и понимание.
См. также
Описание функций closedir, opendir, readdir, rewinddir, seekdir и tell di г в perlfunc(\y
документация по стандартному модулю DlrHandle; раздел «I/O Operators» perlop(\.y
рецепты 6.9 и 9.5.
9.7. Рекурсивная обработка
всех файлов каталога
Проблема
Требуется выполнить некоторую операцию с каждым файлом и подкаталогом
некоторого каталога.
394
Глава 9. Каталоги
Решение
Воспользуйтесь стандартным модулем File::Find.
use File::Fl nd:
sub process_file {
# Делаем то. что хотели
}
find(\&process_file. @DIRLIST);
Комментарий
Модуль File::Find обеспечивает удобные средства рекурсивной обработки фай-
лов. Просмотр каталога и рекурсия организуются без вашего участия — доста-
точно передать fi nd ссылку на функцию и список каталогов. Для каждого файла
в этих каталогах fi nd вызовет заданную функцию.
Перед вызовом функции find переходит в указанный каталог, имя которого
по отношению к начальному каталогу хранится в переменной $Fi 1 е: :Find:: di г.
Переменной $_ присваивается базовое имя файла, а полный путь к этому фай-
лу находится в переменной $Fi 1 е:: Fi nd: :name. Ваша программа может присвоить
$Fi 1 е: :Find::prune истинное значение, чтобы функция find не спускалась в толь-
ко что просмотренный каталог.
Использование File: :Find демонстрируется следующим простым примером.
Мы передаем fi nd анонимную процедуру, которая выводит имя каждого обнару-
женного файла и добавляет к именам каталогов /:
@ARGV = qw(.) unless @ARGV:
use File::Find;
find sub { print $File:-.Find::name. -d && '/'. ’An" }. @ARGV:
Для вывода / после имен каталогов используется оператор проверки -d, кото-
рый при отрицательном результате возвращает пустую строку '', которая воз-
вращается и оператором &&. При успешной проверке && возвращает ’7".
Следующая программа выводит суммарный размер всего содержимого ката-
лога. Она передает fi nd анонимную процедуру для накопления текущей суммы
размера всех рассмотренных ею файлов. Сюда входят не только обычные фай-
лы, но и все типы индексных узлов, включая каталоги и символические ссылки.
После выхода из функции fi nd программа выводит накопленную сумму.
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:
9.7. Рекурсивная обработка всех файлов каталога
395
$saved_size = -s _:
$saved_name = $F11е::Fl nd::name:
}
f1nd(\&biggest, @ARGV):
print "Biggest file $saved_name In @ARGV Is $saved_s1ze bytes longAn";
Переменные $saved_s1ze и $saved_name используются для хранения имени и раз-
мера самого большого файла. Если мы находим файл, размер которого превыша-
ет размер самого большого из просмотренных ранее, сохраненное имя и размер
заменяются новыми значениями. После завершения работы find выводится под-
робная информация об имени и размере самого большого файла. Вероятно, более
практичная программа ограничится выводом имени файла, его размера или и того
и другого. На этот раз мы воспользовались именованной функцией вместо ано-
нимной, поскольку она получилась относительно большой.
Программу нетрудно изменить так, чтобы она находила файл, который изме-
нялся последним:
use File::Fl nd:
@ARGV = unless @ARGV:
my (Sage, $name);
sub youngest {
return If defined $age && Sage > (stat($_))[9];
$age = (stat(_))[9];
$name = $F11e::F1nd::name;
}
f1nd(\&youngest. @ARGV):
print "$name ” . scalardocaltlme(Sage)) . ”\n":
Модуль File::Find не экспортирует имя переменной $name, поэтому на нее
следует ссылаться по полному имени. Пример 9.2 демонстрирует скорее работу
с пространствами имен, нежели рекурсивный перебор в каталогах. Он делает пе-
ременную Sname текущего пакета синонимом переменной File::Find (в сущности,
именно на этом основана работа модуля Exporter). Затем мы объявляем собст-
венную версию fl nd с прототипом, обеспечивающим более удобный вызов.
Пример 9.2. fdirs
#!/usr/bin/perl -lw
# fdirs - поиск всех каталогов
@ARGV = qw(.) unless ©ARGV;
use File::Fl nd ():
sub f1nd(&@) { &F11e::F1nd::f1 nd }
*name = *F11e::F1nd::name;
find { print Sname If -d } @ARGV:
Наша версия find вызывает версию find из File::Find, импортирование кото-
рой предотвращается включением пустого списка () в команду use. Вместо запи-
си вида:
find sub { print SFIle::F1nd::name If -d }, @ARGV:
можно использовать более приятную конструкцию:
find { print Sname If -d } @ARGV:
396
Глава 9. Каталоги
См. также
Документация по стандартным модулям File::Find и Exporter; страница руково-
дства/W(l); рецепт 9.6.
9.8. Удаление каталога вместе с содержимым
Проблема
Требуется рекурсивно удалить ветвь дерева каталога без применения rm -г.
Решение
Воспользуйтесь функцией finddepth модуля File::Find (см. пример 9.3).
Пример 9.3. rmtreel
# !/usr/Ы n/perl
# rmtreel - удаление ветви дерева каталогов (по аналогии с rm -г)
use File::Fl nd:
die "usage: $0 dlr . An" unless @ARGV:
find {
bydepth => 1.
no_chd1r => 1,
wanted => sub {
If (!-l && -d _) {
rmdir or warn "couldn't rmdir directory $_: $!";
} else {
unlink or warn "couldn't unlink file $!":
)
}
} => OARGV:
Или воспользуйтесь функцией rmtree модуля File: :Path (см. пример 9.4).
Пример 9.4. rmtree2
# !/usr/Ы n/perl
# rmtree2 - удаление ветви дерева каталогов (по аналогии с rm -г)
use File::Path:
die "usage: $0 dlr .An" unless @ARGV:
foreach $d1r (@ARGV) {
rmtree($d1r);
}
ВНИМАНИЕ--------------------------------------------------------------------
Эти программы удаляют целые ветви дерева каталогов. Применяйте их крайне осторожно!
Комментарий
Модуль File::Find поддерживает дополнительный интерфейс, при котором в пер-
вом аргументе find передается ссылка на хэш с именами и значениями парамет-
9.9. Переименование файлов
397
ров. Параметр bydepth означает, что вместо find фактически должна быть выпол-
нена функция finddepth, гарантирующая перебор всех внутренних файлов перед
посещением самого каталога. Именно этот вариант поведения необходим для
удаления каталога вместе с содержимым. Параметр no_chd1r запрещает find спус-
каться в каталоги в процессе выполнения; при действии этого параметра $_
означает то же, что и $F11 е: :F1nd: :name. Наконец, в параметре wanted передается
ссылка на выполняемый программный код.
Мы используем две разные функции, rmdir и unlink. Функция unlink удаляет
только файлы, a rmdir — только пустые каталоги. Мы должны использовать
finddepth или параметр bydepth, чтобы содержимое каталога заведомо удалялось
раньше самого каталога.
Перед тем как проверять, является ли файл каталогом, необходимо узнать,
не является ли он символической ссылкой, потому что -d возвращает true и для
каталога, и для символической ссылки на каталог. Функции stat, 1 stat и операто-
ры проверки (типа -d) используют системную функцию stat(2), которая возвра-
щает метаданные файла, хранящиеся в индексном узле. Эти функции и операторы
сохраняют полученную информацию и позволяют выполнить дополнительные
проверки того же файла с помощью специального манипулятора При этом
удается избежать лишних вызовов системных функций, возвращающих старую
информацию и замедляющих работу программы.
В стандарте POSIX не указано, что должно происходить при вызове rmdir
для корневого каталога (точки подключения в файловых системах или результата
системного вызова chroot(2)) или текущего рабочего каталога любого процесса.
Вызов может обрабатываться успешно, а может происходить сбой с присваива-
нием коду errno ($! в Perl) значения EBUSY ("Device busy").
См. также
Описание функций unlink, rmdir, 1 stat и stat в perlfunc(\y, документация по
стандартному модулю File: :F1nd; страницы руководства rm(l) и stat(2)\ раздел
perlfunc(\), посвященный операторам -X.
9.9. Переименование файлов
Проблема
Требуется переименовать файлы, входящие в некое множество.
Решение
Воспользуйтесь циклом foreach и функцией rename:
foreach Sfile (©NAMES) {
my Snewname = Sfile;
# Переименование Sfile
rename($file, Snewname) or
warn "Couldn't rename Sfile to Snewname: $!\n";
398
Глава 9. Каталоги
Комментарий
Решение весьма тривиально. Функция rename получает два аргумента — старое
и новое имя. Она предоставляет интерфейс к системной функции переимено-
вания, которая обычно позволяет переименовывать файлы только в том случае,
если старое и новое имена находятся в одной файловой системе.
После небольших изменений программа превращается в универсальный сце-
нарий переименования наподобие написанного Ларри Уоллом (см. пример 9.5).
Пример 9.5. rename
# !/usr/Ыn/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 Swas eq
)
Первый аргумент сценария — код Perl, который изменяет имя файла (храня-
щееся в $_) и определяет алгоритм переименования. Вся черная работа поруча-
ется функции eval. Кроме того, сценарий пропускает вызов rename в том случае,
если имя осталось прежним. Это позволяет просто использовать универсальные
символы (rename EXPR *) вместо составления длинных списков имен.
Ниже приведены пять примеров вызова программы rename из командного ин-
терпретатора:
% rename 's/\.origS//' *.orig
% rename "tr/A-Z/a-z/ unless /AMake/" *
% rename '$_ .= ".bad"' *.f
% rename 'print "$_: s/foo/bar/ if <STDIN> =~ /Ay/i ' *
% find /tmp -name -print | rename 's/A(.+)-$/.#$1/'
Первая команда удаляет из имен файлов суффикс .orig.
Вторая команда преобразует символы верхнего регистра в символы нижнего
регистра. Поскольку вместо функции 1 с используется прямая трансляция, такое
преобразование не учитывает локальный контекст. Проблема решается следую-
щим образом:
% rename 'use locale; $_ = 1с($_) unless/AMake/' *
Третья команда добавляет суффикс .bad к каждому файлу Fortran с суффик-
сом ".f" — давняя мечта многих программистов.
Четвертая команда переименовывает файлы в диалоге с пользователем. Имя
каждого файла отправляется на стандартный вывод, а из стандартного ввода чи-
тается ответ. Если пользователь вводит строку, начинающуюся с "у" или "Y", то
все экземпляры "foo" в имени файла заменяются на "bar".
Пятая команда с помощью find ищет в /tmp файлы, имена которых заканчи-
ваются тильдой. Файлы переименовываются так, чтобы они начинались с пре-
фикса .#. В сущности, мы переключаемся между двумя распространенными кон-
венциями выбора имен файлов, содержащих резервные копии.
9.10. Деление имени файла на компоненты
399
В сценарии rename воплощена вся мощь философии Unix, основанной на при-
менении утилит и фильтров. Конечно, можно написать специальную команду
для преобразования символов в нижний регистр, однако ничуть не сложнее
написать гибкую, универсальную утилиту с внутренним eval. Позволяя читать
имена файлов из стандартного ввода, мы избавляемся от необходимости рекур-
сивного перебора каталога. Вместо этого используется функция find, которая
прекрасно справляется с этой задачей. Не стоит заново изобретать колесо, хотя
модуль File::Find позволяет это сделать.
См. также
Описание функции rename в perlfunc(V); страницы руководства mv(l) и гепате(2);
документация по стандартному модулю File::Find.
9.10. Деление имени файла на компоненты
Проблема
Имеется строка, содержащая полное имя файла. Необходимо разделить ее на
компоненты (имя, каталог, расширение(я)).
Решение
Воспользуйтесь функциями стандартного модуля File::Basename.
use File::Basename:
Sbase = basename(Spath):
$di r = dirname(Spath):
(Sbase. Sdlr. Sext) = fileparse(Spath):
Комментарий
Функции деления имени файла присутствуют в стандартном модуле File::Basename.
Функции dirname и basename возвращают, соответственно, каталог и имя файла:
Spath = '/usr/1ib/1ibe.a':
Sfile = basename(Spath):
$dir = dirname(Spath):
print "dir Is Sdlr. file is $file\n”:
# dir is /usr/lib, file is libc.a
Функция fileparse может использоваться для извлечения расширений. Для
этого передайте fileparse полное имя и регулярное выражение для поиска рас-
ширения. Шаблон необходим из-за того, что расширения не всегда отделяются
точкой. Например, что считать расширением в ".tar.gz" — ".tar", ”.gz" или
".tar.gz"? Передавая шаблон, вы определяете, какой из перечисленных вариан-
тов будет возвращен.
400
Глава 9. Каталоги
Spath = '/usr/11b/11 be.a':
(Sname,Sdir,Sext) = fileparse($path,:
print "dir is Sdir, name is Sname, extension is $ext\n";
# dir is /usr/11b/, name is libc, extension is .a
По умолчанию в работе этих функций используется разделитель, опреде-
ляемый стандартными правилами вашей операционной системы. Для этого ис-
пользуется переменная $43 (SOSNAME); содержащаяся в ней строка идентифицирует
текущую систему. Ее значение определяется в момент построения и установки
Perl. Значение по умолчанию можно установить с помощью функции fileparse_
set_fstype. В результате изменится и поведение функций File::Basename при по-
следующих вызовах:
fi1eparse_set_fstype("MacOS"):
Spath = "Hard%20Drive:System%20Folder:README.txt":
(Sname,Sdir,Sext) = fi1eparse(Spath\:
print "dir is Sdir. name is Sname, extension is $ext\n":
# dir is Hard%20Drive:System&20Folder, name is README, extension is .txt
Расширение можно получить следующим образом:
sub extension {
my Spath = shift:
my Sext = (fileparse($path,))[2]:
Sext =~ s/A\.//:
return Sext:
}
Для файла source.c.bak вместо простого "bak" будет возвращено расширение
"c.bak". Если вы хотите получить именно "bak", передайте fileparse во втором
аргументе Л.Р.]*' (конечно, при этом имя файла — source.с).
Если передаваемое полное имя заканчивается разделителем каталогов (на-
пример, lib/), fileparse считает, что имя каталога равно "lib/" , тогда как dirname
считает его равным ".".
См. также
Документация по стандартному модулю File::Basename; описание переменной $А0
(SOSNAME) в perlvar(i).
9.11. Работа с разрешениями доступа
к файлам в символьном представлении
Проблема
Требуется вывести, просмотреть или изменить разрешения для файла или ка-
талога, но работать с ними в восьмеричном виде (например, 0644 или 0755)
неудобно. Вы предпочитаете выводить разрешения в том виде, в котором они
9.11. Работа с разрешениями доступа к файлам в символьном представлении
401
выводятся Zs(l) (например, -rwx-r-xr-x), и изменять их в формате chmod(V) (на-
пример, право записи для группы запрещается командой g-w).
Решение
Преобразуйте числовые коды разрешений в символы при помощи модуля CPAN
Stat::1sMode:
use Stat::1sMode:
Sismode = f11e_mode($pathname):
Операции с символическими разрешениями выполняются средствами моду-
ля CPAN File: : chmod:
use File::chmod:
chmod("g=rw,o=-w". ©files): # Группа может читать и записывать,
# остальные записывать не могут
chmod("-rwxr-xr--", ©files): # Разрешения в стиле 1s
Комментарий
Функции модуля Stat:: 1 sMode предназначены для работы с символическими разре-
шениями в стиле 1s. Функция f11e_mode получает имя файла и возвращает стро-
ку разрешений. Если заданный файл не существует или Perl не может получить
по нему данные, возвращается строка с ложным значением. Если все проходит
нормально, вы получаете строку вида "drwxr-x---" для каталогов или строку
вида "-rwxr-x---" для файлов. Для ситуаций, требующих более точного управ-
ления, в модуле Stat:: 1 sMode предусмотрена функция format_mode, которая полу-
чает числовой код разрешений и возвращает строку в стиле 1s из 10 символов.
Обратите внимание на префикс d или - в этой строке. Он определяет тип
файла, к которому относятся разрешения: - обозначает обычный файл, d — ката-
лог, 1 — символическую ссылку и т. д. Функция format_perms модуля Stat:: 1 sMode
делает то же, что и formatjnode, но возвращает строку из 9 символов без префик-
са типа. Пример:
use Stat::1sMode:
print file^odeC'/etc”), "\n":
print format_mode((stat "/etc")[2]), "\n":
drwxr-xr-x
r-xr-xr-x
Модуль File: :chmod содержит функцию chmod, которая получает строку разре-
шений из 9 символов:
use File::chmod:
chmod("rwxr-xr-x", ©files):
Строка делится на три подстроки, каждая подстрока состоит из трех симво-
лов. Подстроки определяют, какие операции с файлом разрешаются владельцу,
группе и остальным пользователям: чтение (г), запись (w ) и исполнение (х).
402
Глава 9. Каталоги
Дефис (-) означает запрет на выполнение соответствующей операции. Таким
образом, строка "rwxrw-r--" означает, что владельцу файла разрешены чтение,
запись и исполнение; пользователи той же группы могут читать и записывать
данные в файл, но не могут исполнять его; наконец, все остальные пользователи
могут только читать файл.
Смена разрешений для файла может производиться не только в абсолютном,
но и в относительном виде. Например, запись g-w означает, что группе запреща-
ется запись в файл. Первая буква определяет сторону, для которой изменяются
разрешения — владелец (и), группа (д), прочие пользователи (о) или их комби-
нация. Далее следует знак + или - (соответственно предоставление или лишение
права) или знак =, который указывает, что далее вы задаете полный набор разре-
шений. Команда завершается некоторыми из символов rwx (или всеми сразу).
Возможно разделение команд запятыми, например, g-w.o-х (запрет записи для
группы, предоставление права исполнения остальным пользователям). Если
символы u, g или о отсутствуют, то изменение относится ко всем сторонам.
Рассмотрим некоторые команды изменения разрешений и их смысл:
и= # Владелец лишается всех прав
g=r # Группе разрешается только чтение
g+wx # Группе добавляются права записи и исполнения
g=rwx,o=rx # Группе разрешается все, остальным - только чтение и исполнение
=rwx # Всем разрешаются любые операции
Модуль File: :chmod также содержит функции, которые возвращают информа-
цию о новых разрешениях без внесения фактических изменений. За подробно-
стями обращайтесь к документации по модулю File: :chmod.
См. также
Документация по модулям CPAN File: :chmod и Stat:: 1 sMode; функции chmod и stat
в perlfunc(\.}.
9.12. Программа: symirror
Программа из примера 9.6 рекурсивно воспроизводит каталог со всем содержимым
и создает множество символических ссылок, указывающих на исходные файлы.
Пример 9.6. symirror
#!/usr/Ыn/perl -w
# symirror - дублирование каталога с помощью символических ссылок
use warnings:
use strict;
use Cwd qw(realpath);
use File::Fl nd qw(find):
die "usage: $0 real dlr mirrordir" unless @ARGV == 2;
9.13. Программа: 1st
403
our $SRC = real path $ARGV[O]:
our $DST = real path $ARGV[1]:
my $oldmask = umask 077:
chdir $SRC or die "can't chdir $SRC: $!":
unless (-d $DST) {
mkd1r($DST, 0700) or die "can't mkdir $DST: $!";
}
find {
wanted => "shadow.
postprocess => "fixmode.
} =>
umask $oldmask:
sub shadow {
(my $name = $F11e::F1nd::name) =~ s!**/!!: # Правильное имя
return If $name eq ".":
If (-d) { # Создание каталога: режим копируется позже
mkdir("$DST/$name". 0700)
or die "can't mkdir $DST/$name: $!":
} else { # Для остального создаются ссылки
syml1nk("$SRC/$name". "$DST/$name")
or die "can't symllnk $SRC/$name to $DST/$name: $!":
}
}
sub fixmode {
my $d1 r = $F11e::F1nd::d1r:
my $mode = (stat("$SRC/$d1r"))[2] & 07777:
chmod($mode, "$DST/$d1r")
or die "can't set mode on $DST/$d1r: $!":
}
9.13. Программа: 1st
Вам не приходилось отбирать из каталога самые большие или созданные по-
следними файлы? В стандартной программе 1s предусмотрены параметры для
сортировки содержимого каталогов по времени (флаг -t) и для рекурсивного
просмотра подкаталогов (флаг -R). Однако 1s делает паузу для каждого каталога
и выводит только его содержимое. Программа не просматривает все подкатало-
ги, чтобы потом отсортировать найденные файлы.
Следующая программа 1 st справляется с этой задачей. Ниже показан пример
подробного вывода, полученного с использованием флага -1:
% 1st -1 /etc
12695 0600 1 root eed wheel 512 Fri May 29 10:42:41 1998
/etc/ssh_random_s
12640 0644 1 root wheel 10104 Mon May 25 7:39:191998
/etc/ld.so.cache
12626 0664 1 root wheel 12288 Sun May 24 19:23:08 1998
/etc/psdevtab
12304 0644 1 root root 237 Sun May 24 13:59:33 1998
/etc/exports
404
Глава 9. Каталоги
12309 0644 1 /etc/inetd.conf root root 3386 Sun May 24 13:24:33 1998
12399 0644 1 /etc/sendmail.cf root root 30205 Sun May 24 10:08:37 1998
18774 0644 1 gnat /etc/Xll/XMetroconfi g perl doc 2199 Sun May 24 9:35:57 1998
12636 0644 1 /etc/mtab root wheel 290 Sun May 24 9:05:40 1998
12627 0640 1 /etc/wtmplock root root 0 Sun May 24 8:24:31 1998
12310 0644 1 /etc/issue root tchrist 65 Sun May 24 8:23:04 1998
Файл /etc/Xll/XMetroconf 1 g оказался посреди содержимого /etc, поскольку лис-
тинг относится не только к /etc, но и ко всему, что находится внутри каталога.
Программа также поддерживает и такие параметры, как сортировка по вре-
мени последнего чтения вместо записи (-и) и сортировка по размеру вместо вре-
мени (-s). Флаг -1 приводит к получению списка имен из стандартного ввода
вместо рекурсивного просмотра каталога функцией fl nd. Если у вас уже есть го-
товый список имен, его можно передать 1 st для сортировки.
Исходный текст программы приведен в примере 9.7.
Пример 9.7. 1st
#!/usr/Ы n/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.13. Программа: 1st
405
die "can only sort on one time or size":
}
$IDX = 'mtime':
$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 {
find(\&wanted, @ARGV):
}
# Отсортировать файлы по кэшированным значениям времени,
# начиная с самых новых.
@skeys = sort { $time{$b} <=> $time{$a} } keys Hime:
# Изменить порядок, если в командной строке был указан флаг -г
@skeys = reverse Oskeys if $opt_r:
for (Oskeys) {
unless ($opt_l) { # Эмулировать Is -1, кроме прав доступа
print "$_\n";
next:
}
$now = localtime $stat{$_}->$TIME_IDX():
printf "%6d %04o %6d Ж %8s Ш &s %s\n",
$stat{$_}->ino().
$stat{$J->mode() & 07777,
$stat{$_}->nlink(),
user($stat{$J->uid()),
group($stat{$_}->gid()),
$stat{$_}->size(),
$now,
}
# Получить от stat информацию о файле, сохраняя критерий
# сортировки (mtime, atime, ctime или size)
# в хэше Hime, индексируемом по имени файла.
# Если нужен длинный список, весь объект stat приходится
# сохранять в %stat. Да. это действительно хэш объектов.
sub wanted {
my $sb = stat($_); # XXX: stat или Istat?
return unless $sb;
продолжение &
406
Глава 9. Каталоги
Пример 9.7 (продолжение)
$t1me{$name} = $sb->$IDX(): # Косвенный вызов метода
$stat{$name} = $sb if $opt_l:
}
# Кэширование преобразований идентификатора пользователя в имя
sub user {
my $u1d = shift:
$user{$u1d} = getpwu1d($u1d)->name || "#$u1d"
unless defined $user{$u1d}:
return $user{$u1d}:
}
# Кэширование преобразований номера группы в имя
sub group {
my $g1d = shift:
$group{$g1d} = getgrg1d($g1d)->name || "#$g1d"
unless defined $group{$g1d}:
return $group{$g1d}:
Процедуры
«Огнем бессмертным наполняя смертных...»
В. Оден, «Три песни на день святой Сесилии»
10.0. Введение
Практика вставки/копирования кода довольно опасна, поэтому в больших про-
граммах многократно используемые фрагменты кода часто оформляются в виде
процедур. Для нас термины «процедура» (subroutine) и «функция» (function)
будут эквивалентными, поскольку в Perl они не различаются. Даже объектно-
ориентированные методы представляют собой обычные процедуры со специ-
альным синтаксисом вызова, описанным в главе 13 «Классы, объекты и связи».
Процедура объявляется с помощью ключевого слова sub. Пример определе-
ния простой процедуры выглядит так:
sub hello {
$greeted++; # Глобальная переменная
print "hi there\n!";
}
Типичный способ вызова этой процедуры выглядит следующим образом:
helloO: # Процедура hello вызывается без аргументов/параметров
Перед выполнением программы Perl компилирует ее, поэтому место объявле-
ния процедуры не имеет значения. Определения не обязаны находиться в одном
файле с основной программой. Они могут быть импортированы из других фай-
лов с помощью операторов do, require или use (см. главу 12 «Пакеты, библио-
теки и модули»), создаваться «на месте» с помощью ключевого слова eval или
механизма AUTOLOAD или генерироваться посредством замыканий, используемых
в качестве шаблонов функций.
Если вы знакомы с другими языками программирования, некоторые особен-
ности функций Perl могут показаться странными. Однако в большинстве рецеп-
тов этой главы показано, как применять эти особенности в свою пользу.
О Функции Perl не имеют формальных (именованных) параметров, но это не
всегда плохо (см. рецепты 10.1 и 10.7).
О Все переменные являются глобальными, если обратное не следует из объяв-
ления. Дополнительная информация приведена в рецептах 10.2, 10.3 и 10.13.
408
Глава 10. Процедуры
О Передача или возвращение нескольких массивов или хэшей обычно приво-
дит к потере ими «индивидуальности». О том, как избежать этого, рассказа-
но в рецептах 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; функция не получает аргументов, но зато может
напрямую обращаться к массиву вызывающей стороны! Если убрать ам-
персанд и воспользоваться формой funcO или func, создается новый, пустой
экземпляр массива
О Исторически в Perl не было конструкций логического ветвления — аналогов
команды С switch или команды case командного интерпретатора. Для ре-
шения этой задачи можно воспользоваться функцией switch, приведенной
в рецепте 10.17.
10.1. Доступ к аргументам процедуры
Проблема
В своей функции вы хотите использовать аргументы, переданные вызывающей
стороной.
Решение
Все значения, переданные функции в качестве аргументов, хранятся в специаль-
ном массиве Следовательно, первый аргумент хранится в элементе $_Е0], вто-
рой — в $_[1] и т. д. Общее число аргументов равно seal аг(@_).
Например:
sub hypotenuse {
return sqrt( ($J0] ** 2) + ($J1J ** 2) ):
}
$d1ag = hypotenuse(3,4); # $d1ag = 5
В начале процедуры аргументы почти всегда копируются в именованные за-
крытые переменные для удобства и повышения надежности:
10.1. Доступ к аргументам процедуры
409
sub hypotenuse {
my ($sidel. $side2) =
return sqrt( ($sidel ** 2) + (Ssldel ** 2) ):
}
Комментарий
Говорят, в программировании есть всего три удобных числа: нуль, единица
и «сколько угодно». Механизм работы с процедурами Perl разрабатывался для
упрощения написания функций со сколь угодно большим (или малым) числом
параметров и возвращаемых значений. Все входные параметры хранятся в виде
отдельных скалярных значений в специальном массиве который автоматически
становится локальным для каждой функции (см. рецепт 10.13). Для возвращения
значений из процедур следует использовать команду return с аргументом. Если
она отсутствует, то возвращается результат последнего вычисленного выражения.
Приведем несколько примеров вызова функции hypotenuse, определенной в ре-
шении:
print hypotenuse(3, 4), "\n": # Выводит 5
@а = (3. 4):
print hypotenuse(@a), "\n"; # Выводит 5
Если взглянуть на аргументы, использованные во втором вызове hypotenuse,
может показаться, что мы передали лишь один аргумент — массив @а. Но это не
так — элементы @а копируются в массив по отдельности. Аналогично, при вызове
функции с аргументами (@а, @Ь) мы передаем ей все аргументы из обоих масси-
вов. При этом используется тот же принцип, что и при сглаживании списков:
©both = (Omen, Owomen);
Скалярные величины в представляют собой неявные синонимы для пере-
даваемых значений, а не их копии. Таким образом, модификация элементов
в процедуре приведет к изменению значений на вызывающей стороне. Это тяж-
кое наследие пришло из тех времен, когда в Perl еще не было нормальных ссылок.
Итак, функцию можно записать так, чтобы она не изменяла свои аргумен-
ты — для этого следует скопировать их в закрытые переменные:
Onums = (1.4, 3.5, 6.7):
©ints = int_all(@nums); # @nums не изменяется
sub int_all {
my @retlist = # Сделать копию для return
for my $n (@retlist) { $n = int($n) }
return ©retlist:
1
Впрочем, функция также может изменять значения переменных вызывающей
стороны:
Onums = (1.4, 3.5, 6.7):
trunc_em(@nums): # @nums = (1,3,6)
sub trunc_em {
for (@_) { $_ = int($_) } # Округлить каждый аргумент
}
410
Глава 10. Процедуры
Таким функциям не следует передавать константы, например, trunc_em (1.4,
3.5,6.7). Если попытаться это сделать, будет выдано исключение Modification of
a read-only value attempted at... («Попытка модифицировать величину, доступ-
ную только для чтения»).
Встроенные функции chop и chomp работают именно так — они модифицируют
переменные вызывающей стороны и возвращают нечто совершенно иное. Начи-
нающие программисты Perl видят, что обычные функции возвращают изменен-
ные значения без модификации аргументов функции, ошибочно предполагают,
что chop и chomp работают аналогично, и пишут в программах следующее:
$11ne = chomp(<>);
# НЕВЕРНО
$removed_chars = chop($lIne): # ВЕРНО
$removed_count = chomp($11ne): # ВЕРНО
пока не поймут, что происходит в действительности. Учитывая широкие возмож-
ности для ошибок, перед модификацией в процедуре стоит дважды подумать —
особенно если процедура также возвращает некоторое значение.
См. также
perlsub(V).
10.2. Создание закрытых
переменных в функциях
Проблема
В процедуре потребовалось создать временную переменную. Использование
глобальных переменных нежелательно, поскольку они могут использоваться
другими процедурами.
Решение
Воспользуйтесь ключевым словом ту для объявления переменной, ограничен-
ной некоторой областью программы:
sub somefunc {
my Svarlable: # Переменная $var1able невидима
# за пределами somefuncO
my ($another, @an_array. &a_hash); # Объявляем несколько
# переменных сразу
# ...
}
Комментарий
Оператор ту ограничивает использование переменной и обращение к ней опре-
деленным участком программы. За пределами этого участка переменная недос-
тупна. Такой участок называется областью действия (scope).
10.2. Создание закрытых переменных в функциях
411
Переменные, объявленные с ключевым словом ту, обладают лексической обла-
стью действия — это означает, что они существуют лишь в границах некоторого
фрагмента исходного текста. Например, областью действия переменной $variable
из решения является функция somefunc, в которой она была определена. Пере-
менная создается при вызове somefunc и уничтожается при ее завершении. Пере-
менная доступна внутри функции, но не за ее пределами.
Лексическая область действия обычно представляет собой программный блок,
заключенный в фигурные скобки, например, определение тела процедуры somefunc
или границы команд If, while, for, foreach и eval. И весь файл с исходным текстом
программы, и строка, переданная eval, также образуют лексические области дей-
ствия1; их можно рассматривать как блоки, заключенные в невидимые фигурные
скобки. Поскольку лексическая область действия обычно является блоком, за-
ключенным в фигурные скобки, иногда мы говорим, что лексические переменные
(переменные с лексической областью действия) видны только в своем блоке —
на самом деле имеется в виду, что они видны только в границах своей области
действия.
Поскольку фрагменты программы, в которых видна переменная ту, опреде-
ляются во время компиляции и не изменяются позднее, лексическая область
действия иногда не совсем точно называется «статической областью действия».
Ее противоположностью является динамическая область действия, рассмотрен-
ная в рецепте 10.13.
Объявление ту может сочетаться с присваиванием. При определении сразу
нескольких переменных используются круглые скобки:
my ($name, $age) = ©ARGV:
ту $start = fetch_time();
Эти лексические переменные ведут себя как обычные локальные перемен-
ные. Вложенный блок видит лексические переменные, объявленные в родитель-
ских по отношению к нему блоках, но не в других, не связанных с ними блоках:
my ($а. $b) = @pair;
ту $с = fetch_t1meО:
sub check_x {
ту $х =
ту $у = "whatever":
run_check();
if (Scondition) {
print "got $x\n";
}
}
В приведенном выше фрагменте блок i f внутри функции может обращать-
ся к закрытой переменной $х. Однако в функции run_check, вызванной из этой
1 Хотя и не равноценные — область действия eval является вложенной (по аналогии с вло-
женными блоками), тогда как файловая область действия не связана ни с какой другой
областью.
412
Глава 10. Процедуры
области, переменные $х и $у недоступны, потому что она предположительно оп-
ределяется в другой области действия. Однако check_x может обращаться к $а,
$Ь и $с из внешней области, поскольку определяется в одной области действия
с этими переменными.
Именованные процедуры не следует объявлять внутри объявлений других
именованных процедур, поскольку при этом нарушается привязка лексических
переменных. В рецепте 10.16 показано, как справиться с этим ограничением.
При выходе лексической переменной за пределы области действия занимае-
мая ею память освобождается, если на нее не существует ссылок, как для масси-
ва ^arguments в следующем фрагменте:
sub save_array {
my ^arguments =
push(our @Global_Агтау, \@arguments):
}
При каждом вызове save_array создается новый массив, поэтому вам не при-
дется беспокоиться о том, что существующее содержимое массива будет испор-
чено при очередном вызове.
Система сборки мусора Perl знает о том, что память следует освобождать
лишь для неиспользуемых объектов. Это и позволяет избежать утечки памяти
при возвращении ссылки на закрытую переменную.
См. также
Раздел «Private Variables via my()» perlsub(\.).
10.3. Создание устойчивых
закрытых переменных
Проблема
Вы хотите, чтобы переменная сохраняла значение между вызовами процедуры,
но не была доступна за ее пределами. Например, функция может запоминать,
сколько раз она была вызвана.
Решение
«Заверните» функцию во внешний блок и объявите переменные ту в области
действия этого блока, а не в самой функции:
{
my Svarlable:
sub mysub {
# ... обращение к Svarlable
}
}
10.3. Создание устойчивых закрытых переменных
413
Если переменные требуют инициализации, снабдите блок ключевым словом
IN IT, чтобы значение переменных заведомо задавалось перед началом работы
основной программы:
INIT {
my $var1able =1: # Начальное значение
sub othersub {
# ... обращение к $variable
}
}
Комментарий
В отличие от локальных1 переменных в языках С и C++, лексические перемен-
ные Perl не всегда уничтожаются при выходе из области действия. Если нечто,
продолжающее существовать, все еще помнит о лексической переменной, память
не освобождается. В нашем примере mysub использует переменную Svariable,
поэтому Perl не освобождает память переменной при завершении блока, вмещаю-
щего определение mysub.
Счетчик вызовов реализуется следующим образом:
{
my $counter;
sub next_counter { return ++$counter }
}
При каждом вызове next_counter функция увеличивает и возвращает пере-
менную $counter. При первом вызове переменная ^counter имеет неопределенное
значение, поэтому для оператора ++ она интерпретируется как 0. Переменная
входит не в область действия next_counter, а в окружающий ее блок. Никакой
внешний код не сможет изменить $counter без вызова next_counter.
Для расширения области действия обычно следует использовать ключевое
слово IN IT. В противном случае возможен вызов функции до инициализации пе-
ременной.
INIT {
my $counter = 42;
sub next_counter { return ++$counter }
sub prev_counter { return --Scounter }
}
Таким образом в Perl создается аналог статических переменных языка С.
В действительности он даже лучше — переменная не ограничивается одной функ-
цией, и обе функции могут совместно использовать свою закрытую переменную.
См. также
Раздел «Private Variables via my()» perlsub(\y раздел «Package Constructors and
Destructors» perlmod(\.y рецепт 11.4.
1 А точнее — автоматических переменных (auto).
414
Глава 10. Процедуры
10.4. Определение имени текущей функции
Проблема
Требуется определить имя функции, работающей в настоящий момент. Оно
пригодится для сообщений об ошибках, которые бы не изменялись при копиро-
вании/вставке исходного текста процедуры.
Решение
Воспользуйтесь функцией caller:
Sth1s_function = (caller(O))E3];
Комментарий
Программа всегда может определить текущей номер строки с помощью специ-
альной метапеременной__LINE__. Текущий файл определяется с помощью ме-
тапеременной ________________FILE_, а текущий пакет —_PACKAGE_. Однако не существует
метапеременной для определения имени текущей процедуры, не говоря уже об
имени той, из которой она была вызвана.
Встроенная функция caller справляется со всеми затруднениями. В ска-
лярном контексте она возвращает имя пакета вызывающей функции, а в спи-
сковом контексте возвращается список с разнообразными сведениями. Функции
также можно передать число, определяющее уровень вложенности получае-
мой информации: 0 — ваша функция, 1 — функция, из которой она была вы-
звана, и т. д.
Полный синтаксис выглядит следующим образом ($1 — количество уровней
вложенности):
(Spackage, Sfilename, SHne, Ssubr, $has_args, Swantarray
# 0 1 2 3 4 5
Sevaltext, $1s_requ1re, Shlnts, Sbltmask
# 6 7 8 9
)= caller(SI):
Возвращаемые значения имеют следующий смысл:
О Spackage — пакет, в котором был откомпилирован код;
О Sfilename — имя файла, в котором был откомпилирован код. Значение -е воз-
вращается при запуске из командной строки, а значение - (дефис) — при
чтении сценария из стандартного ввода;
О Sline — номер строки, из которой был вызван данный кадр стека;
О Ssubr — имя функции данного кадра, включающее ее пакет. Для замыканий
возвращаются имена вида main::_ANON_, вызов по ним невозможен. Для eval
возвращается "(eval)";
О Shas_args — признак наличия аргументов при вызове функции;
10.5. Передача массивов и хэшей по ссылке
415
О Swantarray — значение, возвращаемое функцией wantarray для данного кадра
стека. Равно либо true, либо false (ложное, но определенное), либо undef.
Сообщает, что функция была вызвана в списковом, скалярном или неопреде-
ленном контексте;
О Sevaltext — текст текущей строки eval (если она есть);
О $is_require — признак загрузки кода директивой do, require или use;
О Shints, Sbitmask — внутренняя информация, используемая только самим Perl.
Вместо непосредственного вызова caller, продемонстрированного в решении,
можно написать вспомогательные функции:
$me = whoami О;
Shim = whowasi();
sub whoami { (cal 1 er(1))[3] }
sub whowasi { (cal 1 er(2))[3] }
Аргументы 1 и 2 используются для функций первого и второго уровня вло-
женности, поскольку вызов whoami или whowasi будет иметь нулевой уровень.
См. также
Описание функций wantarray и caller в perlfunc(l); рецепт 10.6.
10.5. Передача массивов и хэшей по ссылке
Проблема
Требуется передать функции несколько массивов или хэшей и сохранить их как
отдельные сущности. Например, вы хотите выделить алгоритм поиска элемен-
тов одного массива, отсутствующих в другом массиве из рецепта 4.8, в отдель-
ную процедуру. При вызове процедура должна получать два массива, которые
не должны смешиваться.
Решение
Передавайте массивы и хэши по ссылке при помощи оператора \:
array_diff( \@arrayl, \@array2 );
Комментарий
Операции со ссылками рассматриваются в главе И «Ссылки и записи». Ниже
показана процедура, получающая ссылки на массивы, и вызов, в котором эти
ссылки генерируются:
@а = (1. 2):
@Ь = (5. 8):
@с = add_vecpair( \@а, \@Ь );
print "@с\п";
6 10
416
Глава 10. Процедуры
sub addj/ecpalr { # Предполагается, что оба вектора
# имеют одинаковую длину
ту ($х. $у) = # Скопировать ссылки на массивы
my ^result:
for (ту $1=0; $1 < @$х; $1++) {
$resultE$1] = $х->Е$1] + $у->Е$1]:
}
return ©result;
}
Функция обладает одним потенциальным недостатком: она не проверяет коли-
чество и типы аргументов. Проверку можно организовать следующим образом:
unless (@_ == 2 && ref($x) eq 'ARRAY' && ref($y) eq 'ARRAY') {
die "usage: add_vecpa1r ARRAYREF1 ARRAYREF2":
}
Если вы собираетесь ограничиться вызовом die в случае ошибки (см. ре-
цепт 10.12), проверка обычно пропускается, поскольку при попытке разымено-
вания недопустимой ссылки все равно происходит исключение. Тем не менее по
правилам хорошего стиля программирования желательно проверять аргументы
во всех функциях.
См. также
Раздел «Pass by Reference» perlsub(X)\ раздел «Prototypes» pertsub(iy, рецепт 10.11;
глава И.
10.6. Определение контекста вызова
Проблема
Требуется узнать, была ли ваша функция вызвана в скалярном или списковом
контексте. Это позволяет решать разные задачи в разных контекстах, как это де-
лается в большинстве встроенных функций Perl.
Решение
Воспользуйтесь функцией wantarrayO, которая возвращает три разных значения
в зависимости от контекста вызова текущей функции:
If (wantarrayO) {
# Списковый контекст
}
elslf (defined wantarrayO) {
# Скалярный контекст
else {
# Неопределенный контекст
10.7. Передача именованных параметров
417
Комментарий
Многие встроенные функции, вызванные в скалярном контексте, работают совсем
не так, как в списковом контексте. Пользовательская функция может узнать
контекст своего вызова с помощью значения, возвращаемого встроенной функци-
ей wantarray. Для спискового контекста wantarray возвращает true. Если возвра-
щается ложное, но определенное значение, функция используется в скалярном
контексте. Если возвращается undef, от функции вообще не требуется возвра-
щаемого значения.
if (wantarrayO) {
print "In list context\n";
return @many_things:
} elsif (defined wantarrayO) {
print "In scalar context\n":
return $one_thing;
} else {
print "In void context\n";
return: # Ничего
mysub():
$а = mysubO:
if (mysubO) { }
@а = mysubO:
print mysub():
# Неопределенный контекст
# Скалярный контекст
# Скалярный контекст
# Списковый контекст
# Списковый контекст
См. также
Описание функций return и wantarray в perlfunc(V).
10.7. Передача именованных параметров
Проблема
Требуется упростить вызов функции с несколькими параметрами, чтобы про-
граммист помнил смысл параметров, а не порядок их следования.
Решение
Укажите имена параметров при вызове:
thefunc(INCREMENT => "20s". START => "+5m", FINISH => "+30m"):
thefunc(START => "+5m". FINISH => "+30m");
thefunc(FINISH => "+30m");
thefunc(START => "+5m". INCREMENT => "15s"):
418
Глава 10. Процедуры
Затем в процедуре создайте хэш, содержащий значения по умолчанию и мас-
сив именованных пар:
sub thefunc {
my £args = (
INCREMENT => '10s'.
FINISH => 0,
START => 0.
# Список пар аргументов
);
If ($args{INCREMENT} =~ /m$/ ){...}
}
Комментарий
Функции, аргументы которых должны следовать в определенном порядке, удоб-
ны для небольших списков аргументов. Но с ростом количества аргументов ста-
новится труднее делать некоторые из них необязательными или присваивать им
значения по умолчанию. Пропускать можно только аргументы, находящиеся в
конце списка, и никогда — в начале.
Существует более гибкое решение — передача пар значений. Первый элемент
пары определяет имя аргумента, а второй — значение. Программа автоматически до-
кументируется, поскольку смысл параметра можно понять, не читая полное опреде-
ление функции. Более того, программистам, использующим такую функцию, не при-
дется запоминать порядок аргументов, и они смогут пропускать любые аргументы.
Решение построено на объявлении в функции закрытого хэша, хранящего зна-
чения параметров по умолчанию. В конец хэша заносится массив текущих аргумен-
тов — значения по умолчанию заменяются фактическими значениями аргументов.
В распространенном варианте такого решения имена параметров начинаются
с дефиса по аналогии с параметрами командной строки:
thefunc(-START => "+5т". -INCREMENT => ”15s”);
Вообще говоря, в Perl дефис не является частью минимального слова, но мо-
дуль лексического разбора Perl делает исключение для оператора =>, что делает
возможным такой стиль передачи аргументов функции.
См. также
Глава 4 «Массивы».
10.8. Пропуск некоторых возвращаемых
значений
Проблема
Имеется функция, которая возвращает много значений, однако вас интересуют
лишь некоторые из них. Классический пример — функция stat; как правило,
требуется лишь одно значение из длинного возвращаемого списка (например,
режим доступа).
10.9. Возврат нескольких массивов или хэшей
419
Решение
Присвойте результат вызова списку, некоторые позиции которого равны undef:
(Sa, undef, Sc) = funcO;
либо создайте срез списка возвращаемых значений и отберите лишь то, что вас
интересует:
(Sa, Sc) = (func())[0.2]:
Комментарий
Применять фиктивные временные переменные слишком расточительно:
(Sdev.Sino.SDUMMY.SDUMMY.Suid) = stat(Sfilename);
Чтобы отбросить ненужное значение, достаточно заменить фиктивные пере-
менные на undef:
(Sdev.Sino,undef.undef,Suid) = stat(Sfilename);
Также можно создать срез и включить в него лишь интересующие вас значения:
(Sdev,$1 no,Suid.Sgid) = (stat($fi1 ename))ГО.1.4.5];
Если вы хотите перевести результат вызова функции в списковый контекст
и отбросить все возвращаемые значения (вызывая его ради побочных эффектов),
его можно присвоить пустому списку:
О = some_function():
Последнее решение напоминает списковый аналог оператора scalar — функ-
ция принудительно вызывается в списковом контексте даже там, где этого быть
не должно. Таким образом можно получить количество возвращаемых значений:
Scount = О = some_function();
Или другой пример — мы вызываем функцию в списковом контексте и убеж-
даемся в том, что количество возвращаемых значений отлично от нуля (и немед-
ленно отбрасываем его):
if (О = some_function())
Без присваивания пустому списку логический контекст вызова i f привел бы
к вызову функции в скалярном контексте.
См. также
Perlsub(]y, рецепт 3.1.
10.9. Возврат нескольких массивов или хэшей
Проблема
Необходимо, чтобы функция возвратила несколько массивов или хэшей, однако
возвращаемые значения сглаживаются в один длинный список скалярных величин.
420
Глава 10. Процедуры
Решение
Возвращайте ссылки на хэши или массивы:
($array_ref. $hash_ref) = somefuncO;
sub somefunc {
my @array;
my £hash;
# ...
return ( \@array. \£hash );
}
Комментарий
Как говорилось выше, все аргументы функции сливаются в общий список скаляр-
ных величин. То же самое происходит и с возвращаемыми значениями. Функция,
возвращающая отдельные массивы или хэши, должна возвращать их по ссылке,
и вызывающая сторона должна быть готова к получению ссылок. Например,
возврат трех отдельных хэшей может выглядеть так:
sub fn {
return (\%а. \%b. Uc); # или
return Ша. W. £c): # то же самое
}
Вызывающая сторона должна помнить о том, что функция возвращает спи-
сок ссылок на хэши. Она не может просто присвоить его списку из трех хэшей.
ahO.Uil.Sh2) = fn(); # НЕВЕРНО!
@array_of_hashes = fn(); # например: $array_of_hashesE2]->{"keystring"}
($r0. $rl, $r2) = fn(); # например: $r2->{"keystring"}
См. также
Общие сведения о ссылках в главе И; рецепт 10.5.
10.10. Возвращение признака
неудачного вызова
Проблема
Функция должна возвращать значение, свидетельствующее о неудачной попыт-
ке вызова.
Решение
Воспользуйтесь командой return без аргументов, которая в скалярном контексте
возвращает undef, а в списковом — пустой список О:
return:
10.11. Прототипы функций
421
Комментарий
Команда return без аргументов означает следующее:
sub empty_retval {
return ( wantarray ? О : undef );
}
Ограничиться простым return undef нельзя, поскольку в списковом контексте
вы получите список из одного элемента: undef. Если функция вызывается в виде:
If (@а = yourfuncO) { ... }
то признак ошибки будет равен true, поскольку @а присваивается список (undef),
интерпретируемый в скалярном контексте. Результат будет равен 1 (количество
элементов в @а), то есть истинному значению. Контекст вызова можно опреде-
лить с помощью функции wantarray, однако return без аргументов обеспечивает
более наглядное и изящное решение, которое работает в любых ситуациях:
unless ($а = sfuncO) { die "sfunc failed" }
unless (@a = afuncO) { die "afunc failed" }
unless (£a = hfuncO) { die "hfunc failed" }
Некоторые встроенные функции Perl иногда возвращают довольно стран-
ные значения. Например, fcntl и loctl в некоторых ситуациях возвращают стро-
ку "О but true" (для удобства эта волшебная строка была изъята из бесчисленных
предупреждений об ошибках преобразования флага -w). Появляется возмож-
ность использовать конструкции следующего вида:
ioctl(....) or die "can't loctl: $!":
В этом случае программе не нужно отличать определенный ноль от неопреде-
ленного значения, как пришлось бы делать для функций read или glob. В числовой
интерпретации "О but true" является нулем. Впрочем, необходимость в возвра-
щении подобных значений возникает довольно редко. Более распространенный
(и более заметный) способ сообщить о неудаче при вызове функции заключает-
ся в инициировании исключения (см. рецепт 10.12).
См. также
Описание функций undef, wantarray и return вperlfunc(\y, рецепт 10.12.
10.11. Прототипы функций
Проблема
Вы хотите использовать прототипы функций, чтобы компилятор мог проверить
типы аргументов.
Решение
В Perl существует нечто похожее на прототипы, но это сильно отличается от прото-
типов в традиционном понимании. Прототипы функций Perl больше напоминают
422
Глава 10. Процедуры
принудительный контекст, используемый при написании функций, которые ведут
себя аналогично некоторым встроенным функциям Perl (например, push и pop).
Комментарий
Фактическая проверка аргументов функции становится возможной лишь во
время выполнения программы. Если объявить функцию до ее реализации,
компилятор сможет использовать очень ограниченную форму прототипизации.
Не путайте прототипы Perl с теми, что существуют в других языках, — в Perl
прототипы предназначены лишь для эмуляции поведения встроенных функций.
Прототип функции Perl представляет собой нуль и более пробелов, обратных
косых черт или символов типа, заключенных в круглые скобки после определе-
ния или имени процедуры. Символ типа с префиксом \ означает, что аргумент
передается по ссылке и что аргумент в данной позиции должен начинаться с ука-
занного символа типа.
Прототип принудительно задает контекст аргументов, используемых при вызо-
ве данной функции. Это происходит во время компиляции программы и в боль-
шинстве случаев вовсе не означает, что Perl проверяет количество или тип аргу-
ментов функции. Если Perl встретит вызов func(3.5) для функции с прототипом
sub func($), он завершит компиляцию с ошибкой. Но если для того же прото-
типа встретится вызов func(@array), компилятор всего лишь преобразует @аггау
в скалярный контекст; он не скажет, что массив передавать нельзя — здесь долж-
на быть скалярная величина.
Это настолько важно, что мы повторим снова: не пользуйтесь прототипами
Perl, если вы надеетесь, что компилятор будет проверять тип и количество аргу-
ментов. В отдельных ситуациях это тоже делается, но в основном прототипы
решают две задачи: они делают программу более компактной и упрощают эмуля-
цию вызова встроенных функций.
Пропуск скобок
Обычно функция получает список аргументов. Если компилятор уже встречал
объявление или определение этой функции, при вызове скобки ставить не обя-
зательно:
©results = reverse myfunc 3. 5:
Без прототипа такая запись эквивалентна следующей:
©results = reverse(myfunc(3, 5)):
При отсутствии скобок Perl преобразует правую часть вызова процедуры в спи-
сковый контекст. Прототип позволяет изменить такое поведение:
sub myfunc($):
©results = reverse myfunc 3. 5;
Теперь эта запись эквивалентна следующей:
©results = reverse(myfunc(3). 5):
10.11. Прототипы функций
423
Обратите внимание: скалярный прототип повлиял на процесс разбора про-
граммного кода! Теперь с функцией связывается только ближайшее значение,
а все остальное интерпретируется как аргументы другой функции.
Пустой прототип вида
sub myfuncO;
показывает, что функция вызывается без аргументов, как встроенная функ-
ция time.
Таким образом, без круглых скобок вы не знаете, что именно происходит в про-
грамме при ее беглом просмотре. Даже внешне одинаковые конструкции могут
работать совершенно по-разному. Рассмотрим следующие объявления и при-
сваивания:
sub fnOO:
sub fnl($):
sub fnN(@);
$x = fnO + 42;
$x = fnl + 42;
$y = fnN fnl + 42, fnO + 42;
$y = fnN fnO + 42. fnl + 42;
$z = fnl fnl + 42, fnl + 42;
$z = fnN fnN + 42. fnN + 42;
Как ни странно, компилятор Perl интерпретирует эти команды следующим
образом:
$х = fnOO + 42;
$х = fnl(42);
$у = fnN(fnl(42). fnOO + 42):
$у = fnNCfnOO + 42. fnl(42)) ;
$z = fnl(fnl(42)). fnl(42);
$z = fnN(fnN(42, fnN(42)));
Чтобы предсказать этот результат, необходимо внимательно проанализиро-
вать прототипы и основательно подумать над тем, как работает система лексиче-
ского разбора Perl. Сопровождение таких программ превращается в настоящий
кошмар.
Это веский довод в пользу применения круглых скобок, даже если они не яв-
ляются абсолютно необходимыми (или если взглянуть с другой стороны — про-
тив использования прототипов).
Имитация встроенных функций
Прототипы также часто применяются для имитации поведения таких встро-
енных функций, как push и shift, передающих аргументы без сглаживания.
При вызове push(@array, 1, 2, 3) функция получает ссылку на @аггау вместо
424
Глава 10. Процедуры
самого массива. Для этого в прототипе перед символом @ ставится обратная
косая черта:
sub mypush (\@@) {
my $array_ref = shift:
my (^remainder =
# ...
}
\@ в прототипе означает «потребовать, чтобы первый аргумент начинался с сим-
вола и передавать его по ссылке». Второй символ @ говорит о том, что ос-
тальные аргументы образуют список (возможно, пустой). Обратная косая черта
в прототипе несколько ограничивает ваши возможности. Например, вам даже
не удастся использовать условную конструкцию ?: для выбора передаваемого
массива:
mypush( $х > 10 ? : @b . 3. 5 ): # НЕВЕРНО
Вместо этого приходится изощряться со ссылками:
mypush( @{ $х > 10 ? \@а : \@Ь }. 3, 5 ): # ВЕРНО
Приведенная ниже функция hpush работает аналогично push, но для хэшей.
Функция дописывает в существующий хэш список пар «ключ/значение», пере-
определяя прежнее содержимое этих ключей.
sub hpush(\£@) {
my $href = shift:
while ( my ($k. $v) = splice(@_, 0. 2) ) {
$href->{$k] = $v:
}
}
hpushC^pieces. "queen" => 9. "rook" => 5):
Чтобы символ \ относился сразу к нескольким аргументам, воспользуйтесь
синтаксисом \[]:
sub mytie ( \[$@U*] $: @ )
Функция принимает любой из пяти типов по ссылке, затем следует один обя-
зательный аргумент в скалярном контексте и необязательный завершающий
список оставшихся аргументов.
Для получения прототипа конкретной функции применяется встроенная
функция prototype. Например, вызов prototype("hpush") для предыдущего опре-
деления вернет строку " W. Таким способом даже можно получать прототипы
встроенных функций — если, конечно, они есть. А поскольку основные встро-
енные функции вроде int всегда можно вызвать в виде CORE::int, можно пред-
положить, что для встроенных функций эта информация хранится где-то в па-
кете CORE. Пример:
for $func (qw/int reverse keys push open print/) {
printf "Prototype for £s is £s\n", $func,
protOtypeC'CORE::$func") || "UNAVAILABLE";
}
10.12. Обработка исключений
425
Prototype for int is ;$
Prototype for reverse is @
Prototype for keys is U
Prototype for push is \@@
Prototype for open is
Prototype for print is UNAVAILABLE
См. также
Описание функции prototype в perlfunc(Y)\ perlsub(l)] рецепт 10.5.
10.12. Обработка исключений
Проблема
Как организовать безопасный вызов функции, способной инициировать исклю-
чение? Как создать функцию, инициирующую исключение?
Решение
Иногда в программе возникает что-то настолько серьезное, что простого воз-
вращения признака ошибки оказывается недостаточно, поскольку он может
быть проигнорирован вызывающей стороной. Включите в функцию конструк-
цию die СТРОКА, чтобы инициировать исключение:
die "some message": # Инициировать исключение
Чтобы перехватить исключение, вызывающая сторона вызывает функцию
в блоке eval, после чего узнает результат с помощью специальной переменной $@:
eval { funcO };
If ($@) {
warn "func raised an exception: $@":
}
Комментарий
Инициирование исключения — крайняя мера, и относиться к ней следует серь-
езно. В большинстве функций следует возвращать признак ошибки с помо-
щью простого оператора return. Перехватывать исключения при каждом вызове
функции скучно и некрасиво, и это может отпугнуть от применения исклю-
чений.
Но в некоторых ситуациях неудачный вызов функции должен приводить
к аварийному завершению программы. Вместо невосстановимой функции exit
следует вызвать die — по крайней мере, у программиста появится возможность
вмешаться в происходящее. Если ни один обработчик исключения не был уста-
новлен с помощью eval, на этом месте программа аварийно завершается.
426
Глава 10. Процедуры
Чтобы обнаружить подобные нарушения, можно поместить вызов функции
в блок eval. Если произойдет исключение, оно будет присвоено переменной $@;
в противном случае переменная равна false.
eval { $val = funcO }:
warn "func blew up: $@" If $@;
Блок eval перехватывает все исключения, а не только те, что интересуют вас.
Непредусмотренные исключения обычно следует передать внешнему обработчику.
Предположим, функция инициирует исключение, описываемое строкой "Full
moon!". Можно спокойно перехватить это исключение и дать другим обработчи-
кам просмотреть переменную $@. При вызове die без аргументов новая строка
исключения конструируется на основании содержимого $@ и текущего контекста.
eval { $val = funcO }:
If ($@ && $@ !~ /Full moon!/) {
die: # Повторно инициировать неизвестные ошибки
}
Если функция является частью модуля, можно использовать модуль Carp и вы-
звать croak или confess вместо die. Единственное отличие die от croak заключает-
ся в том, что croak представляет ошибку с позиции вызывающей стороны, а не
модуля. Функция confess по содержимому стека определяет, кто кого вызвал
и с какими аргументами.
Другая интересная возможность заключается в том, чтобы функция могла уз-
нать о полном игнорировании возвращаемого ею значения (то есть о том, что
она вызывается в неопределенном контексте). В этом случае возвращение кода
ошибки бесполезно, поэтому вместо него следует инициировать исключение.
If (defined wantarrayO) {
return:
} else {
die "pay attention to my error!":
}
Конечно, вызов функции в другом контексте еще не означает, что возвращае-
мое значение будет должным образом обработано. Впрочем, в неопределенном
контексте оно заведомо не проверяется;
Некоторые модули CPAN обеспечивают альтернативные средства обработки
исключений. Например, модуль Error вместо eval и die предлагает классическую
конструкцию try, catch и throw:
use Error ':try';
try {
somethlng( );
}
catch Error:database with {
my $e = shift:
warn "Problem in " . $e->{'-database'} . " (caught)\n":
};
Модуль Error обеспечивает самые широкие средства обработки исключений в
виде блоков try, catch... with, except, otherwise и finally. Модуль CPAN Exception:: Cl ass
10.13. Сохранение глобальных значений
427
позволяет создавать классы исключений и объекты, представляющие конкрет-
ные исключения. Эти два модуля можно использовать вместе и перехватывать
исключения при помощи catch.
См. также
Описание переменной $@ ($EVAL_ERROR) в perlvar(V)\ описание функций die и eval
в perlfunc(V)\ документация по модулям CPAN, Error и Exception:: Cl ass; рецеп-
ты 10.15, 12.2 и 16.21.
10.13. Сохранение глобальных значений
Проблема
Требуется временно сохранить значение глобальной переменной.
Решение
Воспользуйтесь оператором local, чтобы сохранить старое глобальное значение
и автоматически восстановить его при выходе из текущего блока:
$аде = 18; # Объявление и присваивание глобальной переменной
If (CONDITION) {
local $аде = 23;
funcO; # Видит временное значение 23
} # Восстановить старое значение при выходе из блока
Комментарий
Несмотря на свое название оператор Perl local не создает локальной перемен-
ной — это делается оператором ту. Вместо этого local всего лишь сохраняет
существующее значение на время выполнения блока, в котором он находится.
Вероятно, local стоило назвать save_value, это предотвратило бы множество не-
доразумений.
Однако в трех ситуациях вы должны использовать local вместо ту:
1. Глобальной переменной (особенно $_) присваивается временное значение.
2. Создается локальный манипулятор файла или каталога или локальная функция.
3. Вы хотите временно изменить один элемент массива или хэша.
Применение 1оса1() для присваивания временных
значений глобальным переменным
Первая ситуация чаще встречается для стандартных, нежели пользовательских
переменных. Нередко эти переменные используются Perl для передачи допол-
нительной информации в высокоуровневых операциях. В частности, любая функ-
ция, явно или косвенно использующая $_, должна иметь локальную копию $_.
Об этом часто забывают. Одно из возможных решений приведено в рецепте 13.15.
428
Глава 10. Процедуры
В следующем примере используется несколько глобальных переменных. Пере-
менная $/ косвенно влияет на поведение оператора чтения строк, используемого
в операциях <FH>.
Spara = get_paragraph(*FH); # Передать glob файлового манипулятора
$para = get_paragraph(*FH); # Передать манипулятор по ссылке на glob
$para = get_paragraph(*IO{FH}); # Передать манипулятор по ссылке на 10
sub get_paragraph {
my Sfh = shift;
local $/ = '';
my Sparagraph = <$fh>;
chomp(Sparagraph);
return Sparagraph;
}
Применение local() для создания локальных
манипуляторов
Вторая ситуация возникает в случае, когда требуется локальный манипулятор
файла или каталога, реже — локальная функция.
Scontents = get_motd();
sub getjnotd {
local *MOTD;
open(M0TD, "/etc/motd") or die "can’t open motd: $!";
local $/ = undef; # Читать весь файл
local $_ = <MOTD>:
close (MOTD);
return $_;
}
Открытый файловый манипулятор возвращается следующим образом:
return *MOTD;
Впрочем, в современных версиях Perl следует использовать механизм авто-
матического оживления файловых манипуляторов:
Scontents = getjnotdO;
sub getjnotd {
my Smotd; # Значение присваивается в следующей строке
open($motd, "/etc/motd") or die "can't open motd: $!";
local $/ = undef: # Читать весь файл
return scalar <$motd>:
}
Применение localQ в массивах и хэшах
Третья ситуация на практике встречается крайне редко, если не считать одного
распространенного случая. Поскольку оператор local в действительности явля-
ется оператором «сохранения значения», им можно воспользоваться для сохра-
нения одного элемента массива или хэша, даже если сам массив или хэш явля-
ется лексическим!
my @nums = (0 .. 5):
sub first {
local $nums[3] = 3.14159:
secondO;
10.13. Сохранение глобальных значений
429
}
sub second {
print "@nums\n";
}
secondO;
012345
flrstO;
0 1 2 3.14159 4 5
Единственное стандартное применение — временные обработчики сигналов.
sub first {
local $SIG{INT} = ’IGNORE’;
second();
}
Теперь во время работы secondO сигналы прерывания будут игнорироваться.
После выхода из first О автоматически восстанавливается предыдущее значе-
ние $SIG{INT}.
Хотя local часто встречается в старом коде, от него следует держаться по-
дальше, если только это возможно. Поскольку local манипулирует значениями
глобальных, а не локальных переменных, возможен конфликт с директивой use
strict, если только глобальные переменные не были объявлены при помощи our
или более старой конструкции use vars.
Оператор local создает динамическую область действия. Она отличается от
другой области действия, поддерживаемой Perl и значительно более понятной
на интуитивном уровне. Речь идет об области действия ту — лексической области
действия, иногда называемой «статической».
В динамической области действия переменная доступна в том случае, если
она находится в текущей области действия или в области действия всех кадров
(блоков) стека, определяемых во время выполнения. Все вызываемые функции
обладают полным доступом к динамическим переменным, поскольку последние
остаются глобальными, но получают временные значения. Лишь лексические
переменные защищены от вмешательства извне.
Старый фрагмент вида:
sub func {
local($х, $у) =
#....
}
почти всегда удается заменить без нежелательных последствий следующим фраг-
ментом:
sub func {
my($x, $у) =
#....
}
Единственный случай, когда подобная замена невозможна — если от динами-
ческой области действия зависит нормальная работа программы. Это происхо-
дит в ситуации, когда одна функция вызывает другую, и работа второй зависит
430
Глава 10. Процедуры
от доступа к временным версиям глобальных переменных $х и $у первой функ-
ции. Код, который работает с глобальными переменными и вместо нормальной
передачи параметров издалека вытворяет нечто странное, в лучшем случае ненаде-
жен. Хорошие программисты избегают подобных выкрутасов как чумы. (В таких
случаях лучше явно передавать данные в параметрах вместо того, чтобы хранить
их в общих глобальных переменных).
Если вам встретится старый код вида:
&func(*Global_Array):
sub func {
local(*a!1ased_array) = shift:
for (@a!1ased_array) { .... }
}
вероятно, его удастся преобразовать к следующей форме:
func(\@Global_Array):
sub func {
my $array_ref = shift;
for (@$array_ref) { .... }
До появления в Perl нормальной поддержки ссылок использовалась старая
стратегия передачи тип-глобов. Сейчас это уже дело прошлое.
См. также
Описание функций local, my и our в perlfunc(l); разделы «Private Variables via
my()» и «Temporary Values via local()» в perlsub(iy рецепт 10.2; рецепт 10.16.
10.14. Переопределение функции
Проблема
Требуется временно или постоянно переопределить функцию, однако функци-
ям нельзя «присвоить» новый код.
Решение
Чтобы переопределить функцию, присвойте ссылку на новый код тип-глобу
имени функции. Используйте local для временной замены.
undef &grow: # Заглушить жалобы -w на переопределение
*grow = \&expand;
growO: # Вызвать expandO
{
local *grow = \&shr1nk: # Только в границах блока
grow(); # Вызывает shrlnkO
10.14. Переопределение функции
431
Комментарий
В отличие от переменных (но по аналогии с файловыми манипуляторами, ма-
нипуляторами каталогов и форматами), функции нельзя напрямую присвоить
нужное значение. Это всего лишь имя, и оно не изменяется. Однако с функция-
ми можно выполнять многие операции, выполняемые с переменными, посколь-
ку вы можете напрямую работать с таблицей символов с помощью тип-глобов
вида *foo и добиваться многих интересных эффектов.
Если присвоить тип-глобу ссылку, то при следующем обращении к символу
данного типа будет использовано новое значение. Именно это делает модуль
Exporter при импортировании функции или переменной из одного пакета в дру-
гой. Поскольку операции выполняются непосредственно с таблицей символов
пакета, они работают только для пакетных (глобальных) переменных, но не для
лексических.
*one:;var = \Hwo::Tablе; # ta: :var становится синонимом для Hwo: -.Table
*one;;b1g = \&two:;smal1; # &one;:b1g становится синонимом для &two::small
С тип-глобом можно использовать local, но не ту. Если использовать local,
синоним будет действовать только в границах текущего блока.
local *fred = \&barney; # временно связать &fred с &barney
Если значение, присваиваемое тип-глобу, представляет собой не ссылку, а дру-
гой тип-глоб, то замена распространяется на все типы с данным именем. Полное
присваивание тип-глоба относится к скалярным величинам, массивам, хэшам,
функциям, файловым манипуляторам, манипуляторам каталогов и форматам.
Следовательно, присваивание *Тор = ^Bottom делает переменную $Тор текущего
пакета синонимом для $Bottom, @Тор — для ^Bottom, Пор — для ^Bottom, и &Тор —
для &Bottom. Замена распространяется даже на соответствующие манипуляторы
файлов и каталогов и форматы! Впрочем, скорее всего, это окажется лишним.
Присваивание тип-глобов в сочетании с замыканиями (closures) позволяет
легко и удобно дублировать функции. Представьте, что вам понадобилась функ-
ция для генерации HTML-кода, работающего с цветами. Например:
Sstring = red("careful here"):
print Sstring;
<FONT COLOR=,red,>careful here</FONT>
Функция red выглядит так:
sub red { "<FONT COLORSred’>@_</FONT>" }
Если потребуются другие цвета, пишется нечто подобное:
sub color_font {
my Scolor = shift;
return "<FONT COLOR='Scolor'>@_</FONT>";
}
sub red { color_font("red". @_) }
sub green { color_font("green", @_) }
sub blue { color_font("blue", @_) }
sub purple { color_font("purple". @_) }
# И т. д.
432
Глава 10. Процедуры
Сходство функций наводит на мысль, что общую составляющую можно как-то выделить.
Для этого следует воспользоваться косвенным присваиванием тип-глобу. Если вы используете
рекомендуемую директиву use strict, сначала отключите strict 'refs' для этого блока.
^colors = qw(red blue green yellow orange purple violet):
for my $name (^colors) {
no strict 'refs':
*$name = sub { "<FONT COLORSSname’>@_</FONT>" }:
}
Функции кажутся независимыми, однако фактически код был откомпилиро-
ван лишь один раз. Подобная методика экономит время компиляции и память.
Для создания полноценного замыкания все переменные анонимной процедуры
должны быть лексическими. Именно поэтому переменная цикла объявляется
с ключевым словом ту.
Перед вами одна из немногочисленных ситуаций, в которых создание прото-
типа для замыкания оправданно. Если вам захочется форсировать скалярный
контекст для аргументов этих функций (вероятно, это не лучшая идея), ее можно
записать в следующем виде:
*$name = sub ($) { "<FONT COLOR='Sname’>$_[OJ</FONT>" };
Однако прототип проверяется во время компиляции, поэтому приведенное
выше присваивание произойдет слишком поздно и никакой пользы не принесет.
Следовательно, весь цикл с присваиваниями следует включить в BEGIN-блок,
чтобы форсировать его выполнение при компиляции. На этот раз следует ис-
пользовать именно BEGIN, а не INIT, поскольку то, что вы делаете, должно быть
сразу замечено компилятором, а не интерпретатором непосредственно перед за-
пуском программы.
См. также
Раздел «Symbol tables» perlmod(l); описание замыканий в perlref(l); рецеп-
ты 10.11 и 11.4.
10.15. Перехват вызовов неопределенных
функций с помощью AUTOLOAD
Проблема
Требуется перехватить вызовы неопределенных функций и достойно обрабо-
тать их.
Решение
Объявите функцию с именем AUTOLOAD для пакета, вызовы неопределенных функ-
ций которого вы собираетесь перехватывать. Во время ее выполнения перемен-
ная SAUTOLOAD этого пакета содержит имя вызванной неопределенной функции.
10.16. Вложенные процедуры
433
Комментарий
В подобных ситуациях также часто применяются вспомогательные функции
(proxy). При вызове неопределенной функции вместо автоматического иниции-
рования исключения также можно перехватить вызов. Если пакет, к которому
принадлежит вызываемая функция, содержит функцию с именем AUTOLOAD, то она
будет вызвана вместо неопределенной функции, а специальной глобальной пере-
менной пакета SAUTOLOAD будет присвоено полное имя функции. Далее функция
AUTOLOAD сможет сделать все, что должна была делать исходная функция.
sub AUTOLOAD {
use vars qw(SAUTOLOAD):
my $color = SAUTOLOAD:
Scolor =~ s/://:
return "<FONT COLOR=’Scolor'>@_</FONT>":
}
# Примечание: функция sub chartreuse не определена
print chartreuseCstuff");
При вызове несуществующей функции main::chartreuse вместо инициирования
исключения будет вызвана функция main::AUTOLOAD с аргументами, переданными
chartreuse. Пакетная переменная SAUTOLOAD будет содержать строку main::chartreuse.
Методика с присваиваниями тип-глобов из рецепта 10.14 быстрее и удобнее.
Быстрее — поскольку вам не приходится запускать копию и заниматься подста-
новками. Удобнее — поскольку вы сможете делать следующее:
{
local *yellow = \&violet:
local (*red, *green) = (\&green, \&red):
pr1nt_stuff():
}
При работе print_stuff или в любой вызванной ею функции все, что должно
выводиться желтым цветом, выводится фиолетовым; красный цвет заменяется
зеленым, и наоборот.
Однако подстановка функций не позволяет обрабатывать вызовы неопреде-
ленных функций. AUTOLOAD справляется с этой проблемой.
См. также
Раздел «Autoloading» perlsub(iy документация по стандартным модулям AutoLoader
и AutoSplit; рецепт 10.12; рецепт 12.11; рецепт 13.12.
10.16. Вложенные процедуры
Проблема
Требуется реализовать вложение процедур, чтобы одна процедура была видна
и могла вызываться только из другой. Если попытаться применить очевидный
вариант sub FOO { sub BAR { } ...}, Perl предупреждает о переменных, которые
«не останутся общими».
434
Глава 10. Процедуры
Решение
Вместо того чтобы оформлять внутренние функции в виде обычных процедур,
реализуйте их в виде замыканий и затем временно присвойте их тип-глобу пра-
вого имени, чтобы создать локальную функцию.
Комментарий
Вероятно, в других языках программирования вам приходилось работать с вло-
женными функциями, обладающими собственными закрытыми переменными.
В Perl для этого придется немного потрудиться. Интуитивная реализация
приводит к выдаче предупреждения. Например, следующий фрагмент не ра-
ботает:
sub outer {
my $х = $_[0J + 35;
sub Inner { return $x * 19 } # НЕВЕРНО
return $x + Inner();
}
Обходное решение выглядит так:
sub outer {
my $x = $_[0] + 35:
local *1nner = sub { return $x * 19 };
return $x + InnerO;
}
Теперь благодаря временно присвоенному замыканию InnerO может вызы-
ваться только из outer О. При вызове InnerO получает нормальный доступ к лек-
сической переменной $х из области действия outer О.
В сущности, мы создаем функцию, которая является локальной для другой
функции — подобная возможность не поддерживается в Perl напрямую. Впро-
чем, ее реализация не очевидна.
См. также
Раздел «Symbol tables» perlmod(i)\ описание замыканий в perlref(\y, рецепт 10.13;
рецепт 11.4.
10.17. Имитация команды switch
Проблема
Требуется написать многовариантную команду выбора, наподобие команды switch
в языке С или команды case в командном интерпретаторе — в базовом синтак-
сисе Perl ни одна из этих команд не поддерживается.
10.17. Имитация команды switch
435
Решение
Воспользуйтесь модулем Switch, ставшим стандартным начиная с версии 5.8:
use Switch:
switch ($value) {
}
case case 17 "snipe" { print { print "number 17" } "a snipe" }
case /[a-f!+/1 { print "pattern matched" }
case [1..10.42! { print "In the list" }
case (@array) { print "In the array" }
case else (%hash) { print { print "In the hash" } "no case applies" }
Комментарий
Модуль switch расширяет базовый синтаксис Perl и предоставляет в распоряже-
ние программиста гибкую, мощную конструкцию switch. Более того, эта конст-
рукция настолько гибкая и мощная, что вместо полного описания ее работы мы
рассмотрим несколько стандартных примеров ее использования. За полной ин-
формацией обращайтесь к документации, прилагаемой к модулю.
Команда switch получает аргумент и обязательный блок, который может со-
держать произвольное количество секций case. Каждая секция case тоже содер-
жит аргумент и обязательный блок. Аргументы секций case могут относиться
к разным типам, включая любые строковые или числовые величины, регуляр-
ные выражения, сравниваемые со значением switch (и это далеко не полный
список). Если в секции case указывается массив или хэш (или ссылка на них),
то секция case считается совпадающей, если значение switch совпадает с каким-
либо элементом массива или ключом хэша. Если case не совпадает, выполняется
завершающий блок el se.
В отличие от некоторых языков, при обнаружении совпадающей секции case
и выполнении ее блока управление передается из команды switch. Другими сло-
вами, в отличие от языка С, в Perl команда switch не обладает сквозным выпол-
нением секций case. Это следует отнести к ее достоинствам, потому что даже са-
мые опытные программисты иногда забывают о сквозном выполнении.
Наконец, при необходимости аналогичного эффекта можно добиться и в Perl.
Чтобы передать управление следующей секции case, включите в блок case ко-
манду next. Например:
straits = (pride => 2, sloth => 3, hope => 14):
switch (Straits) {
case "Impatience" { print "Hurry up!\n": next }
case ["laziness","sloth"! { print "Maybe tomorrow!\n": next }
case ["hubris","pride"! { print "Mine's best!\n": next }
case ["greed","cupidity"."avarice"! { print "More more more!": next }
}
Maybe tomorrow!
Mine's best!
436
Глава 10. Процедуры
Каждая секция case содержит next, поэтому команда не ограничивается пер-
вым найденным значением, а продолжает проверку остальных условий. Коман-
ду next также можно выполнять в зависимости от некоторого критерия, благода-
ря чему становится возможной условная сквозная передача управления.
Возможно, вы обратили внимание на интересную особенность этого примера:
аргумент switch не является скалярной величиной, это хэш straits. Оказывается,
switch может вызываться не только для скалярных аргументов. И case, и switch
принимают практически любые типы аргументов. Их поведение зависит от кон-
кретной комбинации типов. В приведенном примере строки из каждой секции
case интерпретируются как ключи хэша, указанного в switch.
Если вы предпочитаете, чтобы сквозное выполнение происходило по умолча-
нию, возможно и это:
}
use Switch 'fall through':
straits = (pride => 2, sloth => 3. hope => 14);
switch (Straits) {
case "Impatience" { print "Hurry up!\n"
case ["laziness"."sloth"] { print "Maybe tomorrow!\n
case ["hubris"."pride"] { print "Mine's best!\n"
case ["greed"."cupidity"."avarice"] { print "More more more!"
Впрочем, в некоторых ситуациях предпочтение все же следует отдать каскад-
ным конструкциям If, например, если при очередных проверках используются
разные критерии, и эти критерии сложнее простых сравнений строк или чисел,
а также проверок по шаблону. Пример:
If ($п % 2 == 0) { print "two " }
elslf ($n % 3 == 0) { print "three " }
elslf ($n % 5 == 0) { print "five " }
elslf ($n % 7 == 0) { print "seven " }
А если вы хотите, чтобы могли выполняться сразу несколько условий, воз-
можно и это:
If ($п % 2 == 0) { print "two " }
If ($n % 3 == 0) { print "three " }
If ($n % 5 == 0) { print "five " }
If ($n % 7 == 0) { print "seven " }
Команда switch способна решать такие задачи, но для этого вам придется дей-
ствовать более осторожно. Чтобы аргумент case был произвольным выражени-
ем, придется заключить это выражение в процедуру, которой при вызове переда-
ется аргумент основного блока switch. Если процедура возвращает true, значит,
условие case выполняется.
use Switch 'fall through':
$n = 30:
print "Factors of $n Include:
switch ($n) {
case sub{$_[0] % 2 == 0} { print "two " }
case sub{$_[0] % 3 == 0} { print "three " }
case sub{$_[0] % 5 == 0} { print "five " }
case sub{$_[0] % 7 == 0} { print "seven " }
10.17. Имитация команды switch
437
Такие конструкции крайне неудобно записывать (и читать тоже), но в выс-
шей степени хитроумный трюк позволяет избавиться и от этого недостатка.
Если импортировать процедуру____(да, все верно — два символа подчеркивания),
то вы сможете использовать ее в выражении секции case, и она будет представ-
лять значение основного аргумента switch. Пример:
use Switch qw(_______fall through ):
$n = 30;
print "Factors of $n include: ";
switch ($n) {
case ___ % 2 == 0 { print "two " }
case ___ % 3 == 0 { print "three " }
case ___ % 5 == 0 { print "five " }
case ___ % 7 == 0 { print "seven " }
}
print "\n";
Из-за особенностей реализации________ее использование подчиняется опреде-
ленным ограничениям, главное из которых — запрет на использование в ней
&& и 11.
Остается упомянуть о последнем фокусе, связанном с использованием switch.
На этот раз вместо передачи скалярной величины в аргументе switch и процедур
в секциях case мы пойдем другим путем. В основном аргументе switch можно
передать ссылку на процедуру; каждое значение case передается этой процеду-
ре, и если процедура возвращает true — switch считает, что совпадение найдено,
и выполняет соответствующий блок. В результате наш пример с множителями
принимает следующий вид:
use Switch qw(fall through);
$n = 30:
print "Factors of $n include: ":
switch (sub {$n % $_[0] == 0} ) {
case 2 { print "two " }
case 3 { print "three " }
case 5 { print "five " }
case 7 { print "seven " }
}
Вероятно, этот вариант следует признать самым эстетичным, потому что в нем
полностью отсутствует длинный повторяющийся код в каждой секции case.
ВНИМАНИЕ---------------------------------------------------------------------------
В модуле switch используются так называемые «фильтры источника» для эмуляции поведения, ко-
торое будет реализовано в Рег16 (в каком бы отдаленном будущем это ни произошло). Известно,
что в некоторых случаях это приводит к выдаче таинственных ошибок компиляции, поэтому очень
внимательно ознакомьтесь с разделом «Dependencies, Bugs, and Limitations» документации Switch.
См. также
Документация по модулю Switch; раздел «Basic BLOCKS and Switch Statements»
perlsyn(l).
438
Глава 10. Процедуры
10.18. Сортировка почты
Программа из примера 10.1 сортирует почтовый ящик по темам. Для этого она
читает сообщения по абзацам и ищет абзац, начинающийся с ’’From:". Когда та-
кой абзац будет найден, программа ищет тему, удаляет из нее все пометки ”Re:”,
преобразует в нижний регистр и сохраняет в массиве @sub. При этом сами сооб-
щения сохраняются в массиве @msgs. Переменная $msgno отслеживает номера со-
общений.
Пример 10.1. bysubl
#!/usr/Ы n/perl
# bysubl - простая сортировка по теме
my(@msgs, @sub);
my Smsgno = -Г.
$/=''; # Чтение по абзацам
while (<>) {
If (/'From/m) {
/'Subject:\s*(?:Re:\s*)*(.*)/m1;
$sub[++$msgnoj = lc($l) || ’’:
}
$msgs[$msgno] .=
}
for my $1 (sort { $sub[$aj cmp $sub[$bj || $a <=> $b } (0 .. $#msgs)) {
print $msgs[$1];
}
В этом варианте сортируются только индексы массивов. Если темы совпада-
ют, стр возвращает 0, поэтому используется вторая часть 11, в которой номера
сообщений сравниваются в порядке их исходного следования.
Если функции sort передается список (0,1,2,3), после сортировки будет по-
лучена некоторая перестановка, например (2,1,3,0). Мы перебираем элементы
списка в цикле for и выводим каждое сообщение.
В примере 10.2 показано, как бы написал эту программу программист с боль-
шим опытом работы на a wk. Ключ -00 используется для чтения абзацев вместо
строк.
Пример 10.2. bysub2
#!/usr/Ыn/perl -nOO
# bysub2 - сортировка по теме в стиле awk
BEGIN { Smsgno = -1 }
$sub[++$msgnoj = (/'Subject:\s*(?:Re:\s*)*(.*)/m1)[0] If /'From/m;
$msg[$msgnoj .=
END { print @msg[ sort { $sub[$a] cmp $sub[$b] || $a <=> $b } (0 .. $#msg) ] }
Параллельные массивы широко использовались лишь на ранней стадии сущест-
вования Perl, однако решение с сохранением сообщений в хэше выглядит более
элегантно. Анонимный хэш (см. главу И) сортируется по каждому полю.
Программа из примера 10.3 построена на тех же принципах, что и программа
из примеров 10.1 и 10.2.
10.18. Сортировка почты
439
Пример 10.3. bysub3
# !/usr/Ыn/perl -00
# bysub3 - сортировка по теме с использованием хэша
use strict;
my @msgs = ():
while (<>) {
push tegs, {
SUBJECT => /xSubject:\s*(?:Re:\s*)*(.*)/mi,
NUMBER => scalar tegs, # Номер сообщения
TEXT => ".
} if /xFrom/m;
$msgs[-l]{TEXT} .= $_:
}
for my $msg (sort {
$a->{SUBJECT} cmp $b->{SUBJECT}
$a->{NUMBER} <=> $b->{NUMBER}
} tegs
)
{
print $msg->{TEXT);
}
Работая с полноценными хэшами, нетрудно добавить дополнительные крите-
рии сортировки. Почтовые ящики часто сортируются сначала по теме, а затем
по дате сообщения. Основные трудности связаны с анализом и сравнением дат.
Модуль Date::Maniр помогает справиться с ними и возвращает строку, которую
можно сравнивать с другими. Тем не менее программа datesort из примера 10.4,
использующая Date:: Mani р, работает в 10 раз медленнее предыдущей. Анализ дат
в непредсказуемых форматах занимает слишком много времени.
Пример 10.4. datesort
# !/usr/bin/perl -00
# datesort - сортировка почтового ящика по теме и дате
use strict:
use Date::Manip;
my tegs = 0:
while (<>) {
next unless /xFrom/m:
my $date = ":
if (/xDate:\s*(.*)/m) {
($date = $1) =~ s/\s+\(.*//;
$date = ParseDate($date):
}
push tegs, {
SUBJECT => /^Subject:\s*(?:Re:\s*)*(,*)/mi.
DATE => $date,
NUMBER => scalar tegs,
TEXT => ".
}:
} continue {
$msgs[-l]{TEXT} .= $_:
} продолжение &
440
Глава 10. Процедуры
Пример 10.4 (продолжение)
for my $msg (sort {
$a->{SUBJECT} cmp $b->{SUBJECT}
II
$a->{DATE} cmp $b->{DATE}
$a->{NUMBER} <=> $b->{NUMBER}
} @msgs
)
{
print $msg->{TEXT}:
}
Особого внимания в примере 10.4 заслуживает блок continue. По достижении
конца цикла (нормальном выполнении или переходе по next) этот блок выпол-
няется целиком. Он соответствует третьему компоненту цикла for, но не ограни-
чивается одним выражением. Это полноценный блок, который может состоять
из нескольких команд.
См. также
Описание функции sort в perlfunc(l); описание переменной $/($RS, $INPUT_
RECORD_SEPARATOR) в perlvar(l) и во Введении главы 8 «Содержимое файлов»; ре-
цепты 3.7, 4.16, 5.10 и 11.9.
Ссылки и записи
11.0. Введение
В Perl существует три основных типа данных: скалярные величины, массивы
и хэши. Конечно, многие программы удается написать и без сложных структур
данных, но обычно простых переменных и списков все же оказывается недоста-
точно.
Три встроенных структуры данных Perl в сочетании со ссылками позволяют
строить сколь угодно сложные и функциональные структуры данных — те самые
записи, которых так отчаянно не хватало в ранних версиях Perl. Правильно выби-
рая структуру данных и алгоритм, вы иногда выбираете между элегантной про-
граммой, которая быстро справляется со своей задачей, и убогой поделкой, рабо-
тающей с черепашьей скоростью и нещадно пожирающей системные ресурсы.
Первая часть этой главы посвящена созданию и использованию простых ссы-
лок. Во второй части рассказывается о применении ссылок для создания струк-
тур данных более высокого порядка.
Ссылки
Чтобы хорошо понять концепцию ссылок, сначала необходимо разобраться с тем,
как в Perl хранятся значения переменных. С любой определенной переменной
ассоциируется некоторое имя и адрес области памяти. Идея хранения адресов
играет для ссылок особую роль, поскольку в ссылке хранятся данные о местона-
хождении другой величины. Скалярная величина, содержащая адрес области
памяти, называется ссылкой. Значение, хранящееся в памяти по данному адресу,
называется субъектом (referent) (рис. 11.1).
Субъект может относиться к одному из встроенных типов данных (скалярная
величина, массив, хэш, ссылка, код или глоб) или представлять собой пользова-
тельский тип, основанный на одном из встроенных типов.
Ссылка
Ох83с6с (Субъект)
ARRAY (0х83с6с)
(3, ’is a magic number’)
Рис. 11.1. Ссылка и субьект
442
Глава 11. Ссылки и записи
Субъекты в Perl типизованы. Это означает, что ссылку на массив нельзя ин-
терпретировать как ссылку на хэш. При подобных попытках инициируется ис-
ключение. В Perl не предусмотрен механизм преобразования типов, и это было
сделано намеренно.
На первый взгляд кажется, что ссылка — обычный адрес с сильной типизаци-
ей. На самом деле это нечто большее. Perl берет на себя автоматическое выделе-
ние и освобождение памяти (уборку мусора) для ссылок так же, как и для всего
остального. С каждым блоком памяти в Perl связан счетчик ссылок, который опре-
деляет количество ссылок на данный субъект. Память, используемая субъектом,
возвращается в пул свободной памяти процесса лишь при обнулении счетчика
ссылок. Тем самым гарантируется, что вы никогда не получите недопустимую
ссылку — забудьте об аварийных завершениях и ошибках защиты, часто возни-
кающих при неправильной работе с указателями в С.
Освобожденная память передается Perl для последующего использования, но
лишь немногие операционные системы возвращают ее себе. Это связано с тем,
что в большинстве схем распределения памяти используется стек, а при освобо-
ждении памяти в середине стека операционная система не сможет вернуть ее без
перемещения всех остальных блоков. Перемещение нарушит целостность указа-
телей и прикончит вашу программу.
Чтобы перейти от ссылки к субъекту, снабдите ссылку символом типа для
тех данных, к которым вы обращаетесь. Например, если $sref является ссылкой
на скалярную величину, возможна следующая запись:
print $$sref; # Выводится скалярная величина, на которую ссылается $sref
$$sref =3; # Присваивается субъекту $sref
Для обращения к отдельному элементу массива или хэша, на который у вас
имеется ссылка, используется ассоциативный оператор -> («стрелка»), напри-
мер, $rv->[37] или $rv->{“wllma”}. Помимо разыменования ссылок на массивы
и хэши, стрелка также применяется при обратном вызове функций через ссыл-
ки, например, $code_ref->( "argl", "arg2") (см. рецепт 11.4). Если вы работае-
те с объектами, то с помощью стрелки можно вызывать их методы, $object->
methodname(”argl”, "arg2"), как показано в главе 13 «Классы, объекты и связи».
Правила синтаксиса Perl делают разыменование сложных выражений нетри-
виальной задачей. Чередование правых и левых ассоциативных операторов не
рекомендуется. Например, $$х[4] — то же самое, что и $х->[4]; иначе говоря, $х
интерпретируется как ссылка на массив, после чего из массива извлекается
четвертый элемент. То же самое можно записать в виде ${$х}[4]. Если вы имели
в виду «взять четвертый элемент @х и разыменовать его в скалярное выражение»,
воспользуйтесь ${$х[4]}. Старайтесь избегать смежного расположения символов
типов ($@U) везде, кроме простых и однозначных ситуаций типа ^hash=^$hashref.
Приведенный выше пример с $$sref можно переписать в ином виде:
print ${$sref}; # Выводится скалярная величина, на которую ссылается $sref
${$sref} =3; # Присваивается субъекту $sref
Некоторые программисты для уверенности используют только эту форму.
Функция ref получает ссылку и возвращает строку с описанием субъекта.
Строка обычно принимает одно из значений SCALAR, ARRAY, HASH или CODE, хотя
11.0. Введение
443
иногда встречаются и другие встроенные типы GLOB, REF, 10, Regexp и LVALUE. Если ref
вызывается для аргумента, не являющегося ссылкой, функция возвращает false.
При вызове ref для объекта (ссылки, для субъекта которой вызывалась функция
bless) возвращается класс, к которому был приписан объект: CGI, 10::Socket или
даже АСМЕ::Widget.
Ссылки в Perl можно создавать для субъектов уже определенных или опреде-
ляемых с помощью конструкций [ ], { } или sub { }. Использовать оператор \
очень просто: поставьте его перед субъектом, для которого создается ссылка.
Например, ссылка на содержимое массива @аггау создается следующим образом:
$rv = \@array:
Создавать ссылки можно даже для констант; при попытке изменить значение
субъекта происходит ошибка времени выполнения:
$pi = \3.14159:
$$р1 =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 $aL4][23][53K21];
444
Глава 11. Ссылки и записи
feed
print $а[4][23][53];
ARRAY(Ox81e2494)
print $a[4][23]:
ARRAY(Ox81eO748)
print $a[4]:
ARRAY(0x822cd40)
В табл. 11.1 перечислены механизмы создания ссылок для именованных и ано-
нимных скалярных величин, массивов, хэшей, функций и тип-глобов (меха-
низм автоматического оживления файловых манипуляторов описан во Введе-
нии к главе 7).
Таблица 11.1. Синтаксис создания ссылок для именованных и анонимных значений
Субъект Именованная ссылка Анонимная ссылка
Скалярная величина \$scalar \do{my $anon}
Массив \@array [СПИСОК]
Хэш \%hash { СПИСОК }
Код \&function sub { КОД }
Глоб *symbol open(my $handle, ...);$handle
Рисунки 11.2 и 11.3 поясняют различия между именованными и анонимны-
ми субъектами. На рис. 11.2 изображены именованные субъекты, а на рис. 11.3 —
анонимные.
Иначе говоря, в результате присваивания $а = \$Ь переменные $$а и $Ь за-
нимают одну и ту же область памяти. Если вы напишете $$а = 3, значение $Ь
станет равно 3, хотя в команде упоминается только переменная $а, но не $Ь.
Исходное состояние:
0x351f00
$а = \$Ь;
0x305108
0x305108
5 <
$$а = 3;
SCALAR
(0x351 f00)
0x351f00
0x305108
0x351 fOO
SCALAR
(0x351 f00)
print "$$a $b\n";
3 3
Рис. 11.2. Именованные субъекты
11.0. Введение
445
0x305108
Исходное состояние:
$$а = 3;
0x305108 0x351f00
— Perl присваивает
значение
Рис. 11.3. Анонимные субъекты
print "$$а\п";
3
В логическом контексте все ссылки интерпретируются как true, поэтому если
ваша функция возвращает ссылку, в случае ошибки можно вернуть undef и про-
верить возвращаемое значение следующим образом:
sub cite {
my (^record, Serrcount):
return Serrcount ? undef : ^record;
}
$op_cit = cite(Sibid) or die "couldn't make a reference":
Без аргумента undef создает неопределенное значение. Но если передать ему
в качестве аргумента переменную или функцию, то оператор undef делает эту пе-
ременную или функцию неопределенной для последующей проверки функцией
defined. Однако не следует полагать, что при вызове undef всегда освобождается
память, вызываются деструкторы объектов и т. д. В действительности оператор
всего лишь уменьшает счетчик ссылок на 1.
my ($а. $b) = ("Thingl". "Thing2"):
$а = \$b:
undef $b:
Память еще не освобождается, поскольку значение "Thing2" остается косвен-
но доступным через ссылку в $а. Однако значение "Thingl" уничтожается в ре-
зультате присваивания $а=\$Ь.
Хотя выделение в памяти в Perl в одних случаях производится явно, а в дру-
гих — автоматически, освобождение памяти почти всегда происходит автоматиче-
ски. Как правило, программисту не приходится вручную объявлять переменные
недействительными. Достаточно подождать и дать лексическим переменным
(объявленным с ту) исчезнуть с завершением области действия; при следующем
входе в эту область действия переменные получают новые значения. Если по-
требуется сбросить глобальную переменную (объявленную с our, полностью
уточненную именем пакета или импортированную из другого пакета), обычно
бывает достаточно присвоить пустой список составной переменной или false —
скалярной.
446
Глава 11. Ссылки и записи
Говорят, существуют два противоположных подхода к управлению памятью
в программировании. Сторонники первого считают, что управление памятью —
слишком важная задача, чтобы доверить ее языку программирования, а второго —
что она слишком важна, чтобы доверить ее программисту. Perl явно относится
ко второй категории. Если вам не нужно что-то запоминать, то вы это наверня-
ка не забудете. Как правило, в Perl программисту практически не приходится
думать об освобождении динамически выделенной памяти1, поскольку управление
памяти — уборка мусора, если хотите, — полностью автоматизировано. Впрочем,
в рецептах 11.15 и 13.13 продемонстрированы исключения из этого правила.
Записи
Ссылки традиционно применялись в Perl для обхода ограничения, согласно ко-
торому массивы и хэши могут содержать только скаляры. Ссылки являются
скалярами, поэтому для создания массива массивов следует создать массив ссы-
лок на массивы. Аналогично, хэши хэшей реализуются как хэши ссылок на хэши;
массивы хэшей — как массивы ссылок на хэши; хэши массивов — как хэши ссы-
лок на массивы и т. д.
Имея в своем распоряжении эти сложные структуры, можно воспользоваться
ими для реализации записей. Запись представляет собой отдельную логическую
единицу, состоящую из различных атрибутов. Например, запись, описывающая
человека, может содержать имя, адрес и дату рождения. В С подобные вещи на-
зываются структурами (structs), а в Pascal — записями (RECORDs). В Perl для
них не существует специального термина, поскольку эта концепция может быть
реализована разными способами.
Наиболее распространенный подход в Perl заключается в том, чтобы интер-
претировать хэш как запись, где ключи хэша представляют собой имена полей
записи, а ассоциированные величины — значения этих полей.
Например, запись «человек» может выглядеть так:
Sperson = { "Name" => "Leonhard Euler",
"Address" => "1729 Ramanujan Lane\nMathworld, PI 31416",
"Birthday" => 0x5bb5580.
Поскольку ссылка $NAT является скалярной величиной, ее можно сохранить
в элементе хэша или массива с информацией о целой группе людей и далее ис-
пользовать приемы сортировки, объединения хэшей, выбора случайных записей
и т. д., рассмотренные в главах 4 и 5.
Атрибуты записи, в том числе и «человека» из нашего примера, всегда являются
скалярами. Конечно, вместо строк можно использовать числа, но это банально.
Настоящие возможности открываются в том случае, если атрибуты записи так-
же представляют собой ссылки. Например, атрибут "Birthday" может храниться
в виде анонимного массива, состоящего из трех элементов: день, месяц и год.
Выражение $person->{’’B1rthday"}->L0] выделяет из даты рождения поле «день».
Дата также может быть представлена в виде хэша, для доступа к полям которого
Не считая внешних функций, откомпилированных с языка С.
11.1. Ссылки на массивы
447
применяются выражения вида $person->{"Blrthday"}->{"day"}. После включения
ссылок в коллекцию приемов перед вами откроются многие нетривиальные и по-
лезные стратегии программирования.
На этом этапе мы концептуально выходим за пределы простых записей и пе-
реходим к созданию сложных структур, которые представляют запутанные от-
ношения между хранящимися в них данными. Хотя они могут использоваться
для реализации традиционных структур данных (например, связанных спи-
сков), рецепты второй части этой главы не связаны ни с какими конкретными
структурами. В них описываются обобщенные приемы загрузки, вывода, копи-
рования и сохранения обобщенных структур данных. Завершающая программа
этой главы демонстрирует работу с бинарными деревьями.
См. также
perlref( 1); perlreftut( 1); perllol( 1); perldsc( 1).
11.1. Ссылки на массивы
Проблема
Требуется работать с массивом через ссылку.
Решение
Ссылка на массив создается следующим образом:
$aref = \@array;
$anon_array = [1, 3, 5, 7, 9]:
$anon_copy = [ @array ]:
@$implicit_creation = (2, 4. 6. 8. 10):
Чтобы разыменовать ссылку на массив, поставьте перед ней символ @
push(@$anon_array. 11):
или воспользуйтесь стрелкой с указанием индекса конкретного элемента в квад-
ратных скобках:
$two = $impl ic1t_creat1on->[0];
Для получения индекса последнего элемента массива по ссылке или опреде-
ления количества элементов в массиве применяется следующая запись:
$last_idx = $#$aref;
$num_1terns = @$aref:
Дополнительные фигурные скобки повышают надежность и форсируют нуж-
ный контекст:
$last_1dx = $#{ $aref }:
$num_1tems = scalar @{ $aref };
448
Глава 11. Ссылки и записи
Комментарий
Рассмотрим примеры использования ссылок на массивы:
# Проверить, содержит ли 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;
}
Sarefl = array_ref():
$aref2 = array_ref():
При каждом вызове array_ref функция выделяет для @array новый блок памя-
ти. Если бы мы не вернули ссылку на @аггау, то занимаемая массивом память
была бы возвращена при выходе из блока, то есть при завершении подпрограм-
мы. Однако ссылка на @аггау продолжает существовать, поэтому Perl не освобо-
ждает память, и мы получаем ссылку на блок памяти, недоступный через табли-
цу символов. Такие блоки памяти называются анонимными, поскольку с ними
не связано никакое имя.
К определенному элементу массива, на который указывает ссылка $aref,
можно обратиться в форме $$aref[4], но $aref->[4] делает то же самое и обладает
большей наглядностью.
print $array_ref->[$N]:
print $$array_ref[$N];
print ${$array_ref}[$N];
# Обращение к N-му элементу (лучший вариант)
# То же, но менее наглядно
# То же, но непонятно и уродливо
Имея ссылку на массив, можно получить срез субъектного массива:
@$pie[3..5J: # Срез массива, но читается плохо
@{$pie}[3..5]; # Срез массива, читается лучше (?)
11.2. Создание хэшей массивов
449
Срезы массивов, даже при обращении через ссылки, допускают присваива-
ние. В следующей строке сначала происходит разыменование массива, после
чего элементам среза присваиваются значения:
@{$р1е}[3..5] = ("blackberry", "blueberry", "pumpkin");
Срез массива просто является более удобным заменителем для списка отдель-
ных элементов. Поскольку ссылку на список получить нельзя, вам не удастся
получить ссылку на срез массива:
Ssliceref = \@{$pie}[3..5]; # НЕВЕРНО!
Для перебора в массиве применяется цикл foreach или for:
foreach Sitem ( @{$array_ref} ) {
# Данные в Sitem
for (Sidx = 0; Sidx <= $#{ $array_ref }: $1dx++) {
# Данные в $array_ref->[$idx]
}
См. также
perlref(i), perlreftut^X.) и perllol(l); рецепт 2.13; рецепт 4.6.
11.2. Создание хэшей массивов
Проблема
С каждым ключом хэша может быть ассоциирована лишь одна скалярная вели-
чина, однако вам хочется использовать один ключ для хранения и извлечения
нескольких величин. Иначе говоря, вы хотите, чтобы ассоциированное значение
представляло собой список.
Решение
Сохраните в элементе хэша ссылку на массив. Используйте push для присоеди-
нения новых элементов:
push(@{ $hash{"KEYNAME"} }. "new value");
Затем при выводе хэша разыменуйте значение как ссылку на массив:
foreach Sstring (keys %hash) {
print "Sstring: @{$hash{$str1ng}}\n";
Комментарий
В хэше могут храниться только скалярные величины. Впрочем, ссылки и являются
скалярными величинами. Они помогают решить проблему сохранения нескольких
450
Глава 11. Ссылки и записи
ассоциированных значений с одним ключом — в $hash{Skey} помещается ссылка
на массив, содержащий значения Skey. Все стандартные операции с хэшами
(вставка, удаление, перебор и проверка существования) могут комбинироваться
с операциями массивов (push, splice и foreach).
Присвоение ключу нескольких значений осуществляется следующим образом:
$hash{‘*a key”} = [ 3. 4. 5 ]; # Анонимный массив
Ключ с ассоциированным массивом используется так:
Pvalues = Р{ $hash{"a key"} }:
Для присоединения новых значений к массиву, ассоциированному с конкрет-
ным ключом, используется функция push:
push Р{ $hash{‘*a key"} }. Svalue;
Классическое применение этой структуры данных — инвертирование хэша,
в котором одно значение ассоциируется с несколькими ключами. В хэше, полу-
ченном после инвертирования, один ключ ассоциирован с несколькими значе-
ниями. Эта проблема рассматривается в рецепте 5.9.
Учтите, что запись вида:
Presidents = Р{ Sphone2name{Snumber} };
при действующей директиве use strict вызовет исключение, поскольку вы пы-
таетесь разыменовать неопределенную ссылку без автоматического оживления.
Приходится использовать другую формулировку:
Presidents = ex1sts( Sphone2name{Snumber} )
? P{ Sphone2name{Snumber} }
: ();}
См. также
Раздел «Hashes of Arrays» perldsc(l); рецепт 5.9; пример «Хэш с автоматическим
дополнением» из рецепта 13.15.
11.3. Получение ссылок на хэши
Проблема
Требуется работать с хэшем по ссылке. Например, ссылка может передаваться
функции или входить во внешнюю структуру данных.
Решение
Получение ссылки на хэш:
Shref = \%hash:
$anon_hash = { "keyl" => "valuel", "key2" => "value2 ..." };
$anon_hash_copy = { %hash };
11.4. Получение ссылок на функции
451
Разыменование ссылки на хэш:
%hash = %$href:
Svalue = $href->{$key}:
@slice = @$href{$keyl. $key2, $key3}: # Обратите внимание: стрелки нет!
@keys = keys Hhash;
Проверка того, является ли переменная ссылкой на хэш:
if (ref($someref) ne ’HASH’) {
die "Expected a hash reference, not $someref\n";
}
Комментарий
Следующий пример выводит все ключи и значения двух заранее определенных
хэшей:
foreach $href ( \OV. \%INC ) { # ИЛИ: for $href ( \(%ENV.2JINC) ) {
foreach $key ( keys Hhref ) {
print "$key => $href->{$key}\n":
}
}
Операции co срезами хэшей по ссылке выполняются так же, как со срезами
массивов. Например:
©values = @$hash_ref{"keyT, ,,key2". "кеуЗ"}:
for $val (@$hash_ref{"keyr. "кеу2". "кеуЗ"}) {
$val += 7; # Прибавить 7 к каждому значению в срезе хэша
}
См. также
Глава 5 «Хэши»; perlref(i)\ рецепт 11.9.
11.4. Получение ссылок на функции
Проблема
Требуется создать ссылку для вызова подпрограммы. Такая задача возникает
при создании обработчиков сигналов, функций обратного вызова Тк и хэшей
указателей на функции.
Решение
Получение ссылки на функцию:
$cref = \&func:
$cref = sub { ... }:
452
Глава 11. Ссылки и записи
Вызов функции по ссылке:
(^returned = $cref->(@arguments):
(^returned = &$cref(@arguments):
Комментарий
Чтобы получить ссылку на функцию, достаточно снабдить ее имя префиксом \&.
Кроме того, формулировка sub {} позволяет динамически создавать анонимные
функции. Ссылка на анонимную функцию может быть сохранена так же, как и
любая другая.
Вообще говоря, существует возможность сохранить имя функции в переменной:
Sfuncname = "thefunc":
&$funcname();
однако подобное решение нежелательно по нескольким причинам. Во-первых,
в нем используются символические, а не настоящие (жесткие) ссылки, поэтому
при действующей директиве use strict "refs" оно отпадает. Символические
ссылки на переменные обычно нежелательны, поскольку они не могут исполь-
зоваться для работы с лексическими, а только с глобальными переменными,
и для них не ведется подсчет ссылок. Во-вторых, приведенный фрагмент не
содержит данных о пакете, поэтому его выполнение в другом пакете может
привести к вызову неверной функции. Наконец, если функция была в какой-то
момент переопределена (хотя это происходит нечасто), символическая ссылка
будет обращаться к текущему определению функции, а жесткая ссылка сохра-
нит старое определение.
Вместо того чтобы сохранять имя функции в переменной, создайте ссылку на
нее с помощью оператора \. Именно так следует сохранять функцию в перемен-
ной или передавать ее другой функции. Ссылки на именованные функции мож-
но комбинировать со ссылками на анонимные функции:
my ^commands = (
’’happy" => \&Joy.
"sad" => \&sullen.
"done" => sub { die "See ya!" },
"mad" => \&angry,
);
print "How are you? ";
chomp($str1ng = <STDIN>):
if ($commands{$str1ng}) {
$commands{$string}->();
} else {
print "No such command: $string\n":
}
Если вы создаете анонимную функцию, которая ссылается на лексическую
(ту) переменную из вмещающей области действия, схема подсчета ссылок гаран-
тирует, что память лексической переменной не будет освобождена при наличии
ссылок на нее:
sub counterjnaker {
my Sstart = 0:
11.4. Получение ссылок на функции
453
return sub {
return $start++;
};
}
Scounter = counterjnakerO;
# Замыкание
# Лексическая переменная
# из вмещающей области действия
for ($1 = 0; $1 < 5; $1 ++) {
print &$counter, "\п";
}
Даже несмотря на то, что функция counterjnaker завершилась, а переменная
Sstart вышла из области действия, Perl не освобождает ее, поскольку анонимная
подпрограмма (на которую ссылается Scounter) все еще содержит ссылку на
$start. Если повторно вызвать counterjnaker, функция вернет ссылку на другую
анонимную подпрограмму, использующую другое значение $start:
Scounterl = counterjnakerO;
$counter2 = counterjnakerO;
for ($1 = 0; $1 < 5; $1 ++) {
print &$counterl, ”\n";
}
print &$counterl, " ", &$counter2, "\n";
0
1
2
3
4
5 0
Замыкания часто используются в функциях обратного вызова (callbacks).
В графических интерфейсах и вообще в программировании, основанном на со-
бытиях, определенные фрагменты кода связываются с событиями нажатий кла-
виш, щелчков мыши, отображения окон и т. д. Этот код вызывается много поз-
же, возможно — из совсем другой области действия. Переменные, используемые
в замыкании, должны быть доступными к моменту вызова. Для нормальной ра-
боты они должны быть лексическими, а не глобальными.
Замыкания также используются в генераторах функций, то есть в функциях,
которые создают и возвращают другие функции. В частности, генератором явля-
ется функция counterjnaker. Рассмотрим еще один простой пример:
sub timestamp {
my $start_t1me = tlmeO;
return sub { return tlmeO - $start_t1me }:
}
Searly = t1mestamp():
sleep 20;
$later = tlmestampO:
sleep 10:
prlntf "It’s been £d seconds since early.\n", $early->0:
454
Глава 11. Ссылки и записи
printf "It's been seconds since later.\n". $later->();
It's been 30 seconds since early.
It's been 10 seconds since later.
Каждый вызов timestamp генерирует и возвращает новую функцию. Функция
timestamp создает лексическую переменную $start_tinie, которая содержит теку-
щее время (в секундах с начала эпохи). При каждом вызове замыкания оно воз-
вращает количество прошедших секунд, которое определяется вычитанием на-
чального времени из текущего.
См. также
Описание замыканий в perlref(V)\ рецепт 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 Stemp;
return \Stemp;
11.6. Создание массивов ссылок на скаляры
455
Чтобы разыменовать скалярную переменную, следует снабдить ее дополни-
тельным префиксом $:
$sref = new_anon_scalar():
$$sref = 3;
print "Three = $$sref\n";
@array_of_srefs = ( new_anon_scalar(). new_anon_scalar() );
${ $array[0] } = 6.02e23;
${ $array[lj } = "avocado";
print "\@array contains: ". joinC. ". map { $$_ } @array ). "\n";
Обратите внимание на фигурные скобки вокруг $аггау[0] и $аггау[1]. Если
бы мы попытались ограничиться простым $$аггау[0], то в процессе разыменования
получили бы $аггау->[0]. Переменная $аггау интерпретировалась бы как ссылка
на массив, поэтому в результате был бы возвращен элемент с нулевым индексом.
Приведем другие примеры, в которых фигурные скобки необязательны:
$var = 'uptime':
$vref = \$var;
If ($$vref =~ /load/) {}
chomp $$vref:
# $var содержит текст
# $vref "указывает на" $var
# Косвенное обращение к $var
# Косвенное изменение $var
Как упоминалось во Введении, для определения типа субъекта по ссылке при-
меняется встроенная функция ref. При вызове ref для ссылки на скаляр функ-
ция возвращает строку "SCALAR":
# Проверить, содержит ли Ssomeref ссылку на скаляр
If (ref(Ssomeref) ne "SCALAR") {
die "Expected a scalar reference, not $someref\n";
}
См. также
perlref’(1).
11.6. Создание массивов ссылок на скаляры
Проблема
Требуется создать массив ссылок на скаляры. Такая задача часто возникает при
передаче функциям переменных по ссылке, чтобы функция могла изменить их
значения.
Решение
Чтобы создать массив, либо снабдите префиксом \ каждый скаляр в списке
@array_of_scalar_refs = ( \$а. \$Ь );
либо просто поставьте \ перед всем списком, используя свойство дистрибутив-
ности оператора \:
@array_of_scalar_refs = \( $а. $Ь ):
456
Глава 11. Ссылки и записи
Чтобы получить или задать значение элемента списка, воспользуйтесь конст-
рукцией
${ $array_of_scalar_refs[l] } = 12: # $b = 12
Комментарий
В следующих примерах предполагается, что @аггау — простой массив, содержа-
щий ссылки на скаляры (не путайте массив ссылок со ссылкой на массив). При
косвенных обращениях к данным необходимы фигурные скобки.
($а. $b. $с. $d) = (1 .. 4):
@array = (\$а. \$b. \$с. \$d):
@array = \( $а. $b. $с, $d):
@array = map { \my $anon } 0..3:
${ $array[2] } += 9:
${ $array[ $#array 1 } *= 5;
${ $array[-l] } *= 5:
$tmp = $array[-l]:
$$tmp *= 5:
# Инициализировать
# Ссылки на все скаляры
# То же самое!
# 4 ссылки на анонимные скаляры
# $с = 12
# $d = 20
# То же: $d = 100
# Использование временной переменной
# $d = 500
Две формы присваивания @аггау эквивалентны — оператор \ обладает свойст-
вом дистрибутивности. Следовательно, \ перед списком (но не массивом!) экви-
валентно применению \ к каждому элементу списка. Следующий фрагмент из-
меняет значения переменных, ссылки на которые хранятся в массиве.
А вот как работать с массивом без явного индексирования.
use Math::Tr1g qw(pl); # Загрузить константу pl
foreach $sref (@array) { # Подготовиться к изменению $a,$b.$c,$d
($$sref **= 3) *= (4/3 * pl): # Заменить объемом сферы
}
В этом фрагменте используется формула вычисления объема сферы:
V = 4/Злг3.
Переменная цикла $sref перебирает все ссылки @аггау, а в $$sref заносятся
сами числа, то есть исходные переменные $а, $Ь, $с и $d. Изменение $$sref в цикле
приводит к изменению этих переменных. Сначала мы возводим $$sref в куб, а затем
умножаем полученный результат на 4/3л. При этом используется то обстоятель-
ство, что присваивание в Perl возвращает левостороннее выражение. Это позво-
ляет сцеплять операторы присваивания, как это делается с операторами **= и *=.
Вообще говоря, анонимные скаляры обычно бесполезны — ведь скалярная
величина занимает столько же места, что и ссылка на нее. По этой причине не
предусмотрены и специальные конструкции для их создания. Скалярные ссыл-
ки существуют только для поддержки синонимов, которые могут быть реализо-
ваны и другими способами.
См. также
Раздел «Assignment Operators» perlop(V).
11.7. Применение замыканий вместо объектов
457
11.7. Применение замыканий вместо объектов
Проблема
Вы хотите работать с записями, обладающими определенным состоянием, пове-
дением и идентичностью, но вам не хочется изучать для этого объектно-ориен-
тированное программирование.
Решение
Напишите функцию, которая возвращает (по ссылке) хэш ссылок на фрагменты
кода. Все эти фрагменты представляют собой замыкания, созданные в общей
области действия, поэтому при выполнении они будут совместно использовать
одни и те же закрытые переменные.
Комментарий
Поскольку замыкание представляет собой совокупность кода и данных, в одной
из реализаций оно позволяет имитировать поведение объекта.
Следующий пример создает и возвращает хэш анонимных функций. Функ-
ция mkcounter получает начальное значение счетчика и возвращает ссылку на хэш
ссылок на фрагменты кода, через который можно косвенно оперировать счетчиком.
$cl = mkcounter(20):
$с2 = mkcounter(77):
printf "next cl: W
printf "next c2: £d\n"
printf "next cl: &d\n"
printf "last cl: £d\n"
printf "old c2: £d\n"
$cl->{NEXT}->(); # 21
Sc2->{NEXT}->(): # 78
Scl->{NEXT}->(); # 22
$cl->{PREV}->(); # 21
Sc2->{RESET}->(); # 77
Каждая ссылка на хэш, Scl и $с2, отдельно хранит информацию о своем со-
стоянии. Реализация выглядит так:
sub mkcounter {
my Scount = shift:
my Sstart = 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:
}
Поскольку лексические переменные, используемые замыканиями в ссылке
на хэш Sbundle, используются функцией, они не освобождаются. При следующем
вызове mkcounter замыкания получают другой набор привязок переменных для
того же кода. Никто не сможет обратиться к этим двум переменным за предела-
ми замыканий, поэтому полная инкапсуляция гарантирована.
458
Глава 11. Ссылки и записи
В результате присваивания, расположенного непосредственно перед return, зна-
чения "PREV" и "LAST" будут ссылаться на одно и то же замыкание. Если вы раз-
бираетесь в объектно-ориентированном программировании, можете считать их
двумя разными сообщениями, реализованными с применением одного метода.
Возвращаемая нами совокупность не является полноценным объектом, по-
скольку не поддерживает наследования и полиморфизма (пока). Однако она, не-
сомненно, обладает собственным состоянием, поведением и идентификацией,
а также обеспечивает инкапсуляцию.
См. также
Описание замыканий в perlref(i). Глава 13, рецепт 11.4 и рецепт 11.9.
11.8. Создание ссылок на методы
Проблема
Требуется сохранить ссылку на метод.
Решение
Создайте замыкание, обеспечивающее вызов нужного метода для объекта.
Комментарий
Ссылка на метод — это нечто большее, чем простой указатель на функцию. Вам
также придется определить, для какого объекта вызывается метод, поскольку
исходные данные для работы метода содержатся в объекте. Оптимальным реше-
нием будет использование замыкания. Если переменная $obj имеет лексическую
область действия, воспользуйтесь следующим фрагментом:
$mref = sub { $obj->meth(@_) };
# Позднее...
$mref->("args". "go", "here”):
Даже когда переменная $obj выходит из области действия, она остается в за-
мыкании, хранящемся в $mref. Позднее при косвенном вызове метода будет ис-
пользован правильный объект.
Учтите, что формулировка:
$sref = \$obj->meth;
работает не так, как можно предположить. Сначала она вызывает метод объекта,
а затем дает ссылку либо на возвращаемое значение, либо на последнее из воз-
вращаемых значений, если метод возвращает список.
Метод сап из базового класса UNIVERSAL выглядит заманчиво, но вряд ли дела-
ет именно то, что вы хотите:
$cref = $obj->can("meth"):
11.9. Конструирование записей
459
Он дает ссылку на код соответствующего метода (если он будет найден), не
несущую информации об объекте. В сущности, вы получаете обычный указатель
на функцию. Информация об объекте теряется. Из-за этого и понадобилось за-
мыкание, запоминающее как состояние объекта, так и вызываемый метод.
См. также
Описание методов во Введении к главе 13; рецепт 11.7; рецепт 13.8.
11.9. Конструирование записей
Проблема
Требуется создать тип данных для хранения атрибутов (запись).
Решение
Воспользуйтесь ссылкой на анонимный хэш.
Комментарий
Предположим, вам захотелось создать тип данных, содержащий различные ат-
рибуты — аналог структур С или записей Pascal. Проще всего сделать это с по-
мощью анонимного хэша. Следующий пример демонстрирует процесс инициа-
лизации и применения записи, содержащей информацию о работнике фирмы:
Srecord = {
NAME => "Jason".
EMPNO => 132.
TITLE => "deputy peon".
AGE => 23.
SALARY => 37_000.
PALS => [ "Norbert". "Rhys", "Phineas"],
}:
prlntf "I am £s. and my pals are &s.\n",
$record->{NAME}.
join(". ", @{$record->{PALS}}):
Впрочем, от отдельной записи толку мало — хотелось бы построить структу-
ры данных более высокого уровня. Например, можно создать хэш ^ByName, а за-
тем инициализировать и использовать его следующим образом:
# Сохранить запись
$byname{ $record->{NAME} } = Srecord;
# Позднее искать по имени
If ($rp = $byname{"Aron"}) { # false, если отсутствует
prlntf "Aron Is employee £d.\n", $rp->{EMPNO};
}
# Дать Джейсону нового друга
push @{$byname{"Jason"}->{PALS}}. "Theodore":
prlntf "Jason now has £d pals\n", scalar @{$byname{"Jason"}->{PALS}}:
460
Глава 11. Ссылки и записи
В результате ^byname превращается в хэш хэшей, поскольку хранящиеся в нем
значения представляют собой ссылки на хэши. Найти работника по имени с по-
мощью такой структуры совсем несложно. Если значение присутствует в хэше,
мы сохраняем ссылку на запись во временной переменной $ гр, с помощью кото-
рой далее можно получить любое нужное поле.
Для операций с ^byname можно использовать стандартные средства работы
с хэшами. Например, итератор each организует перебор элементов в произволь-
ном порядке:
# Перебор всех записей
while ((Sname, Srecord) = each ^byname) {
printf "£s Is employee number £d\n", Sname, $record->{EMPNO};
}
А как насчет поиска работников по номеру? Достаточно построить другую струк-
туру данных — массив хэшей ^employees. Если работники нумеруются непоследова-
тельно (скажем, после 1 следует номер 159997), выбор массива окажется неудач-
ным. Вместо этого следует воспользоваться хэшем, в котором номер работника
ассоциируется с записью. Для последовательной нумерации подойдет и массив:
# Сохранить запись
SemployeesE $record->{EMPNO} ] = Srecord:
# Поиск по номеру
If (Srp = Semployee[132]) {
printf "employee number 132 Is £s\n”, $rp->{NAME};
При работе с подобными структурами данных обновление записи в одном
месте обновляет ее везде. Например, следующая команда повышает жалованье
Джейсона на 3,5 %:
$byname{"Jason"}->{SALARY} *= 1.035:
Внесенные изменения отражаются во всех представлениях этих записей. Пом-
ните о том, что $byname{"Jason”} и Semployees[ 132] ссылаются на одну и ту же запись,
поскольку хранящиеся в них ссылки относятся к одному анонимному хэшу.
Как отобрать все записи, удовлетворяющие некоторому критерию? Для этого
и была создана функция grep. Например, в следующем фрагменте отбираются
два подмножества записей — работников, чья должность содержит слово "peon",
и тех, чей возраст равен 27 годам.
@peons = grep { $_->{TITLE} =~ /реоп/1 } ^employees;
Otsevens = grep { $_->{AGE} == 27 } ^employees:
Каждый элемент @peons и @tsevens представляет собой ссылку на запись, по-
этому они, как и ^employees, являются массивами хэшей.
Вывод записей в определенном порядке (например, по возрасту) выполня-
ется так:
# Перебрать все записи
foreach Srp (sort { $a->{AGE} <=> $b->{AGE} } values ^byname) {
printf "£s Is age £d.\n". $rp->{NAME}, $rp->{AGE};
# или co срезом хэша через ссылку
printf "Ss Is employee number Sd.\n". @$rp{'NAME*,’EMPNO*}:
11.10. Чтение и сохранение записей в текстовых файлах
461
Вместо того чтобы тратить время на сортировку по возрасту, можно просто
создать для этих записей другое представление, @byage. Каждый элемент массива
(например, $byage[27]) является массивом всех записей с данным возрастом.
Фактически мы получаем массив массивов хэшей. Он строится так:
# Используем @byage, массив массивов записей
push @{ $byage[ $record->{AGE} J }, 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", $age.
jo1n(", ". map {$_->{NAME}} @{$byage[$age]});
}
См. также
Рецепт 4.14; рецепт 11.3.
11.10. Чтение и сохранение записей
в текстовых файлах
Проблема
Требуется прочитать или сохранить хэш записи в текстовом файле.
Решение
Воспользуйтесь простым форматом, при котором каждое поле занимает отдель-
ную строку вида:
ИмяПоля: Значение
и разделяйте записи пустыми строками.
Комментарий
Если у вас имеется массив записей, которые должны сохраняться в текстовом
файле и читаться из него, воспользуйтесь простым форматом, основанным на
462
Глава И. Ссылки и записи
заголовках почтовых сообщений. Из-за простоты формата ключи не могут со-
держать двоеточия и переводы строк, а значения — переводы строк.
Следующий фрагмент записывает данные в файл:
foreach $record (@Array_of_Records) {
for $key (sort keys Hrecord) {
print "$key: $record->{$key}\n";
print "\n";
}
Прочитать записи из файла тоже несложно:
$/=""; # Режим чтения абзацев
while (<>) {
my ©fields = split Л([?: ]+) :\s*/m;
shift ©fields; # Удалить начальное пустое поле
push(@Array_of_Records, { map /(.*)/.©fields });
}
Функция split работает с своим вторым аргументом по умолчанию, в кото-
ром находится прочитанный абзац. Шаблон ищет начало строки (не просто начало
записи благодаря /т), за которым следует один или более символов, не являющих-
ся двоеточиями, затем двоеточие и необязательный пропуск. Если шаблон split
содержит круглые скобки, они возвращаются вместе со значениями. Возвращаемые
значения заносятся в ©fields в порядке «ключ/значение»; пустое поле в начале
убирается. Фигурные скобки в вызове push создают ссылку на новый анонимный
хэш, куда копируется содержимое ©fields. Поскольку в массиве сохранился поря-
док «ключ/значение», мы получаем правильно упорядоченное содержимое хэша.
Все происходящее сводится к операциям чтения и записи простого текстово-
го файла, поэтому вы можете воспользоваться другими рецептами. Рецепт 7.18
поможет правильно организовать параллельный доступ. В рецепте 1.18 рассказа-
но о сохранении в ключах и значениях двоеточий и переводов строк, а в рецеп-
те 11.3 — о сохранении более сложных структур.
Если вы готовы пожертвовать элегантностью простого текстового файла в поль-
зу быстрой базы данных с произвольным доступом, воспользуйтесь DBM-файлом
(см. рецепт 11.14).
См. также
Описание функции split врег1/ипс(Д}\ рецепты 11.9, 11.13 и 11.14.
11.11. Вывод структур данных
Проблема
Требуется вывести содержимое структуры данных.
Решение
Если важна наглядность вывода, напишите нестандартную процедуру вывода.
11.11. Вывод структур данных
463
В отладчике Perl воспользуйтесь командой х:
DB<1> $reference = [ {"foo" => "bar"}, 3. sub { print "hello. world\n" } ]:
DB<2> x $reference
0 ARRAY(0xld033c)
0 HASH(0x7b390)
’foo’ = ’bar’
1 3
2 CODEC0x2Ie3e4)
-> &main::_ _ANON_ [(eval 15)[/usr/1ocal/...perl5db.pl:17]:2]
in (eval 15)[/usr/local/.../perl5db.pl:17]:2-2
В программе воспользуйтесь функцией Dumper стандартного модуля Data:: Dumper:
use Data::Dumper:
print Dumper preference):
Или если вы хотите получить вывод в стиле отладчика:
use Dumpvalue:
Dumpvalue->new->dumpValue($reference):
Комментарий
Иногда для вывода структур данных в определенном формате пишутся специ-
альные функции, но этот труд часто напрасен. В отладчике Perl поддерживают-
ся команды х и X, обеспечивающие симпатичный вывод. Команда х полезнее, по-
скольку она работает с глобальными и с лексическими переменными, а X — только
с глобальными. Команде х передается ссылка на выводимую структуру данных.
DB<3> х \@INC
0 ARRAY(0x807d0a8)
0 ’/home/tchrlst/perllib'
1 ’/usr/1i b/perl5/i 686-1i nux/5.00403’
2 '/usr/1ib/perl5'
3 ’ /usr/1 i b/perl 5/si teperl /i 686-1 i nux ’
4 '/usr/1ib/perl5/site_perl’
5 ’.’
Стандартный модуль Dumpvalue предоставляет доступ к формату вывода от-
ладчика через объектно-ориентированный интерфейс. Пример:
use Dumpvalue:
Dumpvalue->new->dumpvars("main". "INC"):
@INC = (
0 '/usr/1ocal/1i b/perl5/5.8.1/OpenBSD.i 386-openbsd'
1 ’/usr/1ocal/1i b/perl5/5.8.1’
2 ’ /usr/1 ocal /1 i b/perl 5/si teperl /5.8.1/OpenBSD. i 386 - openbsd ’
3 ’/usr/1ocal/1i b/perl5/si te_perl/5.8.1'
4 ’/usr/1 ocal/1i b/perl5/si te_perl/5.8.0/OpenBSD.i 386-openbsd'
5 ’/usr/1ocal/1i b/perl5/si te_perl /5.8.0’
6 ’/usr/1ocal/1ib/perl5/site_perl’
7 ’.’
)
£INC = (
’Dumpvalue.pm’ = ’/usr/1ocal/1ib/perl5/5.8.1/Dumpvalue.pm’>
'strict.pm’ = ’/usr/1ocal/1ib/perl5/5.8.1/strict.pm’>
464
Глава И. Ссылки и записи
Примерно такой же результат будет получен при выполнении команды V main
INC в отладчике. Dumpvalue поддерживает все параметры форматирования отлад-
чика. Для этого при вызове Dumpvalue->new передаются соответствующие пары:
$dobj = Dumpvalue->new(ларамегр! => значение!, параметр? => значение?);
В версии 5.8.1 поддерживались параметры arrayDepth, hashDepth, compactDump,
veryCompact, globPrInt, dumpDBFIles, dumpPackages, dumpReused, tick, quoteHlghBIt,
prlntllndef, usageOnly, unctrl, subdump, bareStrlnglfy, quoteHlghBIt и stopDbSignal.
В модуле Data:: Dumper, также входящем в стандартную поставку Perl, исполь-
зуется иной подход. Входящая в него функция Dumper получает список ссылок
и возвращает строку с выводимой (и пригодной для eval) формой этих ссылок.
use Data::Dumper: print Dumper(\@INC);
$VAR1 = [
’/usr/1ocal/11b/perl5/5.8.1/OpenBSD.1386-openbsd’,
'/usr/local/11b/perl5/5.8.1',
'/usr/1ocal/11b/perl 5/slte_perl/5.8.1/OpenBSD.1386-openbsd’,
’/usr/1 ocal/11b/perl 5/slte_perl/5.8.1',
'/usr/1ocal/11b/perl5/site_perl/5.8.0/OpenBSD.i 386-openbsd',
'/usr/1ocal/1i b/perl5/si te_perl/5.8.0’,
'/usr/1ocal/11b/perl5/slte_perl’, ’.'
]:
Data:: Dumper поддерживает разнообразные форматы вывода (за подробностя-
ми обращайтесь к документации). Особенно полезна возможность декомпиля-
ции кода Perl:
use Data::Dumper:
$Data::Dumper::Deparse = 1:
$a = sub { print "hello, world\n" };
print Dumper($a):
$VAR1 = sub {
print ’hello, world’;
}:
См. также
Документация по модулю Data::Dumper;perldebug(V).
11.12. Копирование структуры данных
Проблема
Требуется скопировать сложную структуру данных.
Решение
Воспользуйтесь функцией del one стандартного модуля Storable:
use Storable:
$r2 = delone($rl):
11.13. Сохранение структур данных на диске
465
Комментарий
Существует два типа копирования, которые иногда путают. Поверхностное ко-
пирование (surface сору) ограничивается копированием ссылок без создания ко-
пий данных, на которые они ссылаются:
©original = ( \@а. \@Ь. \@с ):
(^surface = (^original;
Глубокое копирование (deep сору) создает абсолютно новую структуру без пе-
рекрывающихся ссылок. Следующий фрагмент копирует ссылки на 1 уровень
вглубь:
@deep = map { [ ] } ©original:
Если переменные @а, @Ь и @с сами содержат ссылки, вызов тар не решит всех
проблем. Написание специального кода для глубокого копирования структур —
дело трудоемкое и быстро надоедающее.
Модуль Storable содержит функцию del one, которая обеспечивает рекурсив-
ное копирование своего аргумента:
use Storable qw(dclone);
$r2 = dclone($rl);
Функция работает только со ссылками или полученными в результате вы-
зова bless объектами типа SCALAR, ARRAY, HASH и CODE1; ссылки на GLOB, 10 и другие
экзотические типы не поддерживаются. Функция safeFreeze модуля FreezeThaw
обеспечивает такую возможность для одного адресного пространства посредст-
вом использования кэша ссылок, который при некоторых обстоятельствах вме-
шивается в процесс сборки мусора и работу деструкторов объектов.
Поскольку del one принимает и возвращает ссылки, при копировании хэша
ссылок в нее приходится включать дополнительные символы:
^newhash = %{ del one(Uoldhash) }:
См. также
Документация по стандартным модулям Storable и Data::Dumper, а также по мо-
дулю CPAN FreezeThaw.
11.13. Сохранение структур данных на диске
Проблема
Требуется сохранить большую, сложную структуру данных на диске, чтобы ее
не пришлось заново строить при каждом запуске программы.
1 Хотите — верьте, хотите — нет, но это правда. Модуль Storable даже позволяет сериали-
зовать замыкания. За информацией о восстановлении сериализованных данных обра-
щайтесь к его документации.
466
Глава 11. Ссылки и записи
Решение
Воспользуйтесь функциями store и retrieve модуля Storable:
use Storable;
store(Uhash. "filename"):
# Позднее...
$href = retrleveCfllename"): # По ссылке
%hash = %{ retrleveCfllename") }: # Прямо в хэш
Комментарий
Модуль Storable использует функции С и двоичный формат для обхода внут-
ренних структур данных Perl и описания данных. По сравнению со строковой
реализацией сохранения записей в Perl такой вариант работает эффективнее,
однако он менее надежен.
Функции store и retrieve предполагают, что в передаваемых двоичных дан-
ных используется порядок байтов, стандартный для данного компьютера. Это
означает, что созданные этими функциями файлы нельзя передавать между раз-
личными архитектурами. Функция nstore делает то же, что и store, но сохраняет
данные в каноническом (сетевом) порядке следования байтов. Быстродействие
при этом несколько снижается:
use Storable qw(nstore);
nstore(Uhash, "filename");
# Позднее ...
$href = retrleveCfllename");
Независимо от того, какая функция сохраняла данные — store или nstore, для
их восстановления в памяти используется одна и та же функция retrieve. О пере-
носимости должен заботиться создатель данных, а не их потребитель. Если созда-
тель изменит свое решение, ему достаточно изменить программу всего в одном
месте. Тем самым обеспечивается последовательный интерфейс со стороны по-
требителя, который ничего не знает об этих изменениях.
Функции store и nstore не блокируют файлы, с которыми они работают.
Если вас беспокоят проблемы параллельного доступа, откройте файл самостоя-
тельно, заблокируйте его (см. рецепт 7.18) и воспользуйтесь функцией store_fd
или более медленной, но не зависимой от платформы версией nstore_fd.
Следующий фрагмент сохраняет хэш в файле с установкой блокировки. При
открытии файла не используется флаг O_TRUNC, поскольку до стирания содержи-
мого нам приходится ждать получения блокировки.
use Storable qw(nstore_fd);
use Fcntl qw(:DEFAULT :flock);
sysopen(DF, "/tmp/dataflle". O_RDWR|O_CREAT. 0666)
or die "can't open /tmp/dataflle; $!";
flock(DF. LOCK_EX) or die "can’t lock /tmp/dataflle: $!";
nstore_fd(Uhash, *DF)
or die "can't store hash\n";
truncate(DF, tell(DF));
close(DF);
11.14. Устойчивые структуры данных
467
Другой фрагмент восстанавливает хэш из файла, также с применением бло-
кировки:
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). На диске могут
сохраняться произвольные структуры данных. Вся структура должна читаться
или записываться полностью.
См. также
Рецепт 11.14.
11.14. Устойчивые структуры данных
Проблема
Существует сложная структура данных, которую требуется сделать устойчивой1
(persistent).
Решение
Воспользуйтесь модулем MLDBM и либо DB_FHe (предпочтительно), либо GDBM_FHe:
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; $!":
# ... Операции c %hash
untie %hash;
Комментарий
Конечно, построение хэша из 100 000 элементов займет немало времени. Сохра-
нение его на диске (медленно вручную или быстро с помощью Storable) также
потребует немалых расходов памяти и вычислительных ресурсов.
1 Термин «устойчивость» означает сохранение состояния между запусками программы.
Наряду с ним встречается также термин «перманентность». — Примеч. перев.
468
Глава И. Ссылки и записи
Модули DBM решают эту проблему посредством связывания хэшей с файлами
баз данных на диске. Вместо того чтобы читать всю структуру сразу, они извле-
кают данные лишь при необходимости. Для пользователя все выглядит так,
словно состояние хэша сохраняется между вызовами программы.
К сожалению, значения устойчивого хэша должны представлять собой про-
стые строки. Вам не удастся легко использовать базу данных для хранения хэша
хэшей, хэша массивов и т. д. — только хэшей строк.
Однако модуль CPAN MLDBM позволяет сохранять ссылки в базе данных. Пре-
образование ссылок в строки для внешнего хранения осуществляется с помощью
Data::Dumper:
use MLDBM qw(DB_File):
use Fcntl:
tiemash, ’MLDBM’, ’testfile, db ’, O_CREAT|O_RDWR. 0666)
or die "can't open tie to testfile.db: $!";
Теперь %hash может использоваться для выборки или сохранения сложных
записей на диске. Единственный недостаток заключается в том, что к ссылкам
нельзя обращаться напрямую. Приходится извлекать ссылку из базы, работать
с ней, а затем снова сохранять в базе.
# Не будет работать!
$hash{"some key"}[4] = "fred":
# ПРАВИЛЬНО
$aref = $hash{"some key"}:
$aref->[4] = "fred":
$hash{"some key"} = $aref:
См. также
Рецепт 11.13.
11.15. Циклические структуры данных
и слабые ссылки
Проблема
Имеется структура данных, содержащая циклические ссылки. Система уборки
мусора Perl основана на подсчете ссылок, поэтому система не заметит, когда
структура перестает использоваться в программе. Требуется предотвратить утеч-
ку памяти в программе.
Решение
Замените все внутренние ссылки в структуре данных слабыми ссылками, чтобы
они не увеличивали значение счетчика.
11.15. Циклические структуры данных и слабые ссылки
469
Комментарий
Система управления памятью Perl основана на механизме подсчета ссылок. Реше-
ние об освобождении памяти принимается на основании счетчика ссылок. На
практике такой подход работает достаточно хорошо, за одним исключением:
если переменная прямо или косвенно ссылается на саму себя. Пример:
{
ту ($а, $Ь):
($а, $Ь) = \($Ь, $а); # То же, что (\$Ь, \$а);
}
Для скалярных величин, представленных переменными $а и $Ь, в первой строке
блока счетчики ссылок инициализируются значением 1. Во второй строке каждой
из этих переменных присваивается ссылка на другую переменную; $а ссылается
на $Ь, и наоборот. Сохранение ссылки увеличивает счетчики, поэтому после вто-
рой строки значения обоих счетчиков становятся равны 2. При выходе из блока
лексические переменные становятся недоступными (по имени), и оба счетчика
уменьшаются до 1 — навсегда. Поскольку счетчики никогда не уменьшаются до О,
память, используемая двумя скалярными переменными, не освобождается. Таким
образом, при каждом выполнении блока возникает утечка памяти в размере двух
скаляров. В цикле это может со временем привести к исчерпанию всей памяти.
Функция Dump стандартного модуля Devel:: Peek выводит значения счетчиков
ссылок, а также делает многое другое. Фрагмент
use Devel::Peek;
$а = 42;
$b = \$а;
Dump $а;
выводит следующий результат:
SV = IV(0xd7cc4) at 0xd72b8
REFCNT = 2
FLAGS = (ЮК.рЮК)
IV = 42
Здесь важно, что счетчик ссылок (REFCNT) равен 2. Дело в том, что обращение
к скаляру может производиться двумя способами: через переменную $а и через
разыменование $Ь в синтаксисе $$Ь.
Ситуация воссоздается и без применения дополнительной переменной:
{ ту $а; $а = \$а; }
Такие ситуации чаще всего возникают при создании структуры данных, эле-
менты которой содержат прямые или косвенные ссылки на начальный элемент.
Представьте циклический список, то есть структуру данных типа «кольцо»:
$r1ng = {
VALUE => undef.
NEXT => undef.
PREV => undef.
}:
$ring->{NEXT} = $ring;
$ring->{PREV} = $r1ng;
470
Глава И. Ссылки и записи
Для хэша, на котором основана реализация, счетчик ссылок равен 3. При-
сваивание $г1 ng значения undef или выход его из области видимости уменьшает
счетчик только на 1, и в результате весь хэш начинает занимать память, недос-
тупную для Perl.
Для решения этой проблемы в Perl версии 5.6 появилась концепция слабых
ссылок. Слабые ссылки в целом похожи на обычные ссылки («жесткие», не «сим-
волические»), но существуют два принципиальных отличия: во-первых, слабые
ссылки не учитываются в счетчике ссылок субъекта, а во-вторых, при уничтоже-
нии субъекта в ходе уборки мусора слабая ссылка становится неопределенной.
Слабые ссылки идеально подходят для структур данных, содержащих внут-
ренние ссылки «на самих себя». При этом внутренние ссылки не учитываются
в счетчике ссылок структуры, а внешние — учитываются.
Хотя Perl поддерживает слабые ссылки начиная с версии 5.6, в стандартной
версии Perl не существовало встроенной функции weaken О для работы с ними.
Программисту приходилось обращаться к архиву CPAN и искать модуль Weak Ref.
Начиная с версии 5.8.1 функция weaken О включается в модуль Scalar:: Util.
Этот модуль также содержит функцию is_weak(), которая сообщает, является ли
слабой ссылка, переданная в аргументе.
Со слабыми ссылками только что рассмотренный пример с циклическим
списком выглядит так:
use Scalar::Util qw(weaken):
$ring = {
VALUE => undef,
NEXT => undef.
PREV => undef.
}:
$ring->{NEXT} = Sring:
$ring->{PREV} = Sring:
weaken($ring->{NEXT}):
weaken(Sr1ng->{PREV}):
В рецепте 13.13 показано, как создать циклический список без утечек памяти
при помощи изощренного фокуса с применением фиктивного головного узла
и объектно-ориентированного механизма, называемого деструктором. При ис-
пользовании слабых ссылок программа заметно упрощается. Ниже приведена
версия алгоритма из рецепта 13.13, в которой проблема утечки памяти решается
с помощью слабых ссылок:
use Scalar::Util qw(weaken):
my SCOUNT = 1000;
for (1..20) {
my Sring = node(100_000 + $_):
for my Svalue (1 .. SCOUNT) {
1nsert_value(Sr1ng. Svalue):
}
}
# Возвращение узла
sub node(S) {
my (Sinit-Value) =
my Snode = { VALUE => S1nit_value }:
11.15. Циклические структуры данных и слабые ссылки
471
$node->{NEXT} = $node->{PREV} = $node;
weaken($node->{NEXT}):
weaken($node->{PREV});
return $node;
}
# $node = search_r1ng($ring. $value) : Поиск $value в кольце
sub search_r1ng {
my ($ring, $value) =
my $node = $r1ng->{NEXT};
while ($node != $r1ng && $node->{VALUE} != $value) {
$node = $node->{NEXT};
}
return $node:
}
# 1nsert_value( $r1ng, Svalue ) : Вставка $value в кольцо
sub 1nsert_value {
my ($ring, $value) =
my $node = { VALUE => $value };
weaken($node->{NEXT} = $r1ng->{NEXT}):
weaken($ring->{NEXT}->{PREV} = $node);
weaken($ring->{NEXT} = $node);
weaken($node->{PREV} = $r1ng);
++$r1ng->{COUNT}:
}
# delete_value( $r1ng, $value ) : Удаление из кольца
# узла с заданным значением
sub delete_value {
my ($r1ng. $value) =
my $node = search_r1ng($r1ng, $value):
return If $node = = $r1ng;
$r1ng->delete_node($node);
}
# Удаление узла из кольца
sub delete_node {
my ($r1ng. $node) =
weaken($node->{PREV}->{NEXT} = $node->{NEXT}):
weaken($node->{NEXT}->{PREV} = $node->{PREV}):
--$r1ng->{COUNT}:
}
Каждый раз, когда мы сохраняем в структуре данных ссылку на эту же струк-
туру, мы ослабляем ее, чтобы эта ссылка не учитывалась в счетчике. В против-
ном случае затраты памяти резко подскочили бы. В этом нетрудно убедиться,
включив в цикл команду
systemU'ps v$$"):
(для систем, поддерживающих программу ^s(l)). Чтобы выявить утечку памя-
ти, достаточно отменить ослабление ссылок при любом из четырех присваива-
ний в функции Insert-Value.
См. также
Рецепт 13.13; документация по стандартным модулям Devel: :Peek и Scalar::Uti 1.
472
Глава 11. Ссылки и записи
11.16. Программа: Outlines
Одним из самых простых (и потому широко распространенных) способов структу-
рирования данных являются контурные схемы. Принцип, используемый в кон-
турных картах, вполне естественно распространяется на наш иерархический тип
мышления в восприятии окружающего мира. Единственная проблема — отсутст-
вие очевидного представления иерархических данных в структурах данных Perl.
Для примера возьмем контурную схему музыкальных жанров:
Alternative
.Punk
. .Emo
. .Folk Punk
.Goth
..Goth Rock
..Glam Goth
Country
.Old Time
.Bluegrass
.Big Hats
Rock
.80s
..Big Hair
..New Wave
.60s
..British
..American
Подгруппы обозначаются точками. Существует множество вариантов пред-
ставления этих данных. Например, можно вывести полные названия жанров:
Alternative
Alternative - Punk
Alternative - Punk - Emo
Alternative - Punk - Folk Punk
Alternative - Goth
Можно пронумеровать строки:
1 Alternative
1.1 Punk
1.1.1 Emo
1.1.2 Folk Punk
1.2 Goth
упорядочить их по алфавиту:
Alternative
Alternative - Goth
Alternative - Goth - Glam Goth
Alternative - Goth - Goth Rock
Alternative - Punk
Alternative - Punk - Emo
11.16. Программа: Outlines
473
или подчеркнуть иерархию наследования:
Alternative
Punk - Alternative
Emo - Punk - Alternative
Folk Punk - Punk - Alternative
Goth - Alternative
Goth Rock - Goth - Alternative
Подобные трансформации выполняются гораздо проще, чем кажется на первый
взгляд. Решение основано на представлении уровней иерархии как элементов
массива. Например, третий элемент в приведенной схеме представляется в виде:
@array = ("Alternative", "Goth", "Glam Goth"):
Теперь задача переформатирования решается элементарно. Существует эле-
гантный способ разбора входного файла для получения массива в нужном пред-
ставлении:
while (<FH>) {
chomp:
$tag[$in = s/\G\.//g] = $_:
# Работать c @tag[0..$in]
}
Подстановка удаляет начальные точки из текущей записи и возвращает ко-
личество удаленных символов. Это число определяет уровень отступа для теку-
щей записи.
Теперь задача упорядочения по алфавиту легко решается при помощи про-
граммы Unix sort:
$ISA =
open(STDOUT. "|sort -b -t'SISA' -df"):
while (<DATA>) {
chomp:
$tag[$in = s/\G\.//g] = $_:
print joint" $ISA ", @tag[0 .. $in]):
}
close STDOUT:
_ _END_ _
Alternative
.Punk
. .Emo
..Folk Punk
.Goth
Так же легко производится нумерация строк:
while (<DATA>) {
chomp:
$count[$in = s/\G\.//g]++:
delete @count[($in+l) .. $#count]:
print joint".", @count), " $_":
}
END
474
Глава 11. Ссылки и записи
Alternative
.Punk
. .Emo
..Folk Punk
.Goth
..Goth Rock
Обратите внимание: нумерация — единственный случай, при котором из мас-
сива удаляются элементы. Это связано с тем, что теперь в массиве хранятся не
имена уровней, а счетчики. При переходе на верхний уровень (например, с третье-
го уровня на второй) происходит сброс счетчика.
11.17. Программа: бинарные деревья
Встроенные типы данных Perl представляют собой мощные, динамические струк-
туры. В большинстве программ этих стандартных возможностей оказывается
вполне достаточно. Для выполнения простого поиска почти всегда следует ис-
пользовать простые хэши. Как выразился Ларри: «Весь фокус в том, чтобы ис-
пользовать сильные, а не слабые стороны Perl».
Однако хэши не обладают внутренним упорядочиванием элементов. Чтобы
перебрать элементы хэша в определенном порядке, необходимо сначала извлечь
ключи, а затем отсортировать их. При многократном выполнении это может от-
разиться на быстродействии программы, что, однако, вряд ли оправдывает за-
траты времени на разработку хитроумного алгоритма.
Древовидные структуры обеспечивают упорядоченный перебор. Как реализо-
вать дерево на Perl? Для начала загляните в свой любимый учебник по струк-
турам данных. Воспользуйтесь анонимным хэшем для представления каждого
узла дерева и переведите алгоритмы, изложенные в книге, на Perl. Обычно это
задача оказывается проще, чем кажется.
Программа в примере 11.1 демонстрирует простую реализацию бинарного дере-
ва, построенную на базе анонимных хэшей. Каждый узел состоит из трех полей:
левый потомок, правый потомок и значение. Важнейшее свойство упорядочен-
ных бинарных деревьев заключается в том, что значение левого потомка всегда
меньше, чем значение текущего узла, а значение правого потомка всегда больше.
Основная программа выполняет три операции. Сначала она создает дерево
с 20 случайными узлами, затем выводит три варианта обхода узлов дерева и, на-
конец, запрашивает у пользователя ключ и сообщает, присутствует ли этот ключ
в дереве.
Функция Insert использует механизм неявной передачи скаляров по ссылке
для инициализации пустого дерева при вставке пустого узла. Присваивание
$_[0] созданного узла приводит к изменению значения на вызывающей стороне.
Хотя такая структура данных занимает гораздо больше памяти, чем простой
хэш, и обычный перебор элементов в ней происходит медленнее, упорядоченные
перемещения выполняются быстрее.
Кстати говоря, бинарные деревья не следует путать со сбалансированными
деревьями; это более гибкая древовидная структура, которая обычно поддержи-
11.17. Программа: бинарные деревья
475
вается для данных, хранящихся на диске. Модуль DB_File поддерживает интер-
фейс BTREE (см. DB_File(3)), а Марк-Джейсон Доминус (Mark-Jason Dominus)
опубликовал превосходную статью о сбалансированных деревьях в «The Perl
Journal» (том 2, номер 4, зима 1997 г., с. 35-42).
Исходный текст программы приведен в примере 11.1.
Пример 11.1. bintree
#!/usr/Ыn/perl -w
# bintree - пример работы с бинарным деревом
use strict:
my($root. $n);
# Сгенерировать 20 случайных узлов
while ($n++ < 20) { insert($root, int(randQOOO)) }
# Вывести узлы дерева в трех разных порядках
print "Pre order: ": pre_order($root): print "\n":
print "In order: "; in_order($root): print "\n":
print "Post order: ": post_order($root): print "\n":
# Запрашивать до получения EOF
for (print "Search? "; <>; print "Search? ") {
chomp:
my Sfound = search($root, $_):
if ($found) { print "Found $_ at $found, $found->{VALUE}\n" }
else { print "No $_ in tree\n" }
}
exit:
// II II IIII II IIII II IIII II IIII II IIII II II II II II II II IIII II IIII II //# IIIIIIIIIIIIIIIIII
и1пти1г1ти1г1ти1г1ти1г1ти1г1т1г1т1г1т1г1ти1г1ти1г1тииииииишг7т1г
# Функция вставляет передаваемое значение в правильную позицию
# передаваемого дерева. Если дерево не передается.
# для используется механизм косвенной передачи по ссылке.
# что приводит к созданию дерева на вызывающей стороне,
sub insert {
my($tree, Svalue) =
unless ($tree) {
$tree = {}: # Создать новый узел
$tree->{VALUE} = Svalue:
$tree->{LEFT} = undef;
$tree->{RIGHT} = undef;
$_[0] = $tree: # $_[0] - ссылочный параметр!
return;
1
if ($tree->{VALUE} > $value) { insert($tree->{LEFT}. Svalue) }
elsif ($tree->{VALUE} < $value) { insert($tree->{RIGHT}, $value) }
else { warn "dup insert of $value\n" }
# XXX: узлы не должны повторяться
}
# Рекурсия по левому потомку.
# вывод текущего значения
# и рекурсия по правому потомку.
sub in_order {
my($tree) =
return unless $tree;
in_order($tree->{LEFT});
print $tree->{VALUE}. " ";
продолжение &
476
Глава 11. Ссылки и записи
Пример 11.1 (продолжение)
1n_order($tree->{RIGHT});
}
# Вывод текущего значения.
# рекурсия по левому потомку
# и рекурсия по правому потомку.
sub pre_order {
my($tree) =
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. $value) =
return unless $tree;
If ($tree->{VALUE} == $value) {
return $tree;
}
search($tree->{ ($value < $tree->{VALUE}) ? "LEFT" : "RIGHT"}. Svalue)
Пакеты, библиотеки
и модули
«Подобно всякому владельцу библиотеки, Ав-
релиан чувствовал вину, что не знает ее всю».
Хорхе Луис Борхес, «Богословы»
12.0. Введение
Представьте, что у вас есть две программы, каждая из которых хорошо работает
сама по себе. Возникает идея — создать третью программу, объединяющую луч-
шие свойства первых двух. Вы копируете обе программы в новый файл и начи-
наете перемещать фрагменты. Выясняется, что в программах встречаются пере-
менные и функции с одинаковыми именами, которые невозможно объединить.
Например, каждая программа может содержать функцию 1 nit или глобальную
переменную $count. При объединении эти компоненты вступают в конфликт.
Проблема решается с помощью пакетов. Пакеты используются в Perl для
разделения глобального пространства имен. Они образуют основу как для тра-
диционных модулей, так и для объектно-ориентированных классов. Подобно
тому как каталог содержит файлы, пакет содержит идентификаторы. Каждый
глобальный идентификатор (переменная, функция, манипулятор файла или
каталога, формат) состоит из двух частей: имени пакета и собственно иденти-
фикатора. Эти две части разделяются символами ::. Например, переменная
$CGI: :needs_binmode представляет собой глобальную переменную с именем $needs_
binmode, принадлежащую пакету CGI. Переменная $Names::startup — это перемен-
ная $startup пакета Names, a $Dates::startup — переменная $startup пакета Dates.
Идентификатор $startup без имени пакета означает глобальную переменную
$startup текущего пакета (при условии, что в данный момент не видна лексиче-
ская переменная Sstartup; о лексических переменных рассказано в главе 10,
«Процедуры»). При указании неполного имени (то есть имени переменной без
пакета) лексические переменные переопределяют глобальные. Лексическая пе-
ременная существует в области действия; глобальная — на уровне пакета. Если
вам нужна глобальная переменная, ее имя необходимо уточнить.
Ключевое слово package является объявлением, обрабатываемым на стадии
компиляции. Оно устанавливает префикс пакета по умолчанию для неполных
478
Глава 12. Пакеты, библиотеки и модули
глобальных идентификаторов, по аналогии с тем, как chdi г устанавливает пре-
фикс каталога по умолчанию для относительных путей. Влияние package распро-
страняется до конца текущей области действия (блока в фигурных скобках,
файла или eval) или до ближайшей команды package в той же области действия
(см. следующий фрагмент). Все программы выполняются в пакете main, пока ко-
мандой package в них не будет выбран другой пакет.
package Alpha;
$name = "first";
package Omega;
$name = "last";
package main;
print "Alpha is $Alpha::name. Omega is $0mega::name.\n";
Alpha is first. Omega is last.
В отличие от пользовательских идентификаторов, встроенные переменные
со специальными именами (например, $_ и $.) и идентификаторы STDIN, STDOUT,
STDERR, ARGV, ARGVOUT, ENV, INC и SIG без указания имени пакета считаются принад-
лежащими пакету main. Благодаря этому STDIN, OARGV, %ENV и $_ всегда означают
одно и то же независимо от текущего пакета; например, OARGV всегда относится
к @main::ARGV, даже если вы измените пакет по умолчанию командой package.
Уточненное имя @Е1 seWhere:: ARGV относится к нестандартному массиву OARGV и не
обладает специальным значением. Не забудьте локализовать переменную $_,
если вы используете ее в своем модуле.
Модули
Многократное использование кода в Perl осуществляется с помощью модулей.
Модуль представляет собой файл, содержащий набор взаимосвязанных функций,
которые используются другими программами и модулями. У каждого модуля
имеется внешний интерфейс — набор переменных и функций, предназначенных
для использования за его пределами. Внутри модуля интерфейс определяется
инициализацией некоторых пакетных переменных, с которыми работает стандарт-
ный модуль Exporter. За пределами модуля доступ к интерфейсу организуется
посредством импортирования имен, что является побочным эффектом команды
use. Внешний интерфейс модуля Perl объединяет все, что документировано
для всеобщего применения. К недокументированному интерфейсу относится
все, что не предназначено для широкой публики. Говоря о модулях в этой главе
и о традиционных модулях вообще, мы имеем в виду модули, использующие
Exporter.
Команды require и use подключают модуль к вашей программе, хотя и обла-
дают несколько разной семантикой. Команда require загружает модуль во время
выполнения с проверкой, позволяющей избежать повторной загрузки модуля.
Команда use работает аналогично, но с двумя дополнительными свойствами:
загрузкой модуля на стадии компиляции и автоматическим импортированием.
Модули, включаемые командой use, обрабатываются на стадии компиля-
ции, а обработка require происходит во время выполнения. Это существенно,
12.0. Введение
479
поскольку при отсутствии необходимого модуля программа даже не запустит-
ся — use не пройдет компиляцию сценария. Другое преимущество use перед
requl re заключается в том, что компилятор получает доступ к прототипам функ-
ций в подпрограммах модуля. Прототипы принимаются во внимание только
компилятором, но не интерпретатором (впрочем, как говорилось выше, мы ре-
комендуем пользоваться прототипами только для замены встроенных команд,
у которых они имеются).
Обработка команды use на стадии компиляции позволяет передавать указа-
ния компилятору. Директива (pragma) представляет собой специальный модуль,
влияющий на процесс компиляции Perl-кода. Имена директив всегда записывают-
ся в нижнем регистре, поэтому при написании обычного модуля следует выбирать
имена, начинающиеся с большой буквы. В Perl 5.8.1 поддерживается большое
количество директив, в том числе attributes, autouse, base, blglnt, blgnum, bigrat,
bytes, charnames, constant, diagnostics, fields, filetest, If, Integer, less, locale, open,
overload, sigtrap, sort, strict, subs, utf8, vars, vmslsh и warnings. Каждой директиве
соответствует отдельная страница руководства.
Другое отличие use и require заключается в том, что use выполняет неяв-
ное импортирование пакета включаемого модуля. Импортирование функции
или переменной из одного пакета в другой создает некое подобие синонима —
иначе говоря, появляются два имени, обозначающих одно и то же. Можно про-
вести аналогию с созданием ссылки на файл, находящийся в другом каталоге,
командой In /somedlr/somef 11 е. После подключения уже не придется вводить
полное имя для того, чтобы обратиться к файлу. Аналогично, импортированное
имя не приходится уточнять именем пакета (или заранее объявлять с помощью
use vars или use subs). Импортированные переменные можно использовать так,
словно они являются частью вашего пакета. Так, после импортирования перемен-
ной $Engl1sh: :OUTPUT_AUTOFLUSH в текущий пакет на нее можно ссылаться в виде
$OUTPUT_AUTOFLUSH.
Модули Perl должны иметь расширение .pm. Например, модуль F11 eHandle
хранится в файле F11 eHandle.pm. Полный путь к файлу зависит от включаемых
путей, хранящихся в глобальном массиве @INC. В рецепте 12.8 показано, как ра-
ботать с этим массивом.
Если имя модуля содержит одну или несколько последовательностей ::,
они преобразуются в разделитель каталогов вашей системы. Следовательно,
модуль File::Find в большинстве файловых систем будет храниться в файле
File/Find.pm. Например:
require "FIleHandle.pm";
require FIleHandle:
use FIleHandle:
require "Cards/Poker.pm";
require Cards::Poker:
use Cards::Poker:
# Загрузка во время выполнения
# Предполагается ".pm":
# то же. что и выше
# Загрузка во время компиляции
# Загрузка во время выполнения
# Предполагается ".pm":
# то же, что и выше
# Загрузка во время компиляции
480
Глава 12. Пакеты, библиотеки и модули
Правила импортирования/экспортирования
Процесс экспортирования демонстрируется ниже на примере гипотетического
модуля Cards::Poker. Программа хранится в файле Poker.pm в каталоге Cards,
то есть Cards/Poker.pm (о том, где должен находиться каталог Cards, рассказано
в рецепте 12.8). Приведем содержимое этого файла с пронумерованными для
удобства строками:
1 package Cards::Poker:
2 use Exporter:
3 @ISA = ('Exporter'):
4 @EXPORT = qw(&shuffle @card_deck):
5 @card_deck = О: # Инициализировать глобальные
# переменные пакета
6 sub shuffle { } # Определение
# заполняется позднее
71: # Не забудьте!
В строке 1 объявляется пакет, в который модуль поместит свои глобальные
переменные и функции. Обычно модуль начинается с переключения на конкрет-
ный пакет, что позволяет ему хранить глобальные переменные и функции так,
чтобы они не конфликтовали с переменными и функциями других программ.
Имя пакета должно быть записано точно так же, как и при загрузке модуля со-
ответствующей командой use.
Не пишите package Poker только потому, что модуль хранится в файле Poker.pm!
Используйте 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 заносит список (' &shuff1 е'. ' @card_deck') в специальный, существую-
щий на уровне пакета массив ^EXPORT. При импортировании модуля для перемен-
ных и функций, перечисленных в этом массиве, создаются синонимы в вызываю-
щем пакете. Благодаря этому после импортирования вам не придется вызывать
функцию в виде Poker: :Deck::shuff 1 е(23) — хватит простого shufflе(23). Этого не
произойдет при загрузке Cards::Poker командой require Cards::Poker; импортиро-
вание выполняется только для use.
Строки 5 и 6 готовят глобальные переменные и функции пакета к экспорти-
рованию (конечно, вы предоставите более конкретные инициализации и опреде-
12.0. Введение
481
ления, чем в нашем примере). Добавьте другие переменные и функции, включая
и те, которые не были включены во внешний интерфейс посредством (^EXPORT. Об
использовании модуля Exporter рассказано в рецепте 12.1.
Наконец, строка 7 определяет общее возвращаемое значение модуля. В нашем
случае это просто 1. Если последнее вычисляемое выражение модуля не дает ис-
тинного значения, инициируется исключение. Обработка исключений рассмат-
ривается в рецепте 12.2.
Пакеты обеспечивают логическую группировку и организацию глобальных
идентификаторов. Они не имеют ничего общего с ограничением доступа. Код,
откомпилированный в пакете Church, может свободно просматривать и изменять
переменные пакета State. Пакетные переменные всегда являются глобальными и
общедоступными. Но это вполне нормально, поскольку модуль представляет со-
бой больше, чем простой пакет; он также является файлом, а файлы обладают
собственной областью действия. Следовательно, если вам нужно ограничить
доступ, используйте лексические переменные вместо глобальных. Эта тема рас-
сматривается в рецепте 12.4.
Другие типы библиотечных файлов
Библиотека представляет собой набор неформально взаимосвязанных функ-
ций, используемых другими программами. Библиотеки не обладают жесткой
семантикой модулей Perl. Их можно узнать по расширению файла . pl — напри-
мер, syslog.pl или chat2.pl. Эти библиотеки включены в стандартную поставку
для совместимости с доисторическими сценариями, написанными на Perl вер-
сии 4 и ниже.
Библиотека Perl (а строго говоря, любой файл, содержащий код Perl) может
загружаться командой do "file.pl" или require "f 11 .pl". Обычно второй вариант
предпочтителен, поскольку в отличие от do, require выполняет неявную провер-
ку ошибок. Команда инициирует исключение, если файл не будет найден в пути
@INC, не компилируется или не возвращает истинного значения при выполнении
инициализирующего кода (последняя строка с 1, о которой говорилось выше).
Другое преимущество require заключается в том, что команда следит за загру-
женными файлами с помощью глобального хэша % INC. Если % INC сообщает, что
файл уже был загружен, он не загружается повторно.
Библиотеки хорошо работают в программах, однако в ситуациях, когда одна
библиотека использует другую, могут возникнуть проблемы. Соответственно,
простые библиотеки Perl в значительной степени устарели и были заменены бо-
лее современными модулями. Однако некоторые программы продолжают поль-
зоваться библиотеками, обычно загружая их командой requl re вместо do.
В Perl встречаются и другие расширения файлов. Расширение . ph использу-
ется для заголовочных файлов С, преобразованных в библиотеки Perl утилитой
h2ph (см. рецепт 12.17). Расширение .xs соответствует исходному файлу С (воз-
можно, созданному утилитой h2xs), скомпилированному утилитой xsubpp и ком-
пилятором С в машинный код. Процесс создания смешанных модулей рассмат-
ривается в рецепте 12.18.
До настоящего времени мы рассматривали лишь традиционные модули, кото-
рые экспортируют свой интерфейс, предоставляя вызывающей стороне прямой
доступ к некоторым подпрограммам и переменным. К этой категории относится
большинство модулей. Но некоторые задачи — и некоторые программисты —
482
Глава 12. Пакеты, библиотеки и модули
связываются с хитроумными модулями, содержащими объекты. Объектно-ори-
ентированный модуль редко использует механизм импортирования/экспорти-
рования. Вместо этого он предоставляет объектно-ориентированный интерфейс
с конструкторами, деструкторами, методами, наследованием и перегрузкой опе-
раторов. Данная тема рассматривается в главе 13.
Пользуйтесь готовыми решениями
CPAN (Comprehensive Perl Archive Network) представляет собой гигантское хра-
нилище практически всех ресурсов, относящихся к Perl, — исходных текстов, до-
кументации, версий для альтернативных платформ, и, что самое главное, моду-
лей — весной 2003 года их насчитывалось около 4500. Перед тем как браться за
новый модуль, загляните на CPAN и поищите там готовое решение. Даже если
его не существует, может найтись что-нибудь похожее, полезное в вашей работе.
Архив CPAN в настоящее время дублируется почти на 250 зеркальных сай-
тах. К нему можно обратиться по адресу http://www.cpan.org/. Если вы просто
хотите познакомиться с доступными модулями, просмотрите каталоги вручную.
Вы найдете в них многочисленные справочные данные, перечни новых модулей,
а также полные списки модулей, упорядоченные по названиям, именам авторов
или категориям.
Если вы считаете, что вручную копаться в тысячах модулей утомительно, су-
ществует удобная альтернатива — поисковый механизм http://search.cpan.org/.
Поддерживается поиск модулей по названиям и именам авторов, но часто более
полезным оказывается другое средство — поиск в документации всех зарегист-
рированных модулей. Благодаря ему вам не придется загружать и устанавливать
модуль только для того, чтобы узнать, что он должен делать.
См. также
Perlmod(V).
12.1. Определение интерфейса модуля
Проблема
Требуется определить внешний интерфейс модуля с помощью стандартного мо-
дуля Exporter.
Решение
Включите в файл модуля (например, YourModule.pm) приведенный ниже фрагмент.
Многоточия заполняются в соответствии с инструкциями, приведенными в раз-
деле «Комментарий».
package YourModule:
use strict:
our (©ISA. OEXPORT. @EXPORT_OK, £EXPORT_TAGS, $VERSION):
12.1. Определение интерфейса модуля
483
use Exporter;
$VERSION =1.00; # Или выше
@ISA = qw(Exporter):
©EXPORT = qw(...);
@EXPORT_OK = qw(...):
mPORT_TAGS = (
TAG1 => [...].
TAG2 => [...].
# Автоматически экспортируемые имена
# (набор :DEFAULT)
# Имена, экспортируемые по запросу
# Определение имен для наборов
):
// // //// // // ###7/ //
WititHHUHTrirttltltunirW'fl'itHirnirTiir
# Ваш программный код
########################
# Так должна выглядеть последняя строка
Чтобы воспользоваться модулем YourModule в другом файле, выберите один
из следующих вариантов:
use YourModule: # Импортировать в пакет имена по умолчанию
use YourModule qw(...); # Импортировать в пакет перечисленные имена
use YourModule О: # Не импортировать никаких имен
use YourModule qw(:TAGl): # Импортировать набор имен
Комментарий
Внешний интерфейс модуля определяется с помощью стандартного модуля
Exporter: Хотя в пакете можно определить собственный метод import, почти ни-
кто этого не делает.
Когда в программе встречается команда use YourModule, в действительности
выполняется команда require ’’YourModule.pm”, за которой вызывается метод
YourModule->import(). Это происходит во время компиляции. Метод import, уна-
следованный из пакета Exporter, ищет в вашем пакете глобальные переменные,
управляющие его работой. Поскольку они должны быть пакетными, мы исполь-
зуем директиву use vars, чтобы избежать проблем с use strict. Это следующие
переменные:
$VERSION
При загрузке модуля можно указать минимальный допустимый номер версии.
Если версия окажется ниже, use инициирует исключение.
use YourModule 1.86 # Если $VERSI0N < 1.86, происходит исключение
©EXPORT
Массив содержит список функций и переменных, экспортируемых в простран-
ство имен вызывающей стороны, чтобы в дальнейшем к ним можно было обра-
щаться без уточнения имени пакета. Обычно используется список в форме qw():
©EXPORT = qw(&Fl &F2 ©List):
^EXPORT = qw( Fl F2 ©List): # To же
484
Глава 12. Пакеты, библиотеки и модули
После выполнения простой команды use YourModule вы сможете вызывать функ-
цию &F1 в виде F1O вместо YourModule: :F1() и обращаться к массиву @List вместо
@YourModule:: LI st. Амперсанд (&) перед спецификацией экспортированной функ-
ции необязателен.
Чтобы загрузить модуль во время компиляции, но при этом запретить экс-
портирование каких-либо имен, воспользуйтесь специальной формой с пустым
списком use ExporterO.
@EXPORT_OK
Массив содержит имена, которые могут импортироваться по конкретному запро-
су. Если массив заполнен следующим образом:
@EXPORT_OK = qw(0p_Func Hable):
то пользователь сможет загрузить модуль командой:
use YourModule qw(0p_Func Hable Fl);
и импортировать только функцию Op_Func, хэш ЖТаЫ е и функцию F1. Функция
F1 присутствует в массиве (^EXPORT. Обратите внимание: команда не выполняет
автоматического импортирования F2 или @Li st, хотя эти имена присутствуют в
@EXPORT. Чтобы получить все содержимое ^EXPORT и плюс к тому все дополнитель-
ное содержимое @EXPORT_OK, воспользуйтесь специальным тегом : DEFAULT:
use YourModule qw(-.DEFAULT Hable):
%EXPORT_TAGS
Хэш используется большими модулями (типа CGI или POSIX) для высокоуровневой
группировки взаимосвязанных импортируемых имен. Его значения представляют
собой ссылки на массивы символических имен, каждое из которых должно при-
сутствовать либо в OEXPORT, либо в @EXPORT_OK. Приведем пример инициализации:
%EXPORT_TAGS = (
Functions => [ qw(Fl F2 Op_Func) ],
Variables => [ qw(@L1st Hable) ].
):
Импортируемое имя с начальным двоеточием означает импортирование груп-
пы имен. Например, команда:
use YourModule qw(functions Hable);
импортирует все имена из
@{ $YourModule:;EXPORT_TAGS{Functions} }.
то есть функции Fl, F2 и Op_Func, а затем — хэш Hable.
Хотя тег ; DEFAULT не указывается в HXPORT_TAGS, он обозначает все содержи-
мое ^EXPORT.
Все эти переменные не обязательно определять в каждом модуле. Ограничь-
тесь лишь теми, которые будут использоваться.
См. также
Документация по стандартному модулю Exporter; рецепт 12.8; рецепт 12.22.
12.2. Обработка ошибок require и use
485
12.2. Обработка ошибок require и use
Проблема
Загружаемый модуль может отсутствовать в системе. Обычно попытка загрузки
несуществующего модуля приводит к фатальной ошибке. Вы хотите обнаружить
и перехватить эту ошибку.
Решение
Поместите require или use в eval, a eval — в блок BEGIN:
# Не импортировать
BEGIN {
unless (eval "require $mod: 1") {
warn "couldn't load $mod: :
}
}
# Импортировать в текущий пакет
BEGIN {
unless (eval "use $mod: 1") {
warn "couldn't load $mod:
}
}
Комментарий
Попытка загрузки отсутствующего или неполного модуля обычно должна при-
водить к аварийному завершению программы. Однако в некоторых ситуациях
программа должна продолжить работу, например, попытаться загрузить другой
модуль. Как и при других исключениях, для изолирования ошибок компиляции
применяется конструкция eval.
Использовать eval { БЛОК } нежелательно, поскольку в этом случае будут
перехватываться только исключения времени выполнения, a use относится к со-
бытиям времени компиляции. Вместо этого следует использовать конструкцию
eval "СТРОКА", что позволит перехватывать и ошибки компиляции. Помните: вы-
зов requl re для простого слова1 имеет несколько иной смысл, чем вызов requi re
для переменной. Команда добавляет расширение . pm и преобразует :: в раздели-
тель каталогов вашей операционной системы — в каноническом варианте / (как
в URL), но в некоторых системах используются \, : и даже . .
Если вы хотите последовательно попытаться загрузить несколько модулей
и остановиться на первом работающем, поступите так:
BEGIN {
my($found. @DBs. $mod):
$found = 0:
1 «Простым словом» (bareword) называется слово, не имеющее специальной грамматиче-
ской интерпретации и интерпретируемое как строка. — Примеч. перев.
486
Глава 12. Пакеты, библиотеки и модули
@DBs = qwCGiant::Eenie Giant::Meanie Mouse::Mynie Мое);
for $mod (@DBs) {
if (eval "require $mod") {
$mod->import(): # При необходимости
$found = 1;
last:
}
}
die "None of @DBs loaded" unless $found:
Мы включаем eval в блок BEGIN, чтобы гарантировать загрузку модуля во вре-
мя компиляции, а не во время выполнения.
См. также
Описания функций eval, die, use и require вperlfunc(l); рецепт 10.12; рецепт 12.3.
12.3. Отложенное использование модуля
Проблема
Имеется модуль, который не обязательно загружать при каждом запуске про-
граммы или загрузку которого желательно отложить до определенного момента
в работе программы.
Решение
Разбейте use на отдельные компоненты require и import, либо воспользуйтесь
директивой use autouse.
Комментарий
Если программа проверяет свои аргументы и завершает работу с информацион-
ным сообщением или ошибкой, загружать неиспользуемые модули бессмыслен-
но. Это лишь вызывает задержки и раздражает пользователей. Но, как говори-
лось во Введении, команды use обрабатываются во время компиляции, а не во
время выполнения.
Наиболее эффективная стратегия состоит в проверке аргументов внутри бло-
ка BEGIN до загрузки модулей. Следующая программа перед загрузкой необходи-
мых модулей проверяет, что она была вызвана ровно с двумя аргументами, каж-
дый из которых является целым числом:
BEGIN {
unless (@ARGV == 2 && (2 == grep {/x\d+$/} 0ARGV)) {
die "usage: $0 numl num2\n":
}
}
use Some;;Module:
use More;:Modules;
12.3. Отложенное использование модуля
487
Похожая ситуация возникает в программах, которые при разных запусках
могут использовать разные наборы модулей. Например, программа factors из
главы 2 «Числа» загружает библиотеку вычислений с повышенной точностью
лишь при запуске с ключом -Ь. Команда use в данном случае бессмысленна, по-
скольку она обрабатывается во время компиляции, задолго до проверки усло-
вия If. По этой причине мы используем команду require:
If ($opt_b) {
require Math::Blglnt;
}
Модуль Math::Blglnt является не традиционным, а объектно-ориентирован-
ным, поэтому импортирование не требуется. Если у вас имеется список импор-
тируемых объектов, укажите его в конструкции qw() так, как это было бы сдела-
но для use. Например, вместо:
use Fcntl qw(O_EXCL O_CREAT O_RDWR);
можно использовать следующую запись:
require Fcntl:
Fcntl->1mport(qw(0_EXCL O_CREAT O_RDWR)):
Откладывая импортирование до времени выполнения, мы сознательно идем
на то, что оставшаяся часть программы не узнает об изменениях импортирован-
ной семантики, которые были бы видны компилятору при использовании use.
В частности, не будут своевременно видны прототипы функций и переопределе-
ния встроенных функций.
Возникает идея — инкапсулировать отложенную загрузку в процедуре. Сле-
дующее, простое на первый взгляд решение не работает:
sub load_module {
require $_[0]: #НЕВЕРНО
Import $Д0]; «ВЕРНО
}
Понять причину неудачи непросто. Представьте себе вызов require с аргу-
ментом "Math::BlgFloat". Если это простое слово, :: преобразуется в разделитель
каталогов операционной системы, а в конец добавляется расширение . pm. Но про-
стая переменная интерпретируется как литерал — имя файла. Дело усугубляет-
ся тем, что Perl не имеет встроенной функции Import. Существует лишь метод
Import, который мы пытаемся применить с сомнительным косвенным объектным
синтаксисом. Как и в случае с применением косвенных файловых манипулято-
ров, косвенный объект можно использовать лишь для простой скалярной пере-
менной, простого слова или блока, возвращающего объект. Выражения, а также
отдельные элементы массивов или хэшей здесь недопустимы.
Усовершенствованный вариант выглядит так:
load_module(’Fcntl’, qw(O_EXCL O_CREAT O_RDWR)):
sub load_module {
eval "require
die If $@:
$_[0]->1mport(@_[l .. $#_]):
488
Глава 12. Пакеты, библиотеки и модули
Но и он в общем случае не идеален. Функция должна импортировать имена
не в свой пакет, а в пакет вызвавшей стороны. В принципе эта проблема решает-
ся, но процедура становится все сложнее и сложнее.
В отдельных случаях условие удается проверить до запуска программы —
например, если в нем используются только встроенные, заранее определенные
переменные, или вы организовали инициализацию переменных, используемых
в условном выражении, на стадии компиляции при помощи блока BEGIN. В этом
случае пригодится директива 1 f со следующим синтаксисом:
use УСЛОВИЕ, МОДУЛЬ:
use УСЛОВИЕ, МОДУЛЬ => АРГУМЕНТЫ:
Пример:
use If $х0 =~ /bsd/1, BSD::Resource;
use If $] >= 5.006-01. F11e::Temp => qw/tempflle tempdir/:
Удобное альтернативное решение — применение директивы autouse. Эта ди-
ректива экономит время для редко загружаемых функций, откладывая их загруз-
ку до момента фактического использования:
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 обращайтесь к электрон-
ной документации.
См. также
Рецепт 12.2; документация по стандартному модулю Exporter (описание метода
Import); документация по стандартной директиве use autouse.
12.4. Ограничение доступа
к переменным модуля
Проблема
Требуется сделать переменную закрытой (то есть разрешить ее использование
только в границах пакета).
12.4. Ограничение доступа к переменным модуля
489
Решение
Общего решения не существует. Однако можно ограничить доступ на уровне
файла, в котором находится модуль, — обычно этого достаточно.
Комментарий
Помните, что пакет всего лишь определяет способ группировки переменных
и функции и потому не поддерживает ограничения доступа. Все содержимое
пакета по определению является глобальным и доступным отовсюду. Пакеты
лишь группируют, ничего не скрывая.
Ограничение доступа возможно только с применением лексических перемен-
ных. Предположим, модуль реализован в виде файла Module.pm, а все его глобаль-
ные имена принадлежат пакету Module. Поскольку файл по определению образует
самостоятельную область действия, а лексические переменные ограничиваются
ею, создание лексической переменной с файловой областью действия фактиче-
ски эквивалентно переменной, ограниченной данным модулем.
Однако переключение пакетов внутри области действия может привести к
тому, что лексические переменные этой области остаются видны в любом месте
области. Дело в том, что команда package всего лишь устанавливает новый пре-
фикс для глобальных идентификаторов, она не завершает текущую область дей-
ствия и не начинает новой области:
package Alpha:
my $аа = 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. Считайте, что глобальные и лексические переменные существу-
ют в разных измерениях, никак не связанных друг с другом. Пакетные команды
не имеют ничего общего с лексическими переменными. После установки те-
кущего префикса первая глобальная переменная $х в действительности пред-
ставляет собой $А1 pha: :х, а вторая — $Beta: :х, поскольку промежуточная коман-
да package изменила префикс по умолчанию. Доступ к пакетным идентификато-
рам при указании полного имени может осуществляться откуда угодно, как это
делается в команде print.
Итак, пакеты не позволяют ограничивать доступ — зато на это способны мо-
дули, поскольку они находятся в файлах, а файл всегда обладает собствен-
ной областью действия. Приведенный ниже простой модуль находится в файле
Flipper.pm и экспортирует две функции, flip_words и flip_boundary. Первая функция
490
Глава 12. Пакеты, библиотеки и модули
переставляет слова строки в обратном порядке, а вторая изменяет определение
границы слова.
# Flipper.pm
package Flipper:
use strict;
require Exporter:
use vars qw(@ISA ^EXPORT $VERSION);
@ISA = qw(Exporter):
^EXPORT = qw(f!1p_words fl1p_boundary):
$VERSION =1.0:
my $Separatr1x = " ": # По умолчанию пробел: предшествует функциям
sub fl1p_boundary {
my $prev_sep = $Separatr1x:
If (@_) { $Separatr1x = $_[0] }
return $prev_sep:
}
sub f!1p_words {
my $11ne = $_[0]:
my @words = spl1t($Separatr1x. $11ne):
return jo1n($Separatr1x. reverse @words):
}
1:
Модуль задает значения трех пакетных переменных, необходимых для работы
Exporter, а также инициализирует лексическую переменную SSeparatrlx уровня
файла. Как говорилось выше, эта переменная ограничивается границами файла,
а не пакета. Весь код той же области действия, расположенный после ее объявле-
ния, прекрасно видит $Separatr1x. Хотя глобальные переменные не экспортирова-
лись, к ним можно обращаться по полному имени, например, $F11 pper: -.VERSION.
Лексические переменные, существующие в некоторой области действия, нель-
зя прочитать или изменить вне этой области, которая в данном случае соответ-
ствует всему файлу после объявления переменной. На лексические переменные
нельзя ссылаться по полному имени или экспортировать их; экспортирование
возможно лишь для глобальных переменных. Если кому-либо за пределами моду-
ля потребуется просмотреть или изменить лексические переменные файла, они
должны обратиться с запросом к модулю. Именно здесь в игру вступает функция
fl1p_boundary, обеспечивающая косвенный доступ к закрытым компонентам модуля.
Работа приведенного выше модуля ничуть не изменилась бы, будь $Separatr1x
пакетной глобальной переменной, а не файловой лексической. Теоретически
к ней можно было бы обратиться снаружи так, чтобы модулю об этом ничего не
было известно. Однако не стоит увлекаться чрезмерными ограничениями и щед-
ро уснащать модули лексическими переменными с файловой областью действия.
У вас уже имеется пространство имен (в нашем примере — Flipper), в котором
можно сохранить все необходимые идентификаторы. Собственно, для этого оно
и предназначено. Хороший стиль программирования на Perl почти всегда избе-
гает полного уточнения идентификаторов.
Если уж речь зашла о стиле, регистр символов в идентификаторах модуля
Flipper выбирался не случайно. В соответствии с руководством по стилю про-
граммирования на Perl, символами верхнего регистра записываются идентифи-
12.5. Ограничение доступа к функциям модуля
491
каторы, имеющие специальное значение для Perl. Имена функций и локальных
переменных записываются в нижнем регистре. Устойчивые переменные модуля
(файловые лексические или пакетные глобальные) начинаются с символа верх-
него регистра. Если идентификатор состоит из нескольких слов, то для удобства
чтения эти слова разделяются символами подчеркивания. Мы не рекомендуем
разделять слова символами верхнего регистра без подчеркиваний — в конце
концов, вряд ли вам захотелось бы читать эту книгу без пробелов.
См. также
perlstyle(Vp рецепт 10.2; рецепт 10.3. Лексические переменные с файловой обла-
стью действия рассматриваются в perlmod(\).
12.5. Ограничение доступа
к функциям модуля
Проблема
Требуется сделать функцию закрытой, то есть разрешить ее использование толь-
ко в границах пакета.
Решение
Общего решения не существует. Однако вы можете создать закрытую перемен-
ную и сохранить в ней ссылку на закрытую функцию:
# Некий файл SomeModule.pm
package Some_Module:
my $secret_function = sub {
# Ваш код
}:
sub regular_funct1on {
# Вызов "закрытой" функции по ссылке
$secret_function->(ARGl. ARG2);
}
Комментарий
Даже если функция не была экспортирована, она все равно доступна для всех,
кто уточнит имя функции именем ее пакета. Это объясняется тем, что имена функ-
ций всегда хранятся в глобально доступной таблице символических имен пакета.
Если создать в модуле лексическую переменную с файловой областью дейст-
вия, то после точки объявления переменная будет полностью доступна для всего
кода модуля, но не для кода других файлов, поскольку эти области действия
никак не связаны. Однако процедуры, создаваемые конструкцией sub {...}, аноним-
ны, поскольку в таблице символических имен отсутствуют имена, по которым
492
Глава 12. Пакеты, библиотеки и модули
к ним можно было бы обратиться извне. Даже код текущего модуля не может обра-
титься к функции по имени, поскольку такого имени не существует, однако возмож-
но использование лексической переменной для разыменования ссылки на этот код:
$secret_funct1on->(ARGS); # Инфиксное разыменование
&$secret_funct1on(ARGS); # Префиксное разыменование
Любопытно заметить, что при желании анонимной функции можно присво-
ить временное имя. Используя методику из рецепта 10.16, присвойте ссылку на
код локализованному тип-глобу:
sub module_funct1on {
local *secret = $secret_funct1on;
Other_Package::funcl( );
secret(ARGl, ARG2):
Y et_Another_Package::func2( );
}
Теперь внутри module-function ранее скрытая функция может вызываться на-
прямую, без разыменования. Тем не менее функция также становится доступ-
ной и для кода за пределами модуля. В данном случае неважно, находятся ли
fund и func2 в файловой области действия модуля, потому что вы создали вре-
менный элемент в таблице символических имен, через который можно обра-
титься к закрытой функции. Следовательно, если функция OtherPackage: :funcl
захочет вызвать Some_Module:: secret, она ее найдет — но только если fund вызы-
вается из module_function в приведенном примере. Если она будет вызвана из
другой точки, в таблице символических имен Some_Module функции secret не будет,
поэтому попытка вызова завершится неудачей.
Это несколько странное поведение, при котором значения и видимость вре-
менных величин зависят от того, кто кого вызвал на стадии выполнения, называ-
ется динамической областью видимости. Такова природа ключевого слова local.
Теперь вы понимаете, почему мы обычно не рекомендуем использовать его.
См. также
Рецепт 12.4.
12.6. Определение пакета вызывающей
стороны
Проблема
Требуется узнать текущий или вызывающий пакет.
Решение
Текущий пакет определяется так:
$this_pack = _PACKAGE_;
12.6. Определение пакета вызывающей стороны
493
Пакет вызывающей стороны определяется так:
$that_pack = call er О;
Комментарий
Метапеременная_____PACKAGE__возвращает пакет, в котором был откомпилирован
текущий код. Ее значение не интерполируется в строках, заключенных в кавычки:
print "I am in package _PACKAGE_\n": # НЕВЕРНО!
I am in package _PACKAGE_
Необходимость узнать пакет вызывающей стороны чаще возникает в старом
коде, которому в качестве входных данных была передана строка для eval, фай-
ловый манипулятор, формат или имя манипулятора каталога. Рассмотрим гипо-
тетическую функцию г unit:
package Alpha:
runit('$11ne = <TEMP>'):
package Beta:
sub runit {
my $codestr = shift:
eval $codestr:
die If $0:
}
Поскольку функция runit была откомпилирована в пакете, отличном от те-
кущего, с точки зрения eval все выглядит так, словно передавались $Beta: :11пе
и Beta: :ТЕМР. В существовавшем ранее обходном решении сначала включался
пакет вызывающей стороны:
package Beta:
sub runit {
my $codestr = shift:
my $h1spack = caller;
eval "package $h1spack; $codestr";
die If
}
Такой подход работает лишь в том случае, если переменная $1 Ine является
глобальной. Для лексических переменных он не годится. Вместо этого следует
организовать передачу функции runit ссылки на функцию:
package Alpha;
run1t( sub { $11ne = <TEMP> } ):
package Beta:
sub runit {
my $coderef = shift:
&$coderef( );
}
Новое решение не только работает с лексическими переменными, но и обла-
дает дополнительным преимуществом — синтаксис кода проверяется во время
компиляции, а это существенный плюс.
494
Глава 12. Пакеты, библиотеки и модули
Если передаваемые данные ограничиваются простым файловым манипулятором,
стоит воспользоваться более переносимым решением — функцией Symbol:: qualify.
Функция получает имя и пакет, для которого оно уточняется. Если имя нужда-
ется в уточнении, оно исправляется, а в противном случае остается без измене-
ний. Однако это решение заметно уступает по эффективности прототипу *
Следующий пример читает и возвращает п строк из файлового манипулято-
ра. Перед операциями с манипулятором функция уточняет его вызовом qualify.
open (FH, "/etc/termcap") or die ’’can’t open /etc/termcap: $!":
(Sa. Sb. Sc) = nreadline(3. "FH"):
use Symbol ():
use Carp:
sub nreadline {
my (Scount, Shandie) =
my(@retl 1st. SHne);
croak "count must be > 0" unless Scount > 0:
Shandie = Symbol::qual1fy(Shandie, (cal 1 er())CO]):
croak "need open filehandle" unless defined flleno(Shandle):
push(@retlist, SHne) while def1ned($11ne = <$handle>) && Scount--:
return ©retl1st:
}
Если при вызове функции nreadline файловый манипулятор всегда передает-
ся в виде тип-глоба *FH, ссылки на глоб \*FH или с помощью объектов FIleHandle
или 10::Handle, уточнение не потребуется. Оно необходимо лишь на случай пере-
дачи минимального "FH".
См. также
Документация по стандартному модулю Symbol; рецепты 7.6 и 12.14. Специаль-
ные метапеременные_FILE_,_LINE_и_PACKAGE_описаны в perldata(\).
12.7. Автоматизированное выполнение
завершающего кода
Проблема
Требуется создать для модуля начальный и завершающий код, вызываемый
автоматически без вмешательства пользователя.
Решение
Начальный код реализуется просто — разместите нужные команды вне опре-
делений подпрограмм в файле модуля. Завершающий код помещается в блок
END модуля.
12.7. Автоматизированное выполнение завершающего кода
495
Комментарий
В некоторых языках программист должен помнить о том, что перед вызовом ка-
ких-либо обычных функций модуля необходимо вызвать код инициализации
модуля. Кроме того, при выходе из программы иногда приходится вызывать
специальный завершающий код, определенный в модуле.
В Perl дело обстоит иначе. В качестве кода инициализации модуля использу-
ются исполняемые команды, не принадлежащие ни одной из процедур. При за-
грузке модуля сразу же выполняется этот код. Пользователю не нужно помнить
о его вызове, поскольку это делается автоматически.
Но зачем может понадобиться автоматическое выполнение завершающего
кода? Все зависит от модуля. Например, вы можете направить сообщение о вы-
грузке в файл журнала, приказать серверу базы данных закрепить все незавер-
шенные транзакции, обновить содержимое экрана или вернуть терминал в ис-
ходное состояние.
Предположим, модуль должен незаметно регистрировать события запуска или
завершения программы. Код, выполняемый при завершении программы, должен
находиться в процедуре END:
$Logf11e = "/tmp/туlog" unless defined $Logf1le:
open(LF, . $Logf11e)
or die "can't append to $Logf1 le: $!":
select(((select(LF), $|=l))[0]): # Отмена буферизации
logmsg("startup"):
sub logmsg {
my $now = scalar gmtlme;
print LF "$0 $$ $now: @_\n"
or die "write to $Logf11e failed: $!":
}
END {
logmsg("shutdown"):
close(LF)
or die "close $Logf11e failed: $!":
}
Первый фрагмент, не входящий ни в одно из объявлений процедур, выполня-
ется во время загрузки модуля, не требуя никаких особых действий со стороны
пользователя. Впрочем, если файл недоступен, это может преподнести кому-то
неприятный сюрприз, поскольку из-за die вызов use или require завершится не-
удачей.
Процедуры END (выходные обработчики) являются аналогами trap 0 в команд-
ном интерпретаторе, atexlt в языке С, глобальных деструкторов или завершите-
лей в объектно-ориентированных языках. Все процедуры END в программе вы-
полняются в порядке, противоположном порядку их загрузки (то есть первой
выполняется процедура END последнего загруженного модуля). Это происходит
при нормальном завершении программы с достижением конца основного процес-
са, явном вызове функции exit, неперехваченном исключении (die) или ошибке
деления на 0.
496
Глава 12. Пакеты, библиотеки и модули
Однако с неперехваченными сигналами дело обстоит иначе — завершение про-
граммы по сигналу не приводит к выполнению выходных обработчиков. Сле-
дующая директива решает эту проблему:
use sigtrap qw(die normal-signals error-signals);
В результате все нормальные сигналы и сигналы об ошибках заставляют вашу
программу прекратить свое существование через механизм die; сигналы фактиче-
ски преобразуются в исключения, благодаря чему выполняются обработчики END.
Можно действовать еще более изощренно:
use sigtrap qw(
die untrapped normal-signals.
stack-trace any untrapped error-signals
):
Директива означает, что программа должна завершаться через die только
для неперехваченных нормальных сигналов, а для сигналов об ошибках перед
завершением должна выполняться трассировка стека (по аналогии с функцией
Confess из модуля Carp).
Функция END также не вызывается при полиморфировании процесса функ-
ции ехес, поскольку процесс остается прежним, изменяется только программа.
Сохраняются все стандартные атрибуты процесса (идентификатор процесса, иден-
тификатор родителя, идентификаторы пользователя и группы, umask, текущий
каталог, переменные окружения, лимиты ресурсов и накопленная статистика,
дескрипторы открытых файлов (но см. описание переменной $^Е в perlvar(l)).
Если бы дело обстояло иначе, это привело бы к лишнему выполнению выход-
ных обработчиков в программах, вручную управляющих своими вызовами fork
и ехес, что было бы нежелательно.
См. также
Описание стандартной директивы use sigtrap в разделе «Package Constructors and
Destructors» perlmod{\.y, описание переменной $^F ($SYSTEM_FD_MAX) в perldata(\y
описание функций fork и exec в perlmod(\.).
12.8. Ведение собственного каталога модулей
Проблема
Вы не хотите включать собственные модули в стандартную библиотеку расши-
рений системного уровня.
Решение
Возможно несколько вариантов: воспользоваться параметром командной строки
Perl -I; присвоить значение переменной окружения PERL5LIB; применить дирек-
тиву use lib (возможно, в сочетании с модулем FindBin).
12.8. Ведение собственного каталога модулей
497
Комментарий
Массив @INC содержит список каталогов, которые просматриваются при каждой
компиляции кода из другого файла, библиотеки или модуля командой do, requl re
или use. Содержимое массива легко вывести из командной строки:
% perl -е 'prlntf "£d £s\n", $1++. $_ for ©INC
0 /usr/1ocal/11b/perl5/5.8.0/OpenBSD.i386-openbsd
1 /usr/1 ocal/11b/perl5/5.8.0
2 /usr/1 ocal/11b/perl5/s 1te_perl/5.8.0/OpenBSD.1386-openbsd
3 /usr/1ocal/11b/perl5/s1te_perl/5.8.0
4 /usr/1ocal/11b/perl5/s1te_perl/5.6.0
5 /usr/1 ocal/11b/perl5/s1te_perl/5.00554
6 /usr/1 ocal /11b/perl5/s1te_perl/5.005
7 /usr/local/11b/perl5/s1te_perl
8 .
Первые два элемента (0 и 1) массива @1NC содержат обычные платформо-зави-
симый и платформо-независимый каталоги, с которыми работают все стандарт-
ные библиотеки, модули и директивы. Этих каталогов два, поскольку некото-
рые модули содержат данные или форматирование, имеющие смысл лишь для
конкретной архитектуры. Например, модуль Config содержит информацию, от-
носящуюся лишь к некоторым архитектурам, поэтому он находится в 0 элементе
массива. Здесь же хранятся модули, содержащие откомпилированные компонен-
ты на С (например, Socket.so). Однако большинство модулей находится в эле-
менте 1 (независимый от платформы каталог).
Следующая пара, элементы 2 и 3, по своим функциям аналогична элементам
О и 1, но относится к конкретной системе. Допустим, у вас имеется модуль, кото-
рый не поставлялся с Perl, например, модуль, загруженный из архива CPAN или
написанный вами. Когда вы (или, что более вероятно, ваш системный админи-
стратор) устанавливаете этот модуль, его компоненты попадают в один из этих
каталогов. Эти каталоги следует использовать для любых модулей, которые
должны быть легко доступными в границах вашей системы.
В этой конкретной конфигурации также присутствуют элементы 4-7, исполь-
зуемые Perl для поиска любых системно-зависимых модулей, установленных
в предыдущей версии Perl. Такие каталоги автоматически добавляются в ©INC при
настройке, построении и установке новой версии Perl, что упрощает модернизацию.
Последний стандартный элемент, "." (текущий рабочий каталог), использу-
ется только в процессе разработки и тестирования программ. Если модули нахо-
дятся в каталоге, куда вы перешли последней командой chdlr, все хорошо. Если
в любом другом месте — ничего не получится.
Иногда ни один из каталогов, указанных в ©INC, не подходит. Допустим, у вас
имеются личные модули, или ваша рабочая группа использует свой набор моду-
лей, относящихся только к данному проекту. В этом случае необходимо допол-
нить поиск по стандартному содержимому ©INC.
В первом варианте решения используется флаг командной строки -1список_
каталогов. После -1 указывается список из одного или нескольких каталогов,
разделенных двоеточиями1. Список вставляется в начало массива ©INC. Этот
1 Или запятыми в MacOS.
498
Глава 12. Пакеты, библиотеки и модули
вариант удобен для простых командных строк и потому может использоваться
на уровне отдельных команд (например, при вызове простой однострочной про-
граммы из сценария командного интерпретатора).
Подобную методику не следует использовать в строках #!. Во-первых, редак-
тировать каждую программу в системе скучно. Во-вторых, в некоторых старых
операционных системах имеются ошибки, связанные с ограничением длины этой
строки (обычно 32 символа, включая #!). В этом случае очень длинный путь
(например, #/opt/languages/free/extrablts/perl) приведет к появлению таинст-
венной ошибки "Command not found". Perl пытается заново просканировать строку,
но этот механизм недостаточно надежен, и полагаться на него не стоит.
Нередко самое удачное решение заключается в использовании переменной
окружения PERL5LIB, значение которой обычно задается в стартовом сценарии
интерпретатора. Если системный администратор задаст переменную в стартовом
файле системного уровня, результаты будут доступны для всех пользователей.
Предположим, ваши модули хранятся в каталоге ~/perl 11b. Включите одну из
следующих строк в стартовый файл командного интерпретатора (в зависимости
от того, каким интерпретатором вы пользуетесь):
# Синтаксис для sh. bash, ksh и zsh
$ export PERL5LIB=$HOME/perl11b
# Синтаксис для csh или tcsh
% setenv PERL5LIB -/perl lib
Возможно, самое удобное решение с точки зрения пользователя — включение
директивы use 11b в начало сценария. При этом пользователям программы вооб-
ще не придется выполнять специальных действий для ее запуска. Допустим,
у нас имеется гипотетический проект Spectre, программы которого используют
собственный набор библиотек. Такие программы могут начинаться с команды:
use lib "/projects/spectre/11b":
Что делать, если точный путь к библиотеке неизвестен? Ведь проект может
устанавливаться в произвольный каталог. Конечно, можно написать детально
проработанную процедуру установки с динамическим обновлением сценария, но
даже в этом случае путь будет жестко фиксироваться на стадии установки. Если
позднее файлы переместятся в другой каталог, библиотеки не будут найдены.
Модуль FlndBln легко решает эту проблему. Он пытается вычислить полный
путь к каталогу выполняемого сценария и присваивает его важной пакетной пе-
ременной $В1п. Обычно он применяется для поиска модулей в одном каталоге с
программой или в каталоге 11 b того же уровня.
Рассмотрим пример для первого случая. Допустим, у вас имеется программа
/wherever/spectre/myprog, которая ищет свои модули в каталоге /wherever/spectre,
однако вы не хотите жестко фиксировать этот путь:
use FlndBln:
use lib $F1ndBIn::Bln;
Второй случай — если ваша программа находится в каталоге /wherever/spectre/
bln/myprog, но ее модули должны находиться в каталоге /wherever/spectre/11Ь:
use FlndBln qw($B1n);
use lib "$B1n/../lib":
12.9. Подготовка модуля к распространению
499
См. также
Документация по стандартной директиве use 11b и стандартному модулю FlndBln;
описание переменной окружения PERL5LIB в perl(\y, описание переменных окру-
жения в руководстве по синтаксису командного интерпретатора.
12.9. Подготовка модуля к распространению
Проблема
Вы хотите подготовить модуль в стандартном формате распространения, чтобы
им можно было легко поделиться с другом. Или, что еще лучше, вы собираетесь
загрузить модуль в архив CPAN и сделать его общедоступным.
Решение
Начните со стандартной утилиты Perl h2xs. Предположим, вы хотите создать
модуль Planets или Astronomy::Orbits. Введите следующие команды:
% h2xs -ХА -n Planets
% h2xs -ХА -n Astronomy::Orbits
Эти команды создают подкаталоги ./Planets/ и ./Astronomy/Orblts/ соот-
ветственно. В каталогах находятся все компоненты, необходимые для начала
работы. Флаг -п задает имя создаваемого модуля, -X запрещает создание ком-
понентов XS (внешних подпрограмм), а -А означает, что модуль не будет ис-
пользовать Autoloader.
Комментарий
Написать модуль несложно, если знать, как это делается. Написание «пра-
вильного» модуля похоже на заполнение юридического контракта — перед вами
множество мест для инициалов, подписей и дат, и все нужно заполнить пра-
вильно. Если вы что-нибудь пропустите, контракт не имеет законной силы.
Вместо того чтобы нанимать специалиста, можно воспользоваться утилитой
h2xs. Она создает «скелет» файла модуля с заполненными данными об автор-
ских правах, а также другие файлы, необходимые для правильной установки
и документирования модуля, для включения его в CPAN или распространения
среди друзей.
Название утилиты h2xs может сбить с толку, поскольку XS представляет со-
бой интерфейс внешних подпрограмм Perl для компоновки с С или C++. Одна-
ко утилита h2xs также в высшей степени удобна для подготовки распространяе-
мых модулей, даже если они и не используют интерфейс XS.
Давайте рассмотрим один из файлов модулей, созданных утилитой h2xs. По-
скольку модуль будет называться Astronomy::Orbits, вместо команды use Orbits
пользователь должен вводить use Astronomy::Orbits. Следовательно, нам потре-
500
Глава 12. Пакеты, библиотеки и модули
буется дополнительный подкаталог Astronomy, в котором будет размещаться ка-
талог Orbits. Приведем первую и, вероятно, самую важную строку Orbits.pm:
package Astronomy::Orbits;
Команда определяет пакет (префикс по умолчанию) для всех глобальных
идентификаторов (переменных, функций, файловых манипуляторов и т. д.) дан-
ного файла. Следовательно, переменная О ISA в действительности является гло-
бальной переменной (^Astronomy::Orbits:: ISA.
Как было сказано во Введении, использовать команду package Orbits только
потому, что она находится в файле Orbits.pm, будет ошибкой. Команда package
в модуле должна точно совпадать с формулировкой use или requl re; это означает
присутствие префикса каталога, а также совпадение регистра символов. Более
того, необходим промежуточный каталог Astronomy. Утилита h2xs позаботится
обо всем, включая правило установки в Маке-файле. Если вы готовите модуль
вручную, помните об этом (см. рецепт 12.1).
Если вы собираетесь использовать автоматическую загрузку (см. рецепт 12.11),
уберите флаг -А из вызова h2xs. В результате будет создан фрагмент вида:
require Exporter:
require AutoLoader:
©ISA = qw(Exporter AutoLoader):
Если ваш модуль использует и Perl, и С (см. рецепт 12.18), уберите флаг -X
из вызова h2xs. Сгенерированный фрагмент выглядит так:
require Exporter:
require DynaLoader:
©ISA = qw(Exporter DynaLoader):
Далее перечисляются переменные модуля Exporter (см. рецепт 12.1). Если вы
пишете объектно-ориентированный модуль (см. главу 13), вероятно, вам вообще
не придется использовать Exporter.
Подготовка завершена. Переходите к написанию кода своего модуля. Когда
модуль будет готов к распространению, введите команду make di st в командной
строке, чтобы преобразовать модуль в tar-архив для удобства распространения
(имя программы make может зависеть от системы).
% perl Makef11e.pl
Шаке di st
Команда создает файл с именем вида Astronomy-Orbits-1.03.tar.Z.
Чтобы зарегистрироваться в качестве разработчика CPAN, обратитесь по ад-
ресу http://pause.cpan.org.
См. также
h2xs(l); документация по стандартным модулям Exporter, AutoLoader, AutoSplIt
и ExtUtlls: :MakeMaker. По адресу http://www.cpan.org можно найти ближайший
зеркальный узел и рекомендации по оформлению модулей.
12.10. Ускорение загрузки модуля с помощью SelfLoader
501
12.10. Ускорение загрузки модуля
с помощью SelfLoader
Проблема
Вам хочется быстро загрузить очень большой модуль.
Решение
Воспользуйтесь модулем Sei fLoader:
require Exporter:
require SelfLoader;
©ISA = qw(Exporter SelfLoader):
#
# Прочие инициализации и объявления
#
_ DATA_
sub abc { .... }
sub def { .... }
Комментарий
При загрузке модуля командой require или use необходимо прочитать содержи-
мое всего файла модуля и откомпилировать его (во внутренние деревья лекси-
ческого разбора, не в байт-код или машинный код). Для очень больших моду-
лей эта раздражающая задержка совершенно не нужна, если вам нужны всего
несколько функций из конкретного файла.
Модуль Self Loader решает эту проблему, откладывая компиляцию каждой
подпрограммы до ее фактического вызова. Использовать Self Loader несложно:
достаточно расположить подпрограммы вашего модуля под маркером_DATA_,
чтобы они были проигнорированы компилятором, обратиться к Self Loader с по-
мощью require и включить SelfLoader в массив ©ISA модуля. Вот и все, что от вас
требуется. При загрузке модуля Self Loader создает заглушки для функций, пере-
численных в секции__DATA_. При первом вызове функции заглушка компили-
рует настоящую функцию и вызывает ее.
В модулях, использующих SelfLoader (или AutoLoader — см. рецепт 12.11), дейст-
вует одно важное ограничение. Функции, загружаемые Sei fLoader или AutoLoader,
не имеют доступа к лексическим переменным файла, в чьем блоке_DATA_они
находятся, поскольку они компилируются функцией eval в импортированном
блоке AUTOLOAD. Следовательно, динамически сгенерированные функции компи-
лируются в области действия AUTOLOAD модуля Self Loader или AutoLoader.
Как скажется применение Self Loader на быстродействии программы — поло-
жительно или отрицательно? Ответ на этот вопрос зависит от количества функ-
ций в модуле, от их размера и от того, вызываются ли они на протяжении всего
жизненного цикла программы или нет. Модуль Sei fLoader не следует применять
на стадии разработки и тестирования модулей. Достаточно закомментировать
строку__DATA_, и функции станут видны во время компиляции.
502
Глава 12. Пакеты, библиотеки и модули
См. также
Документация по стандартному модулю SelfLoader; рецепт 12.11.
12.11. Ускорение загрузки модуля
с помощью AutoLoader
Проблема
Вы хотите воспользоваться модулем AutoLoader.
Решение
Простейшее решение — воспользоваться утилитой h2xs для создания каталога
и всех необходимых файлов. Предположим, у вас имеется каталог -/peril 1Ь/,
содержащий ваши личные библиотечные модули.
% h2xs -Xn Sample
% cd Sample
% perl Makefile.PL LIB=~/perll1b
% (edit Sample.pm)
% make Install
Комментарий
Модуль AutoLoader, как и Sei fLoader, предназначен для ускорения работы програм-
мы. Он также генерирует функции-заглушки, которые заменяются настоящими
функциями при первом вызове. Но вместо того чтобы искать все функции в од-
ном файле под маркером_DATA_, AutoLoader ищет определение каждой функции
в отдельном файле. Например, если модуль Sample.pm содержит две функции, foo
и bar, то AutoLoader будет искать их в файлах Sample/auto/foo.al и Sample/auto/
bar.al соответственно. Модули, загружающие функции с помощью AutoLoader,
работают быстрее тех, что используют Sei fLoader, но за это приходится распла-
чиваться созданием дополнительных файлов, лишним местом на диске и повы-
шенной сложностью.
Процесс подготовки выглядит сложно. Вероятно, сделать это вручную дейст-
вительно непросто, но, к счастью, h2xs оказывает громадную помощь. Помимо
создания каталога с шаблонами Sample.pm и других необходимых файлов, ути-
лита также генерирует Make-файл, который использует модуль AutoSplit для
разделения функций модуля по маленьким файлам, по одной функции на файл.
Правило make Install устанавливает их так, чтобы они находились автоматиче-
ски. Все, что от вас нужно, — разместить функции модуля после строки_END_
(вместо строки_DATA_в SelfLoader), сгенерированной h2xs.
Как и в случае с Sei fLoader, разработку и тестирование модуля лучше осуще-
ствлять без AutoLoader. Достаточно закомментировать строку_END_, пока модуль
не придет к окончательному виду.
12.12. Переопределение встроенных функций
503
При работе с AutoLoader действуют те же ограничения видимости файловых
лексических переменных, что и для Self Loader, поэтому использование файло-
вых лексических переменных для хранения закрытой информации состояния не
подойдет. Если проблема хранения состояния становится настолько важной
и труднореализуемой, подумайте о том, чтобы написать объектный модуль вме-
сто традиционного.
См. также
Документация по стандартному модулю AutoLoader; /z2xs(l); рецепт 12.10.
12.12. Переопределение встроенных функций
Проблема
Вы хотите заменить стандартную функцию собственной версией.
Решение
Импортируйте нужную функцию из другого модуля в свое пространство имен.
Комментарий
Предположим, вы хотите присвоить своей функции имя, совпадающее с именем
одной из встроенных функций Perl. Попытки типа
sub time { "it's howdy doody time" }
print time();
не проходят — в программе все равно будет вызвана исходная, встроенная вер-
сия. Для вызова функции можно воспользоваться синтаксисом
print &time():
В этом случае всегда будет вызываться ваша, а не встроенная функция. Одна-
ко в этом случае вы лишаетесь преимуществ проверки прототипов и приведения
контекста для аргументов функции. Тем не менее проблему все же можно решить.
Многие (хотя и не все) встроенные функции Perl могут переопределяться.
К этому шагу следует относиться серьезно, но в принципе это возможно. Напри-
мер, необходимость в переопределении может возникнуть при работе на платфор-
ме, которая не поддерживает эмулируемой функции. Также переопределение часто
применяется при создании интерфейсных оболочек для встроенных функций.
Не все зарезервированные слова одинаковы. Те, что возвращают отрицатель-
ное число в функции С keyword() файла token.с исходной поставки Perl, могут
переопределяться. В версии 5.8.1 не допускается переопределение следующих
ключевых слов: defined, delete, do, else, el si f, eval, exists, for, foreach, format, glob,
goto, grep, if, last, local, m, map, my, next, no, our, package, pos, print, printf, prototype,
504
Глава 12. Пакеты, библиотеки и модули
q, qq, qr, qw, qx, redo, require, return, s, scalar, sort, split, study, sub, tie, tied, tr,
undef, unless, untie, until, use, while и у. Остальные ключевые слова могут пере-
определяться.
Стандартный модуль Perl Cwd переопределяет функцию chdl г. Также пере-
определение встречается во многих модулях с функциями, возвращающими спи-
ски: File::stat, Net: :hostent, Net: :netent, Net: :protoent, Net: -.servent, Time::gmtlme,
Time: .'localtime, Time: :tm, User: :grent и User: :pwent. Эти модули содержат пере-
определения встроенных функций (таких, как stat или getpwnam), которые возвра-
щают объект с возможностью доступа по имени, например, getpwnam("daemon")
->d1 г. Для этого они переопределяют исходные, списковые версии этих функций.
Переопределение осуществляется импортированием функции из другого па-
кета. Импортирование действует только в импортирующем пакете, а не во всех
возможных пакетах. Простого переобъявления недостаточно, функцию необхо-
димо импортировать. Это защищает от случайного переопределения встроенных
функций.
Допустим, вы решили заменить встроенную функцию time, которая воз-
вращает целое количество секунд, другой, возвращающей вещественное число.
Для этого можно создать модуль Time::HI Res с необязательным экспортировани-
ем функции time:
package Time::HI Res:
use strict;
require Exporter:
use vars qw(@ISA @EXPORT_OK);
@ISA = qw(Exporter):
@EXPORT_OK = qw(tlme):
sub timed { .. }
Затем пользователь, желающий использовать усовершенствованную версию
time, пишет примерно следующее:
use Time::H1Res qw(tlme):
$start = t1me():
1 while print timed - Sstart, "\n":
Предполагается, что в вашей системе есть функция, соответствующая приве-
денной выше спецификации. Впрочем, вам не придется разбираться в этом во-
просе, поскольку модуль Time:: HI Res (из стандартной поставки Perl) работает
именно так, как здесь описано. Вы можете импортировать его функцию timed,
которая обладает большими возможностями по сравнению с базовой версией.
Если вы хотите обойтись без создания полного файла модуля, настройки экс-
порта и прочих хлопот, существует упрощенное решение с использованием ди-
рективы subs. Оно выглядит так:
use subs qw(tlme):
sub time { "It's howdy doody time" }
print t1me():
Теперь даже при отсутствии & в программе будет вызываться пользователь-
ская функция.
12.13. Переопределение встроенной функции во всех пакетах
505
Даже если переопределить встроенную функцию импортированием, встроенная
функция по-прежнему остается доступной — ее имя следует уточнить именем (псев-
до) пакета CORE. Таким образом, даже после импортирования time О из Time:: HI Res
исходная встроенная функция может быть вызвана в виде CORE: :t1me().
Переопределение методов и операторов рассматривается в главе 13.
См. также
Раздел «Overriding Built-in Functions» perlsub(V)', рецепт 10.11.
12.13. Переопределение встроенной
функции во всех пакетах
Проблема
Требуется изменить определение встроенной функции в границах всего проек-
та, а не только в текущем пакете.
Решение
Вручную импортируйте функцию в псевдопакет CORE::GLOBAL, непосредственно
работая с таблицей символических имен:
*CORE::GLOBAL::1 nt = \&myown_1nt:
Комментарий
Методика, продемонстрированная в предыдущем рецепте, переопределяет встро-
енную функцию только для конкретного пакета. Изменение не распространяется
на всю программу и на все пакеты, в которых вызывается эта функция. Такое
поведение могло бы нарушить работу модулей, написанных другими програм-
мистами и не готовых к изменениям.
Говорят, систему Unix проектировали так, чтобы она не запрещала делать
глупости, потому что это помешало бы сделать нечто умное. То же самое можно
сказать о Perl. Перегрузка функции во всех пакетах сразу выглядит... излишне
радикально, но это не означает, что какой-нибудь гений не придумает для нее
потрясающего применения.
Допустим, вы решили, что поведение базовой функции 1 nt (отсечение дроб-
ной части) так мешает вашей программе, что нужно определить другую функ-
цию с тем же именем. Реализация может выглядеть так:
package Math:bounding;
use warnings;
use Carp:
use Exporter:
506
Глава 12. Пакеты, библиотеки и модули
our OEXPORT = qw(int);
our @ISA = qw(Exporter):
sub 1 nt(:$) {
my $arg = @_ ? shift : $_;
use warnings FATAL => "numeric": # Повысить до die()
my Sresult = eval { sprintfCTOf", $arg) }:
if ($@) {
die if $@ /isn't numeric/:
$@ =~ s/ in sprintf.*/ in replacement int/s:
croak $@;
} else {
return Sresult;
} }
В новой версии округление до ближайшего целого производится при помощи
sprintfО. Если аргумент не содержит строкового представления числа, функция
инициирует исключение. Программа либо вызывает функцию в виде
use Math: bounding ( ):
$у = Math::Rounding::int($x):
либо импортирует функцию с переопределением встроенной версии:
use Math::Round!ng qw(int);
$y = int($x):
Однако встроенная функция замещается только в текущем пакете. Чтобы за-
мена распространялась на все пакеты, в какой-то момент компиляции необходи-
мо выполнить команду следующего вида:
*CORE::GLOBAL::int = \&Math:bounding::int:
Стандартный модуль File::Glob позволяет изменить базовый оператор Perl
glob при помощи специальных тегов:
## Переопределить базовую версию glob с учетом регистра символов
use File::Glob qw(globally :case):
my ^sources = <*.{c.h,y}>
## Переопределить базовую версию glob без учета регистра символов
use File::Glob qw(globally :nocase):
my ^sources = <*.{c.h,y}>
Для этого модуль использует собственную версию import, которая распознает
эти теги и вносит необходимые изменения. Вы тоже можете поступить подоб-
ным образом. Таким образом, после выполнения команды
use Math::Round!ng qw(-global int):
Perl будет использовать новую версию при всех вызовах i nt во всех пакетах.
А вот как выглядит измененная версия функции import:
sub import {
if (@_ && $J1] =~ /"-/) {
if ($_[!] ne "-global") {
12.14. Вывод сообщений об ошибках и предупреждений по аналогии со встроенными функциями 507
croak "unknown Import pragma":
}
splice(@_. 1, 1): # Отбросить "-global"
no warnings "once": # Подавить предупреждения "used only once"
*C0RE::GLOBAL::int = \&int:
} else {
die;
}
_PACKAGE_ -> export_to_level (1,
}
В последней строке нашей функции import выполняется стандартное импор-
тирование, для чего используется один из компонентов внутреннего API модуля
Exporter.
См. также
Рецепт 12.12; раздел «Overriding Built-in Functions» perlsuh(Vy, документация по
стандартному модулю BDS:: G1 ob и его исходные тексты.
12.14. Вывод сообщений об ошибках
и предупреждений по аналогии
со встроенными функциями
Проблема
Ваш модуль генерирует ошибки и предупреждения, однако при использовании
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:
508
Глава 12. Пакеты, библиотеки и модули
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. Пример:
use Carp;
sub even_only {
my $n = shift;
if ($n & 1) { # Проверка нечетности
carp "$n is not even, continuing";
++$n;
}
}
Многие встроенные функции выводят предупреждения лишь при использо-
вании ключа командной строки -w. Переменная $AW (не управляющий символ,
а простая последовательность из А и W) сообщает о его состоянии. Например, про-
грамма может выдавать предупреждения, если пользователь попросил об этом:
carp "$n is not even, continuing" if $XW;
Наконец, в модуле Carp существует третья функция — confess. Она работает
аналогично croak за исключением того, что при аварийном завершении выводится
полная информация о состоянии стека, вызовах функций и значениях аргументов.
Если вас интересуют только сообщения об ошибках от carp, croak и т. д., вос-
пользуйтесь функциями longmess и shortness:
use Carp:
$self->transplant_organ() or
$self->error( Carp:;longmess("Unable to transplant organ") );
См. также
Описание функций warn и die в perlfunc (1); документация по стандартному мо-
дулю Carp; рецепт 19.2; описание метапеременных_________WARN__и____DIE__в perlvar(l)
и в рецепте 16.15.
12.15. Настройка предупреждений
509
12.15. Настройка предупреждений
Проблема
Требуется, чтобы ваш модуль учитывал настройки выдачи предупреждений, за-
данные вызывающей стороной, однако эти настройки не могут быть получены
просмотром служебной переменной $^W!.
Решение
Включите в свой модуль директиву
use warnings: register;
Затем изнутри модуля вызовите функцию warnings::enabled (см. коммента-
рий) и проверьте, разрешена ли выдача предупреждений вызывающей стороной.
Решение работает как для классических глобальных предупреждений, так и для
лексических предупреждений, установленных директивой use warnings.
Комментарий
У флага командной строки Perl -w, отраженного в глобальной переменной $^W,
имеется ряд недостатков. Во-первых, этот флаг действует по принципу «все или
ничего», и его действие распространяется на код модулей, используемых про-
граммой (и написанных другими программистами). Во-вторых, использовать его
для управления предупреждениями компиляции в лучшем случае неудобно, поэто-
му программисту приходится прибегать к изощренным блокам BEGIN. Наконец,
предположим, что вас интересуют лишь некоторые категории предупреждений
(например, числовые). В этом случае придется писать обработчик $SIG{_WARN_}
и устраивать фильтрацию нужных или ненужных предупреждений.
Для решения этих и многих других проблем в Perl версии 5.6 появились лек-
сические предупреждения. Под термином «лексические» мы имеем в виду, что
действие предупреждений ограничивается лексической областью действия, в ко-
торой находится директива use warnings или no warnings. Лексические предупре-
ждения игнорируют флаг командной строки -w. Теперь включение предупрежде-
ний в одной области действия (например, в файловой области действия главной
программы) не приведет к активизации предупреждений в загружаемых мо-
дулях. Также существует возможность выборочного включения или подавления
отдельных категорий предупреждений. Пример:
use warnings qw(numer1c uninitialized);
use warnings qw(all);
no warnings qw(syntax);
Директива warnings::register разрешает модулю получить информацию о на-
стройке предупреждений в лексической области действия вызывающей стороны.
1 SWarning при использовании English.
510
Глава 12. Пакеты, библиотеки и модули
Кроме того, она создает новую категорию предупреждений, в которую включает-
ся имя текущего пакета. Пользовательские категории предупреждений легко от-
личимы от встроенных, потому что имя пакета модуля всегда начинается (или
должно всегда начинаться) с прописной буквы. Таким образом, категории преду-
преждений, имена которых начинаются со строчных букв, зарезервированы за Perl.
Встроенные категории предупреждений делятся на несколько групп. Катего-
рия all объединяет все встроенные предупреждения и все субкатегории (unsafe,
io, syntax и т. д.; рис. 12.1). Категория syntax включает категории синтаксических
предупреждений (ambiguous, precedence, deprecated и т. д.). Вы можете разрешать
и запрещать предупреждения по своему усмотрению, но с соблюдением правиль-
ного порядка:
use warnings: # Разрешить все предупреждения
no warnings "syntax"; # Запретить предупреждения группы syntax
use warnings "deprecated": # Но разрешить предупреждения группы deprecated
Но вернемся к нашему модулю. Предположим, вы написали модуль с именем
Whiskey. Файл Whiskey.pm начинается так:
package Whiskey:
use warnings: register:
Теперь использование этого модуля в программе выглядит так:
use Whiskey:
use warnings qw(Whiskey):
Модуль был загружен до того, как для него будет вызвана директива use
warnings. В противном случае категория предупреждений Whiskey не будет заре-
гистрирована, и при попытке ее использования произойдет исключение.
Рассмотрим гипотетический модуль Whiskey:
package Whiskey:
use strict:
use warnings: # Для нашего кода, не для вызывающей стороны
use warnings: register:
sub drink {
if (warnings::enabled( ) && (localtime( ))[2] < 12) {
warnings:warn("Sun not yet over the yardarm");
}
print "Merry!\n":
sub quaff {
if (warnings::enabled("deprecated")) {
warnings::warn("deprecated".
"quaffing deprecated in favor of chugging"):
Sdrink:
sub chug {
print "Very merry\n":
1:
12.15. Настройка предупреждений
511
Функция Whiskey::drink при помощи функции warnings::enabled проверяет,
разрешены ли предупреждения на стороне вызова. Присутствия любой из сле-
дующих директив в области действия вызывающей стороны достаточно, чтобы
функция вернула true:
512
Глава 12. Пакеты, библиотеки и модули
use warnings:
use warnings qw(all): # Означает то же. что и предыдущая строка
use warnings qw(Whlskey):
Функция также возвращает true при включении глобальных предупреждений
при помощи флага -w или $^W.
В функции Whiskey::quaff проверяется конкретная категория предупрежде-
ний deprecated. Она активизируется при включении всех предупреждений (all),
при включении предупреждений категории syntax (поскольку предупреждения
deprecated входят в категорию syntax, которая в свою очередь входит в катего-
рию all), или при включении конкретной категории deprecated. Она не будет
активизироваться только потому, что вызывающая сторона разрешила преду-
преждения Whiskey. Любая категория, созданная вами, считается принадлежащей
к категории all, но ни к каким другим категориям. Предупреждения категории
Whiskey проверяются следующим образом:
warnings::enabled("Wh1skey")
Вместо встроенной функции warn используется функция warnings: :warn, на
тот случай, если предупреждения Whiskey были преобразованы в исключения:
use warnings FATAL => "Whiskey";
См. также
Документация по директиве use warnings в perllexwarn(V).
12.16. Косвенные ссылки на пакеты
Проблема
Требуется сослаться на переменную или функцию в пакете, имена которых неиз-
вестны до момента выполнения программы, однако синтаксис Spackname: :$varname
недопустим.
Решение
Воспользуйтесь символическими ссылками:
{
no strict 'refs':
$val = ${ $packname . ". $varname }:
@vals = @{ $packname . ". $aryname }:
&{ $packname . "::" . $funcname }("args"):
($packname . . $funcname) -> ("args");
}
Комментарий
Объявление пакета имеет смысл во время компиляции. Если имя пакета или
переменной неизвестно до времени выполнения, придется прибегнуть к симво-
12.16. Косвенные ссылки на пакеты
513
лическим ссылкам и организовать прямые обращения к таблице символов пакета.
Учитывая, что обычно программы выполняются с директивой use strict, необ-
ходимо частично подавить ее действие для использования символических ссы-
лок. Включите в блок директиву no strict "refs" и постройте строку с полным
именем интересующей вас переменной или функции. Затем разыменуйте полу-
ченную строку так, словно она является нормальной ссылкой Perl.
В доисторические времена (до выхода Perl версии 5) программистам в подоб-
ных случаях приходилось использовать eval:
eval "package $packname: \$'$val = \$$varname"; # Задать $main'val
die if
Как видите, такое решение затрудняет построение строки. Кроме того, оно
работает относительно медленно. Впрочем, вам никогда не придется делать это
лишь для того, чтобы косвенно обращаться к переменным по именам. Символи-
ческие ссылки обеспечивают необходимый компромисс.
Функция eval также используется для определения функций во время вы-
полнения программы. Предположим, вы хотите иметь возможность вычислять
двоичные и десятичные логарифмы:
printf "log2 of 100 is %.2f\n". 1од2(100):
printf "loglO of 100 is %.2f\n", loglO(lOO):
В Perl существует функция log для вычисления натуральных логарифмов.
Давайте посмотрим, как использовать eval для построения функций во время
выполнения программы. Мы создадим функции с именами от 1од2 до 1од999:
$packname = 'main':
for ($i = 2; $i < 1000; $i++) {
$1 ogN = 1og($i):
eval "sub ${packname}::log$i { log(shift) / $logN
die if
}
Впрочем, в данном конкретном случае это не обязательно. Следующий фраг-
мент делает то же самое, но вместо того, чтобы компилировать новую функ-
цию 998 раз, мы откомпилируем ее всего единожды в виде замыкания. Затем мы
воспользуемся символическим разыменованием в таблице символов и присвоим
одну и ту же ссылку на функцию по многим именам:
$packname = 'main';
for ($i = 2: $i < 1000: $i++) {
my $1ogN = 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;
514
Глава 12. Пакеты, библиотеки и модули
Принимая во внимание гибкость присваиваний тип-глобов и символических
ссылок, полноценные конструкции eval "СТРОКА" почти всегда оказываются из-
лишеством, последней надеждой отчаявшегося программиста. Ничего худшего
себе и представить нельзя — разве что если бы они были недоступны.
См. также
Раздел «Symbolic References» perlsub(l); рецепт 11.4.
12.17. Применение h2ph для преобразования
заголовочных файлов С
Проблема
Полученный от кого-то код выдает устрашающее сообщение об ошибке:
Can't locate sys/syscal 1 .ph in @INC (did you run h2ph?)
(@INC contains: /usr/1ib/perl5/i686-linux/5.00404 /usr/lib/per15
/usr/1ib/per!5/site_perl/1686-1inux /usr/1ib/perl5/site_perl .)
at some_program line 7.
Вы хотите понять, что это значит и как справиться с ошибкой.
Решение
Попросите системного администратора выполнить следующую команду с права-
ми привилегированного пользователя:
% cd /usr/1nclude; h2ph sys/syscall.h
Однако многие заголовочные файлы включают другие заголовочные файлы;
иными словами, придется преобразовать их все:
% cd /usr/include: h2ph *.h */*.h
Если вы получите сообщение о слишком большом количестве файлов или
если некоторые файлы в подкаталогах не будут найдены, попробуйте другую
команду:
% cd /usr/include: find . -name "*.h" -print | xargs h2ph
Комментарий
Файлы с расширением .ph создаются утилитой h2ph, которая преобразует дирек-
тивы препроцессора С из #1 ncl ude-файлов в Perl. Это делается для того, чтобы
программа на Perl могла работать с теми же константами, что и программа на С.
Утилита h2xs обычно оказывается более удачным решением, поскольку вместо
кода Perl, имитирующего код С, она предоставляет откомпилированный код С.
12.17. Применение h2ph для преобразования заголовочных файлов С
515
Однако работа с h2xs требует намного большего опыта программирования (по
крайней мере, в том, что касается С), чем h2ph.
Если процесс преобразования h2ph работает, все прекрасно. Если нет — что ж,
вам не повезло. Усложнение системных архитектур и заголовочных файлов приво-
дит к более частым отказам h2ph. Если повезет, необходимые константы уже бу-
дут присутствовать в модулях Fcntl, Socket или POSIX. В частности, модуль POSIX
реализует константы из sys/file.h, sys/errno.h и sys/wait.h. Кроме того, он обес-
печивает выполнение нестандартных операций с терминалом (см. рецепт 15.8).
Так что же можно сделать с файлом .ph? Рассмотрим несколько примеров.
В первом примере непереносимая функция syscall используется для вызова
системной функции gettimeofday. Перед вами реализация модуля FineTime, опи-
санного в рецепте 12.12.
# Файл 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 timeO {
my $tv = packU'LL". О): # Выделить буфер для двух значений типа long
syscall(&main::SYS_gettimeofday. $tv. undef) >= 0
or die "gettimeofday: $!":
my($seconds, $microseconds) = unpackCLL". $tv):
return $seconds + ($microseconds / l_000_000):
}
1:
Если вам приходится вызывать require для старых файлов .pl или .ph, сде-
лайте это из главного пакета (package main в приведенном выше коде). Эти ста-
рые библиотеки всегда помещают свои символические имена в текущий пакет,
a main служит «местом встречи». Чтобы использовать имя, уточните его, как мы
поступили с main: :SYS_gettimeofday.
Файл sys/ioctl .ph, если вам удастся построить его в своей системе, открыва-
ет доступ к функциям ввода/вывода вашей системы через функции ioctl. К их
числу принадлежит функция TIOCSTI из примера 12.1. Сокращение TIOCSTI
означает «управление терминальным вводом/выводом, имитация терминаль-
ного ввода» (terminal I/O control, simulate terminal input). В системах, где эта
функция реализована, она вставляет один символ в поток устройства, чтобы при
следующем чтении из устройства со стороны любого процесса был получен
вставленный символ.
516
Глава 12. Пакеты, библиотеки и модули
Пример 12.1. jam
#!/usr/Ыn/perl -w
# jam - вставка символов в STDIN
require 'sys/loctl.ph':
die "no TIOCSTI" unless defined &TIOCSTI;
sub jam {
local $SIG{TTOU} = "IGNORE”: # "Остановка для вывода на терминал"
local *TTY; # Создать локальный манипулятор
open(TTY, "+<", "/dev/tty") or die "no tty: $!";
for (splitC//. $_[0])) {
loctl(TTY. &TIOCSTI, $_) or die "bad TIOCSTI: $!";
}
close(TTY):
}
jam("@ARGV\n"):
Поскольку преобразование sys/loctl .h может вызвать некоторые сложности,
вероятно, для получения кода TIOCSTI вам придется запустить следующую
программу на С.
% cat > tlo.c «EOF && сс tlo.c && a.out
#1nclude <sys/1octl.h>
malnO { pr1ntf("£#08x\n". TIOCSTI): }
EOF
0x005412
Функция loctl также часто применяется для определения размеров текущего
окна в строках/столбцах и даже в пикселах. Исходный текст программы приве-
ден в примере 12.2.
Пример 12.2. winsz
#! /usr/Ы n/perl
# winsz - определение размеров окна в символах и пикселах
require 'sys/loctl.ph';
die "no TIOCGWINSZ " unless defined &TIOCGWINSZ:
open(TTY, "+</dev/tty") or die "No tty: $!":
unless (loctl(TTY. &TIOCGWINSZ. $w1ns1ze=")) {
die sprintf "$0: loctl TIOCGWINSZ (W8x: $!)\n". &TIOCGWINSZ;
}
($row, $col. Sxplxel. Syplxel) = unpack('S4', Swlnslze):
print "(row.col) = ($row.$col)":
print " (xplxel.yplxel) = (Sxplxel.Syplxel)" If Sxplxel || Sypixel;
print "\n";
Как видите, для экспериментов с файлами .ph, распаковкой двоичных дан-
ных и вызовами syscall и loctl необходимо хорошо знать прикладной интер-
фейс С, обычно скрываемый Perl. Единственное, что требует такого же уровня
знаний С — это интерфейс XS. Одни считают, что программисты должны бо-
роться с искушением и за версту обходить подобные непереносимые решения.
По мнению других, жесткие требования, поставленные перед рядовым програм-
мистом, оправдывают самые отчаянные меры.
12.18. Применение h2xs для создания модулей с кодом С
517
К счастью, все большее распространение получают менее хрупкие механизмы.
Для большинства этих функций появились модули CPAN. Теоретически они ра-
ботают надежнее, чем обращения к файлам .ph.
См. также
h2ph(l); инструкции по работе с h2ph в файле INSTALL исходной поставки Perl;
описание функций syscall и ioctl в perlmod(V); рецепт 12.18.
12.18. Применение h2xs для создания
модулей с кодом С
Проблема
Вам хотелось бы работать с функциями С из Perl.
Решение
Воспользуйтесь утилитой h2xs для построения необходимых файлов шаблонов,
заполните их соответствующим образом и введите:
% perl Makefile.PL
% make
Комментарий
При написании модуля Perl необязательно ограничиваться одним Perl. Как и для
любого другого модуля, выберите имя и вызовите для него утилиту h2xs. Мы
создадим функцию FineTime::time с той же семантикой, что и в предыдущем ре-
цепте, но на этот раз реализуем ее на С.
Сначала выполните следующую команду:
% h2xs -сп FineTime
Если бы у нас был файл . h с объявлениями прототипов функций, его можно
было бы включить, но поскольку мы пишем модуль с нуля, используется флаг -с —
тем самым мы отказываемся от построения кода, преобразующего директивы
#define. Флаг -п требует создать для модуля каталог FineTime/, в котором будут
находиться следующие файлы:
Manifest Список файлов в поставке
Changes Протокол изменений
Makefile.PL Мета-таке-файл
FineTime.pm Компоненты Perl
FineTime.xs Будущие компоненты С
test.pl Тестовая программа
518
Глава 12. Пакеты, библиотеки и модули
Перед тем как вводить команду make, необходимо сгенерировать make-файл
для текущей системной конфигурации с помощью шаблона Makeflle.PL. Вот как
это делается:
% perl Makefile.PL
Если код XS вызывает библиотечный код, отсутствующий в нормальном на-
боре библиотек Perl, сначала добавьте в Makefile.pl новую строку. Например,
если мы хотим подключить библиотеку Hbrpm.a из каталога /usr/redhat/11 b, то
нам надо изменить строку Makeflle.PL:
"LIBS" => # Например. "-1m"
и привести ее к виду:
"LIBS" => ["-L/usr/redhat/11b -lrpm"L
Наконец, отредактируйте файлы FineTime.pm и FineTime.xs. В первом случае
большая часть работы уже сделана за нас. Нам остается создать список экспор-
тируемых функций. На этот раз мы помещаем его в @EXPORT_OK, чтобы нужные
функции запрашивались пользователем по имени. Файл FineTime.pm выглядит так:
package FineTime;
use strict:
use vars qw($VERSION OISA OEXPORT_OK):
require Exporter:
require DynaLoader;
@ISA = qw(Exporter DynaLoader);
@EXPORT_OK = qw(time):
SVERSION = ' 0.0Г:
bootstrap FineTime SVERSION:
1;
Make автоматически преобразует файл FineTime.xs в FineTime.с и общую библио-
теку, которая на большинстве платформ будет называться FineTime.so. Преобразо-
вание выполняется утилитой xsubpp, описанной на ее собственной странице руко-
водства и в perlxstut(l). Xsubpp автоматически вызывается в процессе построения.
Кроме хороших познаний в С, вы также должны разбираться в интерфейсе
С-Perl, который называется XS (external Subroutine). Подробности и нюансы XS
выходят за рамки этой книги. Автоматически сгенерированный файл FineTime.xs
содержит заголовочные файлы, специфические для Perl, а также объявление
MODULE. Мы добавили несколько дополнительных файлов и переписали код но-
вой функции time. На С пока не похоже, но после завершения работы xsubpp все
придет в норму.
Использованный нами файл FineTime.xs выглядит так:
#include <unistd.h>
#1nclude <sys/time.h>
#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"
MODULE = FineTime PACKAGE = FineTime
double
tlmeO
CODE:
12.18. Применение h2xs для создания модулей с кодом С
519
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 ./Ыib/11b/auto/FineTime
cp FineTime.pm ./blib/1ib/FineTime.pm
/usr/1ocal/bin/perl -I/usr/1ib/perl5/i686-linux/5.00403 -I/usr/1ib/perl5
/usr/1ib/perl5/ExtUti1s/xsubpp -typemap
/usr/1ib/perl5/ExtUti1s/typemap FineTime.xs
FineTime.tc && mv FineTime.tc FineTime.ccc -c -Dbool=char -DHAS_BOOL
-02-DVERSION=\"0.01\" -DXS_VERSION=\”0.01\" -fpic
-I/usr/1 ib/perl5/i686-1inux/5.00403/CQRE FineTime.c
Running Mkbootstrap for FineTime 0
chmod 644 FineTime.bs
LD_RUN_PATH="" cc -o blib/arch/auto/FineTime/FineTime.so
-shared -L/usr/1ocal/1ib FineTime.o
chmod 755 blib/arch/auto/FineTime/FineTime.so
cp FineTime.bs ./blib/arch/auto/FineTime/FineTime.bs
chmod 644 blib/arch/auto/FineTime/FineTime.bs
Instal1ing /home/tchri st/perl1ib/i686-1i nux/./auto/FineTime/FineTime.so
Installing /home/tchrist/perllib/i686-1inux/./auto/FineTime/FineTime.bs
Installing /home/tchrist/perllib/./FineTime.pm
Writing /home/tchrist/perllib/i686-1inux/auto/FineTime/.packlist
Appending installation info to /home/tchrist/perllib/i686-linux/perllocal.pod
Когда все будет готово, в интерпретаторе вводится следующая команда:
% perl -I -/perllib -MFineTime=time -le '1 while print timeO' | head
888177070.090978
888177070.09132
888177070.091389
888177070.091453
888177070.091515
888177070.091577
888177070.091639
888177070.0917
888177070.091763
888177070.091864
См. также
Вызовы функций С из Perl описаны в perlxstut(i) и perlxs(l), внутренний API
Perl — в perlcall(V) и perlguts(l), а вызовы функций Perl из С — в perlembed(Y).
Документация по стандартному модулю ExtUti 1 s: :MakeMaker; Л2/?Л(1) и xsubpp(Vp
По адресу http://www.cpan.org/authors/Dean_Roehrich/ находится подробное руко-
водство по XS с рекомендациями по организации интерфейса с C++.
520
Глава 12. Пакеты, библиотеки и модули
12.19. Написание расширений на С
с использованием Inline::С
Проблема
Требуется написать на С функцию, которую можно было бы вызывать из Perl.
Возможно, вы уже опробовали интерфейс XS и сочли, что у вас для этого недос-
таточно крепкие нервы.
Решение
Воспользуйтесь модулем CPAN Inline: :С:
use Inline С;
Sanswer = somefunc(20. 4):
print "$answer\n": # Выводит 80
_END—
_C_
double somefuncdnt a. 1 nt b) { /* Inline поддерживает большинство */
double answer = a * b; /* базовых типов языка С ★/
return answer:
}
Комментарий
Модуль Inline::С создавался как альтернатива системе XS для построения мо-
дулей расширения на языке С. Он избавляет вас от необходимости изощряться
с h2xs и форматом .xs-файлов, позволяя вставлять код С прямо в программу Perl.
Модули Inline также существуют для многих других языков, включая Python,
Ruby и Java.
По умолчанию код С размещается в секции_____END__или___DATA_, после мар-
кера _______________________________________________________С_. Такой синтаксис позволяет внедрять несколько блоков внешнего
кода в один файл. Если хотите, воспользуйтесь встроенным документом при за-
грузке Inline:
use Inline С «'END_OF_C';
double somefuncdnt a, Int b) { /* Inline knows most basic C types */
double answer = a * b:
return answer:
END_OF_C
Модуль Inline: :C просматривает код и ищет в нем определения функций
в стиле ANSI. Обнаружив определение функции, он генерирует для него «оберт-
ку» Perl. Inline автоматически транслирует базовые типы данных С (double, Int,
char* и т. д.) по карте типов, которая является составной частью Perl. Карта
типов определяет соответствие между типами данных С и Perl. Если вам потре-
буется использовать более сложные структуры данных, не имеющие аналогов
в базовой карте, вы можете установить собственную карту типов.
12.20. Документирование модуля в формате pod
521
Также поддерживается компоновка внешних библиотек, разбор заголовочных
файлов по правилам h2xs, передача и возврат нескольких значений, работа с объ-
ектами и многое другое. За подробностями обращайтесь на страницу руководства
Inline::C-Cookbook, включенную в поставку модуля Inline: :С.
См. также
Документация по модулю CPAN Inline: :С; страница руководства Inline::C-Cook-
book.
12.20. Документирование
модуля в формате pod
Проблема
Вы хотите документировать свой модуль, но не знаете, какой формат следует
использовать.
Решение
Включите документацию в файл модуля в формате pod.
Комментарий
Сокращение pod означает «plain old documentation», то есть «простая докумен-
тация». Документация в формате pod встраивается непосредственно в програм-
му с применением очень простого формата разметки. Как известно, программи-
сты сначала пишут программу, а документацию... не пишут вообще. Формат pod
был разработан для максимальной простоты документирования, чтобы с этой
задачей справился даже лентяй. Иногда это даже помогает.
Если во время анализа исходного текста Perl обнаруживает строку, начинаю-
щуюся со знака = (там, где ожидается новая команда), он игнорирует весь текст
до строки, начинающейся с =cut, после чего продолжает анализировать код. Это
позволяет смешивать в программах или файлах модулей Perl код и документацию.
Поскольку формат pod является сугубо текстовым, никакого особого формати-
рования не требуется. Трансляторы стараются проявить интеллект и преобразу-
ют вывод так, чтобы программисту не приходилось особым образом форматиро-
вать имена переменных, вызовы функций и т. д.
Вместе с Perl поставляется несколько программ-трансляторов, которые фильт-
руют документацию в формате pod и преобразуют ее в другой формат вывода.
Утилита pod2man преобразует pod в формат troff, используемый в программе
man или в системах верстки и печати. Утилита pod2html создает веб-страницы,
работающие даже в системах, не принадлежащих к семейству UNIX. Утилита
pod2text преобразует pod в простой ASCII-текст. Другие трансляторы (pod2i pf,
pod2fm, pod2texi, pod21atex и pod2ps) могут входить в поставку Perl или распро-
страняются через CPAN.
522
Глава 12. Пакеты, библиотеки и модули
Многие книги пишутся в коммерческих текстовых редакторах с ограничен-
ными сценарными возможностями... но только не эта! Она была написана в фор-
мате pod в простых текстовых редакторах (Том использовал vi, а Нат — emacs).
Окончательный вариант книги был получен преобразованием pod-файлов в фор-
мат FrameMaker.
Хотя в perlpod(V) приведено общее описание pod, вероятно, этот формат
удобнее изучать на примере готовых модулей. Если вы начали создавать соб-
ственные модули с помощью утилиты h2xs, то у вас уже имеются образцы. Ути-
лита Makefile знает, как преобразовать их в формат man и установить страницы
руководства так, чтобы их могли прочитать другие. Кроме того, программа
perl doc может транслировать документацию pod с помощью pod2text.
Абзацы с отступами остаются без изменений. Другие абзацы переформатиру-
ются для размещения на странице. В pod используется лишь два вида служебной
разметки: абзацы, начинающиеся со знака = и одного или нескольких слов, и внут-
ренние последовательности в виде буквы, за которой следует текст в угловых
скобках. Теги абзацев определяют заголовки, перечисляемые элементы списков
и служебные символы, предназначенные для конкретного транслятора. Последо-
вательности в угловых скобках в основном используются для изменения начер-
тания (например, выбора полужирного, курсивного или моноширинного шриф-
та). Приведем пример директивы =head2 в сочетании с изменениями шрифта:
=head2 Discussion
If we had a I<.h> file with function prototype declarations, we
could Include that, but since we're writing this one from scratch,
we'll use the B<-c> flag to omit building code to translate any
#def1ne symbols. The B<-n> flag says to create a module directory
named I<F1neT1me/>. 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/"(.)/>$l/:
s/(.{73}).....*/$l
<SNIP>/;
=cut back to perl
12.21. Построение и установка модуля CPAN
523
или парой =beg1n и =end:
=begin comment
if (!open(FILE. $fi1e)) {
unless ($opt_q) {
warn "$me: $file: $!\n":
$Errors++:
next FILE;
$total = 0;
$matches = 0:
=end comment
См. также
Раздел «PODs: Enbedded Documentation» в perlsyn(Vp, perlpod(Y), pod2man(T),
pod2html(V) и pod2text(l).
12.21. Построение и установка модуля 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 выдает предупреждение об ошибках
1 Этот формат отличается от формата zip, используемого на большинстве компьютеров
с Windows, однако новые версии Winzip читают его. До выхода Perl 5.005 для построе-
ния модулей CPAN использовалась стандартная версия Perl для Win32, а не ActiveState.
Также существуют бесплатные версии tar и GNU tar для систем Microsoft.
524
Глава 12. Пакеты, библиотеки и модули
контрольных сумм каталога ("Directory checksum errors"), значит, вы испортили
двоичный файл, приняв его в текстовом формате.
Вероятно, для установки модуля в системные каталоги необходимо стать при-
вилегированным пользователем с соответствующими правами доступа. Стандарт-
ные модули обычно устанавливаются в каталог /usr/11 b/perl 5, а прочие — в ката-
лог /usr/11b/perl5/site_perl.
Ниже приведен примерный процесс установки модуля MD5:
% gunzip MD5-1.7.tar.gz
% tar xf MD5-1.7.tar
% cd MD5-1.7
% perl Makefile.PL
Checking if your kit is complete...
Looks good
Writing Makefile for MD5
t make
mkdir ./blib
mkdir ./blib/lib
cp MD5.pm ./Ыib/1ib/MD5.pm
AutoSplitting MD5 (./blib/1ib/auto/MD5)
/usr/bin/perl -I/usr/local/lib/perl5/1386 ...
cp MD5.bs ./blib/arch/auto/MD5/MD5.bs
chmod 644 ./blib/arch/auto/MD5/MD5.bsmkdir ./blib/man3
Manifying ./blib/man3/MD5.3
t make test
PERL_DL_NONLAZY=1 /usr/bin/perl -1./blib/arch -I./blib/lib
-I/usr/1ocal/1ib/perl5/1386-freebsd/5.00404 -I/usr/1ocal/1ib/perl5 test.pl
1..14
ok 1
ok 2
ok 13
ok 14
% sudo make install
Password:
Instal1ing /usr/1ocal /1ib/perl5/site_perl/1386-freebsd/./auto/MD5/
MD5.so
Instal1ing /usr/1 ocal /1i b/perl 5/site_perl/1386-freebsd/./auto/MD5/
MD5.bs
Instal1ing /usr/1ocal/1ib/perl5/site_perlI./auto/MD5/autosplit.ix
Instal1i ng /usr/1 ocal /1i b/perl 5/site_perlI./MD5.pm
Instal1ing /usr/1 ocal /1ib/perl5/man/man3/./MD5.3
Writi ng /usr/1ocal/1i b/perl5/site_perl/1386-freebsd/auto/MD5/.packli st
Appending installation info to /usr/1ocal/11b/perl5/i386-freebsd/
5.00404/perl 1 ocal.pod
Если ваш системный администратор где-то пропадает или у него нет времени
на установку, не огорчайтесь. Используя Perl для построения make-файла по
шаблону Makeflle.PL, можно выбрать альтернативный каталог для установки.
# Если вы хотите установить модули в свой каталог
% perl Makefile.PL LIB=~/11b
# Если у вас имеется полная поставка
% perl Makefile.PL PREFIX=~/perl5-private
12.21. Построение и установка модуля CPAN
525
Еще проще использовать модуль CPAN из командной строки, поскольку в этом
случае Perl найдет, загрузит и установит необходимый модуль. Допустим, вы хо-
тите найти в CPAN модуль GetOpt:: Decl аге. Все, что для этого необходимо сде-
лать, — ввести команду
% perl -MCPAN -е "Install Getopt::Decl are"
При первом использовании модуля CPAN вам будут заданы вопросы по выбо-
ру конфигурации. Ответы на них сохраняются, поэтому при последующих ис-
пользованиях этого модуля вам уже не придется вводить вопросы заново.
Модуль CPAN также поддерживает интерактивную командную оболочку. В ней
можно найти модуль, точное имя которого вам неизвестно, проверить, какие моду-
ли CPAN были обновлены с момента их установки в вашей системе, установить
группы взаимосвязанных модулей и выполнять другие полезные операции.
Пример использования интерактивной оболочки:
% perl -MCPAN -е shell
cpan shell -- CPAN exploration and modules Installation (vl.70)
ReadLlne support enabled
cpan> h
Display Information
command argument description
a.b.d.m WORD or /REGEXP/ about authors, bundles, distributions, modules
1 WORD or /REGEXP/ about anything of above
r NONE reinstall recommendations
Is AUTHOR about files In the author's directory
Download, Test, Make. Install...
get download
make make (implies get)
test MODULES. make test (Implies make)
Install DISTS, BUNDLES make Install (Implies test)
clean make clean
look open subshell In these di sts' directories
readme display these di sts' README files
Other
h,? display this menu ! perl-code eval a perl command
о conf [opt] set and query options q quit the cpan shell
reload cpan load CPAN.pm again reload Index load newer Indices
autobundle Snapshot force cmd unconditionally do cmd
cpan> 1 /Inflect/
CPAN: Storable loaded ok
Going to read /home/tchrlst/.cpan/Metadata
Database was generated on Mon, 07 Apr 2003 22:42:33 GMT
Distribution D/DC/DCONWAY/L1ngua-EN-Inflect-1.88.tar,gz
Module Lingua::EN::Inflect (D/DC/DC0NWAY/L1ngua-EN-Inflect-1.88.tar.gz)
2 Items found
cpan> Install Lingua::EN::Inflect
[build and Install output deleted]
cpan> quit
526
Глава 12. Пакеты, библиотеки и модули
Модуль CPAN постепенно уступает место CPANPLUS — модулю с аналогич-
ной функциональностью, но обладающему большей гибкостью и более широки-
ми возможностями. Текстовый интерфейс CPANPLUS похож на интерфейс мо-
дуля CPAN, но CPANPLUS также поддерживает графический и программный
интерфейс для доступа ко многим возможностям, скрываемым модулем CPAN.
См. также
Документация по стандартному модулю ExtUtl 1 s::MakeMaker; файл INSTALL в ис-
ходной поставке Perl.
12.22. Пример: шаблон модуля
Ниже приведен «скелет» модуля. Если вы собираетесь написать собственный
модуль, попробуйте скопировать и отредактировать его.
package Some::Module; # Должен находиться в Some/Module.pm
use strict;
require Exporter;
= 0.01;
# Установка версии для последующей проверки
$VERSION = 0.01;
our @ISA
= qw(Exporter):
our ^EXPORT = qw(&funcl &func2 &func4);
our %EXPORT_TAGS = ( ): # например: TAG => [ qw!namel name2! ].
# Здесь находятся экспортируемые глобальные переменные.
# а также функции с необязательным экспортированием
@EXPORT_OK = qw($Varl Rashit &func3):
use vars qw($Varl %Hashit):
# Здесь находятся неэкспортируемые глобальные имена пакета
our (@more, $stuff):
# Инициализировать глобальные переменные пакета,
# начиная с экспортируемых
$Varl =
Rashit =0:
# Затем все остальные (к которым можно обращаться
# в виде $Some::Module::stuff)
$stuff =
@more = ():
# Все лексические переменные с файловой областью действия
# должны быть созданы раньше функций, которые их используют.
# Лексические переменные, доступ к которым
12.23. Программа: поиск версий и описаний установленных модулей
527
# ограничивается данным файлом.
my $pr1v_var =
ту %secret_hash = О:
# Закрытая функция, оформленная в виде замыкания
# и вызываемая через &$priv_func.
ту $priv_func = sub {
# Содержимое функции.
}:
# Все ваши функции, экспортируемые и нет:
# не забудьте вставить что-нибудь в заглушки {}
sub fund {....} # без прототипа
sub func2() {....} # прототип - void
sub func3($$) {....} # прототип - 2 скаляра
# Функция не экспортируется автоматически, но может вызываться!
sub func4(W {....} # прототип - 1 ссылка на хэш
END { } # Завершающий код модуля (глобальный деструктор)
1:
12.23. Программа: поиск версий и описаний
установленных модулей
Perl распространяется вместе с множеством стандартных модулей. Еще больше
модулей можно найти в CPAN. Следующая программа выводит имена, версии и
описания всех модулей, установленных в вашей системе. Она использует стан-
дартные модули (например, File::Find) и реализует некоторые приемы, описан-
ные в этой главе.
Программа запускается следующей командой:
% pmdesc
Она выводит список модулей с описаниями:
F11eHandle (2.00) - supply object methods for filehandles
10::File (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/11 b/perl5/i686- 11nux/5.00404»>
FileHandle (2.00) - supply object methods for filehandles
528
Глава 12. Пакеты, библиотеки и модули
Флаг -w предупреждает о том, что модуль не включает документации в фор-
мате pod, а флаг -s сортирует список модулей в каждом каталоге.
Исходный текст программы приведен в примере 12.3.
Пример 12.3. pmdesc
# !/usr/bin/perl -w
# pmdesc - вывод описаний файлов pm
# tchrist@perl.com
use strict:
use File::Fl nd use Getopt::Std use Carp: qw(flnd): qw(getopts):
use vars ( q!$opt_v!, q!$opt_w!, # Вывод отладочной информации # Предупреждения об отсутствующих # описаниях модулей
q!$opt_a!, q!$opt_s!. # Вывод относительных путей # Сортировка данных по каждому каталогу
$| = 1:
getoptsC’wvas") or die "bad usage":
@ARGV = @INC unless @ARGV:
# Глобальные переменные. Я бы предпочел обойтись без этого.
use vars ( q!$Start_D1r!, # Каталог верхнего уровня, для которого # вызывалась функция find
q! ^Future!, # Другие каталоги верхнего уровня, # для которых find вызывается позднее
my SModule;
# Установить фильтр для сортировки списка модулей,
# если был указан соответствующий флаг.
If ($opt_s) { If (openCME, $/ = Т')) {
while (<МЕ>) {
chomp:
print jo1n("\n", sort split /\n/), "\n":
}
exit:
}
}
MAIN: {
12.23. Программа: поиск версий и описаний установленных модулей
529
my ^visited;
ту ($dev,$ino);
@Future{@ARGV} = (1) х @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_D1r);
next If $visited{$dev,$ino}++;
next unless $opt_a || $Start_Dir =~ m!x/!;
find(\&wanted, $Start_D1r);
}
exit;
}
# Вычислить имя модуля по файлу и каталогу
sub modname {
local $_ = $F11e::F1nd::name;
if (index($_, $Start_D1r . "/")== 0) {
substr($_, 0, 1+1ength($Start_D1r)) = "";
}
S { / } {: :}gx;
s { \.p(m|od)$ } {}x:
return $_;
}
# Решить, нужен ли нам данный модуль
sub wanted {
if ( $Future{$Fi1е::Find;:name} ) {
warn "\t(Skipping $File::Find::name, qui venit in future.)\n"
if 0 and $opt_v;
$Fi1e::Find::prune = 1;
return;
}
return unless /\.pm$/ && -f;
$Module = &modname:
# Пропуск нежелательных модулей
if ($Module =~ /XCPAN(\Z|::)/) {
warn("$Module -- skipping because it misbehaves\n");
return;
}
my $file = $_;
продолжение
530
Глава 12. Пакеты, библиотеки и модули
Пример 12.3 (продолжение)
unless (open(POD, "<", $file)) {
warn "\tcannot open $f11e: $!":
# if $opt_w;
return 0;
}
$: = "
local $/ =
local $_:
while (<POD>) {
if (/=head\d\s+NAME/) {
chomp($_ = <POD>);
s/\*?-\s+//s:
s/\n/ /g;
#write:
my $v;
if (defined ($v = getversion($Module))) {
print "$Module ($v)
} else {
print "$Module
}
print $_\n":
return 1;
}
}
warn "\t(MISSING DESC FOR $File::Find::name)\n”
if $opt_w;
return 0:
}
# Загрузить модуль и вывести его номер версии,
# перенаправляя ошибки в /dev/null
sub getversion {
my $mod = shift;
my $vers = '$XX -m$mod -e 'print \$${mod}::VERSION' 2>/dev/nul1';
$vers =~ s/x\s*(,*?)\s*$/$l/; # Удалить лишние пропуски
return ($vers || undef):
}
format =
x <««««««««—x <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
$Module, $_
Задача также может быть решена при помощи вспомогательного программного
интерфейса модуля CPANPLUS (если он установлен в вашей системе). Следую-
щая программа выводит информацию обо всех доступных модулях (параметр -X
подавляет все предупреждения о неправильных путях или номерах версий):
12.23. Программа: поиск версий и описаний установленных модулей
531
#!/usr/bin/perl -X
use CPANPLUS::Backend;
use Data::Dumper:
$cp = CPANPLUS::Backend->new;
$installed = $cp->1nstalled->rv: # Получить список установленных модулей
foreach my Smodule (sort keys Hi nstal led) {
# Получить информацию о модулях
$info = $cp->deta1Is(modules => [$module])->rv->{$module}:
# Вывести интересующие нас поля
printf(’l-35.35s M4.44s\n". $module, $info->{Description}):
При запуске выводится таблица, которая выглядит примерно так:
Algorithm::Cluster
Algorithm::NaiveBayes
AnyDBM_File
Apache
Apache::AuthDBI
Apache:Connection
Perl extension for the C clustering library
None given
Uses first available *_File module above
Interface to the Apache server API
None given
Inteface to Apache conn_rec struct
Классы, объекты
и связи
«По всему миру я призываю массы на борьбу с классами».
Уильям Гладстон, речь в Ливерпуле, 28 июня 1886 г.
13.0. Введение
Хотя изначально Perl не был задуман как объектно-ориентированный язык,
спустя несколько лет после выхода первого варианта в нем появилась полная
поддержка объектно-ориентированного программирования. Как обычно, Perl не
пытается заставить программиста применять «единственно правильный» стиль,
а предлагает на выбор несколько решений. Такое разнообразие позволяет лю-
дям решать свои задачи так, как они считают нужным.
При написании программ необязательно пользоваться объектами, в отличие
от языка Java, где программы представляют собой экземпляры объектов. Однако
при желании можно написать Perl-программу, в которой используется практи-
чески весь арсенал приемов объектно-ориентированного программирования.
В Perl поддерживаются классы и объекты, одиночное и множественное насле-
дование, методы экземпляров и методы классов, переопределение методов, кон-
структоры и деструкторы, перегрузка операторов, методы-посредники с автоза-
грузкой, делегирование, иерархия объектов и два уровня уборки мусора.
Вы можете использовать ровно столько объектно-ориентированных приемов,
сколько сочтете нужным. Связи (ties) являются единственной частью Perl, где
объектно-ориентированный подход обязателен. Но даже здесь об этом должен
знать только лишь программист, занимающийся реализацией модуля; случайный
пользователь остается в блаженном неведении относительно внутренних меха-
низмов. Связи, рассматриваемые в рецепте 13.15, позволяют организовать про-
зрачный перехват обращений к переменной. Например, с помощью связей мож-
но создать хэш с возможностью поиска по ключу или по значению.
Под капотом
Если спросить десятерых программистов, что такое «объектная ориентация», вы
получите десять разных ответов. Люди рассуждают об «абстракции» и «инкап-
суляции», пытаются выделить основные черты объектно-ориентированных языков
13.0. Введение
533
программирования и придумать для них умные термины, чтобы потом писать
статьи и книги. Не все объектно-ориентированные языки обладают одинаковы-
ми возможностями, но все они считаются объектно-ориентированными. Конеч-
но, в результате появляются все новые статьи и книги.
Мы будем использовать терминологию из документации Perl и страницы ру-
ководства perlobj(V). Объект представляет собой переменную, принадлежащую
к некоторому классу. Методами называются функции, ассоциируемые с классом
или объектом. В Perl класс представляет собой пакет, а обычно и модуль. Объ-
ект является ссылкой на нечто, ассоциируемое с классом.
Ассоциирование субъекта ссылки с классом называется приведением (blessing).
В приведении нет ничего загадочного или мистического; ассоциация создается
функцией bless, вызываемой с одним или двумя аргументами. В первом аргумен-
те передается ссылка на приводимый объект, а в необязательном втором аргу-
менте — пакет, к которому осуществляется приведение.
Sobject = {}; # Ссылка на хэш
bl ess(Sobject. "Data::Encoder"): # Привести Sobject к классу
# Data::Encoder
bless(Sobject): # Привести Sobject к текущему пакету
Имя класса соответствует имени пакета (Data:: Encoder в приведенном выше при-
мере). Поскольку классы являются модулями (обычно), код класса Data::Encoder
находится в файле Data/Encoder.pm. Структура каталогов, как и для традицион-
ных модулей, существует исключительно для удобства; она никак не связана
с наследованием, ограничением доступа к переменным или чем-нибудь еще.
Впрочем, в отличие от традиционных модулей, объектные модули очень редко
используют Exporter. Вся работа должна вестись только через вызовы методов,
но не через импортированные функции или переменные.
После приведения объекта вызов функции ref для ссылки на него возвраща-
ет имя класса вместо фундаментального типа субъекта:
Sobj = [3,5]:
print ref(Sobj), " ". Sobj->[1], "\n":
bless($obj, "Human::Cann1bal"):
print ref(Sobj). " ", Sobj->[1], "\n":
ARRAY 5
Human::Cannibal 5
Как видите, приведенную ссылку все еще можно разыменовать. Чаще всего
объекты реализуются с помощью приведенных ссылок на хэши. Вы можете ис-
пользовать любые разновидности ссылок, но ссылки на хэш обеспечивают мак-
симальную гибкость. Они позволяют создавать в объекте поля данных с произ-
вольными именами:
Sobj->{Stomach} = "Empty": # Прямое обращение к данным объекта
$obj->{NAME} = "Thag":
# Символы верхнего регистра в имени поля
# помогают выделить его (необязательно)
Хотя Perl позволяет любому коду за пределами класса напрямую обращать-
ся к данным объекта, это считается нежелательным. Согласно общепринятому
534
Глава 13. Классы, объекты и связи
мнению, операции с данными должны выполняться только через специальные
методы, предназначенные для этой цели. У разработчика класса появляется воз-
можность изменить его реализацию без модификации всего кода приложений,
использующих данный класс.
Методы
Приведение (то есть ассоциирование субъекта ссылки с пакетом) выполняется
с единственной целью: чтобы Perl мог определить пространство имен пакета,
в котором следует искать функции при вызове методов объекта. Для вызова
методов используется оператор ->. В следующем примере мы вызываем метод
encode О объекта Sobject с аргументом "data” и сохраняем возвращаемое значе-
ние в переменной Sencoded:
Sencoded = $object->encode("data"):
В данном примере вызывается метод объекта, поскольку мы вызываем метод
конкретного экземпляра. Также существуют методы классов, то есть методы, вы-
зываемые для строки с именем пакета (то есть класса):
Sencoded = Data::Encoder->encode("data"):
При вызове метода вызывается функция соответствующего класса с неявной
передачей в качестве аргумента либо ссылки (для метода объекта), либо строки
(для метода класса). Не всегда очевидно, какой из двух типов методов вызыва-
ется в каждом конкретном случае, потому что слева от -> может находиться пе-
ременная, содержащая имя класса вместо приведенной ссылки:
Sclass = "Animal::" . (Saquatlc ? "Fish" : "Mammal"):
Sbeastle = $class->create():
В одних случаях будет вызываться метод create класса Animal: :F1sh, в дру-
гих — метод create класса Animal::Mammal. А возможно, в итоге будет вызвана
одна и та же базовая функция, если у этих двух классов имеется общий класс-
предок. Класс становится известен лишь на стадии выполнения. В рецепте 13.8
показано, как вызывать методы с именами, определяемыми во время выпол-
нения.
В большинстве классов существуют специальные методы, возвращающие
новые объекты — конструкторы. В отличие от некоторых объектно-ориентиро-
ванных языков, конструкторы Perl не имеют специальных имен. В сущности,
конструктор можно назвать, как вам захочется. Программисты C++ обожают
присваивать своим конструкторам в Perl имя new. Мы рекомендуем выбирать
имя конструктора так, чтобы оно имело смысл в контексте решаемой задачи.
Например, конструкторы расширения Тк в Perl называются по именам созда-
ваемых ими элементов (widgets). Менее распространенный подход основан на
экспортировании функции, имя которой совпадает с именем класса; см. пример
в подразделе «Пример: Перегруженный класс StrNum» в рецепте 13.14.
Типичный конструктор выглядит следующим образом:
sub new {
my $class = shift:
my $self = {}; # Выделить новый хэш для объекта
13.0. Введение
535
bl ess($self, $class);
return Sself;
}
Вызов конструктора выглядит так:
Sobject = Class->new();
Если дело обходится без наследования или иных выкрутасов, это фактически
эквивалентно:
Sobject = Class::new("Class"):
Первым аргументом функции new() является имя класса (то есть пакета), к ко-
торому приводится новая ссылка. Конструктор должен передать эту строку bless О
в качестве второго аргумента.
В рецепте 13.1 также рассматриваются функции, возвращающие приведен-
ные ссылки. Конструкторы не обязаны быть методами класса; часто бывает
удобнее использовать методы объектов, возвращающие новые объекты (см. ре-
цепты 13.6 и 13.7).
Деструктором называется функция, которая выполняется при уничтожении
субъекта, соответствующего данному объекту, в процессе уборки мусора. Посколь-
ку деструкторы вызываются автоматически, в отличие от конструкторов, их имена
жестко фиксируются. Методу-деструктору должно быть присвоено имя DESTROY.
Этот метод, если он существует, вызывается для всех объектов непосредственно пе-
ред освобождением памяти. Наличие деструктора (см. рецепт 13.2) необязательно.
Некоторые языки на уровне синтаксиса позволяют компилятору ограничить
доступ к методам класса. В Perl такой возможности нет — программа может
вызывать любые методы объекта. Автор класса должен четко документировать
открытые методы (те, которые можно использовать). Пользователям класса
следует избегать недокументированных (то есть неявно закрытых) методов.
Perl не различает методы, вызываемые для класса (методы классов), и мето-
ды, вызываемые для объекта (методы экземпляров). Если вы хотите, чтобы неко-
торый метод вызывался только как метод класса, поступите следующим образом:
sub class_only_method {
my Sclass = shift:
die "class method called on object" If ref Sclass:
# Дополнительный код
}
Чтобы метод вызывался только как метод экземпляра, воспользуйтесь сле-
дующим кодом:
sub 1nstance_only_method {
my Sself = shift:
die "Instance method called on class" unless ref Sself:
# Дополнительный код
}
Если в вашей программе вызывается неопределенный метод объекта, Perl не
будет жаловаться на стадии компиляции; вместо этого произойдет исключение
во время выполнения. Метод представляет собой обычный вызов функции, пакет
которой определяется во время выполнения. Методы, как и все косвенные функ-
536
Глава 13. Классы, объекты и связи
ции, не имеют проверки прототипа — проверка выполняется на стадии ком-
пиляции. Даже если бы вызовы методов учитывали наличие прототипа, в Perl
компилятор никогда не проверяет точные типы или интервалы аргументов функ-
ции. Прототипы Perl предназначены для форсирования контекста аргумента
функции, а не для проверки интервала. Странности прототипов Perl описаны
в рецепте 10.11.
Чтобы предотвратить инициирование исключений для неопределенных мето-
дов, можно использовать механизм AUTOLOAD для перехвата вызовов несуще-
ствующих методов. Данная возможность рассматривается в рецепте 13.12.
Наследование
Отношения наследования определяют иерархию классов. При вызове метода, не
определенного в классе, поиск метода с указанным именем осуществляется на
предшествующих методах иерархии. Используется первый найденный метод.
Наследование позволяет строить классы «на фундаменте» других классов, что-
бы код не приходилось переписывать заново. Классы являются одной из форм
многократного использования кода и потому способствуют развитию Лени —
главной добродетели программиста.
В некоторых языках существует специальный синтаксис наследования. В Perl
каждый класс (пакет) может занести список своих суперклассов, то есть родите-
лей в иерархии, в глобальную (не лексическую!) пакетную переменную @ISA.
Этот список просматривается во время выполнения программы, при вызове ме-
тода, не определенного в классе объекта. Если первый пакет, указанный в @ISA,
не содержит искомого метода, но имеет собственный массив @ISA, то Perl перед
продолжением поиска рекурсивно просматривает @ISA этого пакета.
Если поиск унаследованного метода заканчивается неудачей, проверка выпол-
няется заново, но на этот раз ищется метод с именем AUTOLOAD. Так, поиск метода
$1nvocant->meth(), где $1nvocant — имя пакета или ссылка на субъект, приведен-
ный к этому пакету, происходит в следующей последовательности:
О Р::meth
О Все методы S:: meth О в пакетах S из @Р:: ISA, рекурсивно
О UNIVERSAL::meth
О Процедура Р:: AUTOLOAD
О Все методы S:: AUTOLOAD() в пакетах S из @Р:: ISA, рекурсивно
О Подпрограмма UNIVERSAL::AUTOLOAD
В большинстве классов массив О ISA состоит из одного элемента — такая си-
туация называется одиночным наследованием. Если массив @ISA содержит не-
сколько элементов, говорят, что класс реализует множественное наследование.
Вокруг достоинств и недостатков множественного наследования идут постоян-
ные споры, но Perl поддерживает эту возможность.
В рецепте 13.10 рассматриваются основы наследования и базовые принципы
построения классов, обеспечивающие удобство субклассирования. В рецепте 13.11
мы покажем, как субкласс переопределяет методы своих суперклассов.
13.0. Введение
537
Perl не поддерживает наследования данных. Можно сказать, что в Perl под-
держивается только наследование интерфейса, но не наследование реализа-
ции. Класс обычно может напрямую обращаться к данным другого класса
(хотя поступать подобным образом не рекомендуется, поскольку это не соот-
ветствует принципам инкапсуляции и нарушает абстракцию). Если вы после-
дуете рекомендациям из рецептов 13.11, это ограничение не вызовет особых
проблем.
Косвенный вызов методов
Косвенный вызов методов:
Slector = new Human::Cannibal:
feed Slector "Zak":
move Slector "New York":
представляет собой альтернативный вариант синтаксиса для:
Slector = Human::Cannibal->new():
$lector->feed("Zak"):
$1 ector->move("New York"):
Синтаксис косвенного вызова методов привлекателен для англоязычных
программистов и хорошо знаком программирующим на C++ (где подобным
образом используется new). Не поддавайтесь соблазну. Косвенный вызов об-
ладает двумя существенными недостатками. Прежде всего, он должен подчи-
няться тем же ненадежным правилам, что и позиция файлового манипулятора
в print и prlntf:
prlntf STDERR "stuff here\n":
Эта позиция, если она заполняется, должна содержать простое слово, блок
или имя скалярной переменной; скалярные выражения недопустимы. Это при-
водит к невероятно запутанным проблемам приоритета, как в двух следующих
строках:
move $obj->{FI ELD}: # Вероятно, ошибка
move SaryESI]: # Вероятно, ошибка
Как ни странно, эти команды интерпретируются следующим образом:
$obj->move->{FIELD}; $ary->move->E$1]: # Сюрприз! # Сюрприз!
вместо ожидаемого:
$obj->{FIELD}->move(): SaryESI]->move: # Ничего подобного # Ничего подобного
Как и в случае с prlntf, проблему можно решить, заключив выражение в фи-
гурные скобки и превратив его в блок:
move { Sobj->{FI ELD} }: # Работает
move { SaryESIJ }:
538
Глава 13. Классы, объекты и связи
Более того, как и в случае с print и printf, круглые скобки не являются обя-
зательными, а вызов метода с позиций синтаксиса превращается в списковый
оператор. Следовательно, запись вида
move Sobj (3 * Sposition) + 2;
print STDERR (3 * Spositlon) + 2:
в конечном счете будет интерпретироваться как
$obj->move(3 * Sposition) + 2;
STDERR->print(3 * Sposition) + 2:
А значит, в нее необходимо добавить дополнительную пару круглых скобок:
move Sobj ((3 * Sposition) + 2):
print STDERR ((3 * Sposition) + 2);
Другая проблема заключается в том, что во время компиляции Perl прихо-
дится гадать, что такое name и move — функции или методы. Запись
Sobj = new Game:
в зависимости от области действия и наличия информации у компилятора мо-
жет означать любую из следующих конструкций:
Sobj = newC’Game"):
Sobj = new(GameO):
Sobj = ”Game”->new():
Скорее всего, вам нужен только третий вариант. Более того, даже использо-
вание инфиксного оператора -> для вызова метода порождает потенциальные
проблемы. Например, команда
Sobj = Game->new():
может быть интерпретирована как
Sobj = Game()->new():
в несколько экзотической ситуации, когда в текущем пакете имеется функция с
GameO. Обычно Perl угадывает правильно, но в случае ошибки функция будет
откомпилирована как метод, и наоборот. Это может привести к появлению не-
вероятно хитрых ошибок, которые очень трудно обнаружить.
Самый верный способ избавиться от всех неоднозначностей — поставить ::
после имени пакета (класса):
Sobj = new Game::: # Всегда "Game"->new()
Sobj = Game::->new; # Всегда "Game"->new()
Теперь неважно, видна ли в текущем пакете функция с именем Game или new;
в любом случае будет вызван метод. Как видно из комментария, при вызове мето-
да символы :: игнорируются.
Честно говоря, практически всегда удается ограничиться простым указанием
имени класса без уродливого суффикса ::, но для этого должны выполняться
два условия. Во-первых, в классе не должно быть процедуры с тем же именем
(если следовать правилу, по которому имена процедур начинаются со строчной
13.0. Введение
539
буквы, а имена классов типа Game — с прописной, этой проблемы не возникнет).
Во-вторых, класс должен быть загружен одной из следующих директив:
use Game:
require Game:
Любое из этих объявлений гарантирует, что Perl будет знать: Game — это имя
модуля. В результате любое простое имя типа new перед именем класса Game ин-
терпретируется как вызов метода, даже если в текущем пакете вы объявили собст-
венную процедуру с именем new. Проблемы с косвенным обращением к объектам
обычно возникают лишь тогда, когда программист пытается упаковать несколь-
ко классов в одном файле; тогда Perl может не понять, что имя пакета должно
интерпретироваться как имя класса. Попытки присвоить своим процедурам
имена типа Modul eNames тоже рано или поздно приведут к беде.
Некоторые замечания по объектной терминологии
В объектно-ориентированном мире одни и те же концепции часто описываются
разными словами. Если вы программировали на другом объектно-ориентирован-
ном языке, возможно, вам захочется узнать, как знакомые термины и концепции
представлены в Perl.
Например, объекты часто называются экземплярами (instances) классов, а ме-
тоды этих объектов — методами экземпляров. Поля данных, относящиеся к каж-
дому объекту, часто называются данными экземпляров или атрибутами объектов,
а поля данных, общие для всех членов класса, — данными класса, атрибутами
класса или статическими переменными класса.
Кроме того, термины базовый класс и суперкласс обозначают одно и то же
понятие (родитель или другой предок в иерархии наследования), тогда как тер-
мины производный класс и субкласс обозначают противоположное отношение
(непосредственный или отдаленный потомок в иерархии наследования).
Программисты на C++ привыкли использовать статические методы, вирту-
альные методы и методы экземпляров, но в Perl существует только общее поня-
тие «метод». Принадлежность метода к классу или объекту определяется исклю-
чительно контекстом использования. Метод класса (со строковым аргументом)
можно вызвать для объекта (с аргументом-ссылкой), но вряд ли это приведет
к разумному результату.
Программисты C++ привыкли к глобальным (то есть существующим на уров-
не класса) конструкторам и деструкторам. В Perl они идентичны соответственно
инициализирующему коду модуля и блоку END{}.
С позиций C++ все методы Perl являются виртуальными. По этой причине
их аргументы никогда не проверяются на соответствие прототипам функции,
как это можно сделать для встроенных и пользовательских функций. Прото-
типы проверяются компилятором во время компиляции, тогда как функция,
вызванная методом, определяется лишь во время выполнения.
Философское отступление
В своих объектно-ориентированных аспектах Perl предоставляет полную свобо-
ду выбора:
О возможность делать одни и те же вещи несколькими способами (приведение
позволяет создать объект из данных любого типа);
540
Глава 13. Классы, объекты и связи
О возможности модификации классов, написанных другими (добавление функ-
ций в их пакеты);
О а также полная возможность превратить отладку программы в сущий ад —
если вам этого сильно захочется.
В менее гибких языках программирования обычно устанавливаются более
жесткие ограничения. Многие языки с фанатичным упорством отстаивают за-
крытость данных, проверку типов на стадии компиляции, сложные сигнатуры
функций и другие возможности. Все эти ограничения отсутствуют в объектах
Perl, поскольку они вообще не поддерживаются Perl. Помните об этом, если объ-
ектно-ориентированные аспекты Perl покажутся вам странными. Все странности
происходят лишь оттого, что вы привыкли к философии других языков. Объект-
но-ориентированная сторона Perl абсолютно разумна, если мыслить катего-
риями Perl. Для любой задачи, которую нельзя решить на Perl по аналогии с Java
или C++, найдется прекрасно работающее решение в идеологии Perl. Програм-
мист-параноик даже сможет обеспечить полную закрытость: в perltootiY) расска-
зано о том, как с помощью приведения замыканий получить объекты, по степени
закрытости не уступающие объектам C++ (и даже превосходящие их).
Объекты Perl не плохи; просто они другие.
См. также
В литературе по объектно-ориентированному программированию Perl упомина-
ется очень редко. Изучение объектно-ориентированных аспектов языка лучше
всего начать с документации Perl — особенно с учебников perltoot(V) и perlboot(Y).
За справочной информацией обращайтесь к perlobj(\). Вероятно, этот документ
понадобится вам при чтении руководства perlbot(\), полного объектно-ориенти-
рованных фокусов.
13.1. Конструирование объекта
Проблема
Необходимо предоставить пользователю возможность создания новых объектов.
Решение
Создайте конструктор. В Perl метод-конструктор не только инициализирует
объект, но и предварительно выделяет память для него — как правило, с исполь-
зованием анонимного хэша. Конструкторы C++, напротив, вызываются после
выделения памяти. В объектно-ориентированном мире конструкторы C++ было
бы правильнее назвать инициализаторами.
Канонический конструктор объекта в Perl выглядит так:
sub new {
my Sclass = shift:
my Sself = {}:
13.1. Конструирование объекта
541
bless($self. Sclass);
return Sself;
}
Данный фрагмент эквивалентен следующей строке:
sub new { bless( {}. shift ) }
Комментарий
Любой метод, который выделяет память для объекта и инициализирует его,
фактически является конструктором. Главное, о чем следует помнить, — ссылка
становится объектом лишь после того, как для нее будет вызвана функция bless.
Простейший, хотя и не особенно полезный конструктор выглядит так:
sub new { bless({ }) }
Давайте включим в него инициализацию объекта:
sub new {
my Sself = { }: # Выделить анонимный хэш
bl ess(Sself):
# Инициализировать два атрибута/поля/переменных экземпляра
$self->{START} = tlmeO;
$self->{AGE} = 0;
return $self;
}
Такой конструктор не очень полезен, поскольку в нем используется одноар-
гументная форма bless, которая всегда приводит объект к текущему пакету. Это
означает, что полезное наследование от него становится невозможным; сконст-
руированные объекты всегда будут приводиться к классу, в котором была от-
компилирована функция new. При наследовании этот класс не обязательно сов-
падет с тем, для которого вызывался данный метод.
Проблема решается просто: достаточно организовать в конструкторе обра-
ботку первого аргумента. Для метода класса он представляет собой имя пакета.
Передайте имя класса функции bless в качестве второго аргумента:
sub new {
my $classname = shift;
my Sself = {};
bless($self Sclassname);
$self->{START} = tlmeO;
$self->{AGE} = 0:
return $self;
}
# Какой класс мы конструируем?
# Выделить память
# Привести к нужному типу
# Инициализировать поля данных
# И вернуть
Теперь конструктор будет правильно наследоваться производными классами.
Выделение памяти и приведение также можно отделить от инициализации
данных экземпляра. В простых классах это не нужно, однако такое разделение
упрощает наследование; см. рецепт 13.11.
sub new {
my Sclassname = shift; # Какой класс мы конструируем?
my Sself = {}: # Выделить память
bless($self. Sclassname); # Привести к нужному типу
542
Глава 13. Классы, объекты и связи
$self->_init(@_); # Вызвать _init
# с остальными аргументами
return $self;
}
# "Закрытый" метод для инициализации полей. Он всегда присваивает START
# текущее время, a AGE - 0. При вызове с аргументами _init
# интерпретирует их как пары «ключ/значение» и инициализирует ими объект,
sub _init {
my $self = shift:
$sel f->{START} = timeO:
$self->{AGE} = 0:
if (@_) {
my ^extra =
@$self{keys ^extra} = values ^extra:
}
}
См. также
perltoot{\), perlobj(V) и perlobj(l); рецепты 13.6, 13.10 и 13.11.
13.2. Уничтожение объекта
Проблема
Некоторый фрагмент кода должен выполняться в случае, если надобность в объ-
екте отпадает. Например, объект может использоваться в интерфейсе с внеш-
ним миром или содержать циклические структуры данных — в этих случаях он
должен «убрать за собой». При уничтожении объекта может происходить удале-
ние временных файлов, разрыв циклических связей, корректное отсоединение
от сокета или уничтожение порожденных процессов.
Решение
Создайте метод с именем DESTROY. Он будет вызываться в том случае, когда на
объект не остается ни одной ссылки или при завершении программы (в зави-
симости от того, что произойдет раньше). Освобождать память не нужно; лишь
выполните все завершающие действия, которые имеют смысл для данного класса.
sub DESTROY {
my $self = shift:
printf("$self dying at £s\n", scalar localtime):
}
Комментарий
У каждой истории есть начало и конец. История объекта начинается с выполне-
ния конструктора, который явно вызывается при создании объекта. Жизненный
цикл объекта завершается в деструкторе — методе, который неявно вызовется
13.2. Уничтожение объекта
543
при уходе объекта из жизни. Весь завершающий код, относящийся к объекту,
помещается в деструктор, который должен называться DESTROY.
Почему деструктору нельзя присвоить произвольное имя, как это делается
для конструктора? Потому что конструктор явно вызывается по имени, а дест-
руктор — нет. Уничтожение объекта выполняется автоматически через систему
уборки мусора Perl, реализация которой в настоящее время основана на быст-
рой, но упрощенной системе подсчета ссылок. Чтобы знать, какой метод должен
вызываться при уничтожении объекта, Perl требует присвоить деструктору имя
DESTROY. Если несколько объектов одновременно выходят из области действия,
Perl не гарантирует вызова их деструкторов в определенном порядке.
Почему имя DESTROY пишется в верхнем регистре? В Perl это обозначение го-
ворит о том, что данная функция вызывается автоматически. К числу других ав-
томатически вызываемых функций принадлежат BEGIN, END, AUTOLOAD и все мето-
ды связанных объектов (см. рецепт 13.15) — например, STORE и FETCH.
Пользователь не должен беспокоиться о том, когда будет вызван конструк-
тор; просто это произойдет именно тогда, когда должно произойти. В языках, не
поддерживающих уборку мусора, программисту приходится явно вызывать де-
структор для очистки памяти и сброса состояния и надеяться на то, что он не
ошибся в выборе момента. Беднягу можно только пожалеть.
Благодаря автоматизированному управлению памятью в Perl деструкторы
объектов используются редко. Но даже в случаях, когда они нужны, явный вы-
зов деструктора — вещь не только излишняя, но и попросту опасная. Деструктор
будет вызван системой времени исполнения в тот момент, когда объект переста-
нет использоваться. В большинстве классов деструкторы не нужны, поскольку
Perl сам решает основные проблемы — такие, как освобождение памяти.
Система сборки мусора не поможет лишь в одной ситуации — при наличии
циклических ссылок в структуре данных:
$self->{WHATEVER} = $self:
В этом случае циклическую ссылку приходится удалять вручную, чтобы при
работе программы не возникали утечки памяти. Такой вариант чреват ошибка-
ми, но это лучшее, что мы можем порекомендовать сейчас. В рецептах 11.5 и 13.13
представлены элегантные решения этой проблемы с применением методик, лег-
ко обобщаемых для любой структуры данных. Однако вы можете быть уверены,
что при завершении программы будут вызваны деструкторы всех ее объектов.
При завершении работы интерпретатора выполняется вторая, более серьезная
уборка мусора. Даже недоступные или циклические объекты не переживут послед-
ней чистки. Следовательно, можно быть уверенным в том, что объект когда-нибудь
будет уничтожен должным образом, разве что если программа зациклится. Если
Perl работает внутри другого приложения, вторая форма уборки мусора встреча-
ется чаще (при каждом завершении интерпретатора).
Метод DESTROY не вызывается при завершении программы, вызванной функ-
цией ехес.
См. также
perltoot(Y), perlboot(\} nperlobj(l); рецепты 13.11 и 13.13.
544
Глава 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};
}
Иногда при установке нового значения полезно вернуть старое:
# Пример одновременного чтения и записи атрибута
sub age {
my $self = shift;
my $oldage = $self->{AGE};
if (@_) { $self->{AGE} = shift }
return $oldage;
}
$previous_age = $obj->age( $obj->age() + $TIME_PASSES );
Комментарий
Работа методов зависит от того, как вы организуете открытый интерфейс к объ-
екту. Нормальный класс не любит, чтобы окружающие копались у него во внут-
ренностях. Для каждого атрибута данных должен существовать метод, обеспе-
чивающий его чтение или обновление. Если пользователь пишет фрагмент вида
$hi m = Person->new();
$him->{NAME} = "Sylvester";
$him->{AGE} = 23;
он нарушает интерфейс объекта и напрашивается на неприятности.
13.3. Работа с данными экземпляра
545
Для номинально закрытых атрибутов вы просто не создаете методы, позво-
ляющие обращаться к ним. Но при изменении реализации вам придется вы-
яснить, какие из методов класса зависят от конкретной реализации, изменяемой
в настоящий момент. Чтобы решение было абсолютно чистым, можно заставить
сам класс работать с данными экземпляров через опосредованный интерфейс на
базе функций.
Эта гипертрофированная осторожность не является строго обязательной для
собственных методов класса, но с точки зрения кода, который просто использует
ваш модуль, она полностью оправданна. Обязательное применение интерфейса
на базе функций позволит изменять внутреннюю реализацию, не опасаясь нару-
шения работы пользовательского кода. Такой интерфейс позволяет выполнять
любые проверки диапазона, а также выполнять необходимое форматирование
или преобразование данных.
Продемонстрируем сказанное на примере улучшенной версии метода name:
use Carp:
sub name {
my $self = shift:
return $self->{NAME} unless
local $ = shift:
croak "too many arguments" if
if ($XW) { /[x\s\w*-]/ /\d/ /\S+(\s+\S+)+/ AS/ i && carp "funny characters in name": && carp "numbers in name": || carp "prefer multiword name":
II carp "name is blank":
s/(\w+)/\u\L$l/g: $self->{NAME} = $ ; } # Начинать с символа верхнего регистра
Если пользователи (или даже другие классы посредством наследования) об-
ращаются к полю "NAME" напрямую, вы уже не сможете добавить подобный код.
Настаивая на косвенном обращении ко всем атрибутам данных через функции,
вы оставляете за собой свободу выбора. Программисты, которым приходилось
работать с объектами C++, привыкли к тому, что к атрибутам объекта можно об-
ращаться из методов в виде простых переменных. Модуль CPAN Alias обеспечи-
вает эту и многие другие возможности, например, создание открытых методов,
которые могут вызываться объектом, но недоступны для кода за его пределами.
Рассмотрим пример создания класса Person с применением модуля Alias.
Обновление «магических» переменных экземпляра приводит к автоматическому
обновлению полей данных в хэше. Удобно, правда?
package Person:
# То же. что и раньше...
sub new {
my $that = shift:
my $class = ref($that) || $that:
my $self = {
546
Глава 13. Классы, объекты и связи
NAME => undef.
AGE => undef.
PEERS => [].
} :
bless($self. $class):
return Sself:
} :
use Alias qw(attr):
our($NAME. $AGE, SPEERS):
sub name {
my $self = attr shift:
if (@_) { $NAME = shift: }
return $NAME:
}
sub age {
my $self = attr shift:
if (@_) { $AGE = shift: }
return $AGE:
}
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".
$NAME. $AGE. join(". ". @PEERS):
}
sub happy_birthday {
my $self = attr shift:
return ++$AGE:
Объявление пакетных переменных our понадобилось из-за того, что Alias игра-
ет с пакетными глобальными переменными, имена которых совпадают с имена-
ми полей. Чтобы использовать глобальные переменные при действующей дирек-
тиве use strict, необходимо заранее объявить их. Эти переменные локализуются
в блоке, содержащем вызов attr(), словно они объявлены с ключевым словом
local. Таким образом, они остаются глобальными пакетными переменными с вре-
менными значениями.
См. также
perltoot(i), perlboot(l'), perlobj(l') и perlbot(l'); документация по модулю CPAN Alias;
рецепт 13.12.
13.4. Управление данными класса
547
13.4. Управление данными класса
Проблема
Вам нужен метод, который вызывается для класса в целом, а не для отдельного
объекта. Например, он может обрабатывать глобальный атрибут данных, общий
для всех экземпляров класса.
Решение
Первым аргументом метода класса является не ссылка, как в методах объектов,
а строка, содержащая имя класса. Методы классов работают с данными пакета,
а не данными объекта, как показывает приведенный ниже метод population:
package Person;
$Body_Count = 0;
sub population { return $Body_Count }
sub new { # Конструктор
$Body_Count++;
return bl ess({}, shift):
}
sub DESTROY { --$BodyCount } # Деструктор
# Позднее пользователь может написать:
package main;
for (1..10) { push ^people. Person->new }
prlntf "There are people allveAn". Person->populat1on();
There are 10 people alive.
Комментарий
Обычно каждый объект обладает определенным состоянием, полная информа-
ция о котором хранится в самом объекте. Значение атрибута данных одного объ-
екта никак не связано со значением этого атрибута в другом экземпляре того же
класса. Например, присваивание атрибуту gender объекта her никак не влияет на
атрибут gender объекта him, поскольку это разные объекты с разным состоянием:
$h1m = Person->new():
$h1m->gender("male");
$her = Person->new();
$her->gender("femal e");
Представьте атрибут, общий для всего класса, — изменение атрибута для од-
ного экземпляра приводит к его изменению для остальных экземпляров. Подоб-
548
Глава 13. Классы, объекты и связи
но тому как имена глобальных переменных часто записываются с большой буквы,
некоторые программисты предпочитают записывать имя символами верхнего
регистра, если метод работает с данными класса, а не с данными экземпляра.
Рассмотрим пример использования метода класса с именем Max_Bounds:
FixedArray->Max_Bounds(100): # Устанавливается для всего класса
$alpha = 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():
50
Реализация выглядит просто:
package FixedArray;
$Bounds = 7: # Значение по умолчанию
sub new { bless( {}, shift ) }
sub Max_Bounds {
my $proto = shift;
$Bounds = shift if # Разрешить обновления
return $Bounds;
}
Чтобы фактически сделать атрибут доступным только для чтения, просто
удалите команды обновления:
sub Max_Bounds { $Bounds }
Настоящий параноик сделает $Bounds лексической переменной, которая огра-
ничена областью действия файла, содержащего класс. В этом случае никто не
сможет обратиться к данным класса через $FixedArray:: Bounds, и работать с дан-
ными придется через интерфейсные методы.
Следующий совет поможет вам строить расширяемые классы: храните данные
объекта в пространстве имен объекта (в хэше), а данные класса — в пространст-
ве имен класса (пакетные переменные или лексические переменные с файловой
областью действия). Только методы класса могут напрямую обращаться к атри-
бутам класса. Методы объектов работают только с данными объектов. Если ме-
тоду объекта потребуется обратиться к данным класса, его конструктор должен
сохранить ссылку на эти данные в объекте. Пример:
sub new {
my $class = shift:
my $self = bless({}, $class):
$self->{Max_Bounds_ref} = \$Bounds;
return $self;
}
См. также
perltoot(l), perlboot(l), perlobj(l) и perlbot(l)', рецепт 13.3; пример использова-
ния метода places в подразделе «Пример: Перегруженный класс FixNum» в ре-
цепте 13.14.
13.5. Использование класса как структуры
549
13.5. Использование класса как структуры
Проблема
Вы привыкли работать со структурированными типами данных — более слож-
ными, чем массивы и хэши Perl (например, структуры С и записи Pascal). Вы
слышали о том, что классы Perl не уступают им по возможностям, но не хотите
изучать объектно-ориентированное программирование.
Решение
Воспользуйтесь стандартным модулем Class::Struct для объявления С-подобных
структур:
use Class::Struct:
struct Person => {
name => ' $'.
age =>'$',
peers => ’@,
};
my $р = Person->new():
# Загрузить модуль построения структур
# Создать определение класса "Person”
# Имя - скаляр
# Возраст - тоже скаляр
# Но сведения о друзьях - массив (ссылка)
# Выделить память для пустой структуры Person
$p->name("Jason Smythe”): # Задать имя
$p->age(13); # Задать возраст
$p->peers( ["Wilbur”. "Ralph”. "Fred" ] ): # Задать друзей
# Или так:
@{$p->peers} = ("Wilbur". "Ralph". "Fred"):
# Выбрать различные значения, включая нулевого друга
prlntf "At age £d, fcs's first friend is £s.\n",
$p->age, $p->name, $p->peers(0):
Комментарий
Функция Class:: Struct-.struct автоматически создает классы, дублирующие струк-
туры. Она создает класс с именем, передаваемым в первом аргументе, генериру-
ет для него конструктор new и методы доступа к полям.
В определении структуры ключи соответствуют именам полей, а значения —
типам данных. Существует три основных значения типа: ' $' для скаляров, ' @'
для массивов и ' %' для хэшей. Каждый метод доступа может вызываться без
аргументов (выборка текущего значения) или с аргументами (присваивание зна-
чения). Для полей с типом «массив» или «хэш» вызов метода без аргументов
возвращает ссылку на весь массив или хэш, вызов с одним аргументом получает
значение по указанному индексу1, а вызов с двумя аргументами задает значение
для указанного индекса.
1 Если только оно не является ссылкой; в этом случае используется субъектная структу-
ра данных с проверкой типа.
550
Глава 13. Классы, объекты и связи
Однако тип может быть именем другой структуры (или любого класса). По-
скольку конструктор класса не обязан называться new, если компонентом вашего
класса является объект другого класса, вам придется вызвать этот конструктор
самостоятельно.
use Class::Struct:
struct Person => {name =>'$', age =>'$'}:
struct Family => {head => 'Person', address => '$'. members => '@'}:
$folks = Family->new();
$folks->head($dad = Person->new);
$dad->name("John"):
$dad->age(34);
printfC'^s's age is £d\n". $folks->head->name. $folks->head->age):
Конструкторам, созданным Class::Struct, могут передаваться пары инициа-
лизаторов:
$dad = Person->new(name => "John", age => 34):
$folks->head($dad);
Во внутреннем представлении этого класса (как и большинства классов) ис-
пользуется хэш. Такое решение упрощает отладку и использование программы.
Для примера рассмотрим отображение содержимого структур в отладчике. Если
вывести только что созданный объект $fol ks с использованием команды х отлад-
чика Perl, можно заметить нечто любопытное:
DB<2> х $folks
О Family=HASH(0xcc360)
'Family::address' => undef
'Family::head' => Person=HASH(0x3307e4)
'Person::age' => 34
'Person:-.name' => 'John'
'Family::members' => ARRAY(OxccO78)
empty array
Ключ хэша содержит не только имя метода, но и префикс имя_пакета::.
Такой синтаксис не позволит двум классам в общей иерархии наследования
использовать один элемент хэша для разных целей. Это мудрое правило, кото-
рое стоит соблюдать в ваших собственных классах. Всегда включайте имя па-
кета в ключ хэша, и вам не придется беспокоиться о конфликтах в субклассах.
Чтобы организовать дополнительную проверку параметров, напишите собст-
венные версии методов доступа, переопределяющие версии по умолчанию. Пред-
положим, вы хотите убедиться, что значение возраста состоит из одних цифр
и не превышает нормальной продолжительности человеческой жизни. Функция
может выглядеть так:
sub Person::age {
use Carp:
my ($self. $age) =
if (@_ > 2) { confess "too many arguments" }
13.5. Использование класса как структуры
551
elsif (@_ == 1) { return $self->{"Person::age"} }
elsif (@_ == 2) {
carp "age '$age' Isn't numeric" If $age !~ /A\d+/:
carp "age '$age' Is unreasonable" If $age > 150;
$self->{'Person::age'} = $age;
}
}
Приемы, описанные в рецепте 12.15, позволяют организовать вывод пре-
дупреждений только в том случае, когда они были запрошены, для чего ис-
пользуется функция warnings::enabled. После того как модуль зарегистрирует
свой пакет директивой warnings: register, можно использовать следующую
запись:
If (warnings::enabled("Person") || warnings::enabled("numer1c")) {
carp "age '$age' Isn't numeric" If $age !~ /A\d+/:
carp "age '$age' Is unreasonable" If $age > 150:
Также возможен другой вариант: если предупреждения активны, вывести
предупреждение, а если нет — инициировать исключение (пусть стрелка вас не
смущает; это косвенный вызов функции, а не вызов метода).
my $gr1pe = warnings::enabled("Person") ? \&carp : \&croak:
$gr1pe->("age '$age' Isn't numeric") If $age !~ /A\d+/;
$gr1pe->("age '$age' Is unreasonable") If $age > 150:
Модуль Class::Struct также поддерживает представление на базе масси-
ва. Для этого достаточно перечислить поля в квадратных скобках вместо фи-
гурных:
struct Family => [head => 'Person', address => members => '@'1:
Существуют эмпирические данные, свидетельствующие о том, что выбор
массива вместо хэша снижает расходы памяти от 10 до 50 % и примерно на 33 %
ускоряет доступ. За это приходится расплачиваться менее содержательной отла-
дочной информацией и трудностями при написании переопределяющих функ-
ций (таких, как приведенная выше функция Person: :age). Обычно представление
объекта в виде массива усложняет наследование. В данном случае это не так, по-
скольку С-подобные структуры обеспечивают намного более понятную реали-
зацию агрегирования.
Директива use fields обеспечивает скорость и компактность массивов в соче-
тании с выразительностью хэшей, а также обеспечивает проверку имен полей на
стадии компиляции.
Если все поля принадлежат к одному типу, то запись вида:
struct Card => {
name => '$'.
color => '$',
cost => ,
type => '$',
release => '$’.
text => '$',
}:
552
Глава 13. Классы, объекты и связи
упрощается с помощью функции тар:
struct Card => { тар { $_ => ’$’ } qw(name color cost type release text) }:
А если вы программируете на С и предпочитаете указывать тип поля перед
его именем, а не наоборот, просто измените их порядок:
struct hostent => { reverse qw{
$ name
@ aliases
$ addrtype
$ length
@ addr_list
}}:
Вы даже можете создавать синонимы в стиле #define (впрочем, такая возмож-
ность выглядит сомнительно), позволяющие обращаться к одному полю по не-
скольким именам. В С можно написать:
#define h_type h_addrtype
#define h_addr h_addr_list[Oj
В Perl можно попробовать следующий вариант:
# Сделать (hostent object)->type()
# эквивалентным (hostent object)->addrtype()
*hostent: :type = \&hostent:-.addrtype:
# Сделать (hostenv object)->addr()
# эквивалентным (hostenv object)->addr_11st(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(V), perlboot(l), perlobj(l) и perlbot(l); документация по стандартному
модулю Class::Struct; исходный текст стандартного модуля Net::hostent; до-
кументация по директиве use fields; документация по модулю CPAN Alias;
рецепт 13.3.
13.6. Клонирование объектов
553
13.6. Клонирование объектов
Проблема
Вы хотите написать конструктор, который вызывается для существующего объ-
екта и использует его данные для заполнения данных нового объекта.
Решение
Начните свой конструктор примерно так:
my Sproto = shift:
ту Sclass = ref(Sproto) || Sproto:
my Sparent = ref(Sproto) && Sproto:
Переменная Sclass содержит класс, к которому выполняется приведение, а пе-
ременная Sparent либо равна false, либо ссылается на клонируемый объект.
Комментарий
Иногда требуется создать объект, тип которого совпадает с типом другого, сущест-
вующего объекта. Вариант:
Sobl = SomeClass->new():
# Далее
Sob2 = (ref $obl)->new():
выглядит не очень понятно. Вместо этого хотелось бы иметь конструктор, ко-
торый может вызываться для класса или существующего объекта. В качестве
метода класса он возвращает новый объект, инициализированный по умолчанию.
В качестве метода экземпляра он возвращает новый объект, инициализирован-
ный данными объекта, для которого он был вызван:
Sobl = Widget->new();
Sob2 = $obl->new():
Следующая версия new учитывает эти соображения:
sub new {
my Sproto = shift:
my Sclass = ref(Sproto) || Sproto;
my Sparent = ref(Sproto) && Sproto:
my Sself:
# Проверить, переопределяется ли new из @ISA
if (@ISA && $proto->SUPER::can("new") {
Sself = $proto->SUPER::new(@_);
} else {
Sself = {}:
bless (Sself. Sproto):
bless($self. Sclass):
Sself->{PARENT} = Sparent;
$self->{START} = timeO: # Инициализировать поля данных
554
Глава 13. Классы, объекты и связи
$self->{AGE} = 0:
return $self:
Инициализация не сводится к простому копированию данных из объекта-про-
тотипа. Если вы пишете класс связанного списка или бинарного дерева, при
вызове в качестве метода экземпляра ваш конструктор может вернуть новый
объект, включенный в дерево или список.
См. также
perlobj(\)\ рецепты 13.1, 13.10 и 13.13.
13.7. Копирующие конструкторы
Проблема
Вы хотите предоставить пользователям класса метод для копирования или ско-
пировать объект, для которого в классе не предусмотрено метода копирования.
Решение
Воспользуйтесь функцией del one О из стандартного модуля Storable:
use Storable qw(dclone):
use Carp:
sub copy {
my $self = shift:
croak "can't copy class $self" unless ref $self:
my $copy = Storable::dclone($self):
return $copy:
Комментарий
Как упоминалось в рецепте 11.12, функция del one модуля Storable осуществляет
рекурсивное копирование (практически) любых структур данных. Она также ра-
ботает с объектами и возвращает новые объекты, приведенные к нужному клас-
су. Предполагается, что в копируемом объекте используются типы SCALAR, ARRAY,
HASH и ссылки на CODE. Такие типы, как ссылки на 10 и GLOB, не поддерживаются.
Одни классы содержат готовые методы для копирования своих объектов,
у других классов такие методы отсутствуют (не столько намеренно, сколько по
небрежности). Рассмотрим следующий пример:
sub UNIVERSAL::сору {
my $self = shift:
unless (ref $self) {
require Carp:
Carp::croak("can't copy class $self"):
13.8. Косвенный вызов методов
555
}
require Storable:
my $сору = Storable::dclone($self):
return Scopy:
}
Теперь все объекты могут копироваться (при условии, что они относятся к под-
держиваемым типам). На классы, содержащие собственные методы сору, это не
влияет, но любой класс, не имеющий собственного метода сору, наследует это оп-
ределение. Вызов require Storable помещен в сам вызов функции, чтобы модуль
Storable загружался только в том случае, если он действительно используется.
Аналогичная директива для модуля Carp также помещена в проверку, в которой
этот модуль используется. Директива require откладывает загрузку до момента
фактического использования модуля.
Мы также избегаем директивы use, потому что она импортирует имена в те-
кущий пакет, а это явно антиобщественное поведение. Из предыдущего фраг-
мента даже невозможно определить, какой пакет является текущим. Тот факт,
что процедура сору объявлена в пакете UNIVERSAL, не означает, что код этой про-
цедуры принадлежит пакету UNIVERSAL. На самом деле он принадлежит тому па-
кету, в котором выполняется компиляция.
Некоторые считают, что введение функций в чужое пространство имен явля-
ется поступком возмутительно бесцеремонным (тем более, если речь идет обо
всех возможных пространствах имен классов UNIVERSAL). Бесцеремонность, по-
жалуй, но вряд ли «возмутительная»; ведь пространство UNIVERSAL существует
для того, чтобы им пользовались. Не стоит относиться к нему как к священному
канону, любое изменение которого является кощунством. Что вы намерены сде-
лать — нечто очень умное или очень глупое? Perl не сможет ни ответить на этот
вопрос, ни помешать вам.
См. также
Рецепт 11.12; рецепт 13.9; документация по стандартным модулям Storable; раз-
дел «Наследование» во Введении к настоящей главе.
13.8. Косвенный вызов методов
Проблема
Требуется вызвать метод по имени, которое станет известно лишь во время вы-
полнения программы.
Решение
Сохраните имя метода в строковом виде в скалярной переменной и укажите имя
переменной там, где обычно указывается имя метода — справа от оператора ->:
$methname = "flicker";
$obj->$methname(10): # Вызывает $ob->f1icker(10):
556
Глава 13. Классы, объекты и связи
# Три метода объекта вызываются по именам
foreach $m ( qw(start run stop) ) {
$obj->$m():
}
Комментарий
Имя метода не всегда известно на стадии компиляции. Как известно, получить
адрес метода нельзя, но можно сохранить его имя. Если имя хранится в ска-
лярной переменной $meth, то для объекта $crystal этот метод вызывается так:
$crystal->$meth().
^methods = qw(name rank serno):
^hisjnfo = map { $_ => $ob->$_() } ^methods:
# Эквивалентно:
^hisjnfo = (
'name' => $ob->name().
'rank' => $ob->rank(),
'serno' => $ob->serno().
):
Если вам никак не обойтись без получения адреса метода, попробуйте перео-
смыслить свой алгоритм. Например, вместо неправильной записи \$ob->method(),
при которой \ применяется к возвращаемому значению или значениям метода,
поступите следующим образом:
my $fnref = sub { $ob->method(@_) };
Когда придет время косвенного вызова этого метода, напишите:
$fnref->(10, "fred"):
В свою очередь, замыкание правильно использует исходное значение $ob (при
условии, что переменная $ob является лексической) на момент создания. В ре-
зультате будет сгенерирован правильный вызов метода:
Sobj->method(10. "fred"):
Такое решение работает даже в том случае, если $ob находится вне области
действия, и потому является предпочтительным.
При использовании косвенного вызова методов разрешается сохранить в ска-
лярной переменной ссылку на процедуру вместо строки с именем метода. При
этом никак не проверяется, что функция представляет правильный метод.
Ссылку на код, возвращаемую методом сап() класса UNIVERSAL, вероятно, не
следует использовать для косвенного вызова методов для объектов, отличных
от объекта, для которого она была создана (или, по крайней мере, относящихся
к тому же классу). Нет гарантий, что она будет соответствовать правильному
методу для объекта произвольного класса.
Например, следующий фрагмент крайне сомнителен:
Scoderef = $some_object->can("wither"):
$other_object->$coderef():
13.9. Определение принадлежности субкласса
557
Такое решение разумно лишь в том случае, если два объекта относятся к од-
ному классу (или к совместимым классам). Если они относятся к разным клас-
сам и второй класс не имеет метода wither, то исключение не возникает, в отли-
чие от следующего фрагмента:
$some_object->wither():
$other_object->wither();
Другая интересная возможность — использование стратегии, описанной в ре-
цепте 12.5, для реализации номинально закрытых методов.
my $secret_meth = sub { ... }
sub reg_meth {
my $self = shift:
# ... Сделать то. что требовалось, затем ...
$self->$secret_meth(@_);
#
}
Поскольку область действия лексической переменной $secret_meth определяет-
ся файлом модуля класса, код за пределами класса не сможет обратиться к этой
переменной, а следовательно вызвать замыкание. Тем не менее, код в файле модуля
видит этот скаляр и может воспользоваться ссылкой в сочетании с $secret_meth
для косвенного вызова метода.
При косвенном вызове метода по ссылке на программный код Perl не прове-
ряет пакет или его массив ©ISA; он просто вызывает функцию и передает левый
операнд в начале списка аргументов. Следовательно, следующие две строки эк-
вивалентны:
$self->$secret_meth(@_); # Косвенный вызов метода
$secret_meth->($self. @_) # Косвенный вызов функции
Если не извлекать левый операнд и оставить его в то вы с таким же успе-
хом можете сами создать эквивалентный вызов разыменованной функции:
sub reg_meth {
# ... Сделать то. что требовалось, затем ...
$secret_meth->(@_);
}
См. также
perlobj(V)', рецепт 11.8.
13.9. Определение принадлежности субкласса
Проблема
Требуется узнать, является ли объект экземпляром некоторого класса или одно-
го из его субклассов. Например, надо выяснить, можно ли вызвать для объекта
некоторый метод.
558
Глава 13. Классы, объекты и связи
Решение
Воспользуйтесь методами специального класса UNIVERSAL:
$obj->1sa("HTTP::Message"): # Как метод объекта
HTTP::Response->1sa("HTTP::Message"); # Как метод класса
If ($obj->can("method_name")) { .... } # Проверка метода
Комментарий
Для нас было бы очень удобно, чтобы все объекты в конечном счете происходили
от общего базового класса. Тогда их можно было бы наделить общими метода-
ми, не дополняя по отдельности каждый массив ©ISA. В действительности такая
возможность существует. Хотя вы этого не видите, но Perl считает, что в конце
©ISA находится один дополнительный элемент — пакет с именем UNIVERSAL.
Класс UNIVERSAL содержит минимальное количество методов, однако вы може-
те дополнить исходный набор. Эти методы встроены непосредственно в дво-
ичный файл Perl, поэтому на их загрузку не расходуется дополнительное время.
К числу стандартных методов относятся Isa, сап и VERSION. Все три метода могут
вызываться как для классов, так и для объектов.
Метод Isa сообщает, наследует ли объект или класс (прямо или косвенно) от
класса, имя которого передается в аргументе. Проверка избавляет вас от необхо-
димости самостоятельно просматривать иерархию, к тому же это решение гораздо
лучше точного сравнения со строкой, возвращаемой встроенной функцией ref.
При вызове Isa даже можно задать базовый тип, который может быть возвращен
ref (например, SCALAR, ARRAY, HASH или GLOB).
$has_1o = $fd->isa("IO::Handle") || $fd->1sa("GLOB"):
$1tza_handle = 10::Socket->isa("IO::Handle"):
Некоторые считают, что подобные проверки типов слишком ограничивают
свободу действий. Если вас просто интересует, можно ли вызвать некоторый ме-
тод для некоторого объекта или класса, вероятно, вместо проверки класса лучше
попытаться вызвать нужный метод.
Другой метод UNIVERSAL, сап, сообщает, соответствует ли его строковый аргу-
мент допустимому имени метода для данного класса. Он возвращает ссылку на
функцию, соответствующую данному методу:
$his_print_method = $obj->can(’as_str1ng’):
Наконец, метод VERSION проверяет, содержит ли класс (или класс объекта) па-
кетную глобальную переменную $ VERSION с достаточно высоким значением:
Some_Module->VERSI0N(3.0):
$his_vers = $obj->VERSION():
Тем не менее нам обычно не приходится вызывать VERSION самим. Вспомни-
те: имена функций, записанные в верхнем регистре, означают, что функция вы-
зывается Perl автоматически. В нашем случае это происходит, когда в програм-
ме встречается строка вида:
use Some_Module 3.0:
13.10. Создание класса с поддержкой наследования
559
Если вам захочется включить проверку версии в класс Person, описанный
выше, добавьте в файл Person.pm следующий фрагмент:
our $VERSION = "1.01”;
Затем в пользовательской программе ставится команда use Person 1.01; —
это позволяет проверить версию и убедиться в том, что она равна указанной
или превышает ее. Помните, что версия не обязана точно совпадать с указанной,
а должна быть не меньше ее. К сожалению, в настоящее время параллельная
установка нескольких версий одного модуля не поддерживается.
См. также
Документация по стандартному модулю UNIVERSAL. Ключевое слово use описано
в perlfunc(\).
13.10. Создание класса с поддержкой
наследования
Проблема
Вы не уверены в том, правильно ли вы спроектировали свой класс и может ли
он использоваться в наследовании.
Решение
Воспользуйтесь «проверкой пустого субкласса».
Комментарий
Допустим, вы реализовали класс Person с конструктором new и методами аде и name.
Тривиальная реализация выглядит так:
package Person;
sub new {
my $class = shift;
my Sself = { }:
return bless $self, $class;
}
sub name {
my $self = shift;
Sself->{NAME} = shift If
return Sself->{NAME};
}
sub age {
my Sself = shift;
Sself->{AGE} = shift If
return Sself->{AGE};
}
560
Глава 13. Классы, объекты и связи
Пример использования класса может выглядеть так:
use Person;
my $dude = Person->new();
$dude->name("Jason");
$dude->age(23);
printf 'Is Is age M\n", $dude->name, $dude->age;
Теперь рассмотрим другой класс с именем Employee:
package Employee:
use Person;
@ISA = ("Person");
1;
Ничего особенно интересного. Класс всего лишь загружает класс Person и за-
являет, что все необходимые методы Employee наследует от Person. Поскольку
Employee не имеет собственных методов, он получит от Person все методы. Мы хо-
тим, чтобы поведение класса Person полностью воспроизводилось в Employee.
Создание подобных пустых классов называется «проверкой пустого субклас-
са»; иначе говоря, мы создаем производный класс, который не делает ничего, кро-
ме наследования от базового. Если базовый класс спроектирован нормально, то
производный класс в точности воспроизведет его поведение. Это означает, что
при простой замене имени класса все остальное будет работать:
use Employee;
my $empl = Employee->new();
$empl->name("Jason");
$empl->age(23);
printf '7s Is age M\n", $empl->name. $empl->age:
Под «нормальным проектированием» имеется в виду использование толь-
ко двухаргументной формы bless, отказ от прямого доступа к данным класса
и отсутствие экспортирования. В определенной выше функции Person: :new()
мы проявили необходимую осторожность: в конструкторе используются неко-
торые пакетные данные, но ссылка на них хранится в самом объекте. Другие
методы обращаются к пакетным данным через эту ссылку, поэтому проблем
быть не должно.
Но почему мы сказали «функции Person: :new()» — разве это не метод? Дело
в том, что метод представляет собой функцию, первый аргумент которой опре-
деляет имя класса (пакет) или объект (приведенную ссылку). Person: :new — это
функция, которая в конечном счете вызывается методами Person->new и Employee-
>new (табл. 13.1). Хотя вызов метода очень похож на вызов функции, они все же
отличаются. Если вы начнете путать функции с методами, то очень скоро у вас
не останется ничего, кроме неработающих программ. Во-первых, функции от-
личаются от методов фактическими конвенциями вызова — метод вызывается
с дополнительным аргументом. Во-вторых, вызовы функций не поддерживают
наследования, а методы — поддерживают.
Если вы привыкнете к вызовам вида:
$h1m = Person::new(); # НЕВЕРНО
в программе возникнет нетривиальная проблема, поскольку функция не получит
ожидаемого аргумента "Person" и не сможет привести его к переданному классу.
13.11. Вызов переопределенных методов
561
Еще хуже, если вам захочется вызвать функцию Employee: :new(). Такой функции
не существует! Это всего лишь вызов унаследованного метода.
Таблица 13.1. Соответствие между методами и функциями
Вызов метода Вызов функции
Person->new() Person: :new("Person")
Employees new() Person:: new("Employee")
Мораль: не вызывайте функции там, где нужно вызывать методы.
См. также
perltoot(l), perlobj(\) и perlbot(i); рецепт 13.1; рецепт 13.11.
13.11. Вызов переопределенных методов
Проблема
Конструктор переопределяет конструктор суперкласса. Вы хотите вызвать кон-
структор родительского класса из своего конструктора.
Решение
Используйте специальный класс SUPER:
sub meth {
my Sself = shift:
$self->SUPER::meth():
}
Комментарий
В таких языках, как C++, где конструкторы не выделяют память, а ограничиваются
инициализацией объекта, конструкторы базовых классов вызываются автомати-
чески. В таких языках, как Java и Perl, приходится вызывать их самостоятельно.
Для вызова методов конкретного класса используется формулировка Sself->
SUPER::meth(). Она представляет собой расширение обычной записи с началом
поиска в определенном базовом классе и допустима только в переопределенных
методах. Сравните несколько вариантов:
$self->meth(); # Вызвать первый найденный meth
$self->Where::meth(): # Начать поиск с пакета "Where"
Sself->SUPER::meth(): # Вызвать переопределенную версию
Вероятно, простым пользователям класса следует ограничиться первым ва-
риантом. Второй вариант возможен, но не рекомендуется. Последний вариант
может вызываться только в переопределенном методе.
562
Глава 13. Классы, объекты и связи
Переопределяющий конструктор должен вызвать конструктор своего класса
SUPER, в котором выполняется выделение памяти и приведение объекта, и огра-
ничиться инициализацией полей данных. В данном случае код выделения памя-
ти желательно отделять от кода инициализации объекта. Пусть имя начинается
с символа подчеркивания — условного обозначения номинально закрытого ме-
тода, аналога таблички «Руками не трогать».
sub new {
my Sclassname = shift: # Какой класс мы конструируем?
my Sself = $classname->SUPER::new(@_);
$self->_1nit(@_);
return Sself: # Вернуть
}
sub _1n1t {
my Sself = shift:
$self->{START} = tlmeO:
$self->{AGE} = 0:
Sself->{EXTRA} = { @_ }:
}
# Инициализировать поля данных
# Прочее
И SUPER: :new, и J nit вызываются co всеми остальными аргументами, что по-
зволяет передавать другие инициализаторы полей:
Sobj = W1dget->new( haircolor => red, freckles => 121 ):
Стоит ли сохранять пользовательские параметры в отдельном хэше — ре-
шайте сами.
Обратите внимание: SUPER работает только для первого переопределенного
метода. Если в массиве @1SA перечислены несколько классов, будет обработан
только первый. Ручной перебор @ISA возможен, но, вероятно, не оправдывает за-
траченных усилий.
my Sself = bless {}. Sclass:
for my Sclass (@ISA) {
my Smeth = Sclass . "::_1n1t":
$self->$meth(@_) if Sclass->can("_1n1t"):
}
В этом ненадежном фрагменте предполагается, что все суперклассы инициа-
лизируют свои объекты не в конструкторе, а в _1n1t. Кроме того, предполагается,
что объект реализуется через ссылку на хэш.
Также существует другой, чуть более общий подход, позволяющий получить
доступ ко всем переопределенным методам: сохраните возвращаемое значение
метода сап() (ссылку на код процедуры, вызываемой при нормальном вызове
метода). Затем воспользуйтесь этой ссылкой для косвенного вызова метода:
sub some_method {
my Sself = shift:
my % seen:
print "some_method(Sself): checking all ancestors\n":
for my Sparent (our @ISA) {
If (my Scode = $parent->can("some_method")) {
$self->$code(@_) unless $seen{$code}++:
}
}
}
13.12. Генерация методов доступа с помощью AUTOLOAD
563
Чтобы избежать многократного вызова, хэш % seen отслеживает вызываемые
процедуры (например, проблемы могут возникнуть при наличии общего предка
у нескольких родительских классов).
Для получения точной информации о методах, вызов которых приводит к сра-
батыванию AUTOLOAD, эти методы должны быть объявлены (но не определены!)
в пакете.
См. также
Класс SUPER рассматривается в perltoot(\) и perlobj(V).
13.12. Генерация методов доступа
с помощью AUTOLOAD
Проблема
Для работы с полями данных объекта нужны методы доступа, а вам не хочется
писать повторяющийся код.
Решение
Воспользуйтесь механизмом AUTOLOAD для автоматического построения методов
доступа — это позволит обойтись без самостоятельного написания методов при
добавлении новых полей данных.
Комментарий
Механизм AUTOLOAD перехватывает вызовы неопределенных методов. Чтобы огра-
ничиться обращениями к полям данных, мы сохраним список допустимых полей
в хэше. Метод AUTOLOAD будет проверять, присутствует ли в хэше запрашиваемое
поле.
package Person:
use strict:
use Carp:
our(£ok_field):
# Проверка четырех атрибутов
for my $attr ( qw(name age peers parent) ) { $ok_field{$attr}++: }
sub AUTOLOAD {
my $self = shift:
my $attr = SAUTOLOAD:
$attr =~ s/://;
return unless $attr =~ /[XA-Z]/: # Пропустить DESTROY и другие
# методы, имена которых
# записаны в верхнем регистре
croak "invalid attribute method: ->$attr()" unless $ok_field{$attr}:
$self->{uc $attr} = shift if
564
Глава 13. Классы, объекты и связи
return $self->{uc Sattr}:
}
sub new {
my Sproto = shift:
my Sclass = ref(Sproto) || Sproto:
my Sparent = ref(Sproto) && Sproto:
my Sself = {}:
bless($self, Sclass):
$self->parent($parent):
return Sself:
}
1;
Класс содержит конструктор new и четыре метода атрибутов: name, age, peers
и parent. Модуль используется следующим образом:
use Person:
my (Sdad. Skid):
Sdad = Person->new:
$dad->name("Jason"):
$dad->age(23):
Skid = $dad->new:
$kid->name("Rachel"):
$kid->age(2):
printf "Kid’s parent Is £s\n", Sk1d->parent->name:
Kid's parent is Jason
В иерархиях наследования это решение вызывает некоторые затруднения.
Предположим, вам понадобился класс Employee, который содержит все атрибуты
данных класса Person и еще два атрибута (например, salary и boss). Класс Employee
не может определять методы своих атрибутов с помощью унаследованного вари-
анта Person::AUTOLOAD, следовательно, каждому классу нужна собственная функ-
ция AUTOLOAD. Она проверяет атрибуты данного класса, но вместо вызова croak
при отсутствии атрибута вызывает переопределенную версию суперкласса.
С учетом этого AUTOLOAD может выглядеть так:
sub AUTOLOAD {
my Sself = shift:
my Sattr = SAUTOLOAD:
Sattr =~ s/://:
return If Sattr eq "DESTROY":
If (Sok_f1eld{$attr}) {
$self->{uc Sattr} = shift If
return $self->{uc Sattr}:
} else {
my Ssuperlor = "SUPER::Sattr":
Sself->$super1or(@_);
}
Если атрибут отсутствует в списке, мы передаем его суперклассу, надеясь,
что он справится с его обработкой. Однако такой вариант AUTOLOAD наследовать
нельзя; каждый класс должен иметь собственную версию, поскольку работа с дан-
ными осуществляется напрямую, а не через объект. Еще худшая ситуация воз-
никает, если класс А наследует от классов В и С, каждый из которых определяет
собственную версию AUTOLOAD — в этом случае при вызове неопределенного
13.13. Использование циклических структур данных
565
метода А будет вызвана функция AUTOLOAD лишь одного из двух родительских
классов.
С этими ограничениями можно было бы справиться, но всевозможные заплат-
ки, исправления и обходные пути вскоре начинают громоздиться друг на друге.
Для сложных ситуаций существуют более удачные решения.
И еще одно замечание: метод UNIVERSAL: :сап обычно не считает вызываемы-
ми те методы, вызов которых приводит к простому срабатыванию механизма
AUTOLOAD. Если вы хотите получать точную информацию об этих методах, объ-
явите их без определения. Например:
sub eat:
sub drink:
sub bejnerry;
sub AUTOLOAD {
my $self = shift:
my Sfuncname = our SAUTOLOAD:
Sfuncname =~ s/.*:://:
}
Обычно для срабатывания AUTOLOAD объявлять функции не обязательно. Если
в программе имеется объект этого класса:
$man->be_merry():
то AUTOLOAD сработает и без объявлений. Однако объявления нужны, чтобы эти
методы были замечены методом сап:
$man->be_merry() if $man->can("be_merry"):
См. также
Примеры использования AUTOLOAD в perltoot(V)', рецепт 10.15.
13.13. Использование циклических
структур данных
Проблема
Имеется структура данных, построенная на циклических ссылках. Система сборки
мусора Perl, использующая подсчет ссылок, не замечает, когда данная структура
перестает использоваться. Вы хотите предотвратить утечку памяти в программе.
Решение
Создайте нециклический объект-контейнер, содержащий указатель на структу-
ру данных с циклическими ссылками. Определите для объекта-контейнера ме-
тод DESTROY, который вручную уничтожает циклические ссылки.
Или воспользуйтесь слабыми ссылками (см. рецепт 11.15).
566
Глава 13. Классы, объекты и связи
Комментарий
Многие интересные структуры данных содержат ссылки на самих себя. Напри-
мер, это может происходить в простейшем коде:
$node->{NEXT} = $node;
Как только в вашей программе встречается такая команда, возникает циклич-
ность, которая скрывает структуру данных от системы уборки мусора Perl с под-
счетом ссылок. В итоге деструкторы будут вызваны при выходе из программы,
но иногда ждать долго не хочется.
Связанный список также обладает циклической структурой: каждый узел со-
держит указатель на следующий узел, указатель на предыдущий узел и значение
текущего узла. Если реализовать его на Perl с применением ссылок, появится
циклический набор ссылок, которые также не будут автоматически уничтожать-
ся с исчезновением внешних ссылок на узлы.
Проблема не решается и созданием узлов, представляющих собой экземпля-
ры специального класса Ri ng. На самом деле мы хотим, чтобы данная структура
уничтожалась Perl по общим правилам, а это произойдет в том случае, если объ-
ект реализуется в виде структуры, содержащей ссылку на цикл. В следующем
примере ссылка хранится в поле "DUMMY":
package Ring:
# Вернуть пустую циклическую структуру
sub new {
my Sclass = shift:
my Snode = { }:
$node->{NEXT} = $node->{RREV} = Snode:
my Sself = { DUMMY => Snode, COUNT => 0 }:
bless Sself, Sclass:
return Sself:
}
Цикличностью обладают узлы кольца, но не сам возвращаемый объект-коль-
цо. Следовательно, следующий фрагмент не вызовет утечки памяти:
use Ring:
SCOUNT = 1000:
for (1 .. 20) {
my Sr = Ring->new();
for (Si = 0: Si < SCOUNT: $i++) { $r->insert($i) }
}
Даже если мы создадим двадцать колец по тысяче узлов, то перед созданием
нового кольца старое будет уничтожено. Пользователю класса не придется бес-
покоиться об освобождении памяти в большей степени, чем для простых строк.
Иначе говоря, все происходит автоматически, как и должно происходить.
Однако при реализации класса необходимо написать деструктор, который
вручную уничтожает узлы:
# При уничтожении Ring уничтожить содержащуюся в нем кольцевую структуру
sub DESTROY {
13.13. Использование циклических структур данных
567
my Sring = shift;
ту $node:
for ( Snode = $ring->{DUMMY}->{NEXT}:
$node != $ring->{DUMMY}:
Snode = $node->{NEXT} )
{
$r1ng->delete_node($node);
}
$node->{PREV} = $node->{NEXT} = undef;
}
# Удалить узел из циклической структуры
sub delete_node {
my (Sring, Snode) =
$node->{PREV}->{NEXT} = $node->{NEXT}:
$node->{NEXT}->{PREV} = $node->{PREV};
--$ring->{COUNT};
}
Ниже приведено еще несколько методов, которые следовало бы включить
в класс. Обратите внимание на то, что вся реальная работа выполняется с по-
мощью циклических ссылок, скрытых внутри объекта:
# Snode = $ring->search( Svalue ) : найти Svalue в структуре Sring
sub search {
my (Sring, Svalue) =
my Snode = $ring->{DUMMY}->{NEXT};
while (Snode != $ring->{DUMMY} && $node->{VALUE} != Svalue) {
Snode = $node->{NEXT}:
}
return Snode;
}
# $ring->insert( Svalue ) ; вставить Svalue в структуру Sring
sub insert_value {
my (Sring, Svalue) =
my Snode = { VALUE => Svalue };
$node->{NEXT} = $ring->{DUMMY}->{NEXT};
$ring->{DUMMY}->{NEXT}->{PREV} = Snode;
$ring->{DUMMY}->{NEXT} = Snode;
$node->{PREV} = $ring->{DUMMY};
++$ring->{COUNT};
}
# $ring->delete_value( Svalue ) : удалить узел по значению
sub delete_value {
my (Sring, Svalue) =
my Snode = $ring->search($value);
return if Snode == $ring->{DUMMY};
Sring->delete_node(Snode);
}
1;
В рецепте 11.15 приводится альтернативная реализация того же кода, которая
вообще не использует объекты. Поскольку ссылки структуры данных на себя
568
Глава 13. Классы, объекты и связи
являются слабыми, для уничтожения ненужной структуры данных Perl оказыва-
ется достаточно стандартной системой управления памятью. Тем самым снимается
необходимость в деструкторе и даже появляется возможность конструирования
структур данных на базе простых ссылок, без применения классов или объектов.
См. также
Документация по стандартным модулям Devel::Peek и Scalar::Util.
13.14. Перегрузка операторов
Проблема
Вы хотите использовать знакомые операторы (например, == или +) с объектами
написанного вами класса или определить интерполированное значение для вы-
вода объектов.
Решение
Воспользуйтесь директивой use overload. Ниже приведены два самых распростра-
ненных и часто перегружаемых оператора:
use overload ('<=>’ => \&threeway_compare):
sub threeway_compare {
my ($sl. $s2) =
uc($sl->{NAME}) cmp uc($s2->{NAME});
use overload
( ' => \&str1ng1fy ):
sub string!fy {
my Sself = shift:
return sprlntf ’Is (^05d)".
ucf1rst(lc($self->{NAME})).
Sself->{IDNUM};
Комментарий
При работе co встроенными типами используются некоторые стандартные опе-
раторы (например, оператор + выполняет сложение, а . — конкатенацию строк).
Директива use overload позволяет перегрузить эти операторы так, чтобы для
ваших собственных объектов они делали что-то особенное.
Директиве передается список пар «оператор/функция»:
package TlmeNumber:
use overload '+' => \&my_plus.
’\&my_m1nus,
=> \&my_star,
'/' => \&my_slash;
13.14. Перегрузка операторов
569
Теперь эти операторы можно использовать с объектами класса TimeNumber,
и при этом будут вызываться указанные функции. Функции могут делать все,
что вам захочется.
Приведем простой пример перегрузки + для работы с объектом, содержащим
количество часов, минут и секунд. Предполагается, что оба операнда принадле-
жат к классу, имеющему метод new, который может вызываться в качестве мето-
да объекта, и что структура состоит из перечисленных ниже имен:
sub my_plus {
my($left, $right) =
my Sanswer = $left->new();
$answer->{SECONDS} = $left->{SECONDS} + $right->{SECONDS}:
$answer->{MINUTES} = $left->{MINUTES} + $right->{MINUTES};
$answer->{HOURS} = $1 eft->{HOURS} + $right->{HOURS};
if ($answer->{SECONDS} >= 60) {
$answer->{SECONDS} %= 60:
$answer->{MINUTES} ++;
if ($answer->{MINUTES} >= 60) {
$answer->{MINUTES} %= 60;
$answer->{HOURS} ++;
return Sanswer;
}
Числовые операторы рекомендуется перегружать лишь в том случае, если объ-
екты соответствуют какой-то числовой конструкции, например, комплексным
числам или числам с повышенной точностью, векторам или матрицам. В про-
тивном случае программа становится слишком сложной, а пользователи делают
неверные предположения относительно работы операторов. Представьте себе
класс, который моделирует страну. Если вы создадите оператор для сложения
двух стран, то почему нельзя заняться вычитанием? Как видите, перегрузка опера-
торов для нечисловых математических объектов быстро приводит к абсурду.
Объекты (а в сущности, и любые ссылки) можно сравнивать с помощью ==
и eq, но при этом вы узнаете лишь о совпадении их адресов (при этом == работа-
ет примерно в 10 раз быстрее, чем eq). Поскольку объект является всего лишь
высокоуровневым представлением обычного машинного адреса, во многих ситуа-
циях требуется определить собственный критерий того, что следует понимать
под равенством двух объектов.
Даже для нечисловых классов особенно часто перегружаются два оператора:
сравнения и строковой интерполяции. Допускается перегрузка как оператора
<=>, так и стр, хотя преобладает первый вариант. После того как для объекта
будет определен оператор <=>, вы также сможете использовать операторы ==, ! =,
<, <=, > и >= для сравнения объектов. Если отношения порядка нежелательны,
ограничьтесь перегрузкой ==. Аналогично, перегруженная версия стр используется
в It, gt и других строковых сравнениях лишь при отсутствии их явной перегрузки.
570
Глава 13. Классы, объекты и связи
Оператор строковой интерполяции обозначается странным именем "" (две ка-
вычки). Он вызывается каждый раз, когда происходит строковое преобразова-
ние, например, внутри кавычек или апострофов или при вызове функции print.
Прочитайте документацию по директиве overload, прилагаемую к Perl. Пере-
грузка операторов Perl откроет перед вами некоторые нетривиальные возможно-
сти, например, методы строковых и числовых преобразований, автоматическая
генерация отсутствующих методов и изменение порядка операндов при необхо-
димости (например, в выражении 5 + $а, где $а является объектом).
Пример: Перегруженный класс StrNum
Ниже приведен класс StrNum, в котором числовые операторы используются для
работы со строками. Да, мы действительно собираемся сделать то, против чего
настраивали вас, то есть применить числовые операторы к нечисловым объек-
там, однако программисты по опыту работы в других языках всегда ожидают,
что + и == будут работать со строками. Это всего лишь несложный пример, де-
монстрирующий перегрузку операторов. Подобное решение почти наверняка не
будет использоваться в коммерческой версии программы из-за проблем, связан-
ных с быстродействием. Кроме того, перед вами один из редких случаев исполь-
зования конструктора, имя которого совпадает с именем класса — наверняка это
порадует программистов со знанием C++ и Python.
# 1 /usr/Ы n/perl
# show_strnum - пример перегрузки операторов
use StrNum:
$х = StrNum("Red"): $у = StrNum("Black"):
$z = $x + $y: $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,
"bool" => \&boolify,
'0+' => \&nummify.
'+' => \&concat.
=> \&repeat.
):
# Конструктор
sub StrNum($) {
13.14. Перегрузка операторов
571
my (Svalue) =
return bless \$value;
}
sub stringify { ${ $_[0] } }
sub numify { ${ $_[0] } }
sub boolify { ${ $_L0] } }
# Наличие <=> дает нам <, == и т. д.
sub spaceship {
my ($sl. $s2, Sinverted) =
return Sinverted ? $$s2 cmp $$sl : $$sl cmp $$s2;
}
# Использует stringify
sub concat {
my ($sl. $s2, Sinverted) =
return StrNum Sinverted ? ($s2 . $sl) : ($sl . $s2):
}
# Использует stringify
sub repeat {
my ($sl, $s2, Sinverted) =
return StrNum Sinverted ? ($s2 x $sl) : ($sl x $s2);
}
1:
Пример: Перегруженный класс FixNum
В этом классе перегрузка оператора позволяет управлять количеством десятич-
ных позиций при выводе. При этом во всех операциях используется полная точ-
ность. Метод places О вызывается для класса или конкретного объекта и задает
количество выводимых позиций справа от десятичной точки.
#!/usr/bin/perl
# demo_fixnum - show operator overloading
use FixNum;
FixNum->places(5):
$x = FixNum->new(40);
$y = FixNum->new(12):
print "sum of $x and $y is ", $x + $y, "\n";
print "product of $x and $y is ", $x * $y, "\n";
$z = $x / $y;
printf "$z has 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
572
Глава 13. Классы, объекты и связи
Исходный текст класса приведен в примере 13.2. Из математических опера-
ций в нем перегружаются только операторы сложения, умножения и деления.
Также перегружен оператор <=>, обеспечивающий выполнение всех сравнений,
оператор строковой интерполяции и оператор числового преобразования. Опе-
ратор строковой интерполяции выглядит необычно, но это было сделано для
удобства отладки.
Пример 13.2. FixNum
package FixNum;
use strict:
my SPLACES = 0:
sub new {
my $proto = shift:
my $class = ref(Sproto) || $proto;
my $parent = ref($proto) && $proto;
my Sv = shift:
my Sself = {
VALUE => Sv,
PLACES => undef,
};
If (Sparent && defined $parent->{PLACES}) {
Sself->{PLACES} = $parent->{PLACES}:
} elsif (Sv =~ /(\.\d*)/) {
Sself->{PLACES} = length(Sl) - 1:
} else {
Sself->{PLACES} = 0:
}
return bless Sself, Sclass:
}
sub places {
my Sproto = shift:
my $self = ref($proto) && Sproto:
my Stype = ref(Sproto) || Sproto:
If (@_) {
my Splaces = shift:
(Sself ? Sself->{PLACES} : SPLACES) = Splaces:
}
return Sself ? Sself->{PLACES} : SPLACES:
}
sub _max { SJO] > $J1] ? SJO] : $ JI] }
use overload '+' => \&add,
=> \&mult1ply,
'/' => \&d1v1de,
'<=>' => \&spacesh1p.
... => \&as_str1ng.
'0+' => \&as_number;
sub add {
my (Sthls, Sthat, Sfllpped) =
my Sresult = Sth1s->new( Sthls->{VALUE} + $that->{VALUE} );
$result->places( _max($th1s->{PLACES}, $that->{PLACES} )):
return Sresult:
}
13.15. Создание «магических» переменных функцией tie
573
sub multiply {
my (Sthls. Sthat, SflIpped) =
my $result = Sth1s->new( $th1s->{VALUE} * $that->{VALUE} ):
$result->places( _max($this->{PLACES}. $that->{PLACES} )):
return $result:
}
sub divide {
my (Sthls. Sthat. $flipped) =
my $result = Sth1s->new( $th1s->{VALUE} / $that->{VALUE} ):
$result->places( _max($th1s->{PLACES}. Sthat->{PLACES} ));
return $result;
}
sub as_str1ng {
my Sself = shift:
return sprlntfC'STR^s: r*f". ref(Sself).
def1ned(Sself->{PLACES}) ? Sself->{PLACES} : SPLACES,
Sself->{VALUE}):
}
sub as_number {
my Sself = shift:
return Sself->{VALUE}:
}
sub spaceship {
my ($this, $that, $flipped) =
$th1s->{VALUE} <=> $that->{VALUE};
}
См. также
Документация по стандартным директивам overload, blglnt и bigrat, а также
стандартным модулям Math::Blglnt, Math::BlgFloat и Math::Complex.
13.15. Создание «магических» переменных
функцией tie
Проблема
Требуется организовать специальную обработку переменной или манипулятора.
Решение
Воспользуйтесь функций tie, чтобы создать объектные связи для обычной пере-
менной.
Комментарий
Каждый, кому приходилось работать с DBM-файлами в Perl, уже использовал
связанные объекты. Возможно, самый идеальный вариант работы с объектами —
тот, при котором пользователь их вообще не замечает. Функция tie связывает
574
Глава 13. Классы, объекты и связи
переменную или манипулятор с классом, после чего все обращения к связанной
переменной или манипулятору перехватываются специальными методами.
Наиболее важными являются следующие методы tie: FETCH (перехват чте-
ния), STORE (перехват записи) и конструктор, которым является один из методов
TIESCALAR, TIEARRAY, TIEHASH или TIEHANDLE.
Таблица 13.2. Интерпретация связанных переменных
Пользовательский код Выполняемый код
tie $s, "SomeClass" SomeClass->TIESCALAR()
$p = $s $p = $obj->FETCH()
$s = 10 $obj->STORE(10)
Откуда берется объект $obj? Вызов tie приводит к вызову конструктора
TIESCALAR соответствующего класса. Perl прячет возвращенный объект и тайком
использует его при последующих обращениях.
Ниже приведен простой пример класса, реализующего кольцевую структуру
данных. При каждом чтении переменной выводится следующее значение из
кольца, а при записи в кольцо заносится новое значение. Пример:
# !/usr/Ы n/perl
# demo_valuering - демонстрация связывания
use ValueRing:
tie Scolor. 'ValueRing', qw(red blue):
print "Scolor Scolor Scolor Scolor Scolor $color\n":
red blue red blue red blue
Scolor = 'green':
print "Scolor Scolor Scolor Scolor Scolor $color\n";
green red blue green red blue
Простая реализация класса ValueRing приведена в примере 13.3.
Пример 13.3. ValueRing
package ValueRing:
# Конструктор для связывания скаляров
sub TIESCALAR {
my (Sclass. lvalues) =
bless \@values. Sclass:
return \@values:
# Перехватывает чтение
sub FETCH {
my Sself = shift:
push(@$self, shlft(©Sself)):
return Sself->[-1]:
}
# Перехватывает запись
sub STORE {
my (Sself. Svalue) =
unshift @$self, Svalue;
return Svalue;
1;
13.15. Создание «магических» переменных функцией tie
575
Вероятно, такой пример кажется надуманным, но он показывает, как легко
создать связь произвольной сложности. Для пользователя Scol or остается старой
доброй переменной, а не объектом. Все волшебство спрятано под связью. При
связывании скалярной переменной совсем не обязательно использовать скаляр-
ную ссылку; мы использовали ссылку на массив, но вы можете выбрать любой
другой вариант. Обычно при связывании любых переменных используется ссыл-
ка на хэш, поскольку она обеспечивает наиболее гибкое представление объекта.
Для массивов и хэшей возможны и более сложные операции. Поскольку пол-
ноценная поддержка связанных переменных требует реализации множества ме-
тодов объекта (возможно, кроме скаляров), многие пользователи предпочитают
наследовать от стандартных модулей, в котором существуют готовые методы
для работы с данным типом переменных. Далее избирательно переопределяются
те методы, поведение которых требуется изменить.
Такими стандартными модулями являются Tie:: Seal ar, Tie: :Array, Tie: :Hash
и Tie::Handle. Каждый модуль содержит два разных класса: минимальный класс,
имя которого совпадает с именем модуля, и более полный класс с именем
Tie::StdTYPE, где TYPE — один из четырех типов.
Ниже приведены некоторые интересные примеры связывания.
Пример связывания: Запрет $___
Этот любопытный связываемый класс подавляет использование неявной пере-
менной $_. Вместо того чтобы подключать его командой use, что приведет к кос-
венному вызову метода Import О класса, воспользуйтесь командой по для вызова
редко используемого метода unimportO. Пользователь включает в программу
следующую команду:
no UnderScore:
После этого любые попытки использования нелокализованной глобальной
переменной $_ приводят к инициированию исключения.
Рассмотрим применение модуля на небольшом тестовом примере:
#!/usr/Ы n/perl
# nounder_demo - запрет использования $_ в программе
no UnderScore:
@tests = (
"Assignment" => sub { $_ = "Bad" }.
"Reading" => sub { print },
"Matching" => sub { $x = /badness/ }.
"Chop" => sub { chop },
"Filetest" => sub { -x }.
"Nesting" => sub { for (1..3) { print } },
);
while ( (Sname. $code) = splice(@tests, 0, 2) ) {
print "Testing Sname: ":
eval { &$code }:
print $@ ? "detected" : "missed!":
print "\n":
576
Глава 13. Классы, объекты и связи
Результат выглядит так:
Testing Assignment: detected
Testing Reading: detected
Testing Matching: detected
Testing Chop: detected
Testing Filetest: detected
Testing Nesting: 123missed!
В последнем случае обращение к переменной не было перехвачено, посколь-
ку она была локализована в цикле for.
Исходный текст модуля UnderScore приведен в примере 13.4. Обратите внима-
ние, каким маленьким он получился. Функция tie вызывается модулем в ини-
циализирующем коде.
Пример 13.4. Underscore
package UnderScore;
use Carp;
sub TIESCALAR {
my Sclass = shift;
my Sdummy;
return bless \$dummy => Sclass:
}
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 и no для этого класса в программе не принесет ни-
какой пользы, поскольку они обрабатываются во время компиляции, а не во
время выполнения. Чтобы снова воспользоваться переменной $_, локализуйте ее.
Пример связывания: Хэш с автоматическим дополнением
Следующий класс создает хэш, который автоматически накапливает повторяю-
щиеся ключи в массиве вместо их замены.
# !/usr/bin/perl
# appendhash_demo - хэш с автоматическим дополнением
use Tie::AppendHash;
tie Uab, "Tie: :AppendHash":
$tab{beer} = "guinness":
$tab{food} = "potatoes";
$tab{food} = "peas":
while (my($k. Sv) = each Hab) {
print "$k => [@$v]\n";
}
Результат выглядит так:
food => [potatoes peas]
beer => [guinness]
13.15. Создание «магических» переменных функцией tie
577
Простоты ради мы воспользовались шаблоном модуля для связывания хэша,
входящим в стандартную поставку (см. пример 13.5). Для этого мы загружаем
модуль Tie::Hash и затем наследуем от класса Tie::StdHash (да, это действительно
разные имена — файл Tle/Hash.pm содержит классы Tie::Hash и Tie::StdHash, не-
сколько отличающиеся друг от друга).
Пример 13.5. Tie::AppendHash
package Tie::AppendHash:
use strict:
use Tie::Hash;
use Carp:
our @ISA = qw(T1e::StdHash):
sub STORE {
my (Sself. $key, $value) =
push @{$self->{key}}, Svalue:
}
1;
Пример связывания: Хэш без учета регистра символов
Ниже приведен другой, более хитроумный пример связываемого хэша Tie: -.Folded.
На этот раз хэш автоматически преобразует ключи к нижнему регистру.
# !/usr/Ы n/perl
# folded_demo - хэш с автоматическим преобразованием регистра
use Tie::Folded:
tie Hab, "Tie: :Folded":
Stab{VILLAIN} = "big ":
$tab{her01ne} = "red riding hood":
$tab{vl11 aln} = "bad wolf":
while ( my($k. Sv) = each ИаЬ ) {
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:
our @ISA = qw(T1e::StdHash):
sub STORE {
my (Sself. Skey. Svalue) =
return $self->{lc Skey} = Svalue:
}
sub FETCH {
продолжение &
578
Глава 13. Классы, объекты и связи
Пример 13.6 (продолжение)
my (Sself. Skey) =
return $self->{lc Skey}:
}
sub EXISTS {
my (Sself. Skey) =
return exists $self->{lc Skey}:
}
sub DEFINED {
my (Sself. Skey) =
return defined $self->{lc Skey):
}
1:
Пример: Хэш с возможностью поиска
по ключу и по значению
Следующий хэш позволяет искать элементы как по ключу, так и по значению.
Для этого метод STORE заносит в хэш не только значение по ключу, но и обрат-
ную пару — ключ по значению.
Если сохраняемое значение представляет собой ссылку, возникают затрудне-
ния, поскольку обычно ссылка не может использоваться в качестве ключа хэша.
Проблема решается классом Tie:: Ref Hash, входящим в стандартную поставку.
Наш класс будет наследовать от него:
#!/usr/Ыn/perl -w
# revhash_demo - хэш с возможностью поиска по ключу *или* по значению
use strict:
use Tie::RevHash:
my ПаЬ:
tie ИаЬ. "Tie: :RevHash":
ПаЬ = qw{
Red Rojo
Blue Azul
Green Verde
}:
$tab{EVIL) = [ "No way!". "Way!!" ]:
while ( my($k. Sv) = each ПаЬ ) {
print ref(Sk) ? "[@$k]" : $k, " => ",
ref(Sv) ? "[@$v]" : Sv, "\n":
}
При запуске программа revhash_demo выдает следующий результат:
[No way! Way!!] = EVIL>
EVIL => [No way! Way!!]
Blue => Azul
Green => Verde
Rojo => Red
Red => Rojo
Azul => Blue
Verde => Green
Исходный текст модуля приведен в примере 13.7. Оцените размеры!
13.15. Создание «магических» переменных функцией tie
579
Пример 13.7. Tie::RevHash
package Tie::RevHash:
use Tie::RefHash:
our @ISA = qw(T1e::RefHash):
sub STORE {
my (Sself, Skey, Svalue) =
Sself->SUPER::STORE(Skey. Svalue):
Sself->SUPER::STORE(Svalue. Skey);
}
sub DELETE {
my (Sself, Skey) =
my Svalue = Sself->SUPER::FETCH(Skey):
Sself->SUPER::DELETE($key):
Sself->SUPER::DELETE($value);
}
1:
Пример связывания: Манипулятор
с подсчетом обращений
Рассмотрим пример связывания для файлового манипулятора:
use Counter:
tie *СН, "Counter":
while (<CH>) {
print "Got $_\n";
}
При запуске эта программа выводит Got 1, Got 2 и так далее, пока вы не пре-
рвете ее, не перезагрузите компьютер или не наступит конец света (все зависит
от того, что случится раньше). Простейшая реализация приведена в примере 13.8.
Пример 13.8. Counter
package Counter:
sub TIEHANDLE {
my Sclass = shift:
my Sstart = shift:
return bless \$start => Sclass:
}
sub READLINE {
my Sself = shift:
return ++$$self:
}
1:
Пример связывания: дублирование вывода по
нескольким манипуляторам
Напоследок мы рассмотрим пример связанного манипулятора, который облада-
ет tee-подобными возможностями — он объединяет STDOUT и STDERR:
use Tie::Тее:
tie *ТЕЕ, "Т1е::Тее". *STDOUT, *STDERR:
print TEE "This line goes both pl aces.\n":
580
Глава 13. Классы, объекты и связи
Или более подробно:
#!/usr/Ы n/perl
# demo_tietee
use Tie::Tee:
use Symbol:
^handles = (*STDOUT);
for $1 ( 1 .. 10 ) {
push(@handles, Shandie = gensymO):
open($handle, ">/tmp/teetest.$1");
}
tie *TEE, "T1e::Tee", ^handles:
print TEE "This lines goes many pl aces.\n";
Содержимое файла Tle/Tee.pm показано в примере 13.9.
Пример 13.9. Tie::Tee
package Tie::Tee:
sub TIEHANDLE {
my Sclass = shift:
my Shandies =
bless Shandies. Sclass:
return Shandies:
}
sub PRINT {
my Shref = shift:
my Shandie:
my Ssuccess = 0;
foreach Shandie (@$href) {
Ssuccess += print Shandie
}
return Ssuccess == @$href:
}
1:
См. также
Функция tie описана в perlfunc(V) и perltie(l).
Базы данных
«Все, чего я прошу — это информация».
Чарльз Диккенс, «Дэвид Копперфильд»
14.0. Введение
Базы данных встречаются везде, где происходит обработка данных. На простей-
шем уровне базой данных можно считать любой файл, а на самом сложном —
дорогую и сложную реляционную базу данных, обрабатывающую тысячи тран-
закций в секунду. Между этими полюсами расположены бесчисленные механиз-
мы ускоренного доступа к более или менее структурированным данным. Perl
поддерживает работу с базами данных на любом из этих уровней.
На заре компьютерной эпохи люди заметили, что базы данных на основе пло-
ских файлов плохо подходят для работы с большими объемами информации.
Плоские файлы улучшались посредством введения записей фиксированной дли-
ны или индексирования, однако обновление требовало все больших затрат, и неко-
гда простые приложения увязали в болоте ввода/вывода.
Умные программисты почесали в затылках и разработали более удачное
решение. Поскольку хэш, находящийся в памяти, обеспечивает более удобный
доступ к данным по сравнению с массивом, хэш на диске также упростит работу
с данными по сравнению с «массивообразным» текстовым файлом. За ускоре-
ние доступа приходится расплачиваться объемом, но дисковое пространство
в наши дни стоит дешево (во всяком случае, так принято считать).
Библиотека DBM предоставляет в распоряжение программистов простую
и удобную базу данных. С хэшами, ассоциированными с DBM-файлами, можно
выполнять те же операции, что и с хэшами в памяти. В сущности, именно так по-
строена вся работа с базами данных DBM в Perl. Вызов tie связывает хэш с клас-
сом и файлом. Затем при любом обращении к хэшу класс выполняет чтение или
запись в базе данных DBM на диске. Старая функция dbmopen тоже решала эту
задачу, но позволяла использовать в программе лишь одну реализацию DBM,
что делало невозможным копирование данных из одного формата в другой.
Рецепт 14.1 демонстрирует процесс создания базы данных DBM, а также
содержит рекомендации относительно ее эффективного использования. Хотя
с файлами DBM допускаются все операции, поддерживаемые для простых хэшей,
возникают проблемы быстродействия, неактуальные для хэшей в памяти. Посколь-
ку файлы DBM хранятся на диске и могут совместно использоваться несколькими
582
Глава 14. Базы данных
процессорами, организуйте параллельный доступ к ним при помощи файла
блокировки (см. рецепт 7.24). Рецепты 14.2 и 14.4 разъясняют суть этих проблем
и показывают, как справиться с ними. С файлами DBM также можно выполнять
операции, не доступные для обычных хэшей. Два примера таких операций рас-
сматриваются в рецепте 14.5.
Разные реализации DBM обладают разными возможностями. В табл. 14.1 пе-
речислены некоторые доступные библиотеки DBM.
Таблица 14.1. Библиотеки DBM и их возможности
Возможности NDBM SDBM GDBM DB
Интерфейсное программное обеспечение поставляется с Perl да да да да
Исходные тексты поставляются с Perl нет да нет нет
Возможность распространения исходных текстов нет да GPL1 да
Доступность через FTP нет да да да
Легкость построения — да да нормально2
Частое применение в Unix да3 нет нет4 нет5
Нормальное построение в Unix — да да да6
Нормальное построение в Windows — да да да7
Размер кода Зависит от поставщика малый большой большой8
Использование диска Зависит от поставщика малое большое нормальное
Скорость Зависит от поставщика низкая нормальная высокая
Ограничение размера блока 4 Кбайт 1 Кбайт нет нет
Произвольный порядок байтов нет нет нет да
Порядок сортировки, определяемый пользователем нет нет нет да
Поиск по неполному ключу нет нет нет да
1 Применение кода с общей лицензией GPL в программах должно удовлетворять некото-
рым условиям. За дополнительной информацией обращайтесь на www.gnu.org.
2 См. библиотечный метод DB_File. Требует символических ссылок.
3 На некоторых компьютерах может входить в библиотеку совместимости с BSD.
4 Кроме бесплатных версий UNIX — Linux, FreeBSD, OpenBSD и NetBSD.
5 Кроме бесплатных версий UNIX — Linux, FreeBSD, OpenBSD и NetBSD.
6 При наличии ANSI-компилятора С.
7 До выхода единой версии 5.005 существовало несколько разных версий Perl для Windows-
систем, включая стандартный порт, построенный по обычной поставке Perl, и ряд спе-
циализированных портов. DB, как и большинство модулей CPAN, строится только в стан-
дартной версии.
8 Уменьшается при компиляции для одного метода доступа.
14.0. Введение
583
NDBM присутствует в большинстве систем семейства BSD. GDBM представ-
ляет собой GNU-реализацию DBM. SDBM входит в поставку ХИ и в стандарт-
ную поставку Perl. DB означает библиотеку Berkeley DB. Хотя остальные биб-
лиотеки фактически реализуют заново исходную библиотеку DB, код Berkeley
DB позволяет работать с тремя разными типами баз данных и старается устра-
нить многие недостатки, присущие другим реализациям (затраты дискового
пространства, скорость и размер).
Строка «Размер кода» относится к размеру откомпилированной библиотеки,
а строка «Использование диска» — к размеру создаваемых ею файлов баз дан-
ных. Размер блока определяет максимальный размер ключа или значения в базе.
Строка «Произвольный порядок байтов» говорит о том, использует ли система
баз данных аппаратный порядок следования байтов или создает переносимые
файлы. Сортировка в пользовательском порядке позволяет сообщить библио-
теке, в каком порядке должны возвращаться списки ключей, а поиск по непол-
ному ключу позволяет выполнять приблизительный поиск в базе.
Большинство программистов Perl предпочитают берклиевские реализации.
На многих системах эта библиотека уже установлена, и Perl может ею пользо-
ваться. Другим мы рекомендуем найти эту библиотеку в CPAN и установить ее.
Это заметно упростит вашу жизнь.
DBM-файлы содержат пары «ключ/значение». В терминологии реляцион-
ных баз данных они соответствуют базе данных, содержащих всего одну таблицу
с двумя полями. В рецепте 14.8 показано, как использовать модуль MLDBM
с CPAN для хранения сложных структур данных в DBM-файлах.
При всех своих достоинствах модуль MLDBM не может преодолеть глав-
ное ограничение: критерием для извлечения записи является содержимое лишь
одного столбца, ключа хэша. Если вам понадобится сложный запрос, могут
возникнуть непреодолимые трудности. В таких случаях подумайте о специа-
лизированной системе управления базами данных (СУБД). Проект DBI со-
держит модули для работы с Oracle, Sybase, mSQL, MySQL, Ingres и другими
системами.
Модуль DBD:: SQL1 te является интересным промежуточным решением меж-
ду полноценным сервером базы данных и DBM-файлом. Он обеспечивает SQL-
интерфейс к реляционной базе данных, но без участия серверного процесса —
модуль читает и записывает единый файл, содержащий все таблицы. Таким
образом, в вашем распоряжении оказывается мощь SQL и работы с несколь-
кими таблицами без неудобств, связанных с администрированием реляцион-
ных СУБД. Управление таблицами в одном процессе обеспечивает заметный
прирост скорости.
За дополнительной информацией обращайтесь по адресам http://dbi .perl.огд/
doc/1 ndex.html и http://search.cpan.org/modl1st/Database_Interfaces. DBI поддержи-
вает большинство основных и второстепенных СУБД, включая Oracle, ODBC,
Sybase, Informix, MySQL, PostgreSQL и XBase. Также существуют DBD-интер-
фейсы к таким источникам данных, как SQLite, файлы Excel и CSV (данные,
разделенные запятыми).
584
Глава 14. Базы данных
14.1. Создание и использование DBM-файла
Проблема
Вы хотите создать, заполнить, просмотреть или удалить значения из базы дан-
ных DBM.
Решение
Воспользуйтесь функцией tie, чтобы открыть базу и сделать ее доступной через
хэш. Затем работайте с хэшем как обычно. После завершения работы вызови-
те untie.
use DB_File: # Загрузить модуль баз данных
tie %HASH, "DB_File", FILENAME # Открыть базу данных
or die "Can't open FILENAME: $!\n": # через %HASH
$V = $HASH{KEY}: # Получить данные из базы
$HASH{KEY} = VALUE; # Занести данные в базу
if (exists $HASH{KEY}) { # Проверить наличие данных в базе
# ...
delete $HASH{KEY}; # Удалить данные из базы
untie £hash; # Закрыть базу данных
Комментарий
Работа с базой данных через хэш отличается широкими возможностями и про-
стотой. В вашем распоряжении оказывается хэш, состояние которого сохраняет-
ся и после завершения программы. Кроме того, он работает намного быстрее,
чем хэш, полностью загружаемый при каждом запуске; даже если хэш состоит
из миллиона элементов, ваша программа запустится практически мгновенно.
Программа из примера 14.1 работает с базой данных так, словно она является
обычным хэшем. Для нее даже можно вызывать keys или each. Кроме того, для
связанных DBM-хэшей реализованы функции exists и defined. В отличие от
обычного хэша, для DBM-хэша эти функции идентичны.
Пример 14.1. userstats
# !/usr/Ыn/perl -w
# userstats - вывод статистики о зарегистрированных пользователях.
# При вызове с аргументом выводит данные по конкретным пользователям.
use DB_File;
$db = "/tmp/userstats.db"; # База для хранения данных между запусками
tie(M), ’DB_File’, $db) or die "Can't open DB_File $db : $!\n";
if (@ARGV) {
14.1. Создание и использование DBM-файла
585
if ("@ARGV" eq "ALL") {
@ARGV = sort keys Xdb:
}
foreach Suser (@ARGV) {
print "$user\t$db{$user}\n";
} else {
@who = 'who'; # Запустить who(l)
if ($?) {
die "Couldn’t run who: $?\n": # Аварийное завершение
}
# Извлечь имя пользователя (первое в строке) и обновить
foreach Sline (@who) {
$1ine /^(\S+)/;
die "Bad line from who; $line\n" unless $1;
$db{$l}++:
}
untie Ш;
Мы воспользовались командой who для получения списка зарегистрирован-
ных пользователей. Обычно результат выглядит следующим образом:
gnat ttypl May 29 15:39 (coprolith.frii.com)
Если вызвать программу userstats без аргументов, она проверяет зарегистри-
рованных пользователей и соответствующим образом обновляет базу данных.
Передаваемые аргументы интерпретируются как имена пользователей, о кото-
рых следует вывести информацию. Специальный аргумент "ALL” заносит в @ARGV
отсортированный список ключей DBM. Для больших хэшей с множеством клю-
чей это обойдется слишком дорого — лучше воспользоваться средствами DB_File,
описанными в рецепте 14.5.
Впрочем, старая функция dbmopen продолжает работать. Ниже приведено ре-
шение, адаптированное для dbmopen и dbmclose:
use DB_File;
dbmopen &HASH. SFILENAME. 0666 # Открытие базы данных
or die "Can't open SFILENAME:$!\n"; # с доступом через &HASH
$V = $HASH{$KEY}; # Выборка из базы данных
$HASH{$KEY} = SVALUE: # Запись в базу данных
if (exists $HASH{$KEY}) { # Проверка присутствия
# ... # в базе данных
) delete $HASH{$KEY}; # Удалить из базы данных
dbmclose £HASH; # Закрыть базу данных
См. также
Документация по стандартным модулям GDBM_File, NDBM_File, SDBM_File, DB_File;
perltie(l); рецепт 13.15. Влияние umask на процесс создания файлов рассматрива-
ется в рецепте 7.1.
586
Глава 14. Базы данных
14.2. Очистка DBM-файла
Проблема
Требуется стереть все содержимое DBM-файла.
Решение
Откройте базу данных функцией tie и присвойте ей О:
use DB_File:
tie(%HASH. "DB_File". SFILENAME) or die "Can't open FILENAME: S!\n";
%HASH = ():
untie %hash;
Существует и другое решение — удалить файл и открыть его заново:
unlink SFILENAME
or die "Couldn't unlink SFILENAME to empty the database: $!\n":
tieaHASH => "DB_File", SFILENAME)
or die "Couldn't create SFILENAME database: $!\n":
Комментарий
Возможно, удаление файла с последующим созданием выполняется быстрее,
чем очистка, но при этом возникает опасность подмены, которая может нару-
шить работу неосторожной программы или сделать ее уязвимой для нападения.
В промежуток между удалением файла и его повторным созданием нападающий
может создать ссылку, указывающую на жизненно важный файл /etc/preci ous,
с тем же именем, что и у вашего файла. При открытии файла библиотекой DBM
содержимое /etc/preci ous будет уничтожено.
При удалении базы данных DB_File с повторным созданием теряются зна-
чения всех настраиваемых параметров — размер страницы, фактор заполне-
ния и т. д. Это еще один веский довод в пользу присваивания связанному хэшу
пустого списка.
См. также
Документация по стандартному модулю DB_File; функция unlink описана
в perlfunc(\.y, рецепт 14.1.
14.3. Преобразование DBM-файлов
Проблема
У вас имеется файл в одном формате DBM, однако другая программа желает
получить данные в другом формате DBM.
14.3. Преобразование DBM-файлов
587
Решение
Прочитайте ключи и значения из исходного DBM-файла и запишите их в дру-
гой файл в другом формате DBM, как показано в примере 14.2.
Пример 14.2. db2gdbm
#!/usr/Ыn/perl -w
# db2gdbm: преобразование DB в GDBM
use strict;
use DB_F11e:
use GDBM_F11e:
unless (@ARGV == 2) {
die "usage: db2gdbm Infile outflleXn":
}
my (Slnflle. Soutflle) = @ARGV;
my (£db_1n, %db_out):
# Открыть файлы
t1e(£db_1n, 'DB-FIle'. Slnflle)
or die "Can’t tie Slnflle: $!":
t1e(£db_out, 'GDBM-FIle'. Soutflle, GDBM_WRCREAT, 0666)
or die "Can't tie Soutflle: $!":
# Скопировать данные (не пользуйтесь £db_out = £db_1n,
# потому что для больших баз это работает медленно)
while (my($k, $v) = each Ш_1п) {
$db_out{$k} = $v:
}
# Функции untie вызываются автоматически при завершении программы
untie Ш_1п:
untie £db_out;
Командная строка выглядит так:
% db2gdbm /tmp/users,db /tmp/users.gdbm
Комментарий
Если в одной программе используются различные типы DBM-файлов, интерфейс
dbmopen исключается — остается только интерфейс tie. Дело в том, что интер-
фейс dbmopen позволяет работать лишь с одним форматом баз данных и поэтому
считается устаревшим.
Копирование хэшей простым присваиванием (%new = Жо1с1) работает и для
DBM-файлов, однако сначала все данные загружаются в память в виде списка.
Для малых хэшей это несущественно, но для больших DBM-файлов затраты
могут стать непозволительно большими. Для хэшей баз данных лучше исполь-
зовать перебор с помощью функции each.
588
Глава 14. Базы данных
См. также
Документация по стандартным модулям GDBM_F11e, NDBM_FHe, SDBM_F11e, DB_F11e;
рецепт 14.1.
14.4. Объединение DBM-файлов
Проблема
Требуется объединить два DBM-файла в один с сохранением исходных пар
«ключ/значение».
Решение
Либо объедините базы данных, интерпретируя их хэши как списки:
^OUTPUT = (&INPUT1, 2SINPUT2):
либо (более разумный вариант) организуйте перебор пар «ключ/значение»:
^OUTPUT = ();
foreach $href ( \£INPUT1. \%INPUT2 ) {
while (my($key. $value) = each(Uhref)) {
if (exists $OUTPUT{$key}) {
# Выбрать используемое значение
# и при необходимости присвоить $OUTPUT{$key}
} else {
$OUTPUT{$key} = Svalue:
} }
Комментарий
Прямолинейный подход из рецепта 5.11 обладает тем же недостатком. Объеди-
нение хэшей посредством списковой интерпретации требует, чтобы хэши были
предварительно загружены в память, что может привести к созданию огромных
временных списков. Если вы работаете с большими хэшами и/или не распола-
гаете достаточной виртуальной памятью, организуйте перебор ключей в цикле
each — это позволит сэкономить память.
Между этими двумя способами объединения есть еще одно отличие — в том,
как они поступают с ключами, присутствующими в обоих базах. Присваивание
пустого списка просто заменяет первое значение вторым. Итеративный перебор
позволяет принять решение, как поступить с дубликатом. Возможные вариан-
ты — выдача предупреждения или ошибки, сохранение первого экземпляра, за-
мена первого экземпляра вторым, конкатенация обоих экземпляров. Используя
модуль MLDBM, можно даже сохранить оба экземпляра в виде ссылки на массив из
двух элементов.
14.5. Сортировка больших DBM-файлов
589
См. также
Рецепт 5.11; рецепт 14.6.
14.5. Сортировка больших DBM-файлов
Проблема
Необходимо обработать большой объем данных, которые должны передаваться
в DBM-файл в определенном порядке.
Решение
Воспользуйтесь возможностью связывания В-деревьев модуля DB_File и пере-
дайте собственную функцию сравнения:
use DB_File:
# Указать функцию Perl, которая должна сравнивать ключи
# с использованием экспортированной ссылки на хэш $DB_BTREE
$DB_BTREE->{'compare'} = sub {
my (Skeyl, $key2) = ;
"\L$keyl" cmp "\L$key2" ;
tie(%hash. "DB_File". Sfilename. O_RDWR|O_CREAT. 0666. $DB_BTREE)
or die "can't tie Sfilename: S’";
Комментарий
Основной недостаток хэшей (как в памяти, так и в DBM-файлах) заключается
в том, что они не обеспечивают нормального упорядочения элементов. Модуль
CPAN Tie:: IxHash позволяет создать хэш в памяти с сохранением порядка встав-
ки, но это не поможет при работе с базами данных DBM или произвольными
критериями сортировки.
Модуль DB_Fi 1 е содержит изящное решение этой проблемы за счет использования
В-деревьев. Одно из преимуществ В-дерева перед обычным DBM-хэшем — его упо-
рядоченность. Когда пользователь определяет функцию сравнения, любые вызовы
keys, values и each автоматически упорядочиваются. Так, программа из примера 14.3
создает хэш, ключи которого всегда сортируются без учета регистра символов.
Пример 14.3. sortdemo
# !/usr/bin/perl
# sortdemo - автоматическая сортировка dbm
use strict:
use DB_File:
$DB_BTREE->{'compare'} = sub {
my (Skeyl. Skey2) = ;
"\L$keyl" cmp "\L$key2" :
my £hash: продолжение &
590
Глава 14. Базы данных
Пример 14.3 (продолжение)
my Sfilename = '/tmp/sorthash.db';
tie(%hash. "DB_File", Sfilename. O_RDWR|O_CREAT, 0666. $DB_BTREE)
or die "can't tie Sfilename: $!";
my Si =0:
for my Sword (qw(Can't you go camp down by Gibraltar)) {
$hash{$word} = ++$i:
while (my($word, Snumber) = each &hash) {
printf "£-12s £d\n", Sword. Snumber:
По умолчанию записи баз данных В-деревьев DB_File сортируются по алфавиту.
Однако в данном случае мы написали функцию сравнения без учета регистра,
поэтому применение each для выборки всех ключей даст следующий результат:
by 6
camp 4
Can't 1
down 5
Gibraltar 7
go 3
you 2
Возможность сортировки хэша настолько удобна, что ею стоит пользоваться
даже без базы данных на диске. Если передать tie вместо имени файла undef,
DB_File создаст файл в каталоге /tmp, а затем немедленно уничтожит его, созда-
вая анонимную базу данных:
tie(£hash. "DBJile". undef, O_RDWR|O_CREAT. 0666. $DB_BTREE)
or die "can't tie: $!":
Определяя критерий сравнения для своей базы данных на основе В-дерева,
необходимо помнить о двух обстоятельствах. Во-первых, при создании базы не-
обходимо передавать новую функцию сравнения. Во-вторых, вы не сможете из-
менить порядок записей после создания базы; одна и та же функция сравнения
должна использоваться при каждом обращении к базе.
Базы данных BTREE также допускают использование повторяющихся или
неполных ключей. За примерами обращайтесь к документации.
См. также
Рецепт 5.7.
14.6. Хранение сложных структур
данных в DBM-файлах
Проблема
В DBM-файле требуется хранить не скаляры, а что-то иное. Например, вы ис-
пользуете в программе хэш хэшей и хотите сохранить его в DBM-файле, чтобы
с ним могли работать другие или чтобы его состояние сохранялось между за-
пусками программы.
14.6. Хранение сложных структур данных в DBM-файлах
591
Решение
Воспользуйтесь модулем CPAN MLDBM — он позволяет хранить в хэше более
сложные структуры, нежели строки или числа.
use MLDBM 'DB_File';
tie(^HASH. 'MLDBM* . [... прочие аргументы DBM]) or die $!;
Модуль сериализации выбирается следующим образом:
use MLDBM qw(DB_File Storable);
Комментарий
MLDBM использует модули сериализации типа Storable, Data::Dumper или FreezeThaw
(см. рецепт 11.14) для преобразования структур данных в строки и обратно, что
позволяет хранить их в DBM-файлах. Модуль не сохраняет ссылки; вместо них
сохраняются данные, на которые эти ссылки указывают:
# %hash - связанный хэш
$hash{"Tom Christiansen"} = [ "book author". 'tchristOperl.com* ];
$hash{"Tom Boutell"} = [ "shareware author", 'boutell@boutell.com' ]:
# Сравниваемые имена
$namel = "Tom Christiansen";
$name2 = "Tom Boutell":
$toml = $hash{$namel}: # Получить локальный указатель
$tom2 = $hash{$name2}; # И еще один
print "Two Tomi ng: $toml $tom2\n";
Two Tomi ng: ARRAY(0x73048)ARRAY(0x73e4c)
Каждый раз, когда MLDBM извлекает структуру данных из файла DBM, строит-
ся новая копия данных. Чтобы сравнить данные, полученные из базы данных
MLDBM, необходимо сравнить значения полей этой структуры:
if ($toml->[0] eq $tom2->[0] &&
$toml->[l] eq $tom2->[l]) {
print "You’re having runtime fun with one Tom made two An";
} else {
print "No two Toms are ever alikeAn";
}
Этот вариант эффективнее следующего:
if ($hash{$namel}->EOJ eq $hash{$name2}->L0] && # НЕЭФФЕКТИВНО
$hash{$namel}->[l] eq $hash{$name2}->[l]) {
print "You’re having runtime fun with one Tom made two An":
} else {
print "No two Toms are ever alikeAn";
}
Каждый раз, когда в программе встречается конструкция $hash{...}, происходит
обращение к DBM-файлу. Приведенный выше неэффективный код обращается
592
Глава 14. Базы данных
к базе данных четыре раза, тогда как код с временными переменными $toml и $tom2
обходится всего двумя обращениями.
Текущие ограничения механизма tie не позволяют сохранять или модифици-
ровать компоненты MLDBM напрямую:
$hash{"Tom Boutell"}->[0J = "Poet Programmer"; # НЕВЕРНО
Любые операции чтения, модификации и присваивания для частей структу-
ры, хранящейся в файле, должны осуществляться через временную переменную:
Sentry = $hash{"Tom Boutell"}: # ВЕРНО
$entry->[0J = "Poet Programmer":
$hash{"Tom Boutell"} = Sentry:
Если MLDBM использует базу данных с ограниченным размером значений (на-
пример, SDBM), вы довольно быстро столкнетесь с этими ограничениями. Чтобы
выйти из положения, используйте GDBM_F11e или DB_F11e, в которых размер ключей
или значений не ограничивается. Предпочтение отдается библиотеке DB_F11e,
поскольку она использует нейтральный порядок байтов, что позволяет исполь-
зовать базу данных в архитектурах, как с начальным старшим, так и с началь-
ным младшим байтом.
См. также
Документация по стандартным модулям Data::Dumper и Storable; документация
по модулям CPAN FreezeThaw и MLDBM; рецепт 11.13; рецепт 14.7.
14.7. Устойчивые данные
Проблема
Вы хотите, чтобы переменные сохраняли значения между вызовами программы.
Решение
Воспользуйтесь модулем MLDBM для сохранения значений между вызовами про-
граммы:
use MLDBM "DB_F11e":
my (SVARIABLE1.SVARIABLE2):
my SPersistent_Store = "/projects/foo/data":
BEGIN {
my £data:
tleWata, "MLDBM". SPersistent_Store)
or die "Can't tie to SPersistent_Store : S’":
SVARIABLEl = $data{VARIABLEl};
SVARIABLE2 = Sdata{VARIABLE2}:
# ...
untie £data:
}
14.7. Устойчивые данные
593
END {
my £data:
tie (^data, "MLDBM". $Persistent_Store)
or die "Can't tie to $Persistent_Store : $!";
$data{VARIABLEl} = SVARIABLEl;
$data{VARIABLE2} = $VARIABLE2:
# ...
untie £data:
}
Комментарий
Существенное ограничение MLDBM заключается в том, что структуру нельзя
дополнить или изменить по ссылке без присваивания временной переменной.
Мы сделаем это в простой программе из примера 14.4, присваивая значение
$array_ref перед вызовом push. Следующая конструкция просто невозможна:
push(@{$db{$user}}. Sduration):
Прежде всего, MLDBM не позволит это сделать. Кроме того, $db{$user} может
отсутствовать в базе (ссылка на массив не создается автоматически, как это
делалось бы в том случае, если бы хэш ^db не был связан с DBM-файлом).
Именно поэтому мы проверяем exists $db{$user} перед тем, как присваивать
$array_ref исходное значение. Мы создаем пустой массив в случае, если он не
существовал ранее.
Пример 14.4. mldbm-demo
#!/usr/bin/perl -w
# mldbm_demo - применение MLDBM c DB_File
use MLDBM "DB_File";
$db = "/tmp/mldbm-array":
tie №. "MLDBM". $db
or die "Can't open $db : $!":
while(<DATA>) {
chomp:
($user. Sduration) = split(/\s+/. $_):
$array_ref = exists $db{$user} ? $db{$user} : [];
push(@$array_ref. Sduration):
$db{$user} = $array_ref;
}
foreach $user (sort keys Ш) {
print "$user:
Stotal = 0;
foreach Sduration (@{ $db{$user} }) {
print "$duration
Stotal += $duration;
}
продолжение &
594
Глава 14. Базы данных
Пример 14.4 (продолжение)
print "(Stotal)\n";
}
_END_
gnat 15.3
tchrist 2.5
Jules 22.1
tchrist 15.9
gnat 8.7
Новые версии MLDBM позволяют выбрать не только модуль для работы с база-
ми данных (мы рекомендуем DB_F11e), но и модуль сериализации (рекоменду-
ем Storable). В более ранних версиях сериализация ограничивалась модулем
Data::Dumper, который работает медленнее Storable. Для использования DB_File со
Storable применяется следующая команда:
use MLDBM qw(DB_File Storable):
См. также
Документация по стандартным модулям Data::Dumper и Storable; документация
по модулям CPAN FreezeThaw и MLDBM; рецепт 11.13; рецепт 14.6.
14.8. Сохранение результатов
запроса в Excel или в CSV
Проблема
Требуется обратиться с запросом к реляционной базе данных и создать файл ре-
зультатов, который мог бы использоваться другим человеком или программой.
На практике для передачи данных часто используются форматы Excel и CSV
(comma-separated values — значения, разделенные запятыми).
Решение
Сохраните манипулятор команды после запроса при помощи модуля CPAN
DBIх: :Dump:
use DBIx::Dump:
use DBI;
# ... Подключение к базе данных
Ssth = $dbh->prepare("SELECT ..."): # Запрос
$sth->execute();
Sout = DBIx::Dump->new('format' => SFORMAT, # excel или csv
'output' => SFILENAME, # Файл для сохранения
'sth' => Ssth):
$out->dump():
14.9. Выполнение команд SQL с помощью DBI
595
Комментарий
Модуль CPAN DBIx::Dump поддерживает форматы файлов Excel и CSV. Для за-
писи файлов Excel он использует модуль CPAN Spreadsheet::WriteExcel, а для
записи файлов CSV — модуль CPAN Text: :CSV_XS.
В первой строке выходного файла перечисляются имена столбцов. Пример:
ID.NAME
1 .Nat
2 . Tom
4 .Larry
5 .Damian
6 . Jon
7 . Dan
См. также
Документация по модулям CPAN DBIx::Dump, Spreadsheet::WriteExcel и Text: :CSV_XS;
рецепт 14.17.
14.9. Выполнение команд SQL
с помощью DBI
Проблема
Вы хотите направить запрос SQL в систему управления базами данных (на-
пример, Oracle, Sybase, mSQL или MySQL) и обработать полученные резуль-
таты.
Решение
Воспользуйтесь модулями CPAN DBI (DataBase Interface) и DBD (DataBase Driver):
use DBI:
$dbh = DBI->connect('dbi:driver:database'. 'username', 'auth'.
{ RalseError => 1. AutoCommit => 1}):
$dbh->do($NON_SELECT_SQL_STATEMENT):
$results = $dbh->selectall_arrayref($SELECT_SQL_STATEMENT):
$sth = $dbh->prepare($SQL_SELECT_STATEMENT);
$sth->execute():
while (@row = $sth->fetchrow_array) {
# ...
}
$dbh->d1sconnect():
596
Глава 14. Базы данных
Комментарий
Модуль DBI абстрагируется от API различных баз данных и предоставляет еди-
ный набор функций для работы с любой СУБД. Непосредственные операции
по подключению к базе данных, передаче запроса, разбору результатов и т. д.
выполняются специализированным модулем DBD для конкретной базы данных
(например, DBD: :mysql, DBD::Oracle и т. д.).
Большинство операций DBI выполняется с использованием манипулятора —
простого объекта, который создается и ассоциируется с конкретной базой дан-
ных и драйвером при вызове DBI->connect.
Первый аргумент DBI->connect представляет собой строку из трех полей, разде-
ленных двоеточиями. Он определяет источник данных (DSN) — СУБД, к кото-
рой вы подключаетесь. Первое поле всегда содержит символы dbi (без учета ре-
гистра символов, так что DBI-тоже подойдет), а второе — имя драйвера, который
вы собираетесь использовать (Oracle, mysql и т. д.). Оставшаяся часть строки
передается модулем DBI запрошенному модулю драйвера (например, DBD::mysql)
и идентифицирует базу данных.
Второй и третий аргументы обеспечивают аутентификацию пользователя.
В четвертом, необязательном аргументе передается ссылка на хэш с определе-
нием атрибутов подключения. Если атрибут Prl ntError равен true, то при каждом
неудачном вызове метода модуль DBI будет выдавать предупреждение. Присваи-
вание RalseError имеет аналогичный смысл, за исключением того, что вместо warn
будет использоваться die. Атрибут AutoCommit относится к управлению транзак-
циями; присваивая ему true, вы указываете, что не хотите самостоятельно управ-
лять ими (см. рецепт 14.11).
На момент написания книги существовали модули DBD для всех основных баз
данных (MySQL, Oracle, PostgreSQL, Informix, DB2, SQLServer), многих второсте-
пенных баз (XBase, SQLite) и для источников, не являющихся базами дан-
ных. Полный список находится по адресу http://search.cpan.org/modl1st/Database_
Interfaces/DBD.
Ниже приведены примеры DSN:
dbi:Oracle:tnsname
dbi:Oracle:host=foo.bar.com:sid=ORCL
dbi:Oracl e:host=foo.bar.com:sid=ORCL:port=1521
dbi:mysql:database=foo:host=foo.bar.com:port=3306:mysql_compress1on=l
dbi:Pg:dbname=foo:host=foo.bar.com:optlons=-F
Простые команды SQL (не возвращающие записи данных) могут выполнять-
ся методом do манипулятора базы данных. При этом возвращается логический
признак (true или false). Самый быстрый вариант выполнения запроса, возвра-
щающего записи данных, основан на использовании методов selectall_arrayref
и selectall_hashref:
$rows = $dbh->selectall_arrayref("SELECT Isbn,title,author FROM books");
print $row[OJ[lJ: # Вывод поля title первой записи
$rows = $dbh->selectall_hashref("SELECT Isbn,title,author FROM books", "Isbn");
print $rows->{596000278}[2]: # Выводится строка "Programming Perl"
14.9. Выполнение команд SQL с помощью DBI
597
Иногда запрос возвращает много записей, тогда как вас интересуют значения
лишь одного поля. Именно для таких случаев существует метод selectcol_arrayref:
он преобразует серию записей с одним полем в ссылку на простой массив Perl:
$books = $dbh->selectcol_arrayref("SELECT title FROM books"):
print $books[3]: # Вывод поля title четвертой записи
Если вы не хотите загружать в память сразу все результаты или желаете
обеспечить эффективное повторное использование запросов, создайте манипу-
лятор команды методом prepare, вызываемым для манипулятора базы данных.
Далее запрос выполняется вызовом метода execute для манипулятора команды,
а записи извлекаются методами выборки fetchrow_array или fetchrow_hashref
(возвращают ссылку на хэш, в котором имя поля ассоциируется со значением).
Этот способ используется в рецепте 14.12.
Если вы точно знаете, что запрос возвращает только одну запись, восполь-
зуйтесь методами selectrow_*:
@row = $dbh->selectrow_array("SELECT title,author FROM books WHERE 1sbn='596000278'"):
print $row[l]; # Вывод автора первой возвращаемой книги
$row = $dbh->selectrow_arrayref("SELECT title,author FROM books WHERE 1sbn='596000278'"):
print $row->[l]: # Вывод автора первой возвращаемой книги
$row = $dbh->selectrow_hashref("SELECT title,author FROM books WHERE 1sbn='596000278'".
"title"):
print $row->{author}: # Вывод автора первой возвращаемой книги
Манипуляторы команд и баз данных часто связываются с подключениями
к базе, поэтому при работе с ними необходима осторожность. При выходе мани-
пулятора из области действия подключение автоматически закрывается. Но если
манипулятор базы данных выходит из области действия при наличии активных
манипуляторов команд для этой базы, вы получите предупреждение вида
disconnect(DBI::db=HASH(0x9df84)) Invalidates 1 active cursor(s)
at -e line 1.
Это означает, что вы выбрали не все данные, возвращенные командой SELECT.
В тех редких случаях, когда это не является признаком ошибки, и вы не хоти-
те использовать методы selectrow_*, можно воспользоваться методом finish —
невыбранные данные теряются, а манипулятор команды помечается как неак-
тивный.
Модуль DBI содержит FAQ (страница руководства DBI::FAQ(3), последняя
версия которой доступна по адресу http://dbi .perl .org) и стандартную докумен-
тацию (perldoc DBI). Также существует документация для драйверов конкретных
СУБД (например, DBD::mysql(3y). Прикладной интерфейс DBI не ограничива-
ется простейшим подмножеством, рассмотренным нами; он предоставляет раз-
нообразные возможности выборки результата и взаимодействия со специфиче-
скими средствами конкретных СУБД (например, сохраняемыми процедурами).
За информацией обращайтесь к документации по модулю драйвера.
Программа из примера 14.5 создает и заполняет таблицу пользователей в
MySQL, после чего выполняет в ней поиск. Она использует атрибут RalseError
и потому обходится без проверки возвращаемого значения для каждого метода.
598
Глава 14. Базы данных
Пример 14.5. dbusers
#!/usr/Ыn/perl -w
# dbusers - работа с таблицей пользователей в MySQL
use DBI:
use User::pwent:
$dbh = DBI->connect('dbi:mysql:dbname:mysqlserver.doma1n.com:3306'.
'user', 'password'.
{ RalseError => 1. AutoCommit => 1 })
$dbh->do("CREATE TABLE users (uid INT. login CHAR(8))"):
$sql_fmt = "INSERT INTO users VALUES( 2d, %s )":
while (Suser = getpwent) {
Ssql = sprintf(Ssql_fmt, Suser->u1d. $dbh->quote($user->name));
$dbh->do(Ssql):
}
Srows = $dbh->selectall_arrayref("SELECT uid.login FROM users WHERE uid < 50"):
foreach Srow (@$rows) {
print joint". ". map {defined $_?$_: "(null)"} @$row). "\n":
$dbh->do("DROP TABLE users"):
Sdbh->d1sconnect:
См. также
Документация по модулям CPAN DBD и DBI, http://dbi .perl . org/ и http://
search.cpan .org/modl 1 st/Database_I interfaces.
14.10. Экранирование строк
Проблема
Требуется интерполировать значения Perl в запросы, но вы не уверены в том,
какие правила экранирования используются в вашей СУБД.
Решение
Воспользуйтесь методом quote манипулятора базы данных:
Squoted = $dbh->quote($unquoted):
Значение Squoted теперь может интерполироваться в запросы:
$sth->prepare("SELECT Id. login FROM People WHERE name = Squoted"):
Кроме того, в запрос можно включить подставляемые заполнители (place-
holders), и тогда DBI автоматически экранирует строки за вас:
$sth->prepare("SELECT Id,login FROM People WHERE name = ?"):
$sth->execute($unquoted);
14.11. Обработка ошибок при операциях с базами данных
599
Комментарий
У каждой СУБД существуют собственные правила экранирования служебных
символов в интерполируемых строках, поэтому вместо того, чтобы создавать
собственную функцию экранирования, лучше поручить эту задачу методу quote
или воспользоваться заполнителями. Жесткое экранирование символов в коде
SQL не только нарушает переносимость программы, но и не учитывает того, что
интерполируемые строки могут содержать служебные символы. Для примера
возьмем следующую команду:
Ssth = $dbh->prepare(qq{SELECT Id.login FROM People WHERE name="Sname"});
Если в переменной $name хранится строка Jon "maddog" Orwant, то вы фактиче-
ски создаете следующий запрос, ошибочный с точки зрения синтаксиса SQL:
SELECT Id.login FROM People WHERE name-'Jon "maddog" Orwant"
У quote есть только одна странность: поскольку в модуле DBI значения NULL
представляются как undef, при вызове quote для undef будет возвращена строка
NULL без кавычек.
См. также
Документация по модулю CPAN DBI; http://dbi .perl .org.
14.11. Обработка ошибок при операциях
с базами данных
Проблема
Программа должна перехватывать и обрабатывать ошибки при операциях с ба-
зами данных, возможно — с выводом содержательных сообщений об ошибках.
Решение
Наилучшее решение — разрешить инициировать RalseError при подключении
к базе данных, а затем инкапсулировать операции с базой данных в eval:
$dbh = DBI->connect($DSN, Suser. Spassword.
{ RalseError > 1 });
eval {
$dbh->do($SQL):
Ssth = $dbh->prepare($SQL2):
$sth->execute():
while (Orow = Ssth->fetchrow_array) {
# ...
}
}:
If ($0) {
# Здесь производится восстановление. Для получения
# сообщения об ошибке используется метод SDBI::lasth->errstr.
}
600
Глава 14. Базы данных
Комментарий
Логика решения проста: сначала мы сообщаем DBI, что при наличии проблем
с SQL следует вызывать die. Затем код, в котором возможен вызов die, «завора-
чивается» в eval для перехвата фатальных ошибок. Далее мы проверяем $@ (либо
сообщение об ошибке, выданное die, либо пустая строка, если ошибки не было)
и смотрим, нормально ли прошла операция. При обнаружении проблем выпол-
няется некая обработка ошибки.
В переменной $DBI:: lasth модуля DBI хранится последний манипулятор, с кото-
рым выполнялась операция. Если возникла ошибка, ее причиной является именно
этот манипулятор. Можно использовать хранящееся в $@ сообщение об ошибке, но
в нем также присутствует текст «died at file... line...» от die, который, скорее всего,
вам не нужен. Команда SQL, ставшая причиной die, идентифицируется при помощи
конструкции $DBI::lasth->{Statement}. Если вы работаете только с одним манипуля-
тором, методы можно вызывать напрямую для манипулятора вместо $DBI::lasth:
Smsg = $dbh->errstr:
$sql = $dbh->{Statement}:
Возможно и другое решение — отключить RaiseError и проверять возвращаемое
значение для каждой операции с базой данных. Такие методы, как do и execute, воз-
вращают true в случае успеха, поэтому в программу включаются фрагменты вида:
$dbh->do($SQL) or die $dbh->errstr;
$sth->execute() or die $sth->errstr:
Метод do возвращает количество записей, участвовавших в операции, но таким
образом, что при успешной операции всегда возвращается истинное значение
(если вас интересуют подробности, обращайтесь к Введению главы 1; там подроб-
но рассказано, как Perl определяет, какие значения истинны, а какие — ложны).
Если вы отлаживаете обработку ошибок, включите атрибут PrintError в под-
ключение к базе данных:
$dbh = DBI->connect($DSN. Suser. Spassword,
{ RaiseError => 1. PrintError => 1 });
Если с манипулятором возникают проблемы, Pri ntError выдаст предупрежде-
ние перед тем, как RaiseError вызовет die. Следовательно, если вы перехватывае-
те ошибку при помощи eval и это не приводит к обязательному закрытию про-
граммы, вы все равно увидите текст сообщения об ошибке.
См. также
Документация по модулю CPAN DBI; http://dbi .perl .org; рецепт 14.12.
14.12. Эффективное повторение запросов
Проблема
Имеется запрос, который будет выполняться многократно. Требуется сделать
его выполнение как можно более эффективным. Возможна и другая ситуация —
14.12. Эффективное повторение запросов
601
имеется несколько похожих, но не идентичных запросов, которые тоже должны
выполняться с максимальной эффективностью (допустим, вы перебираете в цик-
ле массив имен и хотите выполнять запрос вида SELECT ... WHERE name=$name).
Решение
Воспользуйтесь тем фактом, что после подготовки функцией prepare запрос мо-
жет многократно выполняться функцией execute:
$sth = $dbh->prepare($SQL);
# Выполнить запрос 10 раз
for ($1=0; $1 < 10: $1++) {
$sth->execute();
while (@row = $sth->fetchrow_array) {
# ...
}
}
При изменении параметров запроса воспользуйтесь механизмом подстановки
параметров DBI:
$sth = $dbh->prepare('SELECT uid,login FROM People WHERE name = ?');
foreach Sperson (@names) {
$sth->execute($person);
while (Orow = $sth->fetchrow_array) {
# ...
} }
Комментарий
Успешное применение DBI основано на принципе «один раз подготовить, много-
кратно выполнять». Отделение фазы подготовки запроса от фазы выполнения по-
зволяет серверу базы данных один раз разобрать и оптимизировать запрос, чтобы
потом много раз выполнять его. Многие СУБД поддерживают такую возмож-
ность даже в том случае, если запрос содержит параметры, подставляемые на
стадии выполнения.
Процесс подстановки значений на место параметров называется привязкой
(binding). В простейшем варианте привязка производится при выполнении запроса:
$sth = $dbh->prepare('SELECT Id,login FROM People WHERE mlddlejnltlal = ?');
$sth->execute(' J'):
Если параметров несколько, они также передаются при вызове execute:
$sth = $dbh->prepare('SELECT * FROM Addresses WHERE House = ?
AND Street LIKE ?');
$sth->execute('221b', 'BakerD;
Однако привязку не обязательно совмещать с выполнением. Функция bind-
param выполняет привязку без выполнения:
$sth = $dbh->prepare( 'SELECT Id,login FROM People WHERE mlddlejnltlal = ?');
$sth->b1nd_param(l, 'J');
$sth->execute():
602
Глава 14. Базы данных
Первый аргумент bind_param определяет номер параметра (нумерация начи-
нается с 1):
$sth = $dbh->prepare('SELECT * FROM Addresses WHERE House = ?
AND Street LIKE ?'):
$sth->bind_param(l, '221b');
$sth->bind_param(2, 'Baker');
Функции bind_param также может передаваться необязательный третий аргу-
мент, который определяет тип значения и необходимость его экранирования:
$sth->bind_param(l, 'J'. SQL_CHAR);
Используемые типы необходимо импортировать (отдельно или вместе с дру-
гими типами):
use DBI qw(SQL_CHAR SQLJNTEGER);
use DBI qw(:sql_types);
List all types with:
foreach (@{ $dbi::EXPORT_TAGS{sql_types} }) {
prlntf "£s=£d\n", $_, &{"DBI;
Значения, передаваемые при привязке или при вызове execute с привязкой,
экранировать необязательно. DBI автоматически экранирует их при использова-
нии в строковом контексте.
Главное ограничение привязки состоит в том, что параметры не могут опре-
делять имена таблиц или полей. Иначе говоря, подготовить к выполнению сле-
дующий запрос невозможно:
SELECT ?.? FROM ? WHERE ? = ?
Помните: подготовка отделяется от выполнения прежде всего для того, чтобы
сервер базы данных мог оптимизировать запрос. Должен существовать некий ми-
нимум неприкосновенной информации, который бы позволял выполнять с запро-
сом любые оптимизации!
Существует и другое, менее существенное ограничение — каждый параметр мо-
жет представлять отдельную скалярную величину. Рассмотрим следующий запрос:
SELECT id,login FROM People WHERE name IN (?)
Подготовка запроса проходит без проблем, однако к параметру можно будет
привязать не более одного значения.
См. также
Документация по модулю CPAN DBI; http://dbi .perl .org.
14.13. Программное построение запросов
Проблема
Требуется строить запросы на стадии выполнения. Например, вы хотите, чтобы
пользователи вашей программы могли сами задавать интересующие их комби-
нации полей и допустимые интервалы значений.
14.13. Программное построение запросов
603
Решение
Постройте список условий и объедините их в секцию SQL WHERE при помощи
функции join:
if (Syearjnin) { push Oclauses, "Year >= Syearjnin" }
if ($year_max) { push Oclauses. "Year <= $year_max" }
if (Sbedrooms_min) { push Oclauses, "Beds >= Sbedroomsjnin" }
if (Sbedroomsjnax) { push Oclauses, "Beds <= Sbedroomsjnax" }
# ...
Sclause = joinC AND ", Oclauses):
Ssth = $dbh->prepare("SELECT beds,baths FROM Houses WHERE Sclause"):
Комментарий
He пытайтесь строить строку в цикле:
Swhere = ”:
foreach Spossible (Onames) {
Swhere .= ' OR Name=' . Sdbh->quote(Spossible):
}
Это приведет к созданию секций WHERE вида:
OR Name="Tom" OR Name="Nat" OR Name-'Larry" OR Name="Tim"
В итоге вам придется отсекать начальное OR. Гораздо логичнее воспользовать-
ся тар и обойтись без лишнего текста в начале строки:
Swhere = joinC OR ", map { "Name=".$dbh->quote($_) } @names):
Map создает список строк вида
Name="Nat"
Name="Tom"
Name="Larry"
Name="Tim"
Далее мы объединяем отдельные элементы, разделяя их " OR ", и получаем
правильно сформулированное условие:
Name="Nat" OR Name="Tom" OR Name="Larry" OR Name="Tim"
К сожалению, в этом случае не допускается использование параметров:
Ssth = $dbh->prepare("SELECT id,login FROM People WHERE ?"): # НЕЛЬЗЯ
$sth->bind_param(l, Swhere):
Как объяснялось в рецепте 14.12, параметры могут использоваться только
для простых скалярных величин, но не для целых условий. Впрочем, существует
элегантное обходное решение: параллельное конструирование секции и привя-
зываемых значений:
if (Syearjnin) { push Oclauses, "Year >= ?"; push Obi nd, Syearjnin }
if (Syearjnax) { push Oclauses, "Year <= ?": push Obi nd. Syearjnax }
if (Sbedroomsjnin) { push Oclauses, "Beds >= ?"; push Obind, Sbedroomsjnin }
if (Sbedroomsjnax) { Sclause = joinC AND push Oclauses. "Beds <= ?": ", Oclauses): push Obind, Sbedroomsjnax }
Ssth = $dbh->prepare("SELECT id.price FROM Houses WHERE Sclause"):
Ssth->execute(Obind):
604
Глава 14. Базы данных
См. также
Документация по модулю CPAN DBI; http://dbi .perl .org; рецепт 14.12.
14.14. Определение количества записей,
возвращаемых запросом
Проблема
Требуется узнать, сколько записей вернул запрос.
Решение
Для операций, не являющихся запросами (например, INSERT, UPDATE и DELETE), ме-
тод do возвращает количество записей, задействованных в выполнении опера-
ции; -1, если это количество определить не удается, или undef в случае неудачи.
Srows = $dbh->do("DELETE FROM Conference WHERE Language^REBOL'"):
if (! defined Srows) {
# Неудачная попытка (при активном RaiseError проверка необязательна)
} else {
print "Deleted Srows rows\n";
}
Надежная информация о количестве записей может быть получена лишь
двумя способами: либо полной выборкой результата с последующим подсчетом,
либо написанием другого запроса.
Комментарий
Чтобы узнать количество записей, возвращенных запросом, проще всего вос-
пользоваться функцией SQL COUNT. Для примера возьмем следующий запрос:
SELECT id.name FROM People WHERE Age > 30
Количество возвращаемых записей определяется следующим запросом:
SELECT COUNT(*) FROM People WHERE Age > 30
Если содержимое базы данных настолько неустойчиво, что количество запи-
сей может измениться между выборкой данных и вызовом COUNT, лучше всего
произвести выборку и посчитать записи самостоятельно.
В некоторых модулях DBD функция execute возвращает количество задейст-
вованных записей. Такое поведение зависит от реализации и может измениться
в будущем.
См. также
Документация по модулям CPAN DBI; http://dbi .perl .org.
14.15. Использование транзакций
605
14.15. Использование транзакций
Проблема
Некое изменение базы данных требует выполнения нескольких команд SQL
INSERT, UPDATE или DELETE. Допустим, вы хотите включить имя человека в таблицу
People, добавить его адрес в таблицу Address и установить связь между ними
через таблицу LivesAt. От начала первой и до завершения последней операции
вставки база данных находится в логически несогласованном состоянии. Если
другой клиент обратится к базе данных, он получит недопустимые данные (на-
пример, человек без адреса).
Требуется выполнить обновление так, чтобы другой клиент никогда не видел
базу данных в несогласованном состоянии. Во время модификации и после нее
изменения должны быть видны либо все сразу, либо не видны вообще, незави-
симо от сбоев на стороне клиента или сервера в процессе обработки.
Решение
Воспользуйтесь транзакциями. В DBI поддержка транзакций реализована в виде
методов commit и rollback, вызываемых для манипулятора базы данных. Пример:
$dbh->{AutoCommit} = 0: # Разрешение транзакций
$dbh->{RaiseError} = 1: # dieO. если при выполнении запроса
# возникли проблемы
eval {
# Выполнение запросов, вставок, обновлений и удалений
$dbh->commit():
}:
if ($@) {
warn "Transaction aborted:
eval { $dbh->rol 1 back() }; # На случай сбоя rollbackO
# Завершающие действия на уровне приложения
Комментарий
Параметр AutoCommi t управляет режимом автоматического закрепления всех изме-
нений в базе данных после выполнения команды. При отключении этого режима
база данных обновляется лишь при вызове метода commit. Если в процессе серии
обновлений вы вдруг измените свое решение или произойдет ошибка, все неза-
вершенные операции можно будет отменить методом rollback.
Атрибуты AutoCommit и RaiseError необязательно задавать перед каждой тран-
закцией. Удобнее задать их при вызове connect:
$dbh = DBI->connect($dsn. Susername. Spassword.
{ AutoCommit => 0. RaiseError => 1 });
Поскольку RaiseError заставляет DBI вызывать die при каждой неудачной
операции с базой данных, при любом сбое происходит вызов из блока eval (даже
606
Глава 14. Базы данных
если это произошло из-за того, что в нем была вызвана функция, обращающаяся
к базе данных).
Всегда явно завершайте транзакции вызовом commit или rollback. При вызове
disconnect с незавершенными транзакциями разные базы данных ведут себя по-
разному. В одних (например, Oracle и Ingres) незавершенные транзакции закре-
пляются, а в других (MySQL, Informix) происходит откат.
При закреплении или откате транзакции многие драйверы объявляют недей-
ствительными все активные манипуляторы команд для манипулятора базы дан-
ных. Пример:
$sth = $dbh->prepare(...);
$sth->execute():
eval {
$dbh->do(...);
$dbh->commit:
if ($@) { eval { $dbh->rol1 back } }
while (@row = $sth->fetchrow_array) { ... } # Может не сработать
Работоспособность последней строки не гарантирована, поскольку из-за опе-
раций закрепления и отката манипулятор команды $sth может стать недействи-
тельным. Стандартное решение — создать для базы данных два манипулятора
(посредством двукратного вызова connect) и использовать один манипулятор
для всех команд SELECT.
См. также
Документация по модулям CPAN DBI; http://dbi .perl .org.
14.16. Постраничный просмотр данных
Проблема
Требуется выводить содержимое таблицы или результат запроса по страницам.
Решение
Отслеживайте номер начальной записи и на основании этой величины решайте,
сколько записей нужно пропустить перед отображением полной страницы. Если
база данных поддерживает интервальный синтаксис секции LIMIT, используйте
его для предотвращения пересылки лишних записей в программу.
Комментарий
Пример, приведенный ниже, выполняет постраничный перебор записей табли-
цы. Чтобы перебрать результаты запроса, сохраните данные во временной таб-
лице и переберите ее содержимое.
14.16. Постраничный просмотр данных
607
В типичных приложениях (например, Тк) вы самостоятельно отслеживаете
текущий номер страницы. В веб-приложениях текущая позиция проще всего за-
дается параметром запроса в URL:
/users-report/view?start=l
Прежде всего определите общее количество записей:
$row = $Dbh->selectrow_arrayref("SELECT COUNT(*) FROM Users");
$count = $row->[0];
Найдите первую отображаемую запись по параметру start, затем вычислите
номер последней записи. Для этого нужно знать количество записей на страни-
це; ниже предполагается, что оно хранится в переменной $Page_S1ze:
$first = param('start') || 1:
$last = $first + $Page_Size - 1:
$last = $count if $1ast > $count; # До последней отображаемой записи
Произведите выборку данных в массив и выведите интересующие вас записи:
$results = $Dbh->selectall_arrayref('SELECT id,lastname,firstname FROM Users
ORDER BY lastname.firstname.id'):
for (my $i=$first; $i <= $last; $i++) {
my $user = $results->[$i-1]; # В первой строке выводится нулевая запись
printfdd. £s, %s.<br>\n". $i. $user->[l], $user->[2]):
}
Примерный результат выглядит так:
1. Brocard, Leon.<br>
2. Cawley, Piers.<br>
3. Christiansen, Tom.<br>
Остается лишь построить ссылки для перемещения к следующей и предыду-
щей странице (если они существуют):
$prev_rec = $first - $Page_Size;
$prev_rec = 1 if $prev_rec < 1;
$prev_link = sprintf('%s/£d', url(-full => 1). $prev_rec);
$next_rec = $last + 1:
$next_link = sprintf('%s/W , url(-full => 1), $next_rec);
if ($first = = 1) {
print 'Previous';
} else {
printf('<a href="%s">Previous</a>', $prev_link);
}
print " | "; # Разделить "Previous" и "Next"
if ($next_rec < $count) {
printf('<a href="%s">Next</a>', $next_link);
} else {
print 'Next';
}
Задача упрощается, если СУБД позволяет задавать интервалы в секции LIMIT
(как, например, MySQL и PostgreSQL). Из базы данных программе передаются не
все записи, а только те, которые будут непосредственно использоваться при выводе:
608
Глава 14. Базы данных
Sresults = $dbh->selectall_arrayref("SELECT Id,lastname.firstname FROM Users
ORDER BY lastname.flrstname.ld
LIMIT " . ($f1rst-l) . ". $Page_S1ze");
for ($1=0: $1 < @$results: $1++) {
my $user = $results->[$1]:
prlntfCld. %s. %s.<br>". $1+$f1rst. $user->[l], $user->[2]):
}
Конструкция MySQL LIMIT m.n записывается в PostgreSQL в виде LIMIT n
OFFSET m.
См. также
Документация по модулям CPAN DBI и DBIx::Pager; http://dbi .perl .org и http://
www.mysql.com.
14.17. Запросы к файлам CSV
с использованием SQL
Проблема
Требуется использовать SQL для вставки, удаления или выборки данных в фай-
ле данных, разделенных запятыми (CSV).
Решение
Воспользуйтесь модулем CPAN DBD:: CSV:
use DBI:
$dbh = DBI->connect("db1:CSV:f_d1r=/home/gnat/payroll". "". "".
{ AutoCommit => 1. RaiseError => 1 }):
$dbh->do("UPDATE salaries SET salary = salary * 2 WHERE name = 'Nat'"):
$sth = $dbh->prepare("SELECT name.sal ary FROM salaries WHERE name = 'Nat'"):
$sth->execute():
while (Orow = $sth->fetchrow_array) {
# ...
}
$sth->f1n1sh():
$dbh->d1sconnect():
Комментарий
В контексте CSV «таблица» представляет собой файл (а имя таблицы соответ-
ствует имени файла). Таблицы хранятся в каталоге, определяемом параметром
14.18. Работа с SQL без сервера БД
609
f_d1r при вызове метода connect. Модуль DBD::CSV поддерживает синтаксис CREATE
и DROP для создания и уничтожения таблиц:
$dbh->do("CREATE TABLE salaries (salary FLOAT, name CHAR(20))"):
Допустимые типы полей: TINYINT, BIGINT, LONGVARBINARY, VARBINARY, BINARY, LONG-
VARCHAR, CHAR, NUMERIC, DECIMAL, INTEGER, SMALLINT, FLOAT, REAL и DOUBLE.
При обращении к таблице модуль DBD::CSV блокирует соответствующий файл
системной функцией flock(2). Если функция flock(2) не поддерживается в фай-
ловой системе, содержащей файл CSV, два процесса смогут одновременно рабо-
тать с файлом. Теоретически это может привести к получению неверных резуль-
татов или потере данных.
При чтении или записи файлов CSV, созданных в Excel, необходимо сообщить
модулю DBD::CSV, что значения на самом деле разделяются символом «;»:
$dbh = DBI->connect('dbi:CSV:f_d1r=/home/gnat/payroll:csv_sep_char=\;');
Символ «;» приходится экранировать, чтобы функция connect не решила, буд-
то он отделяет csv_sep_char= от другого атрибута подключения. Мы использу-
ем апострофы вместо кавычек, чтобы символ \ тоже не пришлось экранировать:
$dbh = DBI->connect("dbi:CSV:f_d1r=/home/gnat/payrol1:csv_sep_char=\\;"):
См. также
Документация по модулю CPAN DBD: :CSV; рецепт 1.20; рецепт 14.8.
14.18. Работа с SQL без сервера БД
Проблема
Требуется выполнять относительно сложные запросы SQL, но при этом обой-
тись без установки реляционной СУБД.
Решение
Воспользуйтесь модулем CPAN DBD::SQL1 te:
use DBI:
$dbh = DBI->connect("db1:SQL1te:dbname=/Users/gnat/salar1es.sqlt". "". "".
{ RaiseError => 1. AutoCommit => 1 }):
$dbh->do("UPDATE salaries SET salary = 2* salary WHERE name = 'Nat'"):
$sth = $dbh->prepare("SELECT Id.deductions FROM salaries WHERE name = 'Nat'"):
# ...
Комментарий
База данных SQLite представляет собой один файл, задаваемый параметром
dbname конструктора DBI. В отличие от большинства реляционных СУБД, она не
610
Глава 14. Базы данных
требует специального сервера — модуль DBD:-.SQLite работает с файлом напря-
мую. Допускается одновременное чтение из файла сразу несколькими процесса-
ми (то есть выборка SELECT), но только один процесс может вносить изменения,
причем на это время остальным процессам запрещается чтение.
SQLite поддерживает транзакции. Иначе говоря, вы можете внести несколь-
ко изменений в разные таблицы, а непосредственное обновление файла про-
изойдет лишь при вызове commit:
use DBI:
$dbh = DBI->connect("dbi:SQLite:dbname=/Users/gnat/salaries.sqlt". "". "".
{ RaiseError => 1. AutoCommit => 0 }):
eval {
$dbh->do("INSERT INTO people VALUES (29. 'Nat', 1973)");
$dbh->do("INSERT INTO people VALUES (30. ’William'. 1999)"):
$dbh->do("INSERT INTO father_of VALUES (29. 30)"):
$dbh->commit( ):
}:
if ($@) {
eval { $dbh->rol1 back( ) };
die "Couldn't roll back transaction" if $@:
SQLite не различает типы данных. Независимо от типа, указанного при созда-
нии таблицы, в любое поле можно занести данные любого типа (строки, числа,
даты, двоичные объекты). Более того, таблицы вообще могут создаваться без
указания типа:
CREATE TABLE people (id, name. birth_year);
Типы данных учитываются только в одном случае — при сравнении (в усло-
виях WHERE или при сортировке данных). База данных игнорирует тип поля и ис-
пользует только тип конкретного сравниваемого значения. SQLite, как и Perl,
работает только со строками и числами. Два числа сравниваются в веществен-
ном формате, строки сравниваются в строковом виде, а при сравнении разно-
типных величин число всегда меньше строки.
Существует единственная ситуация, в которой SQLite использует объявлен-
ный тип данных поля. Чтобы значение поля автоматически увеличивалось (на-
пример, если в нем хранится уникальный идентификатор), его следует объявить
с типом INTEGER PRIMARY KEY:
CREATE TABLE people (id INTEGER PRIMARY KEY, name, birth_year);
В примере 14.6 показано, как это делается.
Пример 14.6. ipk
# !/usr/bin/perl -w
# ipk - демонстрация INTEGER PRIMARY KEY
use DBI;
use strict;
my $dbh = DBI->connect("dbi:SQLite:ipk.dat", ""
{RaiseError => 1, AutoCommit => 1}):
# Удалить таблицу, если она существовала ранее,
eval {
14.19. Программа: ggh — поиск в глобальном журнале Netscape
611
local Sdbh->{PrintError} = 0:
$dbh->do("DROP TABLE names”):
}:
# Создать таблицу заново.
Sdbh->do("CREATE TABLE names (id INTEGER PRIMARY KEY. name)"):
# Заполнить таблицу данными.
foreach my Sperson (qw(Nat Tom Guido Larry Damian Jon)) {
Sdbh->do("INSERT INTO names VALUES (NULL, ’Sperson’)");
}
# Удаление значения
Sdbh->do("DELETE FROM names WHERE name='Guido'"):
# Вставка нового значения
Sdbh->do("INSERT INTO names VALUES (NULL. 'Dan')"):
# Вывод содержимого таблицы
my Sall = $dbh->selectall_arrayref("SELECT id.name FROM names"):
foreach my Srow (@$all) {
my (Sid. Sword) = @$row;
print "Sword has id $id\n":
}
SQLite работает с 8-разрядными текстовыми данными, но не поддерживает
хранение нуль-символов ASCII (\0). Это ограничение можно обойти только од-
ним способом — использовать собственную кодировку (например, кодировку
символов в URL или Base64) перед сохранением и после выборки данных. Это
относится даже к полям, содержащим двоичные данные.
См. также
Рецепт 14.9; документация по модулю CPAN DBD::SQLite; домашняя страница
SQLite по адресу http://www.hwad.com/sw/sqlite/.
14.19. Программа: ggh — поиск в глобальном
журнале Netscape
Следующая программа выводит содержимое файла Netscape hi story, db. При вы-
зове ей может передаваться полный URL или (один) шаблон. Если программа
вызывается без аргументов, она выводит все содержимое журнала. Если не за-
дан параметр -database, используется файл ~/.netscape/history.db.
В каждой выводимой строке указывается URL и время работы. Время преоб-
разуется в формат local time параметром -local time (по умолчанию) или в пред-
ставление gmtlme параметром -gmtlme, или остается в первоначальном формате
(параметр -epoch), что может пригодиться для сортировки по дате.
Шаблон задается единственным аргументом, не содержащим ://.
Чтобы вывести данные по одному или нескольким URL, передайте их в каче-
стве аргументов:
% ggh http://www.perl.com/index.html
612
Глава 14. Базы данных
Вывод сведений об адресах, которые вы помните лишь приблизительно (шаб-
лоном считается единственный аргумент, не содержащий ://):
% ggh perl
Вывод всех адресатов электронной почты:
%> ggh mail to:
Для вывода всех посещенных сайтов со списками FAQ используется шаблон
Perl с внутренним модификатором /1:
Я ggh -regexp '(?1)\bfaq\b'
Если вы не хотите, чтобы внутренняя дата была преобразована в формат
localtime, используйте параметр -epoch:
%> ggh -epoch http://www.perl .сот/perl/
Если вы предпочитаете формат gmtlme, используйте параметр -gmtlme:
%> ggh -gmtlme http://www.perl.сот/perl/
Чтобы просмотреть весь файл, не задавайте значения аргументов (вероятно,
данные следует перенаправить в утилиту постраничного вывода):
% ggh | less
Чтобы отсортировать выходные данные по дате, укажите флаг -epoch:
%> ggh -epoch | sort -rn | less
Для сортировки по времени в формате местного часового пояса используется
более сложная командная строка:
ggh -epoch | sort -rn | perl -ре 's/\d+/localtime $&/e' | less
Сопроводительная документация Netscape утверждает, что в журнале исполь-
зуется формат NDBM. Это не соответствует действительности: на самом деле
использован формат Berkeley DB, поэтому вместо NDBM_F11e (входит в стандарт-
ную поставку всех систем, на которых работает Perl) в программе загружается
DB_F11e. Исходный текст программы приведен в примере 14.7.
Пример 14.7. ggh
# !/usr/Ыn/perl -w
# ggh - поиск данных в журнале netscape
$USAGE = «EO_COMPLAINT:
usage: $0 [-database dbfllename] [-help]
[-epochtime | -localtime | -gmtlme]
[ [-regexp] pattern] | href ... ]
EO_COMPLAINT
use Getopt::Long;
($opt_database, $opt_epocht1me, $opt_localtime.
$opt_gmt1me. $opt_regexp. $opt_help,
$pattern, )
= (0) x 7:
14.19. Программа: ggh — поиск в глобальном журнале Netscape
613
usageO unless GetOptlons qw{ database=s
regexp=s
epochtime localtime gmtlme
help
}:
if ($opt_help) { print $USAGE; exit; }
usageC'only one of localtime. gmtime. and epochtime allowed")
if $opt_localtime + $opt_gmtime + $opt_epochtime > 1:
if ( $opt_regexp ) {
$pattern = $opt_regexp;
} elsif (@ARGV && $ARGV[0] !~ m(://)) {
$pattern = shift;
}
usageCcan’t mix URLs and explicit patterns")
if $pattern && @ARGV;
if ($pattern && !eval { '' =~ /$pattern/; 1 } ) {
$@ =~ s/ at \w+ line \d+\.//;
die "$0: bad pattern $@";
}
require DB_File; DB_File->import(); # Отложить загрузку до выполнения
$|=1; # Для перенаправления данных
$dotdiг = $ENV{HOME} || $ENV{LOGNAME}:
$HISTORY = $opt_database || "$dotdir/.netscape/history.db":
die "no netscape history dbase in $HISTORY; $!" unless -e $HISTORY;
die "can't dbmopen $HISTORY: $!" unless dbmopen £hist_db, $HISTORY. 0666;
# Следующая строка - хак. поскольку программисты С.
# которые работали над этим, путали strlen и strlen+1.
# Так мне сказал jwz :-)
$add_nulls = (ord(substr(each £hist_db. -D) == 0);
# XXX: Сейчас следовало бы сбросить скалярные ключи, но
# не хочется тратить время на полный перебор.
# необходимый для связанных хэшей.
# Лучше закрыть и открыть заново?
$nulled_href =
$byte_order = "V"; # На PC не понимают "N" (сетевой порядок)
if (OARGV) {
foreach $href (@ARGV) {
$nulled_href = $href . ($add_nulls && "\0");
unless ($binary_time = $hist_db{$nulled_href}) {
warn "$0: No history entry for HREF $href\n";
next;
}
продолжение &
614
Глава 14. Базы данных
Пример 14.7 (продолжение)
$epoch_secs = unpack($byte_order, $b1nary_t1me);
$stardate = $opt_epocht1me ? $epoch_secs
: $opt_gmtime ? gmtlme $epoch_secs
: local time $epoch_secs:
print "$stardate $href\n":
}
} else {
while ( ($href. $b1nary_t1me) = each %h1st_db ) {
chop $href If $add_nulls;
next unless defined $href && defined $b1nary_time;
$b1nary_t1me = pack($byte_order. 0) unless $b1nary_t1me:
$epoch_secs = unpack($byte_order, $b1nary_t1me):
$stardate = $opt_epocht1me ? $epoch_secs
: $opt_gmt1me ? gmtlme $epoch_secs
: local time $epoch_secs;
print "$stardate $href\n" unless $pattern && $href !~ /$pattern/o;
}
}
sub usage {
print STDERR "@_\n” if
die $USAGE:
}
См. также
Введение к этой главе; рецепт 6.17.
Интерактивность
15.0. Введение
Все, чем мы пользуемся, — видеомагнитофоны, компьютеры, телефоны и даже
книги — имеет свой пользовательский интерфейс. Интерфейс есть и у наших
программ. Какие аргументы должны передаваться в командной строке? Можно
ли перетаскивать мышью файлы? Должны ли мы нажимать Enter после каждо-
го ответа или программа читает входные данные по одному символу?
В этой главе мы не будем обсуждать проектирование пользовательского ин-
терфейса — на эту тему и так написано множество книг. Вместо этого мы сосре-
доточим внимание на реализации интерфейсов — передаче аргументов в команд-
ной строке, посимвольному чтению с клавиатуры, записи в произвольное место
экрана и программированию графического интерфейса.
Простейшим пользовательским интерфейсом обычно считается так называе-
мый консольный интерфейс. Программы с консольным интерфейсом читают це-
лые строки и выводят данные также в виде целых строк. Примером консольного
интерфейса являются фильтры (например, grep) и утилиты (например, mall).
В этой главе консольные интерфейсы почти не рассматриваются, поскольку им
уделено достаточно внимания в остальных частях книги.
Более сложный вариант — так называемый полноэкранный интерфейс. Им
обладают такие программы, как vi, elm или lynx. Они читают данные по одному
символу и могут осуществлять вывод в любой позиции экрана. Этот тип интер-
фейса рассматривается в рецептах 15.4, 15.6, 15.9, 15.10 и 15.11.
На еще более высоком уровне находятся графические пользовательские ин-
терфейсы (GUI, Graphic User Interface). Программы с графическим интерфей-
сом работают не только с отдельными символами, но и с отдельными пиксела-
ми. В графических интерфейсах часто используется метафора окна — программа
создает окна, отображаемые на пользовательском устройстве вывода. Окна за-
полняются элементами (widgets), например полосами прокрутки или кнопками.
Netscape Navigator, как и диспетчер окон в вашей системе, обладает полноценным
графическим интерфейсом. Perl позволяет работать со многими инструменталь-
ными пакетами GUI, однако мы ограничимся пакетом Тк, поскольку он являет-
ся самым распространенным и переносимым. См. рецепты 15.14, 15.15 и 15.22.
616
Глава 15. Интерактивность
Существует еще один класс пользовательских интерфейсов, которые мы не
будем рассматривать, — веб-интерфейсы. Все больше программистов перехо-
дят со сложных графических интерфейсов с адресацией на уровне отдельных
пикселов на относительно тяжеловесные страницы HTML, не отягощенные
излишним оформлением. В конце концов, у каждого есть браузер, но не каждый
способен разобраться, как установить Perl/Tk. Веб будет рассматриваться в гла-
вах 19, 20 и 21.
Не путайте пользовательский интерфейс программы со средой, в которой она
работает. Среда определяет тип запускаемых программ. Скажем, при регистрации
на терминале с полноэкранным вводом/выводом вы сможете работать с консоль-
ными приложениями, но не с графическими программами. Давайте кратко рас-
смотрим различные среды.
Некоторые из них позволяют работать лишь с программами, обладающими
чисто консольным интерфейсом. Упрощенный интерфейс позволяет объединять
их в качестве многократно используемых компонентов больших сценариев; такое
объединение открывает чрезвычайно широкие возможности. Консольные програм-
мы прекрасно подходят для автоматизации работы, поскольку они не зависят от
клавиатуры или экрана. Они используют лишь STDIN и STDOUT, да и то не всегда.
Обычно эти программы обладают наилучшей переносимостью, поскольку они
ограничиваются базовым вводом/выводом, поддерживаемым практически в лю-
бой системе.
Типичный рабочий сеанс, в котором участвует терминал с экраном и клавиа-
турой, позволяет работать как с консольными, так и полноэкранными интерфей-
сами. Программа с полноэкранным интерфейсом взаимодействует с драйвером
терминала и хорошо знает, как вывести данные в любую позицию экрана. Для
автоматизации работы таких программ создается псевдотерминал, с которым
взаимодействует программа (см. рецепт 15.13).
Наконец, некоторые оконные системы позволяют выполнять как консольные
и полноэкранные, так и графические программы. Например, можно запустить grep
(консольная программа) из vi (полноэкранная программа) в окне xterm (графиче-
ская программа, работающая в оконной среде). Графические программы автома-
тизируются труднее всего, если только они не обладают альтернативным интер-
фейсом на основе вызова удаленных процедур (RPC).
Существуют специальные инструментальные пакеты для программирования
в полноэкранных и графических средах. Такие пакеты (curses для полноэкран-
ных программ; Тк — для графических) улучшают переносимость, поскольку про-
грамма не зависит от особенностей конкретной системы. Например, программа,
написанная с применением curses, работает практически на любом терминале.
При этом пользователю не приходится думать о том, какие служебные коман-
ды используются при вводе/выводе. Tk-программа будет без изменений работать
и в Unix, и в Windows — при условии, что в ней не используются специфиче-
ские функции операционной системы.
Существуют и другие варианты взаимодействия с пользователем, в первую
очередь — через Веб. Программирование для Веб подробно рассматривается в гла-
вах 19, 20 и 21, поэтому в этой главе мы не будем задерживаться на этой теме.
15.1. Лексический разбор аргументов
617
GUI, веб-страницы и печатные документы часто украшаются графическими
изображениями. В этой главе приводится несколько рецептов по работе с графи-
ческими файлами и построению диаграмм. Как и прежде, тип среды, в которой
вы работаете, не мешает создавать изображения или работать с ними. Для созда-
ния диаграммы не обязателен графический интерфейс (хотя он потребуется для
ее просмотра, если вы не ограничиваетесь выводом на печать).
15.1. Лексический разбор аргументов
Проблема
Вы хотите, чтобы пользователь мог повлиять на поведение вашей программы,
передавая аргументы в командной строке. Например, параметр -v часто управ-
ляет степенью детализации вывода.
Решение
Передача односимвольных параметров командной строки обеспечивается стан-
дартным модулем Getopt:: Std:
use Getopt::Std;
# -v ARG. -D ARG. -o ARG. присваивает $opt_v. $opt_D. $opt_o
getoptCvDo"):
# -v ARG. -D ARG. -o ARG, присваивает $args{v}, $args{D}. $args{o}
getopt("vDo", \£args);
getopts("vDo:"): # -v. -D. -o ARG. присваивает
# $opt_v. $opt_D. $opt_o
getoptsCvDo:", \%args): # -v. -D. -o ARG. присваивает
# sets $args{v}. $args{D}. $args{o}
Или воспользуйтесь модулем Getopt:: Long, чтобы работать с именованными
аргументами:
use Getopt::Long:
GetOpt1ons( "verbose" => \$verbose. # --verbose
"Debug" => \$debug. # --Debug
"output=s" => \$output ): # --output=string
Комментарий
Многие классические программы (такие, как 1 s и rm) получают односимвольные
параметры (также называемые флагами или ключами командной строки), напри-
мер -1 или -г. В командных строках Is -1 и rm -г аргумент является логической
величиной: он либо присутствует, либо нет. Иначе дело обстоит в командной
строке дсс -о compiledfile source.с, где compiledfile — значение, ассоциирован-
618
Глава 15. Интерактивность
ное с параметром -о. Логические параметры можно объединять в любом поряд-
ке; например, строка:
% rm -г -f /tmp/testdir
эквивалентна следующей:
% rm -rf /tmp/testdir
Модуль Getopt:: Std, входящий в стандартную поставку Perl, выполняет раз-
бор этих традиционных типов параметров. Его функция getopt получает одну
строку, где каждый символ соответствует некоторому параметру, разбирает
аргументы командной строки в массиве @ARGV и для каждого параметра присваи-
вает значение глобальной переменной. Например, значение параметра -D будет
храниться в переменной $opt_D. Функция getopt работает только с параметрами,
которые не являются логическими (то есть имеют конкретное значение).
Модуль Getopt::Std также содержит функцию getopts, которая позволяет ука-
зать, является ли параметр логическим или принимает значение. Параметры со
значениями (такие, как параметр -о программы дсс) обозначаются двоеточием,
как это сделано в следующем фрагменте:
use Getopt::Std:
getopts("о:"):
If ($opt_o) {
print "Writing output to $opt_o";
}
Обе функции, getopt и getopts, могут получать второй аргумент — ссылку на
хэш. При наличии второго аргумента значения вместо переменных $opt_X сохра-
няются в $hash{X}:
use Getopt::Std:
^option = ():
getopts("Do:", \^option):
If ($opt1on{D}) {
print "Debugging mode enabled.\n";
}
# Если параметр -о не задан, направить результаты в "-".
# Открытие "-" для записи означает STDOUT
$opt1on{o} = "-" unless defined $opt1on{o}:
print "Writing output to file $opt1on{o}\n" unless $opt1on{o} eq
open(STDOUT, "> $opt1on{o}")
or die "Can't open $opt1on{o} for output: $!\n":
Некоторые параметры программы могут задаваться целыми словами вместо
отдельных символов. Обычно они имеют специальный префикс — двойной дефис:
% gnutar --extract --file latest.tar
Значение параметра --file также может быть задано с помощью знака ра-
венства:
% gnutar --extract --f11e=latest.tar
15.2. Проверка интерактивного режима
619
Функция GetOptl ons модуля Getopt: :Long разбирает параметры этой категории.
Она получает хэш, ключи которого определяют параметры, а значения представ-
ляют собой ссылки на скалярные переменные:
use Getopt::Long:
GetOptlons( "extract" => \$extract.
"file=s" => \$f11e ):
If ($extract) {
print "I'm extracting.\n":
}
die "I wish I had a file" unless defined $f11e:
print "Working on the file $f11e\n";
Если ключ хэша содержит имя параметра, этот параметр является логическим.
Соответствующей переменной присваивается false, если параметр не задан, или
1 в противном случае. Getopt:: Long не ограничивается логическими параметрами
и значениями Getopt:: Std. Возможны следующие описания параметров:
Описание Значение Комментарий
option нет Задается в виде -option или не задается вообще
option! нет Может задаваться в виде -option или -nooption
option=s да Обязательный строковый параметр: -option=somestring
option :s да Необязательный строковый параметр: -option или -option=somestring
option=i да Обязательный целый параметр: -option=35
option :i да Необязательный целый параметр: -option или -option=35
option=f да Обязательный вещественный параметр: —option=3.141
option :f да Необязательный вещественный параметр: -option или -option=3.141
См. также
Документация по стандартным модулям Getopt:: Long и Getopt:: Std; документа-
ция по модулю CPAN Getopt:: Decl аге; примеры ручного разбора аргументов
встречаются в рецептах 1.6, 1.23, 6.21, 7.14, 8.25 и 15.12.
15.2. Проверка интерактивного режима
Проблема
Требуется узнать, была ли ваша программа запущена в интерактивном режиме
или нет. Например, запуск программы пользователем из командного интерпре-
татора является интерактивным, а запуск из cron — нет.
620
Глава 15. Интерактивность
Решение
Воспользуйтесь оператором -t для проверки STDIN и STDOUT:
sub I_am_1 interactive {
return -t STDIN && -t STDOUT;
}
В POSIX-совместимых системах проверяются группы процессов:
use POSIX qw/getpgrp tcgetpgrp/;
sub I_am_1nteractive {
my $tty:
open($tty, "<", "/dev/tty") or die "can't open /dev/tty; $!";
my $tpgrp = tcgetpgrp(fileno($tty));
my $pgrp = getpgrpO:
close $tty:
return ($tpgrp == $pgrp);
}
Комментарий
Оператор -t сообщает, соответствует ли файловый манипулятор или файл терми-
нальному устройству (tty); такие устройства являются признаком интерактивного
использования. Впрочем, из такой проверки можно узнать лишь о перенаправле-
нии ввода/вывода программы. Если программа запущена из командного интер-
претатора, при перенаправлении STDIN и STDOUT первая версия I_am_1 interactive
возвращает false. При запуске из cron функция I_am_interactive также возвра-
щает false.
Второй вариант проверки сообщает, находится ли терминал в монопольном
распоряжении программы. Программа, чей ввод и вывод были перенаправлены,
все равно при желании может управлять своим терминалом, поэтому POSIX-
версия I_am_interactive возвращает true. Программа, запущенная из cron, не имеет
собственного терминала, поэтому I_am_interactive возвратит false.
Какой бы вариант I_am_interacti ve вы ни выбрали, он используется следую-
щим образом:
while (1) {
if (I_am_1nteractive()) {
print "Prompt; ";
}
$1ine = <STDIN>;
last unless defined $11ne;
# Обработать $1 ine
}
Или более наглядно:
sub prompt { print "Prompt; " if I_am_1nteractive() }
for (promptO; $11ne = <STDIN>; promptO) {
# Обработать $1 ine
15.3. Очистка экрана
621
См. также
Документация по стандартному модулю POSIX. Оператор проверки файлов -t
описан в perlop(i).
15.3. Очистка экрана
Проблема
Требуется очистить экран.
Решение
Воспользуйтесь модулем Term::Сар для посылки нужной последовательности
символов. Скорость вывода терминала можно определить с помощью модуля
POSIX:: Terml os (или можно предположить 9600 бит/с). Исключения, возникаю-
щие при работе с POSIX: :Term1os, перехватываются с помощью eval:
use Term::Cap:
$OSPEED = 9600:
eval {
require POSIX:
my $term1os = POSIX::Termlos->new();
$term1os->getattr:
$OSPEED = $term1os->getospeed:
$terminal = Term::Cap->Tgetent({OSPEED=>$OSPEED});
$term1nal->Tputs('cl', 1, STDOUT):
Или выполните команду clear:
systemC'clear");
Комментарий
Если вам приходится часто очищать экран, кэшируйте возвращаемое значение
Term::Сар или команды clear:
$clear = $term1nal->Tputs('сГ):
$clear = 'clear4:
Это позволит очистить экран сто раз подряд без стократного выполнения clear:
print $clear:
См. также
Страницы руководства clear(i) и termcap(l) (если они есть); документация по
стандартному модулю Term::Сар; документация по модулю CPAN Term: :L1b.
622
Глава 15. Интерактивность
15.4 Определение размера
терминала или окна
Проблема
Требуется определить размер терминала или окна. Например, вы хотите отфор-
матировать текст так, чтобы он не выходил за правую границу экрана.
Решение
Воспользуйтесь либо функций iocti (см. рецепт 12.17), либо модулем CPAN
Term::ReadKey:
use Term::ReadKey;
(Swchar. Shchar, Swpixels, Shpixels) = GetTerminalSizeO;
Комментарий
Функция GetTermi rial Size возвращает четыре элемента: ширину и высоту в сим-
волах, а также ширину и высоту в пикселах. Если операция не поддерживается
для устройства вывода (например, если вывод был направлен в файл), возвра-
щается пустой список.
Следующий фрагмент строит визуальное представление lvalues при условии,
что среди элементов нет ни одного отрицательного:
use Term::ReadKey:
(Swidth) = GetTerminalSizeO:
die "You must have at least 10 characters" unless Swidth >= 10:
Smax = 0:
foreach (lvalues) {
Smax = $_ if Smax < $_:
}
Sratio = ($width-10)/$max: # Символов на единицу
foreach (lvalues) {
printf("Ж8.If %s\n", $_. "*" x ($ratio*$_)):
}
См. также
Документация по модулю CPAN Term: :ReadKey; рецепт 12.17.
15.5. Изменение цвета текста
Проблема
Вы хотите выводить на экране символы разных цветов. Например, цвет может
использоваться для выделения текущего режима или сообщения об ошибке.
15.5. Изменение цвета текста
623
Решение
Воспользуйтесь модулем CPAN Term::ANSIColor для передачи терминалу после-
довательностей изменения цвета ANSI:
use Term::ANSIColor:
print colorC'red"), "Danger, Will Robinson!\n", col or("reset"):
print "This is just normal text An":
print colored("<BLINK>Do you hurt yet?</BLINK>", "blink"):
Или воспользуйтесь вспомогательными функциями модуля Term::ANSIColor:
use Term::ANSIColor qw(constants);
print RED, "Danger, Will Robinson An", RESET:
Комментарий
Модуль Term::ANSIColor готовит служебные последовательности, которые опозна-
ются некоторыми (хотя далеко не всеми) терминалами. Например, в color-xterm
этот рецепт работает, а в обычной программе xterm или на терминале vtlOO он
работать не будет.
Существует два варианта использования модуля: либо с экспортированными
функциями со1ог($А77ЖУ7) и coloredUTF/O, ^АТРИБУТ), либо со вспомогательны-
ми функциями (такими, как BOLD, BLUE и RESET).
Атрибут может представлять собой комбинацию цветов и модификаторов. Цвет
символов принимает следующие значения: black, red, green, yellow, blue, magenta
(черный, красный, зеленый, желтый, синий, малиновый). Цвет фона принимает
значения on_black, on_red, on_green, on_yellow, on_blue, on_magenta, on_cyan и on_white
(черный, красный, зеленый, желтый, синий, малиновый, голубой и белый). Допус-
каются следующие модификаторы: clear, reset, bold, underline, underscore, blink,
reverse и concealed (очистка, сброс, жирный, подчеркивание, подчеркивание, мерца-
ние, инверсия и скрытый). Clear и reset являются синонимами (как и underline
с underscore). При сбросе восстанавливаются цвета, действовавшие при запуске
программы, а при выводе скрытого текста цвет символов совпадает с цветом фона.
Атрибуты могут объединяться:
print colorC'red on_black"), "venom lack\n":
print colorC'red on_yellow"), "kill that fellow\n":
print colorC'green on_cyan blink"), "garish An":
print colorC'reset"):
Этот фрагмент можно было записать в виде:
print colored("venom lack\n". "red on_black");
print colored("kill that fellowXn", "red", "on_yellow"):
print colored("garishAn", "green", "on_cyan", "blink"):
или:
use Term::ANSIColor qw(constants):
print BLACK, ON_WHITE, "black on white\n";
624
Глава 15. Интерактивность
print WHITE, ON-BLACK, "white on black\n";
print GREEN. ON-CYAN. BLINK. "garish!\n";
print RESET;
где BLACK и т. д. — функции, экспортированные из Term::ANSIColor.
Не забывайте вызвать print RESET или color("reset") в конце программы, если
вызов colored не распространяется на весь текст. Если этого не сделать, ваш тер-
минал будет раскрашен весьма экзотическим образом. Сброс даже можно вклю-
чить в блок END:
END { print colorU'reset") }
чтобы при завершении программы цвета были гарантированно сброшены.
Атрибуты, распространяющиеся на несколько строк текста, могут привести
в замешательство некоторые программы или устройства. Если у вас возникнут
затруднения, либо вручную установите атрибуты в начале каждой строки, либо ис-
пользуйте colored, предварительно присвоив переменной $Term::ANSIColor::EACHLINE
разделитель строк:
STerm;;ANSIColor::EACHLINE = $/;
print colored(«EOF. RED. ON_WHITE. BOLD. BLINK);
This way
each line
has Its own
attribute set.
EOF
См. также
Документация по модулю CPAN Term:: Ansi Col or.
15.6. Чтение символа с клавиатуры
Проблема
Требуется прочитать с клавиатуры один символ. Например, на экран выведено
меню с клавишами ускоренного вызова, и вы не хотите, чтобы пользователь на-
жимал клавишу Enter при выборе команды.
Решение
Воспользуйтесь модулем CPAN Term::ReadKey, чтобы перевести терминал в режим
cbreak, прочитать символы из STDIN и затем вернуть терминал в обычный режим:
use Term:;ReadKey;
ReadMode 'cbreak';
Skey = ReadKey(O);
ReadMode 'normal';
15.7. Предупреждающие сигналы
625
Комментарий
Модуль Term: :ReadKey может переводить терминал в разные режимы; cbreak лишь
один из них. В этом режиме каждый символ становится доступным для програм-
мы сразу же после ввода (см. пример 15.1). Кроме того, в нем происходит эхо-вы-
вод символов; пример режима без эхо-вывода рассматривается в рецепте 15.10.
Пример 15.1. sascii
#!/usr/Ыn/perl -w
# sascii - Вывод ASCII-кодов для нажимаемых клавиш
use Term::ReadKey:
ReadMode('cbreak');
print "Press keys to see their ASCII values. Use Ctrl-C to quitAn":
while (1) {
Schar = ReadKey(O):
last unless defined Schar:
printfC Decimal: $d\tHex: £x\n", ord(Schar), ord(Schar)):
}
ReadMode('normal'):
Режим cbreak не мешает драйверу терминала интерпретировать символы кон-
ца файла и управления. Если вы хотите, чтобы ваша программа могла прочитать
комбинации Ctrl +С (обычно посылает процессу SIGINT) или Ctrl +D (признак
конца файла в Unix), используйте режим raw.
Вызов ReadKey с нулевым аргументом означает, что мы хотим выполнить
нормальное чтение функцией getc. При отсутствии входных данных программа
ожидает их появления. Кроме того, можно передать аргумент -1 (неблокирую-
щее чтение) или положительное число, которое определяет тайм-аут (продол-
жительность ожидания в секундах; допускаются дробные значения). Операции
асинхронного чтения и чтения с тайм-аутом возвращают либо undef при отсутст-
вии входных данных, либо строку нулевой длины при достижении конца файла.
Последние версии Term::ReadKey также включают ограниченную поддержку
систем, не входящих в семейство Unix.
См. также
Описания функций getc и sysread в perlfunc(V)\ документация по модулю CPAN
Term: :ReadKey; рецепт 15.8; рецепт 15.9.
15.7. Предупреждающие сигналы
Проблема
Требуется выдать предупреждающий сигнал на терминале пользователя.
626
Глава 15. Интерактивность
Решение
Воспользуйтесь символом "\а" для выдачи звукового сигнала:
print "\aWake up!\n";
Другой вариант — воспользуйтесь средством терминала "vb" для выдачи ви-
зуального сигнала:
use Term::Cap:
$OSPEED = 9600:
eval {
require POSIX:
my Stermlos = POSIX::Termlos->new();
$term1os->getattr:
$OSPEED = $term1os->getospeed:
};
Stermlnal = Term::Cap->Tgetent({OSPEED=>$OSPEED}):
$vb = "":
eval {
$term1nal->Trequ1re("vb"):
$vb = $term1nal->Tputs(’vb’. 1):
print $vb; # Визуальный сигнал
Комментарий
Служебный символ "\а" — то же самое, что и "\cG", "\007" и "\х07". Все эти обо-
значения относятся к символу ASCII BEL, который выдает на терминал против-
ный звонок. Вам не приходилось бывать в переполненном терминальном классе
в конце семестра, когда десятки новичков одновременно пытаются вывести vi
из режима вставки? От этой какофонии можно сойти с ума. Чтобы не злить
окружающих, можно использовать визуальные сигналы. Идея проста: терминал
должен показывать, а не звучать (по крайней мере, не в многолюдных помеще-
ниях). Некоторые терминалы вместо звукового сигнала позволяют на короткое
время поменять цвет символов с цветом фона, чтобы мерцание привлекло вни-
мание пользователя.
Визуальные сигналы поддерживаются не всеми терминалами, поэтому мы
включили их вызов в eval. Если визуальный сигнал не поддерживается, Trequlre
инициирует die, при этом переменная $vb останется равной В противном
случае переменной $vb присваивается служебная последовательность для вы-
дачи сигнала.
Более разумный подход к выдаче сигналов реализован в графических тер-
минальных системах (таких, как xterm). Многие из них позволяют включить
визуальные сигналы на уровне внешнего приложения, чтобы программа, тупо
выводящая ch г (7), была менее шумной.
15.8. Использование termios
627
См. также
Раздел «Quote и Quote-like Operators» в рег/ор(1); документация по стандартно-
му модулю Term::Сар.
15.8. Использование termios
Проблема
Вы хотите напрямую работать с характеристиками своего терминала.
Решение
Воспользуйтесь интерфейсом POSIX termios.
Комментарий
Представьте себе богатые возможности команды stty — можно задать все, от
служебных символов до управляющих комбинаций и перевода строки. Стан-
дартный модуль POSIX обеспечивает прямой доступ к низкоуровневому тер-
минальному интерфейсу и позволяет реализовать stty-подобные возможности
в вашей программе.
Программа из примера 15.2 показывает, какие управляющие символы исполь-
зуются вашим терминалом для стирания в предыдущей и текущей позиции кур-
сора (вероятно, это клавиши «забой» и Ctrl +U). Затем она присваивает им исто-
рические значения, # и @, и предлагает ввести какой-нибудь текст. В конце своей
работы программа восстанавливает исходные значения управляющих символов.
Пример 15.2. demo
# !/usr/Ыn/perl -w
# Демонстрация работы с интерфейсом POSIX termios
use POSIX qw(:termlos_h):
Sterm = POSIX::Term1os->new:
Sterm->getattr(f11eno(STDIN));
Serase = $term->getcc(VERASE);
Skill = $term->getcc(VKILL):
printf "Erase Is character £d, £s\n", Serase, uncontrol(chr(Serase));
printf "Kill Is character £d, %s\n", Skill, uncontrol(chr($k111));
$term->setcc(VERASE. ord( ’#')):
$term->setcc(VKILL, ordCO'));
Sterm->setattr(l, TCSANOW):
print("erase Is #, kill Is 0: type something: ");
Sline = <STDIN>:
print "You typed: Sline":
продолжение &
628
Глава 15. Интерактивность
Пример 15.2 (продолжение)
$term->setcc(VERASE. $erase);
$term->setcc(VKILL, Skill);
Sterm->setattr(l, TCSANOW);
sub uncontrol {
local $_ = shift;
s/(E\200-\377])/sprintf("М-Жс".ord(Sl) & 0177)/eg;
s/([\0-\37\177])/sprintf(,,A£c",ord($l) A 0100)/eg;
return
}
Приведенный ниже модуль HotKey реализует функцию readkey на Perl. Он не
обладает никакими преимуществами по сравнению с Term::ReadKey, а всего лишь
показывает интерфейс termios в действии:
# Hotkey.pm
package HotKey;
@ISA = qw(Exporter);
@EXPORT = qw(cbreak cooked readkey);
use strict;
use POSIX qw(:termios_h);
my (Sterm. Soterm. Secho. Snoecho. $fd_stdin);
$fd_stdin = fileno(STDIN);
Sterm = POSIX;:Termios->new();
$term->getattr($fd_stdin);
Soterm = $term->getlflag();
Secho = ECHO | ECHOK | ICANON;
Snoecho = Soterm & -Secho;
sub cbreak {
$term->setlflag($noecho); # Эхо-вывод не нужен
$term->setcc(VTIME. 1);
$term->setattr($fd_stdin, TCSANOW);
}
sub cooked {
$term->setlflag($oterm);
$term->setcc(VTIME. 0);
$term->setattr($fd_stdin. TCSANOW);
}
sub readkey {
my Skey e ;
cbreakO;
sysread(STDIN, Skey. 1);
cookedO;
return Skey;
}
END { cookedO }
1;
15.10. Ввод пароля
629
См. также
Документация по стандартному модулю POSIX; рецепт 15.6; рецепт 15.9.
15.9. Проверка наличия входных данных
Проблема
Требуется узнать, имеются ли необработанные входные данные, не выполняя
их фактического чтения.
Решение
Воспользуйтесь модулем CPAN Term::ReadKey и попытайтесь прочитать символ
в асинхронном режиме с аргументом -1:
use Term::ReadKey:
ReadMode ('cbreak'):
if (defined ($char = ReadKey(-l)) ) {
# Имеется необработанный ввод $char
} else {
# Необработанного ввода нет
}
ReadMode ('normal'): # Восстановить нормальные
# параметры терминала
Комментарий
Аргумент -1 функции ReadKey означает асинхронное чтение символа (то есть
чтение без блокировки). Если символа нет, ReadKey возвращает undef.
См. также
Документация по модулю CPAN Term::ReadKey; рецепт 15.6.
15.10. Ввод пароля
Проблема
Требуется прочитать данные с клавиатуры без эхо-вывода на экране. Например,
вы хотите прочитать пароль так, как это делает passwd, то есть без отображения
пароля пользователя.
630
Глава 15. Интерактивность
Решение
Воспользуйтесь модулем CPAN Term::ReadKey, установите режим ввода noecho,
после чего воспользуйтесь функцией ReadLlne:
use Term::ReadKey:
ReadMode 'noecho':
$password = ReadLlne 0:
Комментарий
Пример 15.3 показывает, как организовать проверку пароля пользователя. Если
в вашей системе используются скрытые пароли, getpwuld вернет зашифрован-
ный пароль лишь привилегированному пользователю. Всем остальным в соот-
ветствующем поле базы данных возвращается лишь * что совершенно бесполез-
но при проверке пароля.
Пример 15.3. checkuser
#!/usr/Ыn/perl -w
# checkuser - чтение и проверка пароля пользователя
use Term::ReadKey:
print "Enter your password: ":
ReadMode 'noecho':
$password = ReadLlne 0:
chomp Spassword:
ReadMode 'normal':
print "\n":
(Susername, Sencrypted) = ( getpwuld $< :
If (crypt($password. $encrypted) ne $encrypted) {
die "You are not $username\n";
} else {
print "Welcome. $username\n":
}
См. также
Документация по модулю CPAN Term::ReadKey; описания функций crypt и getpwuld
в perlfunc(V); страницы руководства crypt(3) npasswd(5) вашей системы (если есть).
15.11. Редактирование входных данных
Проблема
Вы хотите, чтобы пользователь мог отредактировать строку перед тем, как отсы-
лать ее вам для чтения.
15.11. Редактирование входных данных
631
Решение
Воспользуйтесь стандартной библиотекой Term::ReadLine в сочетании с модулем
CPAN Term::ReadLiне: :Gnu:
use Term::ReadLine:
Sterm = Term::ReadLine->new("APP DESCRIPTION"):
SOUT = $term->0UT || *STDOUT;
Sterm->addh1story($fake_11ne):
Sline = Sterm->readl1ne(PROMPT):
print SOUT "Any program output\n":
Комментарий
Программа из примера 15.4 работает как простейший командный интерпретатор.
Она читает строку и передает ее для выполнения. Метод readline читает строку
с терминала с поддержкой редактирования и вызова истории команд. Вводимая
пользователем строка автоматически включается в историю команд.
Пример 15.4. vbsh
#!/usr/Ыn/perl -w
# vbsh - очень плохой командный интерпретатор
use strict:
use Term::ReadL1ne;
use POSIX qw(:sys_wa1t_h);
my Sterm = Term::ReadLine->new("S1mple Shell"):
my SOUT = $term->0UT() || *STDOUT;
my Scmd:
while (defined (Scmd = Sterm->readl1ne('$ ') )) {
my Ooutput = 'Scmd':
my Sex1t_value = $? » 8:
my Ss1gnal_num = $? & 127:
my $dumped_core = $? & 128:
printf SOUT "Program terminated with status £d from signal №\n",
Sex1t_value, Ss1gnal_num,
$dumped_core ? " (core dumped)" : "":
print Ooutput:
Sterm->addh1story(Scmd):
}
Чтобы занести в историю команд свою строку, воспользуйтесь методом
addhlstory:
$term->addh1 story($seed_lIne):
В историю нельзя заносить больше одной строки за раз. Удаление строк из
истории команд выполняется методом remove_h1 story, которому передается
632
Глава 15. Интерактивность
индекс в списке истории. О соответствует первому (самому старому) элемен-
ту, 1 — второму и так далее до самых последних строк.
$term->removejiistory($line_number):
Для получения списка истории команд используется метод GetHi story:
©history = $term->GetH1story:
См. также
Документация по стандартному модулю Term: :ReadL1ne и модулю CPAN Term:
:ReadLlne::Gnu.
15.12. Управление экраном
Проблема
Вы хотите выделять символы повышенной интенсивностью, перехватывать на-
жатия специальных клавиш или выводить полноэкранные меню, не беспокоясь
о том, на каком устройстве вывода работает пользователь.
Решение
Воспользуйтесь модулем CPAN Curses, который использует библиотеку curses(3)
вашей системы.
Комментарий
Библиотека curses обеспечивает простое, эффективное и аппаратно-независимое
выполнение полноэкранных операций. С ее помощью можно писать высокоуров-
невый код вывода данных на логическом экране по символам или по строкам.
Чтобы результаты вывода появились на экране, вызовите функцию refresh. Вы-
вод, сгенерированный библиотекой, описывает только изменения виртуального
экрана с момента последнего вызова refresh. Это особенно существенно для
медленных подключений.
Работа с модулем Curses демонстрируется программой гер из примера 15.5.
При вызове ей передаются аргументы, описывающие командную строку запус-
каемой программы, как в любом из следующих случаев:
% rep ps aux
% rep netstat
% rep -2.5 Ipq
Сценарий rep в цикле вызывает команду и выводит ее данные на экран, обнов-
ляя лишь ту часть, которая изменилась с момента предыдущего запуска. Такой
вариант наиболее эффективен при малых изменениях между запусками. В правом
нижнем углу экрана выводится текущая дата в инвертированном изображении.
По умолчанию гер ожидает 10 секунд перед повторным запуском команды.
Чтобы изменить период задержки, передайте нужное количество секунд (допус-
кается дробное число) в качестве аргумента, как это было сделано выше при
15.12. Управление экраном
633
вызове Ipq. Кроме того, нажатие любой клавиши во время ожидания приводит
к немедленному выполнению команды.
Пример 15.5. гер
#!/usr/bin/perl -w
# rep - циклическое выполнение команды
use strict:
use Curses:
my Stimeout = 10:
if (OARGV && $ARGV[0] =~ Г-(\Ь+\.?\d*)$/) {
Stimeout = $1:
shift:
}
die "usage: $0 [ -timeout ] cmd args\n" unless @ARGV:
initscrO: # Инициализировать экран
noecho():
cbreak0:
nodelay(l): # Чтобы функция getchO выполнялась без блокировки
$SIG{INT} = sub { doneC'Ouch!") }:
sub done { endwinO: print "@_\n": exit: }
while (1) {
while ((my Skey = getchO) ne ERR) { # Возможен ввод
doneCSee ya") if Skey eq 'q' # нескольких символов
}
my @data = '(@ARGV) 2>&Г: # Вывод+ошибки
for (my Si = 0: Si < SEINES: $i++) {
addstr($i. 0. $data[$i] || ' ' x SCOLS):
}
standout 0:
addstr(SEINES-1, SCOLS - 24, scalar localtime):
standend():
move(O.O):
refreshO: # Обновить экран
my (Sin, Sout) = ( " , ''):
vec($in,fileno(STDIN),1) =1: # Искать символ в stdin
select($out = Sin,undef.undef.Stimeout):# Ожидание
}
С помощью Curses можно узнать, когда пользователь нажал клавишу со стрел-
кой или служебную клавишу (например, Ноше или Insert). Обычно это вызы-
вает затруднения, поскольку эти клавиши кодируются несколькими байтами.
С Curses все просто:
keypad(l): # Включить режим ввода
Skey = getchO: # с цифровой клавиатуры
if (Skey eq 'k' || # Режим vi
Skey eq "\cP" || # Режим emacs
Skey eq KEYJJP) # Стрелка
{
# Обработать клавишу
}
634
Глава 15. Интерактивность
Другие функции Curses позволяют читать текст в определенной позиции эк-
рана, управлять выделением символов и даже работать в нескольких окнах.
Модуль perl menu, также хранящийся в архиве CPAN, построен на базе низко-
уровневого модуля Curses. Он обеспечивает высокоуровневые операции с меню
и экранными формами. Приведем пример экранной формы из поставки perl menu:
Template Entry Demonstration
Address Data Example Record #______________________________________
Name: []
Addr: []
City: [] State: [_] Zip: [\\\\\]
Phone: (\\\) \\\-\\\\
Password: ]
Enter all information available.
Edit fields with left/right arrow heys or "delete".
Switch fields with "Tab" or up/down arrow keys.
Indicate completion by pressing "Return".
Refresh screen with "Control-L".
Abort this demo here with "Control-X".
Пользователь вводит текст в соответствующих полях. Обычный текст обо-
значается символами подчеркивания, числовые данные — символами \, а не-
отображаемые данные — символами \ Такие обозначения напоминают форматы
Perl, за исключением того, что формы предназначены для вывода, а не для ввода
данных.
См. также
Страница руководства curses(3) вашей системы (если есть); документация по мо-
дулям CPAN Curses и perlmenu; perlform(l); рецепт 3.10.
15.13. Управление другой программой
с помощью Expect
Проблема
Вы хотите автоматизировать процесс взаимодействия с полноэкранной програм-
мой, которая работает с терминалом, не ограничиваясь STDIN и STDOUT.
Решение
Воспользуйтесь модулем CPAN Expect:
use Expect:
Scommand = Expect->spawn("program to run")
or die "Couldn't start program: $!\n";
15.13. Управление другой программой с помощью Expect
635
# Запретить вывод программы в STDOUT
$command->log_stdout(0):
# 10 секунд подождать появления "Password:"
unless ($command->expect(10, "Password")) {
# Тайм-аут
}
# 20 секунд подождать вывода текста, совпадающего с /[ILJogin: ?/
unless ($command->expect(20, -re => '[ILJogin: ?')) {
# Тайм-аут
}
# Бесконечно долго ждать появления "invalid"
unless ($command->expect(undef. "invalid")) {
# Произошла ошибка: вероятно, работа программы нарушена
}
# Послать программе "Hello, world" и перевод строки
print Scommand "Hello, world\n":
# Если программа завершается сама, предоставить ей такую возможность
$command->soft_close():
# Если программа должна быть закрыта извне, завершить ее
$command->hard_close():
Комментарий
Для работы модуля Expect необходимы два других модуля из архива CPAN:
10:: Pty и I0:Stty. Expect создает псевдотерминал для взаимодействия с про-
граммами, которые непременно должны общаться с драйвером терминального
устройства. Такая возможность часто используется для изменения пароля в про-
грамме passwd. К числу других программ, для которых также необходим настоя-
щий терминал, принадлежат telnet (модуль Net::Telnet из рецепта 18.6 более
функционален и обладает улучшенной переносимостью) и ftp.
Запустите нужную программу методом Expect->spawn, передайте ей имя про-
граммы и аргументы либо в виде одной строки, либо в виде списка. Expect запус-
кает программу и возвращает либо представляющий ее объект, либо undef, если
запустить программу не удалось.
Для ожидания вывода программой конкретной строки применяется метод
expect. Его первый аргумент равен либо числу секунд, в течение которых ожида-
ется вывод строки, либо undef для бесконечного ожидания. Ожидаемая строка
передается во втором аргументе expect. Чтобы определить ее с помощью регу-
лярного выражения, передайте в качестве второго аргумента строку "-ге", а третье-
го — строку с шаблоном. Далее могут следовать другие строки или шаблоны:
Swhich = $command->expect(30. "invalid", "success", "error", "boom"):
if (Swhich) {
# Найдена одна из указанных строк
}
В скалярном контексте expect возвращает номер аргумента, для которого про-
изошло совпадение. В предыдущем примере expect вернет 1 при выдаче программой
636
Глава 15. Интерактивность
строки "Invalid", 2 — при выводе "success" и т. д. Если ни одна строка или шаб-
лон не совпали, expect возвращает false.
В списковом контексте expect возвращает список из пяти элементов. Первый
элемент определяет номер совпавшей строки или шаблона (идентично возвра-
щаемому значению в скалярном контексте). Второй элемент — строка с описа-
нием причины возврата из expect. При отсутствии ошибок второй аргумент ра-
вен undef. Возможные варианты ошибок: "LTIMEOUT", "2:E0F", "3: spawn id(...)
died" и "4:..." (смысл этих сообщений описан в документации Expect(3)). Тре-
тий элемент в возвращаемом списке expect равен совпавшей строке. Четвер-
тый элемент определяет текст до совпадения, а пятый — текст после совпадения.
Передача данных программе, находящейся под управлением expect, сводится
к простейшему вызову print. Единственная трудность состоит в том, что тер-
миналы, устройства и сокеты отличаются по тем последовательностям, которые
они передают и принимают в качестве разделителя строк, — мы покинули убежи-
ще стандартной библиотеки ввода/вывода С, поэтому автоматическое преобра-
зование в "\п" не происходит. Рекомендуем начать с "\г"; если не получится, по-
пробуйте "\п" и "\г\п".
После завершения работы с запущенной программой у вас есть три возмож-
ности. Во-первых, можно продолжить работу с главной программой; вероятно,
запущенная программа будет принудительно завершена по завершении главной
программы. Однако в этом случае плодятся лишние процессы. Во-вторых, если
запущенная программа должна нормально завершиться после вывода всех дан-
ных или по некоторому внешнему условию (как, например, tel net при выходе из
удаленного командного интерпретатора), вызовите метод soft_close. В-третьих,
если запущенная программа будет работать бесконечно (например, tail -f), вы-
зовите метод hard_close; он уничтожает запущенный процесс.
См. также
Документация по модулям CPAN Expect, 10: Pty и IO:Stty.
15.14. Создание меню с помощью Тк
Проблема
Требуется создать окно, в верхней части которого находится меню.
Решение
Воспользуйтесь элементами Tk Menubutton и Frame:
use Тк:
$main = MainWindow->new():
# Создать для меню горизонтальную область
# в верхней части окна.
15.14. Создание меню с помощью Тк
637
Smenubar = $main->Frame(-relief
-borderwidth
->pack (-anchor
-fill
=> "raised",
=> 2)
=> "nw",
=> "x"):
# Создать кнопку с надписью "File" для вызова меню.
$file_menu = $menubar->Menubutton(-text => "File",
-underline => 1)
->pack (-side => "left" );
# Создать команды меню "File"
$file_menu->command(-label => "Print".
-command => \&Print):
To же самое можно сделать намного проще, если воспользоваться сокращен-
ной записью -menuitems:
$file_menu = $menubar->Menubutton(-text => "File".
-underline => 1,
-menuitems => [
[ Button => "Print",-command => \&Print ].
[ Button => "Save",-command => \&Save ] ])
->pack(-side => "left");
Комментарий
Меню приложения можно рассматривать как совокупность четырех совместно
работающих компонентов: области (Frame), кнопок меню (Menubutton), меню
(Menus) и команд меню (Menu Entries). Область представляет собой горизон-
тальную полосу в верхней части окна, в котором находится меню. Внутри об-
ласти находится набор кнопок меню, открывающих различные меню: File, Edit,
Format, Buffers и т. д. Когда пользователь щелкает на кнопке меню, на экране по-
является соответствующее меню — вертикальный список команд.
В меню также могут включаться разделители — горизонтальные линии, отде-
ляющие один набор команд от другого.
С командами (например, Print в меню File) ассоциируются фрагменты кода.
При выборе команды меню вызывается соответствующая функция. Обычно это
делается так:
$filejnenu->command(-label => "Quit Immediately",
-command => sub { exit } );
С разделителями действия не связываются:
$file_menu->separator();
Команд а-флажок может находиться в установленном (on) или сброшенном
(off) состоянии, и с ней ассоциируется некоторая переменная. Если переменная
находится в установленном состоянии, рядом с текстом команды-флажка стоит
специальная пометка (маркер). Если переменная сброшена, маркер отсутствует. При
выборе команды-флажка переменная переходит в противоположное состояние.
$options_menu->checkbutton(-label => "Create Debugging File",
-variable => \$debug,
-onvalue => 1,
-offvalue => 0);
638
Глава 15. Интерактивность
Группа команд-переключателей ассоциируется с одной переменной. В любой
момент времени установленной может быть лишь одна команда-переключатель,
ассоциированная с переменной. При выборе команды-переключателя перемен-
ной присваивается ассоциированное значение:
$debug_menu->radiobutton(-label => "Level 1".
-variable => \$log_level.
-value => 1):
$debug_menu->radiobutton(-label => "Level 2",
-variable => \$log_level.
-value => 2);
$debug_menu->radiobutton(-label => "Level 3".
-variable => \$log_level,
-value => 3);
Вложенные меню создаются с помощью каскадных команд. Например, в Net-
scape Navigator кнопка меню File содержит каскадную команду New, которая откры-
вает подменю с несколькими вариантами. Создать каскадную команду сложнее,
чем любую другую: вы должны создать каскадную команду, получить ассоции-
рованное с ней новое меню и создать команды в этом меню.
# Шаг 1: создать каскадную команду меню
$format_menu->cascade (-label => "Font");
# Шаг 2: получить только что созданное меню
$font_menu = $format_menu->cget("-menu");
# Шаг 3: заполнить зто меню
$font_menu->radiobutton (-label => "Courier".
-variable => \$font_name.
-value => "courier");
$font_menu->radiobutton (-label => "Times Roman".
-variable => \$font_name.
-value => "times");
Отсоединяемый разделитель позволяет перемещать меню, в котором он нахо-
дится. По умолчанию все кнопки меню и каскадные команды открывают меню,
в верхней части которого находится отсоединяемый разделитель. Чтобы создать
меню без него, воспользуйтесь параметром -tearoff:
$format_menu = $menubar->Menubutton(-text => "Format".
-underline => 1
-tearoff => 0)
->pack;
$font_menu = $format_menu->cascade(-label => "Font".
-tearoff => 0):
Параметр -menuitems метода Menubutton представляет собой сокращенную фор-
му для создания команд меню. В нем передается ссылка на массив с описаниями
команд Menubutton. В свою очередь, каждая команда описывается анонимным мае-
15.15. Создание диалоговых окон с помощью Тк
639
сивом. Первые два элемента массива команды определяют тип кнопки ("command",
"radiobutton", "checkbutton", "cascade" или "tearoff") и название меню.
my $f = $menubar->Menubutton(-text => "File", -underline => 0,
-menuitems =>
[
[Button => 'Copy'. -command => \&ed1t_copy L
[Button => 'Cut'. -command => \&ed1t_cut ].
[Button => 'Paste'. -command => \&ed1t_paste ].
[Button => 'Delete'. -command => \&ed1t_delete ].
[Separator => ''].
[Cascade => 'Object -tearoff => 0.
-menuitems => [
[ Button => "Circle", -command => \&ed1t_c1rcle ].
[ Button => "Square", -command => \&ed1t_square ].
[ Button => "Point". -command => \&ed1t_po1nt ] ] ].
])->gr1d(-row => 0. -column => 0. -sticky => 'w');
См. также
Документация по модулю CPAN Tk.
15.15. Создание диалоговых
окон с помощью Тк
Проблема
Требуется создать диалоговое окно, то есть новое окно верхнего уровня с кнопками
для его закрытия. Диалоговое окно также может содержать другие элементы —
например, надписи и текстовые поля для ввода информации. Например, в диало-
говом окне можно ввести регистрационные данные и закрыть его после переда-
чи сведений или в том случае, если пользователь не захочет регистрироваться.
Решение
В простых случаях воспользуйтесь элементом Tk::DIalogBox:
use Тк::D1alogBox;
Sdlalog = $ma1n->D1alogBox( -title => "Register This Program",
-buttons => [ "Register". "Cancel" ] );
# Добавьте элементы в диалоговое окно методом $d1alog->Add()
# Позднее, когда понадобится отобразить диалоговое окно
$button = $d1alog->Show();
If ($button eq "Register") {
# ...
} elsif ($button eq "Cancel") {
# ...
} else {
# Такого быть не должно
}
640
Глава 15. Интерактивность
Комментарий
Диалоговое окно состоит из набора кнопок (в нижней части) и произвольных
элементов (в верхней части). Вызов Show отображает диалоговое окно на экране
и возвращает кнопку, выбранную пользователем.
В примере 15.6 приведена полная программа, демонстрирующая принципы
работы с диалоговыми окнами.
Пример 15.6. tksample3
# !/usr/Ыn/perl -w
# tksample3 - работа с диалоговыми окнами
use Тк;
use Тк::DI alogBox;
Smaln = MainW1ndow->new();
Sdlalog = Sma1n->D1alogBox( -title => "Register",
-buttons => [ "Register", "Cancel" ],
):
# В верхней части окна пользователь вводит имя, при зтом
# надпись (Label) действует как подсказка.
$d1alog->add("Label". -text => "Name")->pack():
Sentry = $d1alog->add("Entry", -width => 35)->pack();
# Диалоговое окно вызывается кнопкой
Smaln->Button( -text => "Click Here For Registration Form",
-command => \®1ster) ->pack(-s1de => "left"):
Smaln->Button( -text => "Quit",
-command => sub { exit } ) ->pack(-s1de => "left"):
MalnLoop:
#
# register
#
# Вызывает диалоговое окно регистрации.
#
sub register {
my Sbutton:
my Sdone = 0:
do {
# Отобразить диалоговое окно.
Sbutton = Sd1alog->Show:
# Действовать в зависимости от того, какая кнопка была нажата.
If (Sbutton eq "Register") {
my Sname = $entry->get:
If (deflned(Sname) && length(Sname)) {
print "Welcome to the fold, $name\n";
Sdone = 1:
} else {
15.15. Создание диалоговых окон с помощью Тк
641
print "You didn’t give me your name!\n":
}
} else {
print "Sorry you decided not to register An":
$done = 1;
}
} until $done:
}
В верхней части диалогового окна расположены два элемента: надпись и тек-
стовое поле. Для ввода дополнительной информации понадобятся другие надпи-
си и текстовые поля.
Диалоговые окна часто применяются для вывода предупреждений или со-
общений об ошибках. Пример 15.7 показывает, как вывести в диалоговом окне
результаты вызова функции warn.
Пример 15.7. tksample4
# !/usr/bin/perl -w
# tksample4 - диалоговые окна для предупреждений
use Tk:
use Tk::DialogBox:
my $main;
# Создать обработчик предупреждений, который отображает
# предупреждение в диалоговом окне Тк
BEGIN {
$SIG{_WARN_J = sub {
if (defined $main) {
my Sdialog = $main->DialogBox( -title => "Warning",
-buttons => [ "Acknowledge" ]);
$dialog->add("Label", -text => $_[0])->pack:
$dialog->Show:
} else {
print STDOUT join("\n". @_). "n":
}
}:
}
# Команды вашей программы
$main = MainWindow->new():
$main->Button( -text => "Make A Warning",
-command => \&make_warning) ->pack(-side => "left"):
$main->Button( -text => "Quit",
-command => sub { exit } ) ->pack(-side => "left"):
MainLoop:
# Фиктивная подпрограмма для выдачи предупреждения
sub make_warning {
my $a:
my $b = 2 * $a:
}
642
Глава 15. Интерактивность
См. также
Страница руководства Tk: :D1 alogBox в документации по модулю CPAN Tk; стра-
ница руководства тепи(п) (если она есть).
15.16. Обработка событий
масштабирования в Тк
Проблема
Вы написали программу на базе Тк, но при изменении размеров окна пользова-
телем нарушается взаимное расположение элементов.
Решение
Перехватывая событие Configure, можно запретить пользователю изменять раз-
меры окна:
use Tk:
Smaln = Ma1nW1ndow->new();
$ma1n->b1nd(’<Conf1gure>' => sub {
$xe = $main->XEvent:
Sma1n->maxs1ze($xe->w, $xe->h):
$ma1n->m1ns1ze($xe->w. $xe->h):
}):
Кроме того, можно определить особенности масштабирования элементов при
изменении размеров контейнера с помощью метода pack:
$w1dget->pack( -fill => "both", -expand => 1 ):
$widget->pack( -fill => "x", -expand => 1 ):
Комментарий
По умолчанию упакованные элементы изменяют размеры вместе с контейне-
ром — они не масштабируют себя или свое содержимое в соответствии с новым
размером. В результате между элементами возникают пустые места, а их содер-
жимое обрезается или искажается.
Первое решение — вообще запретить изменение размеров. Мы перехватыва-
ем событие <Conf1gure>, которое возникает при изменении размера или положе-
ния элемента, и регистрируем функцию обратного вызова (callback) для восста-
новления прежнего размера окна. Именно так обеспечивается фиксированный
размер окон с сообщениями об ошибках.
Иногда запрещать изменение размеров окна нежелательно; в этом случае
необходимо определить, как каждый элемент должен реагировать на измене-
ния. Для этого используются аргументы метода pack: -fill управляет той обла-
стью, внутри которой должен находиться элемент, a -expand говорит о том, дол-
15.17. Удаление окна сеанса DOS в Perl/Tk для Windows
643
жен ли элемент изменять свой размер для заполнения доступного места. Параметр
-expand принимает логические значения, true или false. Строковый параметр -fill
обозначает оси, по которым может изменяться размер элемента: "х", "у", "both"
или "попе".
Для правильной работы необходимы оба параметра: -expand без -fill не узна-
ет, в какой области должен увеличиваться элемент, a -fill без -expand захватит
область нужного размера, но сохранит прежние размеры.
Разные части вашего приложения ведут себя по-разному. Например, главная
область браузера при изменении размера окна, вероятно, должна изменить свои
размеры в обоих направлениях. Метод pack для такого элемента выглядит так:
$ma1narea->pack( -fill => "both", -expand => 1);
Однако меню, расположенное над главной областью, должно расширяться по
горизонтали, а не по вертикали:
$menubar->pack( -fill => "х". -expand => 1 ):
С изменением размеров связана и другая задача — закрепление элементов в
определенной точке контейнера. Например, полоса меню закрепляется в левом
верхнем углу контейнера следующим образом:
$menubar->pack (-fill => "х".
-expand => 1.
-anchor => "nw" );
Теперь при изменении размеров окна меню останется на своем месте и не бу-
дет выровнено по центру пустой области.
См. также
Страницы руководства pack(n), XEvent(3) и XConfigureEvent(3) (если есть).
15.17. Удаление окна сеанса DOS в Perl/Tk
для Windows
Проблема
Вы написали программу для Windows-версии Perl и Тк, однако при каждом за-
пуске программы открывается окно DOS-сеанса.
Решение
Включите следующий фрагмент в начало программы:
BEGIN {
if ($А0 eq ’MSW1n32') {
require Win32::Console;
Win32::Console::Free();
}
}
644
Глава 15. Интерактивность
Комментарий
Модуль Win32::Console позволяет управлять терминальным окном, запустившим
вашу программу. В нашем примере окно просто закрывается (или освобождает-
ся в странной терминологии Windows API).
См. также
Документация по модулю Win32::Console, входящая в поставки Perl для систем
Microsoft.
15.18. Построение диаграмм
Проблема
Имеются числовые данные, которые требуется представить в виде гистограммы,
круговой или линейчатой диаграммы.
Решение
Воспользуйтесь модулями CPAN GD::Graph: :* :
use GD::Graph::1ines: # Линейчатые, точечные, круговые диаграммы.
# гистограммы.
$chart = GD::Graph::1ines->new(480.320):
$chart->set(x_label => $X_AXIS_LABEL, # На круговой диаграмме
y_label => $Y_AXIS_LABEL, # оси отсутствуют
title => $GRAPH_TITLE,
# ... Также возможны другие параметры
):
$plot = $chart->plot($DATA_REF) or die $chart->error:
# Дальнейшая обработка $plot->png (изображение в формате PNG)
Пример структуры данных (количество значений в строках должно совпадать):
$DATA_REF = [
[ 1990. 1992, 1993, 1995, 2002 L
[ 10. 15. 18. 20. 25 L
[ 9, undef,17. undef.12 L
# ...
# Значения оси X
# Первый набор данных
# Второй набор данных
Комментарий
Для работы модуля GD::Graph должен быть установлен модуль GD, который, в свою
очередь, зависит от библиотеки С, доступной по адресу http://www/boutell .сот/
gd/. Ранние версии библиотеки создавали изображения в формате GIF, но из-за
последних трудностей с держателями патента GIF библиотека теперь выдает
изображения в форматах PNG и JPEG:
$png_data = $plot->png:
$jpg_data = $plot->jpeg:
15.19. Создание миниатюр
645
В документации GD:: Graph перечислены многочисленные параметры для на-
стройки изображения (цвета, шрифты, расположение), но самыми важными па-
раметрами являются надписи на осях и заголовок изображения. В круговых диа-
граммах надписи на осях не используются, поэтому параметры x_label и у_1 abel
недоступны. По умолчанию круговые диаграммы рисуются в псевдообъемном
виде, однако этот вид можно отключить, присвоив параметру 3d значение false.
В рецепте 15.23 приведена программа, которая (весьма упрощенно) извлека-
ет день недели из всех отправленных почтовых сообщений и затем отображает
распределение сообщений по дням в графическом виде.
См. также
Документация по модулям GD и GD::Graph.
15.19. Создание миниатюр
Проблема
Имеется большое графическое изображение. Требуется создать уменьшенную вер-
сию этого изображения, или миниатюру (thumbnail). Например, на веб-сайтах ми-
ниатюры часто используются для предварительного просмотра изображений, что-
бы пользователь мог решить, пожелает ли он загрузить более крупный оригинал.
Решение
Воспользуйтесь модулем CPAN Image:: Magick:
use Image::Magick:
Simage = Image::Magick->new( ):
$image->Read($ORIGINAL_FILENAME);
$1mage->Resize(geometry => '120x90'):
$1mage->Wr1te($THUMBNAIL_FILENAME):
Комментарий
Модуль Image::Magick обеспечивает интерфейс к программному пакету Image-
Magick, доступному по адресу http://1magemagick.sourceforge.net. Пакет выпол-
няет множество сложных и нетривиальных операций с графическими изображе-
ниями, но в данном случае нас интересует простейшее масштабирование.
Размеры нового изображения определяются параметром geometry метода Resize
в формате ширинахвысота. Также масштаб нового изображения может задаваться
в процентах: например, при масштабе ' 75%' изображение пропорционально умень-
шается до 3/4 исходного размера, а при масштабе ' 10%х30%' изображение сжима-
ется до 10 % исходного значения по оси X и до 30 % исходного значения по оси Y.
Вы можете выбрать тип фильтра и степень размывки/резкости изображения:
$1mage->Res1ze(geometry => '120x90',
filter => 'Gaussian',
blur => 2):
646
Глава 15. Интерактивность
Если значение blur больше 1, происходит размывка изображения, а если
меньше 1 — повышается резкость. Поддерживаются следующие фильтры: Point,
Box, Triangle, Hermite, Hanning, Hamming, Blackman, Gaussian, Quadratic, Cubic, Catrom,
Mitchell, Lanczos, Bessel и Sine.
См. также
Документация по модулям Image: -.Magick.
15.20. Включение текста в изображение
Проблема
Требуется записать текст в существующее изображение (например, вы хотите
поместить небольшое сообщение с информацией об авторских правах на все фо-
тографии, находящиеся на сайте).
Решение
Воспользуйтесь модулем CPAN GD:
use GD:
Slmage = GD::Image->new($FILENAME);
Sblue = $1mage->colorAllocate(0.0,255):
$1mage->str1ng(gdT1nyFont. 10. 10. "Copyright Me. 2037". $blue):
# write $1mage->png() to file
Комментарий
Модуль GD поддерживает не все форматы графических файлов. Все зависит от
того, какие библиотеки С были доступны во время построения базовой библио-
теки С модуля GD. На момент написания книги модуль GD позволял читать и запи-
сывать данные в форматах PNG, JPEG, ХВМ, ХРМ и WBMP (Windows Bitmap),
а также собственные форматы GD2 и GD.
Метод string вызывается со следующими аргументами: шрифт, координаты
начала вывода, выводимая строка и цвет выводимого текста.
В GD включена поддержка пяти шрифтов: gdTinyFont, gdSmal 1 Font, gdMedi umBol dFont,
gdLargeFont и gdGiantFont. Если модуль GD был откомпилирован для работы со
шрифтами TrueType, возможен вывод шрифтов TrueType в формате
$1mage->str1ngFT($color. $font, Spo1nt_s1ze, $angle. $x, $y. Sstrlng):
Здесь $font — абсолютное имя файла .ttf, содержащего шрифт TrueType.
Параметры $point_size и Sangle определяют размер шрифта в пунктах (допуска-
ются дробные значения) и угол поворота (в радианах). Пример:
$1mage->str1ngFT($blue. ’/Users/gnat/fonts/arlal.ttf', 8. 0.
10. 20. 'Copyright Me Me Me'):
15.21. Программа: tcapdemo
647
См. также
Документация по модулю GD.
15.21. Программа: tcapdemo
Описание
Следующая программа очищает экран и рисует на нем до тех пор, пока не будет
прервана. Она показывает, как использовать модуль Term::Сар для очистки экра-
на, перемещения курсора и записи в любую позицию экрана. В ней также ис-
пользуется рецепт 16.6.
Исходный текст программы приведен в примере 15.8.
Пример 15.8. tcapdemo
# !/usr/Ыn/perl -w
# tcapdemo - прямое позиционирование курсора
use POSIX;
use Term::Cap:
InItO; # Инициализация Term::Cap.
zipO: # Рисование линий на экране.
finishO; # Последующая очистка.
exitO:
# Две вспомогательные функции. Смысл clear_screen очевиден, а
# clear_end очищает до конца экрана.
sub clear_screen { $tcap->Tputs(’cl’. 1. *STD0UT) }
sub clear_end { $tcap->Tputs(’cd’, 1. *STDOUT) }
# Переместить курсор в конкретную позицию,
sub gotoxy {
my($x. $y) =
$tcap->Tgoto('em'. $x. $y, *STDOUT):
}
# Определить скорость терминала через модуль POSIX и использовать
# для инициализации Term::Cap.
sub Inlt {
$| = 1:
$delay = (shiftO || 0) * 0.005;
my Stermios = POSIX::Termi os->new();
$termios->getattr:
my Sospeed = $termios->getospeed;
Stcap = Term::Cap->Tgetent ({ TERM => undef. OSPEED => Sospeed });
$tcap->Trequire(qw(cl cm cd));
}
# Рисовать линии на экране, пока пользователь
# не нажмет Ctrl-С. _
продолжение &
648
Глава 15. Интерактивность
Пример 15.8 (продолжение)
sub zip {
clear_screen():
($maxrow, $maxcol) = ($tcap->{_11} - 1. $tcap->{_co} - 1):
@chars = qw(* - / | \ _ );
sub circle { push(@chars, shift @chars): }
$1 interrupted = 0;
$SIG{INT} = sub { ++$1 interrupted };
$col = $row = 0:
($row_sign, $col_sign) = (1,1):
do {
gotoxy($col. $row);
print $chars[0];
select(undef. undef, undef. $delay):
$row += $row_sign:
$col += $col_sign:
if ($row == $maxrow) { $row_sign = -1: circle; }
elslf ($row == 0 ) { $row_sign = +1: circle: }
if ($col == $maxcol) { $col_sign = -1: circle: }
elslf ($col == 0 ) { $col_sign = +1: circle: }
} until Sinterrupted;
}
# Очистить экран.
sub finish {
gotoxy(0, $maxrow):
clear_end():
}
Вот как выглядит экран во время работы программы:
15.22. Программа: tkshufflepod
649
См. также
Страница руководства termcap(5) (если есть); документация по стандартному
модулю Term::Сар.
15.22. Программа: tkshufflepod
Эта короткая программа с помощью Тк выводит список всех заголовков =headl
в файле и позволяет изменить порядок их следования перетаскиванием. Клави-
ша "s" сохраняет изменения, a "q" завершает программу. Двойной щелчок на
элементе списка выводит его содержимое в элементе Pod. Текст раздела запи-
сывается во временный файл, находящийся в каталоге /tmp; файл удаляется при
уничтожении элемента Pod.
При запуске программе передается имя просматриваемого pod-файла:
% tkshufflepod chapl5.pod
Мы часто использовали эту программу при работе над книгой.
Исходный текст программы приведен в примере 15.9.
Пример 15.9. tkshufflepod
# !/usr/Ыn/perl -w
# tkshufflepod - изменение порядка разделов =headl в pod-файле
use Tk:
use Tk::Pod:
use strict:
# Объявление переменных
my Spodflle: # Имя открываемого файла
my Sm; # Главное окно
my $1: # Элемент Listbox
my (Sup. Sdown): # Позиции для перемещения
my ^sections: # Список разделов pod
my $all_pod: # Текст pod-файла (используется при чтении)
# Прочитать pod-файл в память и разбить его на разделы.
Spodflle = shift || "-":
undef $/:
open(F, " < Spodflle")
or die "Can't open Spodflle : $!\n":
$all_pod = <F>:
close(F):
^sections = spl1t(/(?==headl)/, $all_pod):
# Превратить ^sections в массив анонимных массивов. Первый элемент
# каждого массива содержит исходный текст сообщения, а второй -
# текст, следующий за =headl (заголовок раздела).
продолжение
650
Глава 15. Интерактивность
Пример 15.9 (продолжение)
foreach (^sections) {
/(.*)/:
$_ = L $_. $1 ]:
}
# Запустить Tk и вывести список разделов.
$m = Ma1nW1ndow->new():
$1 = $m->L1stbox('-width' => 60)->pack('-expand' => 1. '-fill' => 'both');
foreach my Ssectlon (^sections) {
$1->1nsert("end". Ssect1on->[1]):
}
# Разрешить перетаскивание для элемента Listbox.
$l->b1nd( '<Any-Button>' => \&down ):
$1->b1nd( '<Any-ButtonRelease>' => \&up ):
# Разрешить просмотр при двойном щелчке
$1->b1nd( '<Double-Button>' => \&v1ew ):
# 'q' завершает программу, a 's' сохраняет изменения.
Sm->b1nd( '<q>' => sub { exit } ):
$m->b1nd( ' <s>' => \&save ):
MalnLoop:
# down(wldget): вызывается, когда пользователь щелкает в Listbox.
sub down {
my Sself = shift:
Sdown = Sself->curselect1on;:
}
# up(wldget): вызывается, когда пользователь отпускает
# кнопку мыши в Listbox.
sub up {
my Sself = shift:
my Self;
Sup = $self->curselect1on::
return If Sdown == Sup;
# change selection list
Selt = SsectlonsESdown]:
sp!1ce(@sect1ons. Sdown, 1):
sp!1ce(@sect1ons. Sup. 0. Selt);
$self->delete($down);
Sself->1nsert(Sup. Ssect1onsE$up]->El]):
15.23. Программа: graphbox
651
# save(wldget): сохранение списка разделов.
sub save {
my Sself = shift;
open(F, "> Spodflle")
or die "Can’t open $podf11e for writing; $!";
print F map { $_->L0] } ^sections;
close F;
exit;
}
# vlew(wldget): вывод раздела. Использует элемент Pod.
sub view {
my Sself = shift;
my Stemporary = "/tmp/$$-sect1on.pod";
my Spopup:
open(F, "> Stemporary")
or warn ("Can't open Stemporary : $!\n"), return;
print F Ssect1onsL$down]->L0]:
close(F);
Spopup = $m->Pod('-file* => Stemporary);
Spopup->b1nd('<Destroy>' => sub { unlink Stemporary } );
}
15.23. Программа: graphbox
Программа graphbox (см. пример 15.10) строит гистограмму с распределением
количества отправленных почтовых сообщений по дням недели. Гистограмма стро-
ится при помощи модуля GD::Graph: :Bars (см. рецепт 15.18). Программа извлекает
дни недели из заголовков Date: и затем отображает результаты.
Пример 15.10. graphbox
graphbox
# !/usr/Ыn/perl -w
# graphbox - построение гистограммы с распределением количества
# отправленных сообщений электронной почты по дням недели
use GD::Graph:;bars;
use Getopt::Std:
use strict;
my Scount: # Накапливаемое количество сообщений по дням недели
my Schart; # Объект GD::Graph::bars
my Splot: # Объект GD с диаграммой
my ©DAYS = qw(Mon Tue Wed Thu Frl Sat Sun);
my $day_re = jo1n("|". @DAYS):
продолжение &
652
Глава 15. Интерактивность
Пример 15.9 (продолжение)
$day_re = qr/$day_re/:
# Обработка параметров
my Wpt:
getopts(’ho: ’, \Wpt):
if ($Opt{h) or !$Opt{o}) {
die "Usage:\n\t$0 -o outfile.png < mailbox\n";
}
# Извлечение дат из заголовков Date (неточное!)
while (<>) {
if (/4)ate: .*($day_re)/) {
$count{$l}++:
}
}
# Построение гистограммы
Schart = GD::Graph::bars->new(480.320):
$chart->set(x_label => "Day".
y_label => "Messages".
title => "Mail Activity"):
Splot = $chart->plot([ [ @DAYS ].
[ @count{@DAYS} ].
1):
# Сохранение гистограммы
open(F. "> $0pt{o}")
or die "Can't open $Opt{o} for writing: $!\n";
print F $plot->png:
close F:
и межпроцессные
взаимодействия
16.0. Введение
Многие из нас относятся к Perl по-своему, но большинство считает его чем-то
вроде «клея», объединяющего разнородные компоненты. Эта глава посвящена
командам и отдельным процессам — их созданию, взаимодействию и заверше-
нию. Итак, речь пойдет о системном программировании.
В области системного программирования на Perl, как обычно, все простое уп-
рощается, а все сложное становится доступным. Если вы хотите работать на вы-
соком уровне, Perl с радостью вам поможет. Если вы собираетесь закатать рука-
ва и заняться низкоуровневым программированием, уподобившись хакерам С, —
что ж, возможно и это.
Perl позволяет очень близко подобраться к системе, но при этом могут воз-
никнуть некоторые проблемы переносимости. Из всей книги эта глава в наиболь-
шей степени ориентирована на Unix. Изложенный материал чрезвычайно полезен
для тех, кто работает в Unix-системах, и в меньшей степени — для всех осталь-
ных (если вы не работаете в Unix, обратитесь к странице руководства perlport(3)
и проверьте, какие из описанных в книге приемов поддерживаются в других
системах или эмулируются Perl). Возможности, рассматриваемые в этой главе,
не являются универсальными, как, например, строки, числа или базовая ариф-
метика. Большинство базовых операций более или менее одинаково работает
повсюду. Но если вы не работаете в системе семейства Unix или другой POSIX-
совместимой системе, многие интересные возможности у вас будут работать
иначе (или не будут работать вообще). В сомнительных ситуациях обращайтесь
к документации, прилагаемой к вашей версии Perl.
Иногда вас даже могут ожидать приятные сюрпризы. Например, пользова-
тели Windows часто с большим удивлением узнают, что функция Perl fork,
которая долгое время оставалась уникальной для Unix, поддерживается и на их
платформе. См. perlfork(V).
654
Глава 16. Управление процессами и межпроцессные взаимодействия
Создание процессов
В этой главе рассматриваются порожденные процессы. Иногда вы просто вы-
полняете автономную команду (с помощью system) и оставляете созданный про-
цесс на произвол судьбы. В других случаях приходится сохранять тесную связь
с созданным процессом, скармливать ему тщательно отфильтрованные данные
или управлять его потоком вывода и конвейерные вызовы open). Наконец,
даже без запуска нового процесса вызов ехес позволяет заменить текущую про-
грамму чем-то совершенно новым.
Сначала мы рассмотрим самые переносимые и распространенные операции
управления процессами: \..4, system, open и операции с хэшем %SIG. Здесь нет ни-
чего сложного, но мы не остановимся на этом и покажем, что делать, когда про-
стые решения не подходят.
Допустим, вы хотите прервать свою программу в тот момент, когда она за-
пустила другую программу. Или вам захотелось отделить стандартный поток
ошибок порожденного процесса от его стандартного вывода. Или вы собирае-
тесь одновременно управлять как вводом, так и выводом программы. Или вы
решили воспользоваться преимуществами многозадачности и разбить свою про-
грамму на несколько одновременно работающих процессов, взаимодействующих
друг с другом.
В подобных ситуациях приходится обращаться к системным функциям pl ре,
fork и ехес. Функция pipe создает два взаимосвязанных манипулятора, записы-
вающий и читающий; при этом все данные, записываемые в первый, могут быть
прочитаны из первого. Функция fork является основой многозадачности, но, к со-
жалению, она не поддерживается некоторыми системами, не входящими в семей-
ство Unix. Функция создает процесс-дубликат, который практически во всех отно-
шениях идентичен своему родителю, включая значения переменных и открытые
файлы. Самые заметные изменения — идентификатор процесса и идентифика-
тор родительского процесса. Новые программы запускаются функцией fork,
после чего функция ехес заменяет программу порожденного процесса чем-то
другим. Функции fork и ехес не всегда используются вместе, поэтому наличие
отдельных примитивов оказывается более выразительным и мощным по сравне-
нию с ситуацией, когда ваши возможности ограничиваются выполнением system.
На практике fork по отдельности используется чаще, чем с ехес.
При уничтожении порожденного процесса его память возвращается операци-
онной системе, но соответствующий элемент таблицы процессов не освобожда-
ется. Благодаря этому родитель может проверить статус завершения всех поро-
жденных процессов. Процессы, которые умерли, но не были удалены из таблицы
процессов, называются зомби; их следует своевременно удалять, чтобы они не
заполнили всю таблицу процессов. Оператор а также функции system и open
автоматически следят за этим и работают в большинстве систем, не входящих
в семейство Unix. При выходе за рамки этих простых переносимых функций
и запуске программ с помощью низкоуровневых примитивов возникают допол-
нительные хлопоты. Кроме того, не стоит забывать и о сигналах.
Сигналы
Ваш процесс узнает о смерти созданного им порожденного процесса с помощью
сигнала. Сигналы представляют собой нечто вроде оповещений, доставляемых
16.0. Введение
655
операционной системой. Они сообщают о происшедших ошибках (когда ядро
говорит: «Не трогай эту область памяти!») и событиях (смерть порожденного
процесса, тайм-аут процесса, прерывание по Ctrl +0). При ручном запуске про-
цесса обычно указывается подпрограмма, которая должна вызываться при завер-
шении потомка.
Каждый процесс имеет стандартные обработчики для всех возможных сиг-
налов. Вы можете установить свой собственный обработчик или изменить от-
ношение программы к большинству сигналов. Не изменяются только SIGKILL
и SIGTOP, все остальные сигналы можно игнорировать, перехватывать и блоки-
ровать.
Приведем краткую сводку важнейших сигналов:
SIGINT
Обычно возникает при нажатии Ctrl+C. Требует, чтобы процесс завершил
свою работу. Простые программы (например, фильтры) обычно просто аварий-
но завершаются, но более сложные программы — командные интерпретаторы,
редакторы и программы FTP — часто используют SIGINT для прерывания затя-
нувшихся операций.
SIGQUIT
Обычно генерируется терминалом, как правило при нажатии Ctrl +\. По умол-
чанию выводит в файл содержимое памяти.
SIGTERM
Посылается командой kill при отсутствии явно заданного имени сигнала.
Может рассматриваться как вежливая просьба умереть, адресованная процессу.
SIGUSR1 и SIGUSR2
Никогда не вызываются системными событиями, поэтому пользовательские
приложения могут смело использовать их для собственных целей.
SIGPIPE
Посылается ядром, когда ваш процесс пытается записать в канал (pipe) или
сокет, а процесс на другом конце канала/сокета отсоединился (обычно потому,
что он перестал существовать).
SIGALRM
Посылается по истечении промежутка времени, установленного функцией
alarm (см. рецепт 16.21).
SIGHUP
Посылается процессу при разрыве связи (hang-up) на управляющем тер-
минале (например, при потере несущей модемом), но также часто означает,
что программа должна перезапуститься или заново прочитать свою конфигу-
рацию.
656
Глава 16. Управление процессами и межпроцессные взаимодействия
SIGCHLD
Вероятно, самый важный сигнал во всем низкоуровневом системном про-
граммировании. Система посылает процессу сигнал SIGSHLD в том случае, если
один из его порожденных процессов перестает выполняться, или, что более
вероятно, при его завершении. Дополнительные сведения о SIGCHLD приведены
в рецепте 16.19.
Имена сигналов существуют лишь для удобства программистов. С каждым
сигналом связано определенное число, используемое операционной системой
вместо имени. Хотя мы говорим о сигнале SIGCHLD, операционная система опозна-
ет его по номеру, например, 20 (в зависимости от операционной системы). Perl
преобразует номера сигналов в имена, поэтому вы можете работать с именами
сигналов.
Обработка сигналов рассматривается в рецептах 16.15, 16.7, 16.21, 16.18 и 16.20.
16.1. Получение вывода от программы
Проблема
Требуется запустить программу и сохранить ее вывод в переменной.
Решение
Воспользуйтесь либо оператором
Soutput = 'program args': # Сохранение данных в одной
# многострочной переменной.
^output = ' program args ': # Сохранение данных в массиве.
# по одной строке на элемент.
либо решением из рецепта 16.4:
open(my $fh. , "program", @args)
or die "Can't run program: $!\n";
while (<$fh>) {
Soutput .= $_:
}
close Sfh;
Комментарий
Оператор '...' является удобным средством для запуска других программ и по-
лучения их выходных данных. Возврат из него происходит лишь после заверше-
ния вызванной программы. Для получения вывода Perl предпринимает некото-
рые дополнительные усилия, поэтому было бы неэффективно использовать '...'
и игнорировать возвращаемое значение:
'fsck -у /dev/rsdla': # ОТВРАТИТЕЛЬНО
Оператор '...' обращается к командному интерпретатору для выполнения ко-
манд. Из-за этого он недостаточно безопасно работает в привилегированных
16.1. Получение вывода от программы
657
программах, но позволяет использовать в командах метасимволы командного
интерпретатора:
@files = Ms -1 /music/*.mp3':
Если вы хотите получать результаты командной строки по мере их накопле-
ния (и знаете о потенциальных проблемах безопасности), воспользуйтесь сле-
дующей формой open:
open(README. "Is -1 /music/*.mp3 |") or die "Can't run program: $!\n":
wh11e(<README>) {
# Последняя строка находится в $_
}
close(README):
До выхода Perl версии 5.8 поддерживалась только форма open с двумя аргу-
ментами. В этих версиях вызов open приходилось записывать в виде
open(FH, "program @args |")
or die "Can't run program: $!\n":
Ниже приводится низкоуровневое обходное решение с использованием pipe
(создание двух соединенных манипуляторов), fork (порождение нового процес-
са) и ехес (замена нового процесса программой, передающей данные):
use POSIX qw(:sys_wa1t_h);
my (Sreadme, Swrlteme):
pipe Sreadme, Swrlteme:
If (Spld = fork) {
# Родительский процесс
$SIG{CHLD} = sub { 1 while ( wa1tp1d(-l, WNOHANG)) > 0 }:
close Swrlteme:
} else {
die "cannot fork: $!" unless defined $p1d:
# Порожденный процесс
open(STDOUT, ">&=", Swrlteme) or die "Couldn't redirect STDOUT: $!":
close Sreadme:
exec($program, Sargl, Sarg2) or die "Couldn't run Sprogram : $!\n":
}
while (<$readme>) {
Sstrlng .= $_:
# или push(@str1ngs, $_):
}
close(README):
Нет никаких доводов в пользу кода open " -1" перед приведенным решением,
если не считать того, что низкоуровневый обходной путь позволяет изменить
обработку сигналов перед запуском новой программы. Например, можно отклю-
чить сигнал INT в порожденном процессе так, чтобы этот сигнал принимался
только родительским процессом.
См. также
perlsec(l); рецепт 16.2; рецепт 16.4; рецепт 16.10; рецепт 16.19; рецепт 19.5.
658
Глава 16. Управление процессами и межпроцессные взаимодействия
16.2. Запуск другой программы
Проблема
Вы хотите запустить другую программу из своей, дождаться ее завершения и за-
тем продолжить работу. Запущенная программа должна использовать те же STDIN
и STDOUT, что и основная.
Решение
Вызовите функцию system со строковым аргументом, который интерпретирует-
ся как командная строка:
Sstatus = systemC’vi Smyfile");
Если вы не хотите привлекать командный интерпретатор, передайте system
список:
$status = systemCvl", Smyfile);
Комментарий
Функция system обеспечивает самую простую и универсальную возможность за-
пуска других программ в Perl. Она не возвращает выходные данные внешней про-
граммы, как '...' или open. Вместо этого ее возвращаемое значение (фактически)
совпадает с кодом завершения программы. Во время работы новой программы
основная программа приостанавливается, поэтому новая программа может взаимо-
действовать с пользователем посредством чтения данных из STDIN и записи в STDOUT.
При вызове с одним аргументом функция system (как и open, ехес и '...') ис-
пользует командный интерпретатор для запуска программы. Это может приго-
диться для перенаправления или других фокусов:
systemCcmdl args | cmd2 | cmd3 >outfile"):
systemCcmd args <infile >outfile 2>errfile"):
Чтобы избежать обращений к интерпретатору, вызывайте system со списком
аргументов:
$status = system($program, $argl, $arg);
die "Sprogram exited funny: $?" unless Sstatus == 0:
Возвращаемое значение не является обычным кодом возврата; оно включает
номер сигнала, от которого умер процесс (если он был). Это же значение при-
сваивается переменной $? функцией wait. В рецепте 16.19 рассказано о том, как
декодировать его.
Функция system (но не '...'!) игнорирует SIGINT и SIGQUIT во время работы по-
рожденных процессов. Сигналы убивают лишь порожденные процессы. Если вы
хотите, чтобы основная программа умерла вместе с ними, проверьте возвращае-
мое значение system или переменную $?:
if ((Ssigno = system(@argl1 st)) &= 127) {
die "program killed by signal $signo\n":
16.2. Запуск другой программы
659
Чтобы игнорировать SIGINT, как это делает system, установите собственный
обработчик сигнала, а затем вручную вызовите fork и ехес:
if ($pid = fork) {
# Родитель перехватывает INT и предупреждает пользователя
local $SIG{INT} = sub { print "Tsk tsk. no process interruptus\n" }:
waitpid($pid, 0);
} else {
die "cannot fork: $!" unless defined $pid;
# Потомок игнорирует INT и делает свое дело
$SIG{INT} = "IGNORE";
ехес("summarize". "/etc/logfiles") or die "Can't exec: $!\n":
}
Некоторые программы просматривают свое имя. Командные интерпретаторы
узнают, были ли они вызваны с префиксом -, обозначающим интерактивность.
Программа ехрп в конце главы 18 при вызове под именем vrfy работает иначе;
такая ситуация возникает при создании двух ссылок на файл (см. описание ехрп).
По этой причине не следует полагать, что $0 всегда содержит имя вызванной про-
граммы — вас могли обмануть несколькими способами.
Если вы хотите подсунуть запускаемой программе другое имя, укажите на-
стоящий путь в виде «косвенного объекта» перед списком, передаваемым system
(также работает для ехес). После косвенного объекта не ставится запятая, по
аналогии с вызовом printf для файлового манипулятора или вызовом методов
объекта без ->.
$shel1 = 1/bin/tcsh1;
system Sshell '-csh': # Прикинуться другим интерпретатором
Или непосредственно:
system {'/bin/tcsh'} '-csh': # Прикинуться другим интерпретатором
В следующем примере настоящее имя программы передается в виде косвен-
ного объекта {'/home/tchrist/scripts/expn'}. Фиктивное имя 'vrfy' передается
в виде первого настоящего аргумента функции, и программа увидит его в пере-
менной $0.
# Вызвать ехрп как vrfy
system {'/home/tchrist/scripts/expn'} 'vrfy'. ^ADDRESSES:
Применение косвенных объектов c system более надежно. В этом случае аргу-
менты заведомо интерпретируются как список, даже если он состоит лишь из
одного элемента. Это предотвращает расширение метасимволов командным ин-
терпретатором или разделение слов, содержащих пропуски.
@args = ( "echo surprise" ):
system @args; # Если @args == 1, используются
# служебные преобразования интерпретатора
system { $args[0] } @args: # Безопасно даже для одноаргументного списка
Первая версия (без косвенного объекта) запускает программу echo и передает
ей аргумент "surprise". Вторая версия этого не делает — она честно пытается за-
пустить программу "echo surprise", не находит ее и присваивает $? ненулевое
значение, свидетельствующее об ошибке.
660
Глава 16. Управление процессами и межпроцессные взаимодействия
См. также
perlsec(l); описание функций waitpid, fork, ехес, system и open в perlfunc(\)\ ре-
цепт 16.1; рецепт 16.4; рецепт 16.19; рецепт 19.5.
16.3. Замена текущей программы
Проблема
Требуется заменить работающую программу другой, например, после проверки
параметров и настройки окружения, предшествующих выполнению основной
программы.
Решение
Воспользуйтесь встроенной функцией ехес. Если ехес вызывается с одним аргу-
ментом, содержащим метасимволы, то для запуска будет использован команд-
ный интерпретатор:
ехес("archive *.data")
or die "Couldn’t replace myself with archive: $!\n":
Если exec передаются несколько аргументов, командный интерпретатор не
используется:
ехес("archive". "account!ng.data")
or die "Couldn’t replace myself with archive: $!\n";
При вызове с одним аргументом, не содержащим метасимволов, аргумент
разбивается по пропускам и затем интерпретируется так, словно функция ехес
была вызвана для полученного списка:
ехес("arch!ve account!ng.data")
or die "Couldn't replace myself with archive: $!\n":
Комментарий
Функция Perl exec обеспечивает прямой интерфейс к системной функции execlp(2),
которая заменяет текущую программу другой без изменения идентификатора
процесса. Программа, вызвавшая ехес, стирается, а ее место в таблице процессов
операционной системы занимает программа, указанная в качестве аргумента ехес.
В результате новая программа сохраняет тот же идентификатор процесса ($$),
что и у исходной программы. Если указанную программу запустить не удалось,
ехес возвращает false, а исходная программа продолжает работу. Не забывайте
проверять такую ситуацию.
Как и в случае с system (см. рецепт 16.2), запускаемая программа задается при
помощи косвенного объекта:
ехес { '/usr/1ocal/bin/lwp-request’ } 'HEAD*. $url;
16.4. Получение или передача данных другой программе
661
Первый «настоящий» аргумент (' HEAD' в этом примере) передает новой про-
грамме информацию о ее «идентичности». Одни программы используют его для
управления своим поведением, другие — для создания записей в журналах.
Впрочем, главное применение этого синтаксиса связано с тем, что вызов ехес
с косвенным объектом никогда не использует командный интерпретатор для
запуска программы.
При переходе к другой программе с помощью ехес не будут автоматически
вызваны ни блоки END, ни деструкторы объектов, как это произошло бы при нор-
мальном завершении процесса.
См. также
Описание функции ехес в perlfunc(l); страница руководства execlp(2) вашей
системы (если есть); рецепт 16.2.
16.4. Получение или передача
данных другой программе
Проблема
Вы хотите запустить другую программу и либо прочитать ее вывод, либо пре-
доставить входные данные.
Решение
Вызовите open с символом | в начале или конце строки. Чтобы прочитать вывод
программы, поставьте | в конце:
$pid = open Sreadme. , "program", "arguments"
or die "Couldn't fork: $!\n";
while (<$readme>) {
# ...
}
close(README) or die "Couldn't close: $’\n":
Чтобы передать данные, поставьте | в начале:
$p1d = open $writeme. "program", "arguments"
or die "Couldn't fork: $!\n";
print $writerne "data\n":
close Ssriteme or die "Couldn't close: $!\n":
Комментарий
При чтении происходящее напоминает разве что на этот раз у вас имеется
идентификатор процесса и файловый манипулятор, а командный интерпретатор
не задействуется при вызове. Если вы хотите, чтобы Perl использовал команд-
ный интерпретатор при обнаружении метасимволов в аргументе (например,
662
Глава 16. Управление процессами и межпроцессные взаимодействия
чтобы интерпретатор мог выполнить расширение метасимволов в именах фай-
лов или перенаправить ввод/вывод), выберите форму open с двумя аргументами:
open($wr1terne, "| program args"):
open($readme, "program args |"):
Однако в некоторых ситуациях это нежелательно. Конвейерные вызовы open,
в которых участвуют непроверенные пользовательские данные, ненадежны при
работе в режиме меченых данных или в ситуациях, требующих абсолютной уве-
ренности.
Обратите внимание на явный вызов close для файлового манипулятора. Когда
функция open используется для подключения файлового манипулятора к поро-
жденному процессу, Perl запоминает этот факт и при закрытии манипулятора
автоматически переходит в состоянии ожидание. Если порожденный процесс
к этому моменту не завершился, Perl ждет, пока это произойдет. Иногда ждать
приходится очень, очень долго:
$p1d = openCF. "sleep". "100000"): # Производный процесс приостановлен
close(F); # Родитель надолго задумался
Чтобы избежать этого, уничтожьте производный процесс по значению PID,
полученному от open, или воспользуйтесь конструкцией pipe-fork-exec (см. ре-
цепт 16.10).
При попытке записать данные в завершившийся процесс ваш процесс полу-
чит сигнал SIGPIPE. По умолчанию этот сигнал убивает ваш процесс, поэтому
программист-параноик на всякий случай установит обработчик SIGPIPE.
Если вы хотите запустить другую программу и предоставить содержимое ее
STDIN, используется аналогичная конструкция:
$p1d = open(WRITEME. "|-". "program", "args"):
print $wr1terne "hello\n": # Программа получит hello\n в STDIN
close Swrlteme: # Программа получит EOF в STDIN
Второй аргумент open (" | -") сообщает Perl о необходимости запустить дру-
гой процесс. Файловый манипулятор, открытый функцией open, подключается
к STDIN порожденного процесса. Все, что вы запишете в этот манипулятор, может
быть прочитано процессом из STDIN. После закрытия манипулятора (close) при
следующей попытке чтения из STDIN порожденный процесс получит EOF.
Описанная методика может применяться для изменения нормального вывода
вашей программы. Например, для автоматической обработки всех данных ути-
литой постраничного вывода используется фрагмент вида:
Spager = $ENV{PAGER} || '/usr/Ыn/1ess': # XXX: может не существовать
open(STDOUT. "|-". $pager):
Теперь все данные, направленные в стандартный вывод, будут автоматически
проходить через утилиту постраничного вывода. Вам не придется исправлять
другие части программы.
Как и прежде, родитель должен помнить о close. При закрытии файлового
манипулятора, подключенного к порожденному процессу, родитель блокируется
до завершения потомка. Если порожденный процесс не завершается, то и закры-
тие не произойдет. Приходится либо заранее убивать порожденный процесс,
либо использовать низкоуровневый сценарий pipe-fork-ехес.
16.5. Фильтрация выходных данных
663
При использовании конвейерных открытий всегда проверяйте значения, воз-
вращаемые open и close, не ограничиваясь одним open. Дело в том, что возвра-
щаемое значение open не говорит о том, была ли команда успешно запущена.
При конвейерном открытии команда выполняется вызовом fork для порожден-
ного процесса. Если возможности создания процессов в системе не исчерпаны,
fork немедленно возвращает PID порожденного процесса.
К тому моменту, когда порожденный процесс пытается выполнить команду
ехес, он уже является самостоятельно планируемым. Следовательно, если коман-
да не будет найдена, практически не существует возможности сообщить об этом
функции open, поскольку она принадлежит другому процессу!
Проверка значения, возвращаемого close, позволяет узнать, успешно ли вы-
полнилась команда. Если порожденный процесс завершается с ненулевым ко-
дом (что произойдет в случае, если команда не найдена), то close возвращает
false, а переменной $? присваивается статус ожидания процесса. Об интерпрета-
ции содержимого этой переменной рассказано в рецепте 16.19.
При открытии канала для записи также следует устанавливать обработчик
SIGPIPE, поскольку при попытке записи в недоступный порожденный процесс
произойдет исключение SIGPIPE.
См. также
Описание функции open в perlfunc(\y, рецепт 16.10; рецепт 16.15; рецепт 16.19;
рецепт 19.5.
16.5. Фильтрация выходных данных
Проблема
Требуется обработать выходные данные вашей программы без написания от-
дельного фильтра.
Решение
Присоедините фильтр с помощью разветвляющего (forking) вызова open. Напри-
мер, в следующем фрагменте вывод программы ограничивается сотней строк:
head(100):
while (<>) {
print:
}
sub head {
my Slines = shift || 20:
return if Spid = open STDOUT.
die "cannot fork: $!" unless defined Spid:
while (<STDIN>) {
print:
last unless --Slines :
}
exit:
664
Глава 16. Управление процессами и межпроцессные взаимодействия
Комментарий
Создать выходной фильтр несложно — достаточно открыть STDOUT разветвляю-
щим вызовом open, а затем позволить порожденному процессу фильтровать
STDIN в STDOUT и внести те изменения, которые он посчитает нужным. Обратите
внимание: выходной фильтр устанавливается до генерации выходных данных.
Это вполне логично — нельзя отфильтровать вывод, который уже покинул вашу
программу. Все подобные фильтры должны устанавливаться в порядке очеред-
ности стека — последний установленный фильтр работает первым.
Рассмотрим пример, в котором используются два выходных фильтра. Пер-
вый фильтр нумерует строки; второй снабжает их символами цитирования (как
в сообщениях электронной почты). Для файла /etc/motd результат выглядит при-
мерно так:
1: > Welcome to Linux, version 2.0.33 on a i686
2: >
3: > "The software required ‘Windows 95 or better’,
4: > so I installed Linux."
Если изменить порядок установки фильтров, вы получите следующий результат:
> 1: Welcome to Linux, Kernel version 2.0.33 on a i686
> 2:
> 3: "The software required ‘Windows 95 or better’,
> 4: so I installed Linux."
Исходный текст программы приведен в примере 16.1.
Пример 16.1. qnumcat
# !/usr/Ы n/perl
# qnumcat - установка сцепленных выходных фильтров
number(); quote(); # Установить для STDOUT фильтр number # Установить для STDOUT фильтр quote
while (<>) { # Имитировать /bin/cat
print;
}
close STDOUT: # Вежливо сообщить потомкам о завершении
exit:
sub number {
my Spld;
return if $p1d = open STDOUT, "
die "cannot fork: $!" unless defined Spld:
while (<STDIN>) { printf "&d: %s", $., $_ }
exit:
}
sub quote {
my Spld:
return If Spld = open STDOUT. "|-":
die "cannot fork: $!" unless defined Spld;
while (<STDIN>) { print "> $_" }
exit:
16.6. Предварительная обработка ввода
665
Как и при любых разветвлениях, для миллиона процессов такое решение не
подойдет, но для пары (илй даже нескольких десятков) процессов расходы будут
небольшими. Если ваша система изначально проектировалась как многозадач-
ная (как Unix), все обойдется дешевле, чем можно себе представить. Благодаря
виртуальной памяти и копированию во время записи такие операции выполняют-
ся достаточно эффективно. Разветвление обеспечивает элегантное и недорогое
решение многих (если не всех) задач, связанных с многозадачностью.
См. также
Описание функции open в perlfunc(\y, рецепт 16.4.
16.6. Предварительная обработка ввода
Проблема
Ваша программа умеет работать лишь с обычным текстом в локальных файлах.
Однако возникла необходимость работать с экзотическими файловыми формата-
ми, например, сжатыми файлами или веб-документами, заданными в виде URL.
Решение
Воспользуйтесь удобными средствами Perl для работы с каналами и замените
имена входных файлов каналами перед тем, как открывать их.
Например, следующий фрагмент автоматически восстанавливает архивные
файлы, обработанные утилитой gzlp:
@ARGV = map { /\.(gz|Z)$/ ? "gzip -de } @ARGV:
while (<>) {
# ....
}
А чтобы получить содержимое URL перед его обработкой, воспользуйтесь
программой GET из модуля LWP (см. главу 20 «Автоматизация в Веб»):
@ARGV = map { mF\w+://# ? "GET } @ARGV:
while (<>) {
# ....
}
Конечно, вместо HTML-кода можно принять простой текст. Для этого доста-
точно воспользоваться другой командой (например, lynx -dump).
Комментарий
Как показано в рецепте 16.1, встроенная функция Perl open очень удобна: кана-
лы открываются в Perl так же, как и обычные файлы. Если то, что вы открываете,
похоже на канал, Perl открывает его как канал. Мы используем эту особенность
666
Глава 16. Управление процессами и межпроцессные взаимодействия
и включаем в имя файла восстановление архива или иную предварительную об-
работку. Например, файл "09tails.gz" превращается в "gzcat -de 09tails.gz|".
Эта методика применима и в других ситуациях. Допустим, вы хотите про-
читать /etc/passwd, если компьютер не использует NIS, и вывод ypcat passwd
в противном случае. Мы определяем факт использования NIS по выходным дан-
ным программы domainname, после чего выбираем в качестве открываемого файла
строку "</etc/passwd" или "ypcat passwd |".
Spwdlnfo = 'domainname' =~ /^(\(none\))?$/
? ’< /etc/passwd’
: ’ypcat passwd |‘;
openCPWD, Spwdlnfo) or die "can’t open Spwdlnfo: $!";
Но и это еще не все! Даже если вы не собирались встраивать подобные возмож-
ности в свою программу, Perl делает это за вас! Представьте себе фрагмент вида:
print "File, pl ease? ":
chomp(Sflle = <>):
open (FH. Sflle) or die "can’t open Sflle: $!":
Пользователь может ввести как обычное имя файла, так и строку вида
"webget http://www.perl .com |" — и ваша программа вдруг начинает получать вы-
ходные данные от webget! А если ввести всего один символ, дефис (-), то при от-
крытии для чтения будет интерполирован стандартный ввод.
В рецепте 7.14 эта методика использовалась для автоматизации обработки ARGV.
См. также
Рецепт 7.7; рецепт 16.4.
16.7. Чтение содержимого STDERR
Проблема
Вы хотите выполнить программу с помощью system, '...' или open, но содержимое
ее STDERR не должно выводиться в ваш STDERR. Необходимо либо игнорировать
содержимое STDERR, либо сохранять его отдельно.
Решение
Воспользуйтесь числовым синтаксисом перенаправления и дублирования для
файловых дескрипторов. Для упрощения примеров мы не проверяем возвращае-
мое значение open, но вы обязательно должны делать это в своих программах!
Одновременное сохранение STDERR и STDOUT:
Soutput = 'emd 2>&Г : # Для '...'
# или
Spld = openCPH. "emd 2>&1 |"): # Для open
while (<РН>) { } # Чтение
16.7. Чтение содержимого STDERR
667
Сохранение STDOUT с игнорированием STDERR:
Soutput = 'cmd 2>/dev/null'; # Для
# или
Spld = open(PH, "cmd 2>/dev/null |"): # Для open
while (<PH>) { } # Чтение
Сохранение STDERR с игнорированием STDOUT:
Soutput = 'cmd 2>&1 l>/dev/null': # Для
# или
Spld = openCPH, "cmd 2>&1 l>/dev/nul1 |"): # Для open
while (<PH>) { } # Чтение
Замена STDOUT и STDERR команды, то есть сохранение STDERR и направление
STDOUT в старый STDERR:
Soutput = 'cmd 3>&1 1>&2 2>&3 3>&-': # Для
# или
Spld = openCPH, "cmd 3>&1 1>&2 2>&3 3>&-|"); # Для open
while (<РН>) { } # Чтение
Чтобы организовать раздельное чтение STDOUT и STDERR команды, проще и на-
дежнее всего будет перенаправить их в разные файлы, а затем прочитать из этих
файлов после завершения команды:
system("prog args l>/tmp/program.stdout 2>/tmp/program.stderr");
Комментарий
При выполнении команды оператором конвейерным вызовом open или system
для одной строки Perl проверяет наличие символов, имеющих особый смысл
для командного интерпретатора. Это позволяет перенаправить файловые де-
скрипторы новой программы. STDIN соответствует файловому дескриптору с номе-
ром О, STDOUT — 1, a STDERR — 2. Например, конструкция 2>файл перенаправляет
STDERR в файл. Для перенаправления в файловый дескриптор используется специ-
альная конструкция &N, где N — номер файлового дескриптора. Следователь-
но, 2>&1 направляет STDERR в STDOUT.
Ниже приведена таблица некоторых интересных перенаправлений файловых
дескрипторов (табл. 16.1).
Таблица 16.1. Примеры перенаправления
Перенаправление Смысл
0</dev/null Немедленно выдать EOF в STDIN
l>/dev/null Игнорировать STDOUT
2>/dev/null Игнорировать STDERR
2>&1 Направить STDERR в STDOUT
2>&- Закрыть STDERR (не рекомендуется)
3<>/dev/tty Связать файловый дескриптор 3 с /dev/tty в режиме чтения/записи
668
Глава 16. Управление процессами и межпроцессные взаимодействия
На основании этой таблицы мы рассмотрим самый сложный вариант перена-
правления в Решении:
$output = 'cmd 3>&1 1>&2 2>&3 3>&-';
Он состоит из четырех этапов.
Этап 1: 3>&1
Скопировать файловый дескриптор 1 в новый дескриптор 3. Прежнее место
назначения STDOUT сохраняется в только что открытом дескрипторе.
Этап 2: 1>&2
Направить STDOUT по месту назначения STDERR. В дескрипторе 3 остается преж-
нее значение STDOUT.
Этап 3: 2>&3
Скопировать файловый дескриптор 3 в дескриптор 2. Данные STDERR будут
поступать туда, куда раньше поступали данные STDOUT.
Этап 4: 3>&-
Перемещение потоков закончено, и мы закрываем временный файловый де-
скриптор. Это позволяет избежать «утечки» дескрипторов.
Если подобные цепочки сбивают вас с толку, взгляните на них как на обычные
переменные и операторы присваивания. Пусть переменная $fdl соответствует
STDOUT, a $fd2 — STDERR. Чтобы поменять значения двух переменных, понадобится
временная переменная для хранения промежуточного значения. Фактически
происходит следующее:
$fd3 = $fdl:
$fdl = $fd2:
$fd2 = $fd3;
$fd3 = undef;
Когда все будет сказано и сделано, возвращаемая оператором строка
будет соответствовать STDERR выполняемой команды, a STDOUT будет направлен
в прежний STDERR.
Во всех примерах важна последовательность выполнения. Это связано в тем,
что командный интерпретатор обрабатывает перенаправления файловых дескрип-
торов слева направо.
system("prog args l>tmpf11е 2>&Г);
systemCprog args 2>&1 l>tmpfile"):
Первая команда направляет и STDOUT, и STDERR во временный файл. Вторая ко-
манда направляет в файл только STDOUT, a STDERR будет выводиться там, где рань-
ше выводился STDOUT. Непонятно? Снова рассмотрим аналогию с переменными
и присваиваниями. Фрагмент:
# system ("prog args l>tmpfile 2>&1");
$fdl = "tmpfile": # Сначала изменить место назначения STDOUT
$fd2 = $fdl; # Направить туда же STDERR
сильно отличается от другого фрагмента:
# systemCprog args 2>&1 l>tmpfile"):
$fd2 = $fdl; # Совместить STDERR co STDOUT
$fdl. = "tmpflle": # Изменить место назначения STDOUT
16.8. Управление потоками ввода и вывода другой программы
669
См. также
Дополнительные сведения о перенаправлении файловых дескрипторов приведе-
ны на странице руководства s/z(l) вашей системы (если есть). Функция system
описана в рег1/ипс(Д}.
16.8. Управление потоками ввода
и вывода другой программы
Проблема
Вы хотите управлять как входными, так и выходными данными другой програм-
мы. Функция open позволяет решить одну из этих задач, но не обе сразу.
Решение
Воспользуйтесь стандартным модулем IPC: :0реп2:
use IPC::0pen2:
$p1d = open2(*README, *WRITEME, $program):
print WRITEME "here's your input\n":
$output = <README>:
close(WRITEME):
close(README):
waitpid($pid. 0):
Комментарий
Желание управлять вводом и выводом другой программы возникает очень час-
то, однако за ним таится на удивление много опасностей. Поэтому вам не удаст-
ся вызвать open в виде:
open(my $double_handle, "| program args |") # НЕВЕРНО
Большая часть трудностей связана с буферизацией. Поскольку в общем слу-
чае нельзя заставить другую программу использовать небуферизованный вывод,
нет гарантии, что операции чтения не будут блокироваться. Если переход к ожи-
данию ввода происходит одновременно с тем, как другой процесс переходит к ожи-
данию вывода, возникает состояние взаимной блокировки (deadlock). Процессы
входят в клинч, пока кто-нибудь не убьет их или не перезагрузит компьютер.
Если вы можете управлять буферизацией другого процесса (потому что вы
сами написали программу и знаете, как она работает), возможно, вам поможет
модуль IPC: :0реп2. Если в первых двух аргументах функции ореп2 передаются
неопределенные скалярные значения, ореп2 создает новые манипуляторы:
use IPC::0pen2:
$pid = open2(my $reader, my $writer. $program);
670
Глава 16. Управление процессами и межпроцессные взаимодействия
Другой вариант — передать аргументы вида "<&OTHERFILEHANDLE" или
">&OTHERFILEHANDLE", определяющие существующие файловые манипуляторы для
порожденных процессов. Эти файловые манипуляторы не обязаны находиться
под контролем вашей программы; они могут быть подключены к другим про-
граммам, файлам или сокетам.
Программа может задаваться в виде списка (где первый элемент определяет
имя программы, а остальные элементы — ее аргументы) или в виде отдельной
строки (передаваемой интерпретатору в качестве команды запуска программы).
Если вы также хотите управлять потоком STDERR программы, воспользуйтесь мо-
дулем IPC: :0репЗ (см. следующий рецепт).
Если произойдет ошибка, возврат из ореп2 и орепЗ не происходит. Вместо это-
го вызывается die с сообщением об ошибке, которое начинается с "ореп2" или
"орепЗ". Для проверки ошибок следует использовать конструкцию eval БЛОК:
eval {
open2($readme, Swriteme, @program_and_arguments):
}:
if ($@) {
If ($@ =~ /жореп2/) {
warn "open2 failed: $!\n$@\n";
return;
}
die: # Заново инициировать непредвиденное исключение
}
Не забудьте вызвать waitpld, как показано в Решении, потому что модуль
IPC: :0реп2 не уничтожает порожденные процессы после выхода. За подробностя-
ми обращайтесь к рецепту 16.19.
См. также
Документация по стандартным модулям IPC: :0реп2 и I PC:: ОрепЗ; рецепт 10.12;
описание функции eval в perlfunc(]y, описание переменной $@ в разделе «Special
Global Variables» perlvar(l).
16.9. Управление потоками ввода, вывода
и ошибок другой программы
Проблема
Вы хотите полностью управлять потоками ввода, вывода и ошибок запускаемой
команды.
Решение
Аккуратно воспользуйтесь стандартным модулем IPC:: ОрепЗ, возможно — в соче-
тании со стандартным модулем 10:: Sei ect.
16.9. Управление потоками ввода, вывода и ошибок другой программы
671
Комментарий
Если вас интересует лишь один из потоков STDIN, STDOUT или STDOUT программы,
задача решается просто. Но если потребуется управлять двумя и более пото-
ками, сложность резко возрастает. Мультиплексирование нескольких потоков
ввода/вывода всегда выглядело довольно уродливо. Существует простое обход-
ное решение:
@all = '($cmd | sed -е 's/^/stdout: Г ) 2>&Г:
for (©all) { push @{ s/stdout: // ? \@outlines : \@errlines }, $_ }
print "STDOUT:\n". (^outlines. "\n";
print "STDERRAn". @errlines, "\n":
Если утилита sed не установлена в вашей системе, то в простых случаях вроде
показанного можно обойтись командой perl -ре, которая работает практически
так же, как sed -е.
Однако то, что здесь происходит, в действительности нельзя считать парал-
лельными вычислениями. Мы всего лишь помечаем строки STDOUT префиксом
"stdout:" и затем удаляем их после чтения всего содержимого STDOUT и STDERR,
сгенерированного программой.
Кроме того, можно воспользоваться стандартным модулем IPC: :0репЗ. Как
ни странно, аргументы функции IPC: :0репЗ следуют в другом порядке, нежели
в IPC::0реп2.
орепЗ($write_me, $read_me, $errors, "program to run");
Открываются широкие потенциальные возможности для создания хаоса —
еще более широкие, чем при использовании ореп2. Если попытаться прочитать
STDERR программы, когда она пытается записать несколько буферов в STDOUT, про-
цесс записи будет заблокирован из-за заполнения буферов, а чтение заблокиру-
ется из-за отсутствия данных.
Чтобы избежать взаимной блокировки, можно имитировать орепЗ с помощью
fork, open и ехес, сделать все файловые манипуляторы ^буферизованными и ис-
пользовать sysread, syswrite и select, чтобы решить, из какого доступного для
чтения манипулятора следует прочитать байт. Однако ваша программа стано-
вится медленной и громоздкой, к тому же при этом не решается классическая
проблема взаимной блокировки ореп2, при которой каждая программа ждет по-
ступления данных от другой стороны:
use IPC::ОрепЗ:
$pid = open3($child_in, $child_out, $child_err, $cmd):
close $child_in: # give end-of-file to kid
^outlines = <$child_out>: # Чтение до EOF
Oerrlines = <$child_err>: # XXX: потенциальная возможность блокировки
print "STDOUT:\n", ^outlines. "\n":
print "STDERRAn". Oerrlines. "\n":
Кроме того (как будто одной взаимной блокировки недостаточно), такое реше-
ние чревато нетривиальными ошибками. Существует, по крайней мере, три непри-
ятных ситуации: первая — когда и родитель, и потомок пытаются читать одно-
временно, вызывая взаимную блокировку. Вторая — когда заполнение буферов
672
Глава 16. Управление процессами и межпроцессные взаимодействия
заставляет потомка блокироваться при попытке записи в STDERR, тогда как роди-
тель блокируется при попытке чтения из STDOUT потомка. Третья — когда запол-
нение буферов заставляет родителя блокировать запись в STDIN потомка, а потомок
блокируется при записи в STDOUT или STDERR. Первая проблема в общем случае не
решается, хотя ее можно обойти, создавая таймеры функцией alarm и предотвра-
щая перезапуск блокирующих операций при получении сигнала SIGALRM.
Мы используем модуль 10::Select, чтобы узнать, из каких файловых манипу-
ляторов можно прочитать данные (для этой цели можно использовать встроен-
ную функцию select). Это решает вторую, но не третью проблему. Для решения
третьей проблемы также потребуются alarm и SIGALRM.
Если вы хотите отправить программе входные данные, прочитать ее вывод и
затем либо прочитать, либо проигнорировать ошибки, работы заметно прибавит-
ся (см. пример 16.2).
Пример 16.2. cmd3sel
#!/usr/bin/perl
# cmd3sel - управление всеми тремя потоками порожденного процесса
# (ввод, вывод и ошибки).
use IPC::ОрепЗ:
use 10::Select:
$cmd = "grep vt33 /попе/such - /etc/termcap":
Spiel = орепЗ($cmd_in, $cmd_out, $cmd_err, $cmd):
$SIG{CH1_D} = sub {
print "REAPER: status $? on $pid\n" if waitpid($pid, 0) > 0
}:
print $cmd_in "This line has a vt33 lurking in it\n";
close $cmd_in:
$selector = 10::Select->new( ):
$selector->add($cmd_err, $cmd_out);
while (Oready = $selector->can_read) {
foreach Sfh (@ready) {
if (fileno($fh)==fileno($cmd_err)) {print "STDERR: ", scalar <$cmd_err>}
else {print "STDOUT: ", scalar <$cmd_out>}
$selector->remove($fh) if eof($fh):
}
}
close $cmd_out:
close $cmd_err;
Мы отправляем короткую входную строку, а затем закрываем манипулятор.
Тем самым предотвращается ситуация взаимной блокировки двух процессов,
каждый из которых ожидает записи данных другим процессом.
См. также
Документация по стандартным модулям 10::Seiect, IPC: :0реп2 и IPC: :0репЗ; опи-
сание функции alarm в perlfunc(\y, рецепт 16.8; рецепт 16.15; рецепт 16.16.
16.10. Взаимодействие между родственными процессами
673
16.10. Взаимодействие между
родственными процессами
Проблема
Имеются два взаимосвязанных процесса, которые должны обмениваться данны-
ми. Вам требуется более высокая степень контроля по сравнению с той, что
обеспечивают open, system и
Решение
Воспользуйтесь pipe, а затем — fork:
my ($reader, Swrlter):
pipe $reader, Swrlter;
If (fork) {
# Выполнить родительский код. в котором происходит либо чтение.
# либо запись (что-то одно).
} else {
# Выполнить код потомка, в котором происходит либо чтение,
# либо запись (что-то одно).
}
Либо используйте особую форму open:
if (Spld = (open($ch1Id. "|-")) {
# Выполнить родительский код. передающий данные потомку
} else {
die "cannot fork: $!" unless defined Spld:
# Иначе выполнить код потомка, принимающий данные от родителя
}
Или по-другому:
If (Spld = open($ch11d, "-|")) {
# Выполнить родительский код, принимающий данные от потомка
} else {
die "cannot fork: $!" unless defined Spld;
# Иначе выполнить код потомка, передающий данные родителю
}
Комментарий
Канал представляет собой два файловых манипулятора, связанных так, что за-
писанные в один файловый манипулятор данные могут быть прочитаны другим.
Функция pi ре создает два манипулятора, связанных в канал; первый (приемник)
предназначен для чтения, а второй (передатчик) — для записи. Хотя вы не смо-
жете взять два существующих манипулятора и объединить их в канал, функция
pipe часто используется при обмене данными между процессами. Один процесс
создает пару манипуляторов функцией pipe, после чего создает потомка с помо-
щью fork; в результате возникают два разных процесса, выполняющих одну и ту
же программу, каждый из которых обладает копией связанных манипуляторов.
674
Глава 16. Управление процессами и межпроцессные взаимодействия
Как и в случае с open, если функции pl ре вместо манипуляторов передаются неоп-
ределенные скалярные переменные, она автоматически создает в них манипуляторы.
Неважно, какой процесс будет приемником, а какой — передатчиком; когда про-
цесс начинает играть одну из этих ролей, его напарнику достается другая. Такой
обмен данными может быть только односторонним (но не бросайте читать!).
Мы воспользуемся модулем 10::Handle, в котором нас интересует метод
autofl ushО (если вы предпочитаете более эффективные решения, воспользуйтесь
решением с select, описанным в главе 7). Если этого не сделать, наша отдельная
строка вывода застрянет в канале и не доберется до другого конца до закрытия
канала.
Версия родителя, передающего данные потомку, приведена в примере 16.3.
Пример 16.3. pipel
#’/usr/Ыn/perl -w
# pipel - применение pipe и fork для отправки данных родителем потомку
use 10::Handlе:
my ($reader. $writer):
pipe $reader, $writer:
$writer->autoflush(l):
if (Spid = fork) {
close Sreader:
print Swriter "Parent Pid $$ is sending this\n":
close $writer:
wai tpi d(Spi d.0):
} else {
die "cannot fork: $!" unless defined Spid:
close Swriter:
chomp(Sline = <$reader>):
print "Child Pid $$ just read this: '$line’\n":
close Sreader: # Произойдет в любом случае
exit:
}
В примерах этого рецепта основная проверка ошибок была оставлена читате-
лю для самостоятельной работы. Мы так поступили для того, чтобы взаимодей-
ствие функций стало более наглядным. В реальной жизни проверяются возвра-
щаемые значения всех вызовов системных функций.
В примере 16.4 показана версия потомка, передающего данные родителю.
Пример 16.4. pipe2
# !/usr/bin/perl -w
# pipe2 - применение pipe и fork для передачи данных потомком родителю
use 10::Handle:
my (Sreader. Swriter):
pipe($reader, Swriter):
$writer->autoflush(l):
if (Spid = fork) {
close $writer:
16.10. Взаимодействие между родственными процессами
675
chomp($11ne = <$reader>):
print "Parent Pld $$ just read this: '$line'\n":
close $reader:
waitpid($p1d.0):
} else {
die "cannot fork: $!" unless defined $p1d:
close $reader;
print Swriter "Child Pid $$ is sending this\n":
close Swriter: # Произойдет в любом случае
exit;
}
Обычно обе половины входят в цикл, и приемник продолжает читать до конца
файла. Это происходит до тех пор, пока передатчик не закроет канал или пере-
дача не завершится.
Поскольку манипуляторы каналов работают лишь в одном направлении, ка-
ждый процесс использует лишь один канал из пары и закрывает неиспользуе-
мый манипулятор. Причина, по которой это делается, нетривиальна; представь-
те себе ситуацию, при которой принимающий процесс не закрыл передающий
манипулятор. Если после этого передающий процесс завершится, пока принимаю-
щий процесс пытается что-нибудь прочитать, последний намертво «зависнет».
Система не может сообщить приемнику о том, что данных для чтения больше не
будет, пока не будут закрыты все копии передающего манипулятора.
Функция open, получая в качестве второго аргумента или "|=", неявно
вызывает pipe и fork. Это несколько упрощает приведенный выше фрагмент. По-
рожденный процесс общается с родителем через STDIN или STDOUT в зависимости
от того, какая строка была использована, " -1" или " |
При подобном применении open, когда родитель хочет передать данные по-
томку, он поступает, как показано в примере 16.5.
Пример 16.5. pipe3
# !/usr/bin/perl -w
# piреЗ - применение разветвляющего вызова open
# для передачи данных от родителя к потомку
use 10::Handlе:
if ($pid = open (Schild. "|-")) {
$child->autoflush(l);
print Schild "Parent Pid $$ is sending this\n":
close Schild:
} else {
die "cannot fork: $!" unless defined Spid:
chomp($line = <STDIN>);
print "Child Pid $$ just read this: '$line'\n":
exit:
}
Поскольку STDIN потомка уже подключен к родителю, потомок может запус-
тить через ехес другую программу, читающую данные из стандартного ввода —
например, 1 рг. Это полезная и часто используемая возможность.
676
Глава 16. Управление процессами и межпроцессные взаимодействия
Если потомок захочет передать данные родителю, он поступает, как показано
в примере 16.6.
Пример 16.6. pipe4
# !/usr/Ыn/perl -w
# pipe4 - применение разветвляющего вызова open
# для передачи данных от потомка к родителю
use 10::Handlе;
if (Spld = open Schild. "-|") {
chomp($line = <Sch11d>):
print "Parent Pid $$ just read this: '$line'\n":
close Schild:
} else {
die "cannot fork: $!" unless defined Spld:
STDOUT->autoflush(l):
print STDOUT "Child Pid $$ is sending this\n":
exit:
}
И снова, поскольку STDOUT потомка уже подключен к родителю, потомок мо-
жет запустить через ехес другую программу, выдающую нечто интересное в его
стандартный вывод. Эти данные также будут переданы родителю как ввод от
<CHILD>.
При подобном использовании open мы не обязаны вручную вызывать waitpid,
поскольку не было явного вызова fork. Однако close вызвать все же надо. В обоих
случаях переменная $? содержит статус ожидания порожденного процесса (о том,
как интерпретировать это значение, рассказано в рецепте 16.19).
В предыдущих примерах рассматривалась однонаправленная связь. Что делать,
если вы хотите, чтобы данные передавались в обе стороны? Дважды вызовите
pipe перед вызовом fork. Вам придется следить за тем, кто, что и когда передает,
иначе может возникнуть взаимная блокировка (см. пример 16.7).
Пример 16.7. pipe5
# !/usr/bin/perl -w
# pipe5 - двусторонний обмен данными с использованием двух каналов
# без применения socketpair
use 10::Handlе;
my ($parent_rdr. $child_wtr, $child_rdr, $parent_wtr):
pipe $parent_rdr, $child_wtr:
pipe $child_rdr. $parent_wtr:
$child_wtr->autoflush(l):
$parent_wtr->autoflush(l);
if (Spld = fork) {
close $parent_rdr: close $parent_wtr:
print $child_wtr "Parent Pid $$ is sending this\n":
chomp(Sline = <$child_rdr>):
print "Parent Pid $$ just read this: '$line'\n":
close $child_rdr: close $child_wtr:
wai tpi d(Spld.0):
16.10. Взаимодействие между родственными процессами
677
} else {
die "cannot fork: $!" unless defined Spid;
close Sch11d_rdr: close Sch11d_wtr;
chomp(Sline = <$parent_rdr>):
print "Child Pid $$ just read this: 'Sllne'Xn":
print $parent_wtr "Child Pid $$ Is sending th1s\n";
close $parent_rdr; close $parent_wtr;
exit:
}
Ситуация усложняется. Оказывается, существует специальная системная
функция socketpair (см. пример 16.8), которая упрощает предыдущий пример.
Она работает аналогично pipe, за исключением того, что оба манипулятора мо-
гут использоваться как для приема, так и для передачи.
Пример 16.8. pipe6
# !/usr/Ыn/perl -w
# р1реб - двусторонний обмен данными с применением socketpair
use Socket;
use 10::Handle:
# Мы говорим AFJJNIX. потому что хотя константа *_LOCAL
# соответствует POSIX 1003.1g. на многих компьютерах
# она еще не поддерживается.
socketpa1r($ch11d. Sparent. AFJJNIX. SOCK_STREAM. PFJJNSPEC)
or die "socketpair: $!":
$ch11d->autof1ush(1):
$parent->autoflush(l):
If (Spid = fork) {
close Sparent;
print Schild "Parent Pid $$ Is sending th1s\n":
chomp($11ne = <$ch11d>):
print "Parent Pid $$ just read this: 'Sllne'Xn";
close Schild;
waltpld(Spld,0):
} else {
die "cannot fork: $!" unless defined Spid;
close Schild:
chomp(Sline = <$parent>);
print "Child Pid $$ just read this; 'Sllne'Xn":
print Sparent "Child Pid $$ Is sending th1s\n";
close Sparent;
exit;
}
В некоторых системах каналы исторически были реализованы как два полу-
закрытых конца пары сокетов. Фактически реализация pl ре($reader .Swrlter) вы-
глядела так:
socketpa1r($reader. Swrlter. AFJJNIX. SOCK_STREAM. PFJJNSPEC);
shutdown($reader. 1); # Запретить запись для READER
shutdown(Swrlter. 0); # Запретить чтение для WRITER
678
Глава 16. Управление процессами и межпроцессные взаимодействия
См. также
Описания всех использованных функций в perlfunc(l); документация по стан-
дартному модулю IPC:: Ореп2; рецепт 16.8; рецепт 19.5.
16.11. Имитация файла на базе
именованного канала
Проблема
Вы хотите, чтобы процесс перехватывал все обращения к файлу. Например,
файл -/.plan должен превратиться в программу, которая будет возвращать слу-
чайную цитату.
Решение
Воспользуйтесь именованными каналами. Сначала создайте канал (вероятно,
в командном интерпретаторе):
% mkflfo /path/to/named.pl ре
Принимающий фрагмент выглядит так:
open($f1fo. "/path/to/named.pipe") or die $!;
while (<$f1fo>) {
print "Got:
}
close($f1fo):
Передающий фрагмент выглядит так:
open($f1fo. ">", "/path/to/named.pipe") or die $1:
print $f1fo "Smoke thlsAn":
close($f1fo):
Комментарий
Именованный канал (также встречается термин FIFO) представляет собой спе-
циальный файл, используемый в качестве буфера для взаимодействия процес-
сов на одном компьютере. Обычные каналы также позволяют процессам обме-
ниваться данными, но они должны наследовать файловые манипуляторы от
своих родителей. Для работы с именованным каналом процессу достаточно
знать его имя. В большинстве случаев процессы даже не обязаны сознавать, что
они читают данные из FIFO.
Операции чтения и записи для именованных каналов выполняются точно
так же, как и для обычных файлов (в отличие от сокетов Unix, рассматривае-
мых в главе 17). Данные, записанные в FIFO, буферизуются операционной сис-
темой, а затем читаются обратно в порядке записи. Поскольку FIFO играет роль
16.11. Имитация файла на базе именованного канала
679
буфера для взаимодействия процессов, открытие канала для чтения блокирует
его до тех пор, пока другой процесс не откроет его для записи, и наоборот. Если
открыть канал для чтения и записи с помощью режима +< функции open, блоки-
ровки (в большинстве систем) не будет, поскольку ваш процесс сможет и при-
нимать, и передавать данные.
Давайте посмотрим, как использовать именованный канал, чтобы при каж-
дом запуске finger люди получали разные данные. Чтобы создать именованный
канал с именем .plan в основном каталоге, воспользуйтесь mkfifo или mknod:
% mkfifo -/.plan # Есть практически везде
% mknod -/.plan р # На случай, если у вас все же нет mkfifo
В некоторых системах приходится использовать mknod(8). Имена и местона-
хождение этих программ могут быть другими — обращайтесь к системной доку-
ментации.
Затем необходимо написать программу, которая будет поставлять данные
программам, читающим из файла -/.plan. Мы ограничимся выводом текущей
даты и времени (см. пример 16.9).
Пример 16.9. dateplan
# 1/usr/Ыn/perl -w
# dateplan - вывод текущей даты и времени в файл .plan
while (1) {
open(FIFO. "> $ENV{HOME}/.pl an")
or die "Couldn’t open $ENV{HOME}/.plan for writing: $!\n":
print FIFO "The current time is ". scalar(localtime). "\n":
close FIFO:
sleep 1:
}
К сожалению, такое решение работает не всегда, потому что некоторые вари-
анты finger и соответствующие демоны проверяют размер файла .plan перед
тем, как пытаться читать из него. Поскольку именованные каналы в файловой
системе представлены в виде специальных файлов нулевого размера, такие кли-
енты и серверы не станут открывать именованный канал и читать из него, и наш
фокус не удастся.
В примере с .plan демоном был передатчик. Приемники-демоны тоже встре-
чаются не так уж редко. Например, именованный канал может применяться для
ведения централизованного журнала, собирающего данные от нескольких про-
цессов. Программа-сервер читает сообщения из именованного канала и записы-
вает их в базу данных или файл. Клиенты передают сообщения в именованный
канал. Такая схема избавляет клиентов от хлопот, связанных с логикой переда-
чи данных, и позволяет легко внести необходимые изменения в реализацию ме-
ханизма передачи.
В примере 16.10 приведена простая программа для чтения двухстрочных
блоков, где первая строка определяет процесс, а вторая — текст сообщения.
Все сообщения от httpd игнорируются, а сообщения от login сохраняются в /var/
log/login.
680
Глава 16. Управление процессами и межпроцессные взаимодействия
Пример 16.10. fifolog
#!/usr/Ыn/perl -w
# fifolog - чтение и сохранение сообщений из FIFO
$SIG{ALRM} = sub { close(FIFO) }; # Переход к следующему
# процессу в очереди
while (1) {
alarm(O): # Отключить таймер
open($f1fo. "</tmp/log") or die "Can't open /tmp/log : $!\n":
alarm(l): # 1 секунда на регистрацию
Sservlce = <$fifo>:
next unless defined $serv1ce: # Прерывание или нечего регистрировать
chomp Sservlce:
$message = <$f1fo>;
next unless defined Smessage: # Прерывание или нечего регистрировать
chomp Smessage:
alarm(O); # Отключить таймеры
# для обработки сообщений
If (Sservlce eq "http") {
# Игнорировать
} elslf (Sservlce eq "login") {
# Сохранить в /var/log/logln
If ( open($log. "» /tmp/logln") ) {
print Slog scalar(localtlme). " Sservlce $message\n";
close($log):
} else {
warn "Couldn’t log $serv1ce $message to /var/log/logln : $!\n":
}
}
}
Программа получилась сложнее предыдущей по нескольким причинам. Пре-
жде всего, мы не хотим, чтобы наш сервер ведения журнала надолго блокировал
передатчики. Нетрудно представить ситуацию, при которой злонамеренный или
бестолковый передатчик открывает именованный канал для записи, но не пере-
дает полного сообщения. По этой причине мы используем alarm и SIGALRM для пе-
редачи сигналов о нарушениях во время чтения.
При использовании именованных каналов может возникнуть лишь два ис-
ключительных состояния: когда у приемника исчезает передатчик, и наоборот.
Если процесс читает из именованного канала, а передатчик закрывает его со сво-
его конца, то принимающий процесс получит признак конца файла (<> возвра-
щает undef). Однако если приемник отключается от канала, то при следующей
попытке записи передатчик получит сигнал SIGPI РЕ. Если игнорировать сигналы
о нарушении канала конструкцией $SIG{РIРЕ} = ' IGNORE', print возвращает false,
а переменной $! присваивается значение EPIPE:
use POSIX qw(:errno_h):
$SIG{PIPE} = 'IGNORE';
# ...
16.12. Совместное использование переменных в разных процессах
681
Sstatus = print FIFO "Are you there?\n";
if (!$status && $! == EPIPE) {
warn "My reader has forsaken me!\n";
next;
}
Возможно, у вас возник вопрос: «Если сто процессов одновременно пытают-
ся передать данные серверу, как можно быть уверенным в том, что я получу сто
разных сообщений, а не хаотическую мешанину из символов или строк разных
процессов?» Хороший вопрос. Согласно стандарту POSIX, запись менее PIPEJ3UF
байт будет доставлена автоматически, то есть не перепутается с другими. Значе-
ние константы PIPE_BUF можно узнать из модуля POSIX:
use POSIX;
print _POSIX_PIPE_BUF, "\n";
К счастью, стандарт POSIX также требует, чтобы значение PIPE_BUF было не
менее 512 байт. Следовательно, остается лишь позаботиться о том, чтобы клиен-
ты не пытались передавать более 512 байт за раз.
Но что если вам понадобилось зарегистрировать более 512 байт? Разделите
каждое большое сообщение на несколько маленьких (менее 512 байт), снабдите
каждое сообщение уникальным идентификатором клиента (например, иденти-
фикатором процесса) и организуйте их сборку на сервере. Нечто похожее проис-
ходит при фрагментации и сборке сообщений TCP/IP.
Один именованный канал не обеспечивает двухстороннего обмена данными
между передатчиком и приемником, что усложняет аутентификацию и другие
способы борьбы с передачей ложных сообщений (если не делает их невозмож-
ными). Вместо того чтобы упрямо втискивать эти возможности в модель, в ко-
торой они неуместны, лучше ограничить доступ к именованному каналу средст-
вами файловой системы (на уровне прав владельца и группы).
См. также
Страницы руководства mkfifo(8) или mknod(8) (если они есть); рецепт 17.6.
16.12. Совместное использование
переменных в разных процессах
Проблема
Требуется организовать совместный доступ к переменным в разветвлениях или
неродственных процессах.
Решение
Используйте средства SysV IPC, если ваша система их поддерживает.
682
Глава 16. Управление процессами и межпроцессные взаимодействия
Комментарий
Хотя средства SysV IPC (общая память, семафоры и т. д.) реже используются
в межпроцессных коммуникациях, нежели каналы, именованные каналы и сокеты,
они все же обладают рядом интересных свойств. Тем не менее для совместного
использования переменной несколькими процессами обычно нельзя рассчиты-
вать на работу с общей памятью через shmget или ттар(2). Дело в том, что Perl
заново выделит память под строку тогда, когда вы этого совсем не ждете.
Проблема решается с помощью модуля CPAN IPC: Shareable. Умный модуль
tie, общая память SysV и модуль CPAN Shareable позволяют организовать со-
вместный доступ к структурам данных произвольной сложности для процессов
на одном компьютере. При этом процессы даже не обязаны быть родственными.
В примере 16.11 продемонстрирован несложный случай применения этого
модуля.
Пример 16.11. sharetest
#!/usr/Ы n/perl
# sharetest - совместный доступ к общим переменным в разветвлениях
use IPC:Shareable:
Shandie = tie $buffer, 'IPC:Shareable'. undef, { destroy => 1 }:
$SIG{INT} = sub { die "$$ dying\n" };
for (1 .. 10) {
unless (Schild = fork) { # Я - потомок
die "cannot fork: S!" unless defined Schild:
squabble();
exit:
}
push @k1ds, Schild: # Если нас интересуют идентификаторы процессов
while (1) {
print "Buffer is Sbuffer\n":
sleep 1:
}
die "Not reached":
sub squabble {
my Si =0:
while (1) {
next if Sbuffer =~ /^$$\b/o:
$handle->shlock();
Si++:
Sbuffer = "$$ $1";
Shandle->shunlock():
1
}
Исходный процесс создает общую переменную, порождает 10 потомков, а за-
тем выводит значение буфера примерно каждую секунду в бесконечном цикле
или до тех пор, пока вы не нажмете Ctrl +С.
16.13. Получение списка сигналов
683
Поскольку обработчик SIGI NT был установлен до всех вызовов fork, его наследу-
ют все потомки, которые также уничтожаются при прерывании группы процессов.
Сигналы с клавиатуры передаются целой группе процессов, а не одному процессу.
Что же происходит в squabble? Потомки разбираются, кому из них удастся
обновить общую переменную. Каждый порожденный процесс смотрит, измени-
лось ли состояние переменной с момента последнего визита. Если буфер на-
чинается с его собственной сигнатуры (идентификатора процесса), процесс не
трогает его. Если буфер был изменен кем-то другим, процесс устанавливает
блокировку для общей переменной вызовом специального метода для манипу-
лятора, полученного от tie, обновляет ее и снимает блокировку.
Программа заработает намного быстрее, если закомментировать строку, начинаю-
щуюся с next, где каждый процесс проверяет, кто последним прикасался к буферу.
Шаблон Л$$\Ь/о выглядит подозрительно, поскольку модификатор /о обозна-
чает однократную компиляцию шаблона, а переменная $$ меняется при ответв-
лении. Впрочем, значение фиксируется не во время компиляции программы,
а при первой компиляции шаблона в каждом процессе, во время жизни которо-
го $$ остается постоянной.
Модуль IPC: Shareable также поддерживает совместное использование пере-
менных неродственными процессами на одном компьютере. За подробностями
обращайтесь к документации.
См. также
Описание функций semctl, semget, semop, shmctl, shmget, shmread и shmwrlte
вperlfunc(\y, документация по модулю CPAN IPC: Shareable.
16.13. Получение списка сигналов
Проблема
Вы хотите знать, какие сигналы поддерживаются вашей операционной системой.
Решение
Если ваш командный интерпретатор поддерживает встроенную команду kill -1,
используйте ее:
% kill -1
HUP INT QUIT ILL TRAP ABRT BUS FPE KILL USR1 SEGV USR2 PIPE
ALRM TERM CHLD CONT STOP TSTP TTIN TTOU URG XCPU XFSZ VTALRM
PROF WINCH POLL PWR
Чтобы сделать то же самое только на Perl версии 5.004 и выше, выведите ключи
хэша XSIG:
% perl -е ’print jo1n(" ", keys %SIG), "\n"’
XCPU ILL QUIT STOP EMT ABRT BUS USR1 XFSZ TSTP INT I0T USR2 INFO TTOU
ALRM KILL HUP URG PIPE CONT SEGV VTALRM PROF TRAP 10 TERM WINCH CHLD
FPE TTIN SYS
684
Глава 16. Управление процессами и межпроцессные взаимодействия
До выхода версии 5.004 приходилось использовать модуль Config:
% perl -MConfig -е 'print SConfig{sig_name}'
ZERO HUP INT QUIT ILL TRAP ABRT EMT FPE KILL BUS SEGV SYS PIPE ALRM
TERM URG STOP TSTP CONT CHLD TTIN TTOU 10 XCPU XFSZ VTALRM PROF WINCH
INFO USR1 USR2 I0T
Комментарий
Если вы работаете в Perl версии младше 5.004, для получения списка сигналов
вам также придется использовать signame и slgno модуля Config, поскольку кон-
струкция keys %SIG в ранних версиях еще не реализована.
Следующий фрагмент извлекает имена и номера доступных сигналов из стан-
дартного модуля Conf 1g.pm. Индексирование Oslgname по номеру дает имя сигна-
ла, а индексирование Xsigno по имени — номер сигнала.
use Config:
defined $Config{sig_name} or die "No sigs?":
$1=0; # Config добавляет ложный сигнал О
# с именем "ZERO".
foreach Sname (splitC $Config{sig_name})) {
$signo{$name} = $1:
$signame[Si] = Sname:
S1++:
}
См. также
Документация по стандартному модулю Config; раздел «Signals» perlipc(\).
16.14. Посылка сигнала
Проблема
Требуется послать сигнал процессу. Возможна посылка сигнала как вашему
собственному процессу, так и другому процессу в той же системе. Например, вы
перехватили сигнал SIGI NT и хотите передать его потомкам.
Решение
Функция kill отправляет сигнал с заданным именем или номером процессам,
идентификаторы которых перечисляются в качестве остальных аргументов:
kill 9 => $pid: # Послать Spid сигнал 9
kill -1 => $pgrp; # Послать всему заданию сигнал 1
kill USR1 => $$: # Послать себе SIGUSR1
kill HUP => @pids: # Послать SIGHUP процессам из @pids
Комментарий
Функция Perl kill обеспечивает интерфейс к системной функции с тем же име-
нем. Первый аргумент определяет посылаемый сигнал и задается по номеру или
16.15. Установка обработчика сигнала
685
по имени; остальные аргументы определяют идентификаторы процессов, кото-
рым отправляется сигнал. Функция возвращает количество процессов, успешно
получивших сигнал. Сигналы можно отправлять только процессам, для которых
реальный или сохраненный идентификатор пользователя совпадает с вашим ре-
альным или текущим идентификатором — если только вы не являетесь приви-
легированным пользователем.
Если номер сигнала отрицателен, Perl интерпретирует остальные аргументы
как идентификаторы групп процессов и отправляет сигнал процессам, входящим
в эти группы, с помощью системной функции killpg(2).
Группа процессов фактически представляет собой задание. Именно так опе-
рационная система объединяет родственные процессы. Например, когда вы с помо-
щью командного интерпретатора сцепляете две команды, при этом запускаются
два процесса, но лишь одно задание. Когда текущее задание прерывается по
Ctrl +С или приостанавливается по Ctrl +Z, соответствующие сигналы отправля-
ются всему заданию, которое может состоять из нескольких процессов.
Функция kill также позволяет проверить, жив ли процесс. Посылка специ-
ального псевдосигнала с номером 0 сообщает, можно ли послать сигнал процессу,
хотя сам сигнал при этом не передается. Если функция возвращает true, процесс
жив. Если возвращается false, процесс либо сменил свой действующий иден-
тификатор (в этом случае переменной $! присваивается EPERM), либо прекратил
существование ($! присваивается ESRCH). Для процессов-зомби (см. рецепт 16.19)
также возвращается ESRCH.
use POSIX qw(:errno_h):
If (kill 0 => Smlnlon) {
print "Smlnlon Is al1ve!\n";
} elsif ($! == EPERM) { # Изменился UID
print "Smlnlon has escaped my control!\n":
} elsif (S' == ESRCH) {
print "Smlnlon Is deceased.\n": # Или зомби
} else {
warn "Odd: I couldn't check on the status of Smlnlon: S!\n":
}
См. также
Раздел «Signals» perlipc^Vy, страницы руководства sigaction(2), signal(3) и kill(2)
вашей системы (если есть); описание функции kill вperlfunc(\).
16.15. Установка обработчика сигнала
Проблема
Вы хотите управлять реакцией программы на сигналы. Это может понадобиться
для перехвата Ctrl +С, избежания накопления завершившихся подпроцессов или
предотвращения гибели вашего процесса при попытке передать данные исчез-
нувшему потомку.
686
Глава 16. Управление процессами и межпроцессные взаимодействия
Решение
Воспользуйтесь хэшем %SIG для установки обработчика по имени или ссылке
на код:
$SIG{QUIT} = \&got_sig_quit: # Вызвать &got_sig_quit
# для каждого SIGQUIT
$SIG{PIPE} = ’got_sig_p1pe'; # Вызвать main::got_sig_pipe
# для каждого SIGPIPE
$SIG{INT} = sub { $ouch++ }: # Увеличить $ouch для каждого SIGINT
Хэш %SIG также позволяет игнорировать сигналы:
$SIG{INT} = 'IGNORE': # Игнорировать сигнал INT
Также есть возможность восстановить стандартный обработчик сигнала:
$SIG{STOP} = 'DEFAULT': # Восстановить стандартный обработчик
# сигнала STOP
Комментарий
Хэш %SIG используется в Perl для управления тем, что происходит при получе-
нии сигналов. Каждый ключ %S IG соответствует определенному сигналу, а значе-
ние — действию, которое должно предприниматься при его получении. В Perl
предусмотрено два особых ассоциированных значения: "IGNORE” означает, что при
получении сигнала не следует выполнять никаких действий, a "DEFAULT" выпол-
няет стандартные действия Unix для данного сигнала.
Хотя программисты на С привыкли к термину SIGINT, в Perl используется
только INT. Предполагается, что имена сигналов используются только в функци-
ях, связанных с обработкой сигналов, поэтому префикс SIG оказывается лишним.
Следовательно, чтобы изменить действия вашего процесса при получении сиг-
нала SIGCHLD, следует присвоить значение $SIG{CHLD}.
Чтобы ваш код выполнялся при получении конкретного сигнала, в хэш зано-
сится либо ссылка на код, либо имя функции (следовательно, при сохранении
строки вам не удастся использовать обработчик с именем IGNORE или DEFAULT;
впрочем, для обработчика сигнала эти имена выглядят довольно странно). Если
имя функции не содержит информации о пакете, Perl считает, что функция при-
надлежит пакету main::, а не тому пакету, в котором обработчик был установлен.
Ссылка на код относится к конкретному пакету, и этот вариант считается пред-
почтительным.
Perl передает коду обработчика один аргумент: имя сигнала, по которому он
вызывается (например, "INT" или "USR1"). При выходе из обработчика продолжа-
ется выполнение действий, выполнявшихся в момент поступления сигнала.
Perl определяет два специальных сигнала,___DIE__и___WARN__. Обработчики
этих сигналов вызываются каждый раз, когда программа на Perl выводит предупре-
ждение (warn) или умирает (die). Это позволяет нам перехватывать предупреж-
дения и по своему усмотрению обрабатывать их или передавать дальше. На вре-
мя своего выполнения обработчики die и warn отключаются, поэтому вы можете
спокойно вызвать die в обработчике___DIE_или warn в обработчике___WARN_, не
опасаясь рекурсии.
16.16. Временное переопределение обработчика сигнала
687
См. также
Раздел «Signals» perlipc(l); страницы руководства sigaction(2), signal(3) и kill(2)
вашей системы (если есть).
16.16. Временное переопределение
обработчика сигнала
Проблема
Вы хотите установить обработчик сигнала, действующий только во время выпол-
нения конкретной процедуры. Например, ваша процедура перехватывает сигнал
SIGI NT, но за ее пределами SIGI NT должен обрабатываться обычными средствами.
Решение
Используйте local для временного переопределения обработчика:
# Обработчик сигнала
sub ding {
$SIG{INT} = \&ding:
warn "\aEnter your name!\n";
}
# Запросить имя с переопределением SIGINT
sub get_name {
local $SIG{INT} = \&ding;
my Sname;
print "Kindly Stranger, please enter your name: ":
chomp( Sname = <> ):
return Sname:
}
Комментарий
Для временного сохранения одного элемента &SIG необходимо использовать local,
а не ту. Изменения продолжают действовать во время выполнения блока, вклю-
чая все функции, которые могут быть вызваны из него. В приведенном примере
это процедура get_name. Если сигнал будет доставлен во время работы другой
функции, вызванной вашей функцией, сработает ваш обработчик сигнала — если
только вызванная подпрограмма не установила собственный обработчик. Пре-
дыдущее значение элемента хэша автоматически восстанавливается при выходе
из блока. Это один из немногочисленных случаев, когда динамическая область
действия оказывается скорее удобной, нежели запутанной.
См. также
Рецепт 10.13; рецепт 16.15; рецепт 16.18.
688
Глава 16. Управление процессами и межпроцессные взаимодействия
16.17. Написание обработчика сигнала
Проблема
Требуется написать процедуру, которая будет вызываться программой при каж-
дом получении сигнала.
Решение
Обработчик сигнала представляет собой обычную процедуру. С некоторой сте-
пенью риска в обработчике можно делать все, что допустимо в любой другой
процедуре Perl, но чем больше вы делаете, тем больше рискуете.
В некоторых системах обработчик должен переустанавливаться после каждо-
го сигнала:
$SIG{INT} = \&gotjnt:
sub gotjnt {
$SIG{INT} = \&gotjnt: # Но не для SIGCHLD!
# ...
}
Некоторые системы перезапускают блокирующие операции (например, чте-
ние данных). В таких случаях необходимо вызвать в обработчике die и перехва-
тить вызов при помощи eval:
my $1 interrupted = 0;
sub gotjnt {
Sinterrupted = 1;
$SIG{INT} = ‘DEFAULT’: # или ’IGNORE’
die:
}
eval {
$SIG{INT} = \&got_int:
# ... Длинный код, который нежелательно перезапускать
}:
if (Sinterrupted) {
# Разобраться с сигналом
}
Комментарий
На уровне С сигналы могут прерывать практически все, что угодно. К сожале-
нию, это означает, что сигналы также могут прервать Perl во время модифика-
ции внутренних структур данных, в результате чего нарушается целостность
этих структур и происходит системный сбой. В версии 5.8 Perl прилагает все
усилия к тому, чтобы этого не случилось, — при установке обработчика сигнала
устанавливается обработчик уровня С, который говорит: «Perl получил этот
сигнал». Если после очередной выполненной операции структуры данных Perl
16.17. Написание обработчика сигнала
689
сохраняют целостность, интерпретатор Perl проверяет, был ли получен сигнал,
и если был — вызывает ваш обработчик.
Тем самым предотвращаются системные сбои, но за это приходится распла-
чиваться некоторой задержкой обработки сигналов при выполнении долгих
встроенных операций Perl. Например, построение списка
= 1..5_000_000;
в сильно загруженной системе может занять до 10 секунд, однако вы не сможете
прервать эту операцию, поскольку Perl не проверяет сигналы до того, как будет
завершено построение списка. В команде задействованы две операции (построе-
ние списка и присваивание), и Perl проверяет сигналы лишь после завершения
каждой операции.
Сигналы были реализованы во многих операционных системах, причем не
всегда одинаково. Отличия в реализации сигналов чаще всего проявляются в двух
ситуациях: когда сигнал происходит во время активности обработчика (надеж-
ность) и когда сигнал прерывает блокирующий вызов системной функции типа
read или accept (перезапуск).
Первоначальная реализация сигналов в Unix была ненадежной. Это означа-
ло, что во время работы обработчика при других поступлениях того же сигнала
происходило некоторое стандартное действие (обычно аварийное завершение
программы). Новые системы решают эту проблему (конечно, каждая — в своем,
слегка особом стиле), позволяя подавлять другие экземпляры сигнала с данным
номером до завершения обработчика. Если Perl обнаружит, что ваша система
может использовать надежные сигналы, он генерирует соответствующие вызовы
системных функций, чтобы программы вели себя более логично и безопасно.
Система сигналов POSIX позволяет запретить доставку сигналов и в другие мо-
менты времени (см. рецепт 16.20).
Чтобы получить по-настоящему переносимый код, программист-параноик за-
ранее предполагает самое худшее (ненадежные сигналы) и вручную переустанав-
ливает обработчик сигналов, обычно в самом начале функции:
$SIG{INT} = \&catcher:
sub catcher {
# ...
$SIG{INT} = X&catcher:
}
Особый случай перехвата SIGCHLD описан в рецепте 16.19. System V ведет себя
очень странно и может сбить с толку.
Чтобы узнать, располагаете ли вы надежными сигналами, воспользуйтесь мо-
дулем Config:
use Config:
print "Hurrah!\n" if $Config{d_sigaction};
Наличие надежных сигналов еще не означает, что вы автоматически получаете
надежную программу. Впрочем, без них программа заведомо окажется ненадежной.
Первые реализации сигналов прерывали медленные вызовы системных функ-
ций, которые требовали взаимодействия со стороны других процессов или драй-
веров устройств. Если сигнал поступает во время выполнения этих функций,
690
Глава 16. Управление процессами и межпроцессные взаимодействия
они (и их аналоги в Perl) возвращают признак ошибки и присваивают коду ошиб-
ки значение EINTR, "Interrupted system call". Проверка этого условия настолько
усложняет программу, что во многих случаях это вообще не делается, поэтому
при прерывании сигналом медленных системных функций программа начинает
вести себя неверно или аварийно завершается. Большинство современных версий
Unix позволяет изменить ход событий. Perl всегда делает системные функции
перезапускаемыми, если эта возможность поддерживается системой. В POSIX-
совместимых системах можно управлять перезапуском с помощью модуля POSIX
(см. рецепт 16.20).
Чтобы узнать, будет ли прерванная системная функция автоматически пере-
запущена, загляните в заголовочный файл signal.h вашей системы:
% egrep ’S[AV]_(RESTART|INTERRUPT)’ /usr/1nclude/*/s1gnal.h
Два сигнала не перехватываются и не игнорируются: SIGKILL и SIGSTOP. Пол-
ная информация о сигналах вашей системы и об их значении приведена на стра-
нице руководства signal(3).
Наконец, в особо враждебных операционных системах возникают другие
проблемы с сигналами. В частности, некоторые операционные системы содер-
жат библиотечные функции, которые сами перехватывают сигналы. Например,
функция gethostbyname(3) в некоторых системах использует сигналы SIGALRM для
управления тайм-аутами и перезапусками. Работать может только один таймер,
поэтому вы не можете сказать: «Прервать поиск хоста через пять секунд», так
как сразу же после вызова библиотечной функции ваш 5-секундный таймер будет
замещен таймером gethostbyname. Следовательно, в таких системах поиск хостов
не прерывается, потому что сигналы не доходят до обработчиков. К счастью,
такие ситуации встречаются редко.
См. также
Раздел «Signals» perUpc(l)-, страницы руководства sigaction(2), signal(3) и kill(2)
вашей системы (если есть).
16.18. Перехват Ctrl+С
Проблема
Требуется перехватить нажатие Ctrl+C, приводящее к остановке работы про-
граммы. Вы хотите либо игнорировать его, либо выполнить свою собственную
функцию при получении сигнала.
Решение
Установите обработчик для SIGINT. Присвойте ему "IGNORE", чтобы нажатие
Ctrl+C игнорировалось:
$SIG{INT} = ’IGNORE’;
16.19. Уничтожение процессов-зомби
691
Или задайте собственную процедуру, которая должна реагировать на Ctrl +С:
$SIG{INT} = \&tsktsk;
sub tsktsk {
$SIG{INT} = \&tsktsk: # См. "Написание обработчика сигнала"
warn "\aThe long habit of living indisposeth us for dying.\n";
}
Комментарий
Ctrl+C не влияет на вашу программу напрямую. Драйвер терминала, обрабаты-
вающий нажатия клавиш, опознает комбинацию Ctrl+C (или другую комбина-
цию, заданную вами в качестве символа прерывания при настройке параметров
терминала) и посылает SIGI NT каждому процессу активной группы {активного
задания) данного терминала. Активное задание обычно состоит из всех программ,
запущенных отдельной строкой в командном интерпретаторе, а также всех про-
грамм, запущенных этими программами. За подробностями обращайтесь к раз-
делу Введения «Сигналы».
Символ прерывания — не единственный служебный символ, интерпретируе-
мый драйвером терминала. Текущие настройки терминала можно узнать с по-
мощью команды stty -а:
% stty -а
speed 9600 baud; 38 rows; 80 columns;
1 flags: icanon isig iexten echo echoe -echok echoke -echonl echoctl
-echoprt -altwerase -noflsh -tostop -flusho pendin - nokerninfo
-extproc
iflags: -istrip icrnl -inlcr -igncr ixon -ixoff ixany imaxbel -ignbrk
brkint -inpck -ignpar -parmrk
oflags: opost onlcr oxtabs
cflags: cread cs8 -parenb -parodd hupcl -clocal -cstopb -crtscts -dsrflow
-dtrflow -mdmbuf
cchars: discard - '0; dsusp = 'Y; eof = 'D; eol = <undef;>
eo!2 = <undef; erase = 'H; intr = 'C; kill = 'll; Inext = 'V;>
min = 1; quit = '\; reprint = 'R; start = 'Q; status = <undef;>
stop = 'S; susp = 'Z; time = 0; werase = 'W;
В последней секции, cchars;, перечисляются служебные символы. В рецеп-
те 15.8 показано, как изменить в сценарии без вызова программы stty.
См. также
Страница руководства stty(l) вашей системы (если есть); рецепт 15.8; рецепт 16.17.
16.19. Уничтожение процессов-зомби
Проблема
Программа создает порожденные процессы с помощью fork. Зомби накаплива-
ются, забивают таблицу процессов и раздражают системного администратора.
692
Глава 16. Управление процессами и межпроцессные взаимодействия
Решение
Если вам не нужно регистрировать завершившихся потомков, используйте:
$SIG{CHLD} = ‘IGNORE’;
Чтобы следить за умирающими потомками, установите обработчик SIGCHLD
с вызовом waitpid:
use POSIX ":sys_wait_h";
$SIG{CHLD} = \&REAPER;
sub REAPER {
my Sstiff;
while (Sstiff = waitpid(-l, &WNOHANG) > 0) {
# Обработать Sstiff. если нужно
}
$SIG{CHLD} = \&REAPER; # Установить *после* вызова waitpid
}
Комментарий
Когда процесс завершается, система оставляет его в таблице процессов, чтобы
родитель мог проверить его статус, то есть узнать, как завершился потомок,
нормально или аварийно. Определение статуса потомка (после которого он полу-
чает возможность навсегда покинуть систему) называется «чисткой» (reaping).
В этом рецепте приведены различные рекомендации по чистке зомби. В процес-
се чистки используется вызов wait или waitpid. Некоторые функции Perl (кон-
вейерные вызовы open, system и '...') автоматически вычищают созданных ими
потомков, но при запуске другого процесса с помощью fork вам придется дожи-
даться его завершения.
Чтобы избежать накопления зомби, достаточно сообщить системе, что они
вас не интересуют. Для этого $SIG{CHLD} присваивается значение "IGNORE". Если
вы хотите узнать, когда скончался тот или иной потомок, необходимо использо-
вать waitpid.
Функция waitpid вычищает один процесс. Ее первый аргумент определяет
идентификатор процесса (-1 означает любой процесс), а второй — набор флагов.
Флаг WNOHANG заставляет waitpid немедленно вернуть 0, если нет ни одного мерт-
вого потомка. Флаг 0 поддерживается всеми системами и означает блокирую-
щий вызов. Вызов waitpid в обработчике SIGCHLD (см. Решение) вычищает потом-
ков сразу после их смерти.
Функция wait тоже вычищает потомков, но она вызывается только в блоки-
рующем режиме. Если случайно вызвать ее при наличии работающих потомков,
ни один из которых не умер, программа приостанавливается до появления зомби.
Поскольку ядро следит за недоставленными сигналами посредством битового
вектора (по одному биту на сигнал), если до перехода вашего процесса в актив-
ное состояние умрут два потомка, процесс все равно получит один сигнал SIGCHLD.
Чистка в обработчике SIGCHLD всегда выполняется в цикле, поэтому wait исполь-
зовать нельзя.
16.19. Уничтожение процессов-зомби
693
И wait, и waitpid возвращают идентификатор только что вычищенного про-
цесса и присваивают $? его статус ожидания. Код статуса в действительности со-
стоит из двух 8-разрядных значений, объединенных в одном 16-разрядном чис-
ле. Старший байт определяет код возврата процесса. Младшие 7 бит определяют
номер сигнала, убившего процесс, а 8-й бит показывает, произошла ли критиче-
ская ошибка. Составляющие можно выделить следующим образом:
$exit_value = $? » 8:
$signal_num = $? & 127:
$dumped_core = $? & 128:
Стандартный модуль POSIX содержит специальные макросы для выделения
составляющих статуса: WIFEXITED, WEXITSTATUS, WIFSIGNALLED и WTERMSIG. Как ни
странно, POSIX не содержит макроса для определения того, произошла ли крити-
ческая ошибка.
При использовании SIGCHLD необходимо помнить о двух обстоятельствах. Пре-
жде всего, сигнал SIGCHLD посылается системой не только при завершении по-
томка; сигнал также посылается при остановке. Процесс может остановиться по
многим причинам — он может ожидать перехода в активное состояние для вы-
полнения терминального ввода/вывода, получить сигнал SIGSTOP (после чего
будет ожидать SIGCONT для продолжения работы) или быть приостановленным
с терминала. Проверьте статус функцией WIFEXITED1 модуля POSIX, чтобы убедить-
ся, что процесс действительно умер, а не был остановлен:
use POSIX qw(:signal_h :errno_h):
$SIG{CHLD} = \&REAPER:
sub REAPER {
my Spid:
Spid = waitpid(-l. &WNOHANG):
if (Spid == -1) {
# Ожидающих потомков нет. Игнорировать.
} elsif (WIFEXITED($?)) {
print "Process Spid exited.\n":
} else {
print "False alarm on SpidAn":
}
$SIG{CHLD} = \&REAPER: # На случай ненадежных сигналов
}
Вторая ловушка, связанная с SIGCHLD, относится к Perl, а не к операционной
системе. Поскольку system, open и '...' запускают подпроцессы через fork, а опе-
рационная система отправляет процессу SIGCHLD при выходе из любого подпро-
цесса, вызов обработчика может быть и непредвиденным. Встроенные опера-
ции сами ожидают завершения потомков, поэтому иногда SIGCHLD прибывает
до того, как вызов close для манипулятора заблокирует его для чистки. Если
первым до него доберется обработчик сигнала, то к моменту нормального закры-
тия зомби уже не будет. В результате close вернет false и присвоит $! значение
1 Но не SPOUSEXITED, даже на PC.
694
Глава 16. Управление процессами и межпроцессные взаимодействия
"No child processes". Если вызов close первым доберется до умершего потомка,
waitpid возвращает 0.
В большинстве систем поддерживается асинхронный режим waitpid. Об этом
можно узнать из стандартного модуля Perl Conf 1g.pm:
use Config:
$has_nonblock1ng = $Conf1g{d_wa1tp1d} eq "define" ||
$Conf1g{d_wa1t4} eq "define":
System V определяет сигнал SIGCLD, который имеет тот же номер, что и SIGCHLD,
но слегка отличается по семантике. Чтобы избежать путаницы, используйте SIGCHLD.
См. также
Раздел «Signals» регНрс(Гр описание функций wait и waitpid в perlfunc(V)', доку-
ментация по стандартному модулю POSIX; страницы руководства sigaction(2),
signal(3) и kill(2) вашей системы (если есть); рецепт 16.17.
16.20. Блокировка сигналов
Проблема
Требуется отложить прием сигнала — например, чтобы предотвратить непред-
сказуемые последствия от сигналов, которые могут прервать программу в лю-
бой момент.
Решение
Воспользуйтесь интерфейсом модуля POSIX к системной функции sigprocmask
(только в POSIX-совместимых системах).
Блокировка сигнала на время выполнения операции выполняется так:
use POSIX qw(:s1gnal_h):
Ssigset = POSIX::S1gSet->new(SIGINT): # Определить блокируемые сигналы
$old_s1gset = POSIX::S1gSet->new; # Для хранения старой маски
sigprocmask(SIG_BLOCK, Ssigset. $old_s1gset)
or die "Could not block SIGINTXn":
}
Снятие блокировки выполняется так:
defined sigprocmask(SIG_UNBLOCK, $old_s1gset)
or die "Could not unblock SIGINTXn";
Комментарий
В стандарт POSIX входят функции sigaction и sigprocmask, которые позволяют
лучше управлять доставкой сигналов. Функция sigprocmask управляет отложен-
16.21. Тайм-аут
695
ной доставкой сигналов, a sigaction устанавливает обработчики. При изменении
%SIG Perl по возможности использует sigaction.
Чтобы использовать sigprocmask, сначала постройте набор сигналов методом
POSIX: :S1gSet->new. В качестве аргумента передается список номеров сигналов.
Модуль POSIX экспортирует функции, возвращающие номера сигналов; имена
функций совпадают с именами сигналов:
use POSIX qw(:s1gnal_h):
$s1gset = POSIX::S1gSet->new( SIGINT. SIGKILL ):
Передайте объект POSIX::SlgSet функции sigprocmask с нужным флагом. Флаг
SIG_BLOCK откладывает доставку сигнала. Флаг SIGJJNBLOCK восстанавливает нор-
мальную доставку сигналов, a SIG_GETMASK блокирует только сигналы, содержа-
щиеся в POSIX::SlgSet. Самые отчаянные перестраховщики блокируют сигналы
при вызове fork, чтобы предотвратить вызов обработчика сигнала в порожден-
ном процессе перед тем, как Perl обновит его переменную $$ (идентификатор
процесса). Если обработчик сигнала вызывается немедленно и сообщает значе-
ние $$, то вместо своего собственного $$ он может использовать родительское
значение. Такая проблема возникает очень редко.
См. также
Страница руководства sigprocmaskiT) вашей системы (если есть); документация
по стандартному модулю POSIX.
16.21. Тайм-аут
Проблема
Вы хотите гарантировать, что продолжительность некоторой операции не пре-
вышает заданный промежуток времени. Допустим, вы проводите архивацию
файловой системы и хотите прервать ее, если она затянется более чем на час.
Или вы хотите, чтобы пользователь дал ответ на вопрос в течение определенно-
го промежутка времени.
Решение
Чтобы прервать затянувшуюся операцию, используйте обработчик SIGALRM и вы-
зовите в нем die. Установите таймер функцией alarm и включите код в eval:
eval {
local $SIG{ALRM} = sub { die "alarm clock restart" }:
alarm 10: # Установить сигнал на 10 секунд
eval {
# Продолжительные операции
696
Глава 16. Управление процессами и межпроцессные взаимодействия
Н Н Н IIIIII IIII
ТПТТиНпиНР
}:
alarm 0; # Отмена установленного сигнала
}:
alarm 0: # Защита от перехвата
die if $@ && $@ !~ /alarm clock restart/; # Сгенерировать исключение
Комментарий
Функция alarm получает один аргумент: целое число секунд, после истечения
которых ваш процесс получит сигнал-оповещение SIGALRM. В сильно загру-
женных системах с разделением времени сигнал может быть доставлен позже
указанного времени. По умолчанию SIGALRM завершает программу, поэтому вы
должны установить собственный обработчик сигнала.
Поскольку этот пример должен работать независимо от того, для какой опе-
рации устанавливается тайм-аут, мы предпринимаем специальные меры на слу-
чай, если продолжительная операция содержит вызов медленной системной
функции. К категории «медленных» относятся системные функции, которые не
возвращают управление немедленно, а ожидают наступления некоторого внеш-
него события (например, завершения ввода/вывода или срабатывания таймера).
К их числу относятся read (с readline и оператором <...>), write и open для неко-
торых устройств, каналов и сокетов, а также accept, connect, send, recv, flock, wait,
waitpid и, конечно, sleep. Если во время выполнения медленной системной функ-
ции будет получен сигнал, вы просто перехватите его и вернете управление, то
вы снова вернетесь к этой системной функции. Дело в том, что Perl по возможно-
сти автоматически перезапускает системные функции. Выйти из ситуации можно
только одним способом — сгенерировать исключение die и перехватить его при
помощи eval (такое решение работает, потому что исключение в конечном счете
вызывает функцию longjmp(3) библиотеки С, которая и предотвращает переза-
пуск системной функции).
Почему мы используем вложенный перехват исключений? Потому что вы не
можете быть уверены в том, что произвольный код вашей долгой операции не
сгенерирует свое собственное исключение. Если это произойдет, управление
выйдет за пределы внутреннего блока eval с необработанным сигналом. Вторая
команда alarm 0 необходима на тот случай, если сигнал поступил после выполне-
ния длительной операции, но до первого вызова alarm 0. Если этого не сделать,
возникает совсем ничтожный риск «ситуации перехвата» — но в этом случае
размер значения не имеет; ситуация либо есть, либо ее нет. Конечно, нам бы
хотелось, чтобы ее не было.
Функции alarm нельзя (с пользой) передать дробное число секунд; если вы
попытаетесь это сделать, число секунд будет округлено до целого. Создание бо-
лее точных таймеров рассматривается в рецепте 3.9.
См. также
Раздел «Signals» perlipc(l); описание функции alarm в perlfunc(l); рецепт 3.9.
16.22. Преобразование сигналов в фатальные ошибки
697
16,22. Преобразование сигналов
в фатальные ошибки
Проблема
Если программа завершается из-за неперехваченного сигнала, блоки END выпол-
няться не будут. Ваша программа получает такие сигналы. Требуется обеспечить
возможность выполнения блоков END.
Решение
Воспользуйтесь директивой sigtrap:
use sigtrap qw(die untrapped normal-signals):
Комментарий
Сигнал, который не был перехвачен программой, заставляет ее умереть без вы-
полнения блоков END. Хотя обработчики сигналов для вызова die можно устано-
вить вручную, при большом количестве сигналов это становится утомительно:
$SIG{INT} = $SIG{HUP} = $SIG{PIPE} = $SIG{TERM} = sub { die }:
Директива sigtrap обеспечивает удобную сокращенную форму записи:
use sigtrap qw(die untrapped normal-signals):
Импортирование die сообщает sigtrap о необходимости вызова die (также
можно импортировать stack-trace для установки обработчиков, выводящих трас-
сировку стека). Импортирование untrapped сообщает sigtrap о том, что обработ-
чики должны устанавливаться только для сигналов, не имеющих обработчиков;
таким образом, если вы обрабатываете SIGPIPE самостоятельно, то sigtrap не будет
заменять ваш обработчик.
Normal-signals принадлежит к числу импортируемых имен, которые опреде-
ляют стандартные наборы сигналов, часто перехватываемые в программах. Спи-
сок этих наборов приведен в табл. 16.2.
Таблица 16.2. Списки сигналов
Список Сигналы
normal-signals HUP, INT, PIPE, TERM
error-signals ABRT, BUS, EMT, FPE, ILL, QUIT, SEGV, SYS, TRAP
old-interface-signals ABRT, BUS, EMT, FPE, ILL, PIPE, QUIT, SEGV, SYS, TERM, TRAP
Списки сигналов могут объединяться:
use sigtrap qw(die untrapped normal-signals error-signals);
Даже допускается объединение разных типов обработчиков в одном списке
импортирования. В следующем фрагменте мы сначала используем untrapped для
698
Глава 16. Управление процессами и межпроцессные взаимодействия
обозначения всех нормальных сигналов, для которых еще не установлен обра-
ботчик, а затем при помощи any возвращаемся к стандартному поведению sigtrap
с назначением обработчиков для всех сигналов в указанном списке:
use sigtrap qw(
die untrapped normal-signals
stack-trace any error-signals
);
См. также
Рецепт 12.7; документация по стандартному модулю sigtrap; рецепт 16.15.
16.23. Программа: sigrand
Следующая программа выдает случайные подписи с применением именованных
каналов. Предполагается, что файл подписей хранится в формате программы
fortune, то есть каждый многострочный блок завершается последовательностью
"H\n". Приведем пример:
Make is like Pascal: everybody likes it, so they go in and change it.
--Dennis Ritchie
%%
I eschew embedded capital letters in names: to my prose-oriented eyes.
they are too awkward to read comfortably. They jangle like bad typography.
--Rob Pike
%%
God made the integers: all else is the work of Man.
--Kronecker
%%
I'd rather have :rofix than const. --Dennis Ritchie
%%
If you want to program in C. program in C. It's a nice language.
I use it occasionally... :-) --Larry Wall
%%
Twisted cleverness is my only skill as a programmer.
--Elizabeth Zwicky
%%
Basically, avoid comments. If your code needs a comment to be understood,
it would be better to rewrite it so it's easier to understand.
--Rob Pike
%%
Comments on data are usually much more helpful than on algorithms.
--Rob Pike
%%
Programs that write programs are the happiest programs in the world.
--Andrew Hume
%%
Мы проверяем, не была ли программа запущена ранее — для этого использу-
ется файл с идентификатором процесса. Если посылка сигнала с номером 0 по-
казывает, что идентификатор процесса все еще существует (или, что случается
16.23. Программа: sigrand
699
редко, им воспользовался кто-то другой), программа просто завершается. Также
мы проверяем текущую отправку Usenet и решаем, следует ли искать специа-
лизированные файлы подписей для конкретных конференций. В этом случае
можно завести разные подписи для каждой конференции, в которую вы пишете.
Для большего разнообразия глобальный файл подписей иногда применяется даже
при наличии специализированного файла.
Программа sigrand может использоваться даже в системах без именованных
каналов — достаточно удалить код создания именованного канала и увеличить
паузу перед обновлениями файла. После этого .signature может быть обычным
файлом. Другая проблема переносимости возникает при переходе программы
в фоновый режим (при котором она почти становится демоном). Если функция
fork недоступна, просто закомментируйте ее.
Полный текст программы приведен в примере 16.12.
Пример 16.12. sigrand
# !/usr/Ы n/perl -w
# sigrand - выдача случайных подписей для файла .signature
use strict:
# Конфигурационные переменные
use vars qw( $NG_IS_DIR $MKNOD $FULLNAME $FIFO $ART $NEWS $SIGS $SEMA
$GLOBRAND $NAME );
# Глобальные имена
use vars qw( $Home $Fortune_Path @Pwd ):
# // // // IIIIIIII I! //// // // // // // // //_// // // //#### // // // // //////# // // II //##-//-//I! I! I! IIIIIIIIIIII I! IIII I! IIII I! IIII I! I! I! I!
# Начало секции конфигурации
# В действительности следует читать из ~/. slgrandrc
gethome():
# rec/humor/funny вместо rec.humor.funny
$NG_IS_DIR = 1:
$MKNOD = "/bin/mknod";
$FULLNAME = "$Home/.fulIname":
$FIFO = "$Home/.signature":
$ART = "$Home/.article":
$NEWS = "$Home/News":
$SIGS = "$NEWS/SIGNATURES";
$SEMA = "$Home/.sigrandpid":
$GLOBRAND =1/4; # Вероятность использования глобальных
# подписей при наличии специализированного файла
# $NAME следует: (1) оставить неопределенным, чтобы программа
# попыталась угадать адрес подписи (возможно, заглянув
# в ~/.fullname. (2) присвоить точный адрес или (3) присвоить
# пустую строку, чтобы отказаться от использования имени.
$NAME = # Означает, что имя не используется
# # $NAME = "me\@home.org\n": Л
продолжение &
700
Глава 16. Управление процессами и межпроцессные взаимодействия
Пример 16.12 (продолжение)
# Конец секции конфигурации -- НОМЕ и FORTUNE
# настраиваются автоматически
setupO; # Выполнить инициализацию
justmeO: # Убедиться, что программа еще не работает
fork && exit; # Перейти в фоновый режим
open (SEMA. "> $SEMA") or die "can't write $SEMA: $!";
print SEMA "$$\n";
close(SEMA) or die "can’t close $SEMA: $!":
# В бесконечном цикле записывать подпись в FIFO.
# Если именованные каналы у вас не поддерживаются, измените
# паузу в конце цикла (например. 10, чтобы обновление
# происходило только каждые 10 секунд).
for (;:) {
open (FIFO, "> SFIFO") or die "can't write SFIFO: $!":
my Ssig = pick_quote():
for ($sig) {
s/4( :?[A\n]*\n){4}) .*$/$l/s: # Ограничиться 4 строками
s/Ч.{1,80}).*? *$/$l/gm; # Обрезать длинные строки
}
# Вывести подпись с именем, если оно присутствует,
# и дополнить до 4 строк
if (SNAME) {
print FIFO SNAME, "\n" x (3 - (Ssig =~ tr/\n//)). Ssig:
} else {
print FIFO Ssig:
}
close FIFO:
# Без небольшой паузы приемник не закончит чтение к моменту,
# когда передатчик снова попытается открыть FIFO:
# поскольку приемник существует, попытка окажется успешной.
# В итоге появятся сразу несколько подписей.
# Небольшая пауза между открытиями дает приемникам возможность
# завершить чтение и закрыть канал.
select(undef. undef. undef, 0.2): # Выждать 1/5 секунды
}
die "XXX: NOT REACHED": # На эту строку вы никогда не попадете
# Игнорировать SIGPIPE на случай, если кто-то открыл FIFO и
# снова закрыл, не читая данных: взять имя пользователя из файла
# .fullname. Попытаться определить полное имя хоста. Следить за
# амперсандами в паролях. Убедиться, что у нас есть подписи или
# цитаты. При необходимости построить FIFO.
sub setup {
$SIG{PIPE} = 'IGNORE':
16.23. Программа: sigrand
701
unless (defined SNAME) { # Если SNAME не определено
if (-e SFULLNAME) { # при конфигурации
SNAME = 'SFULLNAME':
die "SFULLNAME should contain only 1 line, aborting"
if SNAME =~ tr/\n// > 1;
} else {
my($user, $host);
chop($host = 'hostname');
(Shost) = gethostbyname(Shost) unless Shost =~ A./:
Suser = $ENV{USER} || SENV{LOGNAME} || $Pwd[O]
or die "intruder alert";
(SNAME = $PwdC6]) =~ s/..*//;
SNAME =~ s/&/\u\L$user/g: # До сих пор встречается
SNAME = "\t$NAME\t$user\@$host\n":
}
}
check_fortunes() if !-e SSIGS:
unless (-p SFIFO) { # -p проверяет, является ли операнд
# именованным каналом
if (!-е _) {
systemCSMKNOD SFIFO р") && die "can’t mknod SFIFO":
warn "created SFIFO as a named pipe\n";
} else {
die "SO: won’t overwrite file .signatured";
}
} else {
warn "SO: using existing named pipe $FIFO\n";
}
# Получить хорошее начальное значение для раскрутки генератора.
# Не нужно в версиях 5.004 и выше.
srand(time() * ($$ + ($$ « 15))):
}
# Выбрать случайную подпись
sub pick_quote {
my Ssigfile = signame():
if (!-e Ssigfile) {
return fortuneO:
}
open (SIGS, "< Ssigfile" ) or die "can’t open Ssigfile":
local $/ = "H\n":
local S_:
my Squip:
rand($.) < 1 && (Squip = $_) while <SIGS>:
close SIGS:
chomp Squip:
return Squip || "ENOSIG: This signature file is empty.\n":
}
# Проверить, содержит ли ~/.article строку Newsgroups. Если содержит,
# найти первую конференцию и узнать, существует ли для нее
# специализированный набор цитат: в противном случае вернуть глобальный
# набор. Кроме того, время от времени возвращать глобальный набор
# для внесения большего разнообразия в подписи.
продолжение
702
Глава 16. Управление процессами и межпроцессные взаимодействия
Пример 16.12 (продолжение)
sub signame {
(rand(l.O) > ($GLOBRAND) && open ART) || return $SIGS:
local $/ = ’ ’:
local $_ = <ART>:
my($ng) = /Newsgroups:\s*([A,\s]*)/;
$ng =~ s!\.!/!g If $NG_IS_DIR: # If rn -/. or SAVEDIR=£p/£c
$ng = "$NEWS/$ng/SIGNATURES":
return -f $ng ? $ng : $SIGS;
}
# Вызывать программу fortune с параметром -s до тех пор.
# пока мы не получим достаточно короткую цитату или не
# превысим лимит попыток.
sub fortune {
local $_:
my $tr1es = 0:
do {
$_ = '$Fortune_Path -s':
} until tr/\n// < 5 || $tr1es++ > 20:
s/^/ /mg:
$_ || " SIGRAND: deliver random signals to all processes.\n";
}
# Проверить наличие программы fortune. Определить полный путь
# и занести его в глобальную переменную.
sub check_fortunes {
return If $Fortune_Path: # Уже найден
for my $d1r (sp!1t(/:/. $ENV{PATH}). ’/usr/games’) {
return If -x ($Fortune_Path = "$d1r/fortune");
}
die "Need either $SIGS or a fortune program, balling out":
}
# Определение каталога
sub gethome {
@Pwd = getpwu1d($<):
$Home = $ENV{HOME} || $ENV{LOGDIR} || $Pwd[7]
or die "no home directory for user $<":
}
# "Останется только один" -- из фильма "Горец"
sub justme {
If (open SEMA) {
my $p1d:
chop($p1d = <SEMA>);
kill(0. $p1d) and die "$0 already running (pid $p1d). balling out":
close SEMA;
}
}
Сокеты
«Глсндаур: Я духов вызывать могу из бездны.
Хотспер: И я могу, и каждый это может,
Вопрос лишь, явятся ль они на зов».
Вильям Шекспир, «Генрих IV»
17.0. Введение
Сокеты являются «конечными пунктами» в процессе обмена данными. Одни
типы сокетов обеспечивают надежный обмен данными, другие почти ничего не
гарантируют, зато расходуют минимум системных ресурсов. Обмен данными
через сокеты может осуществляться на одном компьютере или через Интернет.
В этой главе мы рассмотрим два самых распространенных типа сокетов: пото-
ковые и дейтаграммные. Потоковые сокеты обеспечивают двусторонние, после-
довательные и надежные коммуникации; они похожи на каналы (pipes). Дейта-
граммные сокеты не обеспечивают последовательную, надежную доставку, но
они гарантируют, что в процессе чтения сохранятся границы сообщений. Ваша
система также может поддерживать сокеты других типов; за подробностями об-
ращайтесь к странице руководства socket(2) или к эквивалентной документации.
Сокеты также делятся по областям (domain): сокеты Интернета и сокеты Unix.
Имя сокета Интернета содержит две составляющих: хост (IP-адрес в определен-
ном формате) и номер порта. В мире Unix сокеты представляют собой файлы
(например, /tmp/mysock).
Кроме области и типа, с сокетом также ассоциируется определенный протокол.
Протоколы не имеют особого значения для рядового программиста, поскольку
для конкретного сочетания области и типа сокета редко используется более од-
ного протокола.
Области и типы обычно идентифицируются числовыми константами (которые
возвращаются функциями, экспортируемыми модулями Socket и 10:: Socket). По-
токовые сокеты имеют тип SOCK_STREAM, а дейтаграммные — SOCK_DGRAM. Области
Интернета соответствует константа PF_INET, а области Unix — константа PF_UNIX
(в POSIX вместо PFJJNIX используется PF_LOCAL, но константа PFJJNIX почти все-
гда допустима просто потому, что используется в огромном количестве сущест-
вующих программ). Используйте символические имена вместо числовых значе-
ний, поскольку последние могут измениться (что неоднократно происходило).
704
Глава 17. Сокеты
Имена протоколов (например, tcp и udp) тоже соответствуют числам, исполь-
зуемым операционной системой. Встроенная функция Perl getprotobyname возвра-
щает номер по имени протокола. Если функциям сокетов передается значение О,
система выберет подходящий протокол по умолчанию.
Perl содержит встроенные функции для создания сокетов и управления ими;
они в основном дублируют свои прототипы на С. Хотя это удобно для получения
низкоуровневого, прямого доступа к системе, большинство предпочитает рабо-
тать с более удобными средствами. На помощь приходят классы 10: -.Socket:: INET
и 10::Socket::UNIX они обеспечивают высокоуровневый интерфейс к низкоуровне-
вым системным функциям.
Начнем с рассмотрения встроенных функций. В случае ошибки все они возвра-
щают undef и присваивают $! соответствующее значение. Функция socket соз-
дает сокет, bind назначает ему локальное имя, connect подключает локальный
сокет к другому (возможно, удаленному). Функция listen готовит сокет к подклю-
чениям со стороны других сокетов, a accept последовательно принимает подклю-
чения. При обмене данными с потоковыми сокетами можно использовать как
print и <>, так и syswrite и sysread, а при обмене с дейтаграммными сокетами —
send и recv (в настоящее время Perl не поддерживает sendmsg(2)).
Типичный сервер вызывает socket, bind и listen, после чего в цикле вызывает
accept в блокирующем режиме, ожидая входящих подключений (см. рецепт 17.2
и рецепт 17.5). Типичный клиент вызывает socket и connect (см. рецепт 17.1 и ре-
цепт 17.4). Дейтаграммные клиенты ведут себя особым образом. Они не обязаны
вызывать connect для передачи данных, поскольку могут указать место назначе-
ния в качестве аргумента send.
При вызове bind, connect или send для конкретного приемника необходимо
указать имя сокета. Имя сокета Интернета состоит из хоста (IP-адрес, упакован-
ный функцией inet_aton) и порта (числа), объединенных в С-подобную структу-
ру функцией sockaddrjn:
use Socket:
Spackedjp = inet_aton("208.146.240.1"):
Ssocketjame = sockaddrjn(Sport, $packed_ip);
Имя сокета Unix представляет собой имя файла, упакованное в структуру С
функцией sockaddrjn:
use Socket:
Ssocketjame = sockaddrjn ("/tmp/mysock"):
Чтобы преобразовать упакованное имя сокета и снова получить имя файла
или пару «хост/порт», вызовите sockaddrjn или sockaddrjn в списковом контексте:
(Sport, Spackedjp) = sockaddrJn(Ssocketjame): # Для сокетов PFJNET
(Sfilename) = sockaddrjn(Ssocketjame): # Для сокетов PFJNIX
Функция inetjitoa преобразует упакованный IP-адрес в ASCII-строку.
$ip_address = inetjtoa( Spackedjp);
Spackedjp = inet_aton( "208.201.239.37"):
Spackedjp = inet_aton("www.oreilly.com"):
17.1. Написание клиента TCP
705
В большинстве рецептов используются сокеты Интернета, однако практиче-
ски все сказанное в равной мере относится и к сокетам Unix. В рецепте 17.6 объ-
ясняются отличия и возможные расхождения.
Сокеты являются основой для работы сетевых серверов. Мы рассмотрим три
варианта построения серверов: в первом для каждого входящего подключения
создается порожденный процесс (рецепт 17.11), во втором сервер создает поро-
жденные процессы заранее (рецепт 17.12), а в третьем процесс-сервер вообще не
создает порожденные процессы (рецепт 17.13).
Некоторые серверы должны одновременно вести прослушивание по многим
IP-адресам (см. рецепт 17.16). Хорошо написанный сервер деинициализируется
и перезапускается при получении сигнала HUP; в рецепте 17.18 показано, как
реализовать такое поведение в Perl. Кроме того, вы узнаете, как идентифициро-
вать оба конца соединения (см. рецепты 17.7 и 17.8).
17.1. Написание клиента TCP
Проблема
Вы хотите подключиться к сокету на удаленном компьютере.
Решение
Следующее решение предполагает, что связь осуществляется через Интернет. ТСР-
подобные коммуникации на одном компьютере рассматриваются в рецепте 17.6.
Либо воспользуйтесь стандартным классом 10: :Socket:: INET:
use 10::Socket:
$socket = 10:-.Socket:: INET->new(PeerAddr => $remote_host,
PeerPort => $remote_port.
Proto => "tcp".
Type => SOCK_STREAM)
or die "Couldn't connect to $remote_host:$remote_port : $@\n":
# ... Сделать что-то с сокетом
print $socket "Why don't you call me anymore?\n":
$answer = <$socket>:
# Отключиться после завершения
close($socket):
либо создайте сокет вручную, чтобы лучше управлять его поведением:
use Socket:
# Создать сокет
socket(TO_SERVER. PF_INET, SOCK_STREAM, getprotobyname('tcp')):
# Построить адрес удаленного компьютера
$internet_addr = inet_aton($remote_host)
or die "Couldn't convert $remote_host into an Internet address: $!\n":
706
Глава 17. Сокеты
$paddr = sockaddr_1n($remote_port, $1nternet_addr);
# Подключиться
connect(TO_SERVER, $paddr)
or die "Couldn't connect to $remote_host:$remote_port : $!\n":
# ... Сделать что-то с сокетом
print TO_SERVER "Why don't you call me anymore?\n":
# И отключиться после завершения
close(TO_SERVER);
Комментарий
Ручное кодирование состоит из множества действий, а класс 10::Socket:: INET объ-
единяет их все в удобном конструкторе. Главное, что необходимо знать, — куда
вы направляетесь (параметры PeerAddr и PeerPort) и каким образом (параметр
Туре). По переданной информации 10: :Socket:: INET пытается узнать все осталь-
ное. Так, протокол по возможности вычисляется по типу и номеру порта; если
это не удается сделать, предполагается протокол tcp.
Параметр PeerAddr содержит строку с именем хоста ("www.oreilly.com") или его
IP-адресом ("204.148.40.9"). PeerPort — целое число, номер порта для подключе-
ния. Номер порта можно включить в адрес в виде "www.orel 1 ly.com:80". Параметр
Туре определяет тип создаваемого сокета: SOCK_DGRAM для дейтаграммного сокета
или SOCK_STREAM для потокового.
Чтобы подключиться через SOCK_STREAM к порту конкретного компьютера, не
поддерживающего других возможностей, передайте 10: :Socket: :INET->new одну
строку с именем хоста и портом, разделенными двоеточием:
$c!1ent = 10::Socket::INET->new("www.yahoo.com:80")
or die $0:
При возникновении ошибки 10: :Socket:: INET возвращает undef, а переменной
$0 (не $ ’.) присваивается сообщение об ошибке.
$s = 10::Socket::INET->new(PeerAddr => "Does not Exist".
Peerport => 80.
Type => SOCK_STREAM )
or die $0:
Если ваши пакеты бесследно исчезают в глубинах сети, вероятно, невоз-
можность подключения к порту будет обнаружена лишь через некоторое вре-
мя. Вы можете уменьшить этот промежуток, передавая параметр Timeout при
вызове 10::Socket:: INET->new():
$s = 10::Socket::INET->new(PeerAddr => "bad.host.com".
PeerPort => 80.
Type => SOCK_STREAM,
Timeout => 5 )
or die $0;
Но в этом случае вы уже не сможете использовать $! или $@, чтобы узнать
причину неудачи — невозможность подключения или тайм-аут. Иногда бывает
удобнее установить тайм-аут вручную, без использования модуля.
17.2. Написание сервера TCP
707
При наличии нескольких сетевых интерфейсов ядро выбирает используемый
интерфейс на основании текущих маршрутов. Если вы захотите переопределить
это поведение, включите параметр LocalAddr в вызов 10::Socket:: INET->new. При
ручном кодировании это делается так:
$inet_addr = inet_aton("208.201.239.37"):
Spaddr = sockaddr_1n(Sport. $inet_addr):
bind(SOCKET, Spaddr) or die "bind: $!":
Если вам известно только имя, действуйте следующим образом:
$inet_addr = gethostbynameCwww.yahoo.com")
or die "Can't resolve www.yahoo.com: $!":
Spaddr = sockaddrjn(Sport. $inet_addr):
bind(SOCKET. Spaddr) or die "bind: $!";
См. также
Описание функций socket, bind, connect и gethostbyname вperlfunc^Yy, документа-
ция по стандартным модулям Socket, 10: -.Socket и Net::hostent; раздел «Internet
TCP Clients and Servers» perlipc(l); рецепт 17.2; рецепт 17.3.
17.2. Написание сервера TCP
Проблема
Вы хотите написать сервер, который ожидает подключения клиентов по сети
к определенному порту.
Решение
Следующее решение предполагает, что связь осуществляется через Интернет.
TCP-подобные коммуникации на одном компьютере рассматриваются в ре-
цепте 17.6.
Воспользуйтесь стандартным классом 10::Socket:: INET:
use 10::Socket:
Sserver = 10::Socket::INET->new(LocalPort => $server_port.
Type => SOCK_STREAM,
Reuse => 1.
Listen => 10 ) # или SOMAXCONN
or die "Couldn't be a tcp server on port $server_port : $@\n":
while (Sclient = Sserver->acceptO) {
# Sclient - новое подключение
}
close(Sserver):
708
Глава 17. Сокеты
Или создайте сокет вручную, что позволит получить полный контроль над ним:
use Socket:
# Создать сокет
socket(SERVER. PF_INET. SOCK_STREAM, getprotobyname('tcp')):
# Чтобы мы могли быстро перезапустить сервер
setsockopt(SERVER. SOL_SOCKET. SO_REUSEADDR. 1);
# Построить свой адрес сокета
$my_addr = sockaddr_1n($server_port. INADDR_ANY):
bl nd(SERVER. $my_addr)
or die "Couldn't bind to port $server_port : $!\n":
# Установить очередь для входящих соединений
11sten(SERVER. SOMAXCONN)
or die "Couldn't listen on port $server_port : $!\n";
# Принимать и обрабатывать подключения
while (accept(CLIENT, SERVER)) {
# Сделать что-то c CLIENT
}
close(SERVER):
Комментарий
Написать сервер сложнее, чем клиент. Необязательная функция 11 sten сообщает
операционной системе, сколько подключений могут находиться в очереди к серверу,
ожидая обслуживания. Функция setsockopt, использованная в Решении, позволяет
избежать двухминутного интервала после уничтожения сервера перед его переза-
пуском (полезна при тестировании). Функция bind регистрирует сервер в ядре.
Наконец, функция accept последовательно принимает входящие подключения.
Числовой аргумент listen определяет количество не принятых функцией
accept подключений, которые будут поставлены в очередь операционной систе-
мой перед тем, как клиенты начнут получать сообщения об ошибке «отказ в об-
служивании». Исторически значение этого аргумента было равно 5, но и сегодня
многие операционные системы тайно устанавливают максимальный размер оче-
реди равным примерно 20. Сильно загруженные веб-серверы стали распростра-
ненным явлением, поэтому многие поставщики увеличивают это значение. Мак-
симальный документированный размер очереди для вашей системы хранится
в константе SOMAXCONN модуля Socket.
Функции accept передаются два аргумента: файловый манипулятор, подклю-
чаемый к удаленному клиенту, и файловый манипулятор сервера. Она возвра-
щает IP-адрес и порт клиента, упакованные 1net_ntoa:
use Socket:
while ($client_address = accept(CLIENT, SERVER)) {
(Sport. $packed_1p) = sockaddr_1n($c!1ent_address):
$dotted_quad = 1net_ntoa($packed_1p):
# Обработать
}
В классах 10:: Socket accept является методом, вызываемым для манипулято-
ра сервера:
17.3. Передача данных через TCP
709
while (Sclient = $server->accept()) {
# ...
}
При вызове в списковом контексте метод accept возвращает клиентский со-
кет и его адрес:
while (($cl1ent,$client_adciress) = $server->accept()) {
# ...
}
Если ожидающих подключений нет, программа блокируется на вызове accept
до того, как появится подключение. Если вы хотите гарантировать, что вызов
accept не будет блокироваться, воспользуйтесь неблокирующими сокетами:
use Fcntl qw(F_GETFL F_SETFL O_NONBLOCK);
$flags = fcntl($SERVER, F_GETFL. 0)
or die "Can't get flags for the socket: $!\n";
$flags = fcntl($SERVER. F_SETFL, $flags | O_NONBLOCK)
or die "Can't set flags for the socket: $!\n";
Если теперь при вызове accept не окажется ожидающих подключений, accept
вернет undef и присвоит $! значение EWOULDBLOCК.
Может показаться, что при возвращении нулевых флагов от F_GETFL будет вы-
звана функция die, как и при неудачном вызове, возвращающем undef. Это не
так — неошибочное возвращаемое значение fcntl, как и для ioctl, преобразуется
Perl в специальное значение ”0 but true". На эту специальную строку даже не
распространяются надоедливые предупреждения флага -w о нечисловых величи-
нах, поэтому вы можете использовать ее в своих функциях, когда возвращаемое
значение равно 0 и, тем не менее, истинно.
См. также
Описание функций socket, bind, listen, accept, fcntl и setsockopt в perlfunc(Y);
страницы руководства fcntl(2), socket(2), setsockopt(2) вашей системы (если они
есть); документация по стандартным модулям Socket, 10: :Socket и Net: :hostent;
раздел «Internet TCP Clients and Servers» perlipc(l); рецепт 7.22; рецепт 7.20; ре-
цепт 17.1; рецепт 17.3; рецепт 17.7.
17.3. Передача данных через TCP
Проблема
Требуется передать или принять данные по ТСР-соединению.
Решение
Следующее решение предполагает, что связь осуществляется через Интернет. ТСР-
подобные коммуникации на одном компьютере рассматриваются в рецепте 17.6.
710
Глава 17. Сокеты
Первый вариант — print или <>:
print SERVER "What is your name?\n":
chomp ($response = <SERVER>):
Второй вариант — функции send и recv:
defined (send(SERVER, $data_to_send, $flags))
or die "Can't send : $!\n":
recv(SERVER, $data_read, $maxlen, $flags)
or die "Can't receive: $!\n":
Третий вариант — соответствующие методы объекта 10: -.Socket:
use 10:-.Socket:
$server->send($data_to_send. $flags)
or die "Can't send: $!\n":
$server->recv($data_read. $f1ags)
or die "Can't recv: $!\n":
Чтобы узнать, могут ли данные быть получены или приняты, воспользуйтесь
функцией select, для которой в классе 10::Socket также предусмотрена удобная
оболочка:
use 10::Select:
$select = 10::Select->new():
$select->add(*FROM_SERVER):
$select->add($to_client);
@read_from = $select->can_read($timeout):
foreach $socket (@read_from) {
# Прочитать ожидающие данные из $socket
}
Комментарий
Сокеты используются в двух принципиально различных типах ввода/вывода, ка-
ждый из которых обладает своими достоинствами и недостатками. Стандартные
функции ввода/вывода Perl, используемые для файлов (кроме seek и sysseek),
работают и для потоковых сокетов, однако для дейтаграммных сокетов необхо-
димы системные функции send и recv, работающие с целыми записями.
При программировании сокетов очень важно помнить о буферизации. Хотя
буферизация и была спроектирована для повышения быстродействия, она мо-
жет повлиять на интерактивное поведение некоторых программ. Если при вводе
данных с помощью <...> будет обнаружен разделитель записей, программа может
попытаться прочитать из сокета больше данных, чем доступно в данный момент.
И print, и <...> используют буферы stdio, поэтому без включения автоматической
очистки буфера (см. Введение главы 7 «Доступ к файлам») для манипулятора
сокета данные не отправятся на другой конец в момент их передачи функцией
print. Вместо этого они будут дожидаться заполнения буфера.
17.3. Передача данных через TCP
711
Вероятно, для клиентов и серверов с построчным обменом данных это подхо-
дит — при условии, что вы не забыли включить автоматическую очистку буфе-
ра. Новые версии 10:: Socket делают это автоматически для анонимных файло-
вых манипуляторов, возвращаемых 10: :Socket->new.
Но стандартный ввод/вывод — не единственный источник буферизации.
Операции вывода (print, printf, syswrite или send для сокета TCP) буферизу-
ются на уровне операционной системы по так называемому алгоритму Нейгла.
Если пакет данных отправлен, но еще не подтвержден, другие передаваемые дан-
ные ставятся в очередь и отправляются либо после набора следующего полного
пакета, либо при получении подтверждения. В некоторых ситуациях (события
мыши в оконных системах, нажатия клавиш в приложениях реального времени)
такая буферизация оказывается неудобной или попросту неверной. Буфериза-
ция Нейгла отключается параметром сокета TCP_NODELAY:
use Socket:
require "sys/socket.ph": # Для &TCP_NODELAY
setsockopt(SOCKET. SOL_SOCKET. &TCP_NODELAY. 1)
or die "Couldn't disable Nagle's algorithm: $!\n";
Ее повторное включение происходит так:
setsockopt(SOCKET, SOL_SOCKET. &TCP_NODELAY, 0)
or die "Couldn't enable Nagle's algorithm: $!\n":
Как правило, TCP_NODELAY все же лучше не указывать. Буферизация TCP суще-
ствует не зря, поэтому не отключайте ее без крайней необходимости, например,
если ваше приложение работает в режиме реального времени с крайне интен-
сивным обменом пакетов.
TCP_NODELAY загружается из sys/socket.ph — этот файл не устанавливается ав-
томатически вместе с Perl, но может быть легко построен. Подробности приве-
дены в рецепте 12.17.
Буферизация чрезвычайно важна, поэтому в распоряжение программиста пре-
доставляется функция select. С ее помощью можно узнать, какие манипуляторы
содержат непрочитанный ввод, в какие манипуляторы возможна запись и для
каких имеются необработанные «исключительные состояния». Функции select
передаются три строки, интерпретируемые как двоичные данные; каждый бит
соответствует файловому манипулятору. Типичный вызов select выглядит так:
$rin = ''; # Инициализировать маску
vec($rin, fl 1 eno(SOCKET). 1) = 1: # Пометить SOCKET в $rin
# Повторить вызовы vec() для каждого проверяемого сокета
Stimeout =10: # Подождать 10 секунд
Snfound = select($rout = $rin, undef, undef, $timeout):
if (vec($rout. fi1 eno(SOCKET),!)){
# В SOCKET имеются данные для чтения
}
Функция select вызывается с четырьмя аргументами. Три из них представляют
собой битовые маски; первая проверяет в манипуляторах наличие непрочитан-
ных данных; вторая — возможность безопасной записи без блокировки; третья —
712
Глава 17. Сокеты
наличие в них исключительных состояний. Четвертый аргумент определяет макси-
мальную длительность ожидания в секундах (может быть вещественным числом).
Функция модифицирует передаваемые ей маски, поэтому при выходе из нее
биты будут установлены лишь для манипуляторов, готовых к вводу/выводу. От-
сюда один стандартный прием — входная маска ($ri п в предыдущем примере)
присваивается выходной ($rout), чтобы вызов select изменил только $rout и ос-
тавил $ri п в прежнем состоянии.
Нулевой тайм-аут определяет режим опроса (проверка без блокировки). Не-
которые начинающие программисты не любят блокировки, и в их программах
выполняется «занятое ожидание» (busy-wait) — программа в цикле выполняет
опрос, снова и снова. Когда программа блокируется, операционная система пони-
мает, что процесс ждет ввода, и передает процессорное время другим программам
до появления входных данных. Когда программа находится в «занятом ожидании»,
система не оставляет ее в покое, поскольку программа всегда что-то делает —
проверяет ввод! Иногда опрос действительно является правильным решением,
но гораздо чаще это не так. Тайм-аут, равный undef, означает отсутствие тайм-
аута, поэтому ваша программа терпеливо блокируется до появления ввода.
Поскольку select использует битовые маски, которые утомительно созда-
вать и трудно интерпретировать, в Решении используется стандартный модуль
10::Select. Он обходит работу с битовыми масками и, как правило, более удобен.
Полное объяснение исключительных состояний, проверяемых третьей мас-
кой select, выходит за рамки данной книги.
Другие флаги send и recv перечислены на страницах руководства этих систем-
ных функций.
См. также
Описание функций send, recv, fl 1 eno, vec, setsockopt и select в perlfunc(l); разделы
«I/O Operators» и «Bitwise String Operators» в perlop(i); страница руководства
setsockopt(2) вашей системы (если есть); документация по стандартным модулям
Socket и 10: :Socket; раздел «Internet TCP Clients and Servers» perlipc(l); ре-
цепт 17.1; рецепт 17.2.
17.4. Создание клиента UDP
Проблема
Вы хотите обмениваться сообщениями с другим процессом, используя UDP
(дейтаграммы).
Решение
Чтобы создать манипулятор для сокета UDP, воспользуйтесь либо низкоуров-
невым модулем Socket для уже существующего манипулятора:
use Socket:
socket(SockHandle. PF_INET, SOCK_DGRAM, getprotobynameCudp"))
or die "socket: $!":
17.4. Создание клиента UDP
713
либо модулем 10:: Socket, возвращающим анонимный манипулятор:
use 10::Socket:
$handle = 10::Socket::INET->new(Proto => ’udp’)
or die "socket: $0": # Да, здесь используется $0
Отправка сообщения на компьютер с именем SHOSTNAME и адресом порта SPORTNO
выполняется так:
$ipaddr = inet_aton($HOSTNAME):
$portaddr = sockaddr_in($PORTNO, $1paddr):
send(SockHandle, $MSG, 0, $portaddr) == length($MSG)
or die "cannot send to $HOSTNAME($PORTNO): $!":
Получение сообщения, длина которого не превышает SMAXLEN:
$portaddr = recv(SockHandle, $MSG, $MAXLEN, 0) or die "recv: $!":
($portno, $ipaddr) = sockaddr_in($portaddr):
$host = gethostbyaddr($ipaddr, AF_INET);
print ”$host($portno) said $MSG\n":
Комментарий
Дейтаграммные сокеты не похожи на потоковые. Поток создает иллюзию посто-
янного соединения. Он напоминает телефонный звонок — установка связи об-
ходится дорого, но в дальнейшем связь надежна и проста в использовании. Дей-
таграммы больше похожи на почту — если ваш знакомый находится на другом
конце света, дешевле и проще отправить ему письмо, чем дозвониться по те-
лефону. Дейтаграммы потребляют меньше системных ресурсов, чем потоки.
Вы пересылаете небольшой объем информации, по одному сообщению за раз.
Однако доставка сообщений не гарантируется, и они могут быть приняты в не-
верном порядке. Если очередь получателя переполнится, как маленький почто-
вый ящик, то дальнейшие сообщения теряются.
Если дейтаграммы настолько ненадежны, зачем же ими пользоваться? Просто
некоторые приложения наиболее логично реализуются с применением дейтаграмм.
Например, при пересылке аудиоданных важнее сохранить поток в целом, чем га-
рантировать прохождение каждого пакета, особенно если потеря пакетов вызва-
на недостаточной пропускной способностью. Дейтаграммы также часто приме-
няются в широковещательной рассылке (аналог массовой рассылки рекламных
объявлений по почте). В частности, широковещательные пакеты используются
для отправки в локальную подсеть сообщений типа: «Есть здесь кто-нибудь, кто
хочет быть моим сервером?»
Поскольку дейтаграммы не создают иллюзии постоянного соединения, в работе
с ними вы располагаете несколько большей свободой. Вам не придется вызывать
connect для подключения сокета к удаленной точке, с которой вы обмениваетесь
данными. Вместо этого каждая дейтаграмма адресуется отдельно при вызове send.
Предполагая, что $remote_addr является результатом вызова sockaddr_in, посту-
пите следующим образом:
send(MYSOCKET, $msg_buffer, $flags, $remote_addr)
or die "Can't send: $!\n";
714
Глава 17. Сокеты
Единственный часто используемый флаг, MSG_OOB, позволяет отправлять и при-
нимать внеполосные (out-of-band) данные в нетривиальных приложениях.
Удаленный адрес ($remote_addr) должен представлять собой комбинацию
порта и адреса Интернета, возвращаемую функцией sockaddrjn модуля Socket.
Если хотите, вызовите connect для этого адреса — в этом случае последний аргу-
мент при вызове send можно опускать, а все сообщения будут отправлены этому
получателю. В отличие от потоковых коммуникаций, один дейтаграммный сокет
позволяет подключаться к разным компьютерам.
В примере 17.1 приведена небольшая программа, использующая протокол
UDP. Она устанавливает связь с портом времени UDP на компьютере, имя кото-
рого задается в командной строке, или по умолчанию на локальном компьютере.
Программа работает не на всех компьютерах, но при наличии сервера UDP вы
получите четырехбайтовое целое число, байты которого упакованы в сетевом
порядке; число равно количеству секунд с 1900 года по данным этого компьютера.
Чтобы передать это время функции преобразования local time или gmtlme, необ-
ходимо вычесть из него количество секунд от 1900 до 1970 года.
Пример 17.1. clockdrift
#!/usr/Ы n/perl
# clockdrift - сравнение текущего времени с другой системой
use strict:
use Socket:
my (Shost. $him. Ssrc. $port. $ipaddr, $ptime. Sdelta):
my $SECS_of_70_YEARS = 2_208_988_800;
socket(MsgBox. PF_INET. SOCK_DGRAM. getprotobyname("udp"))
or die "socket: $!";
$him = sockaddr_in(scalar(getservbyname("time". "udp")),
inet_aton(shift || '127.1'));
defined(send(MsgBox, 0. 0. Shim))
or die "send: S’":
defined($src = recv(MsgBox, Sptime, 4. 0))
or die "recv: S’";
(Sport. Sipaddr) = sockaddr_in($src);
Shost = gethostbyaddr(Si paddr. AF_INET):
my Sdelta = (unpackCN". Sptime) - $SECS_of_70_YEARS) - timeO:
print "Clock on Shost is Sdelta seconds ahead of this one.\n":
Если компьютер, с которым вы пытаетесь связаться, не работает или ответ
потерян, программа застрянет при вызове recv в ожидании ответа, который ни-
когда не придет.
См. также
Описание функций send, recv, gethostbyaddr и unpack в perlfunc(V)\ документация
по стандартным модулям Socket и 10: :Socket; раздел «Message passing» perlipc(\)\
рецепт 17.5.
17.5. Создание сервера UDP
715
17.5. Создание сервера UDP
Проблема
Вы хотите написать сервер UDP.
Решение
Сначала вызовите функцию bi nd для номера порта, по которому будет осущест-
вляться связь с вашим сервером. С модулем 10:: Socket это делается просто:
use 10::Socket:
$server = 10::Socket::INET->new(Local Port => $server_port.
Proto => "udp")
or die "Couldn't be a udp server on port $server_port : $@\n":
Затем в цикле принимайте сообщения:
while ($him = $server->recv($datagram, $MAX_TO_READ. $flags)) {
# Обработать сообщение
}
Комментарий
Программирование для UDP намного проще, чем для TCP. Вместо того чтобы
последовательно принимать клиентские подключения и вступать в долгосроч-
ную связь с клиентом, достаточно просто принимать сообщения от клиентов по
мере их поступления. Функция recv возвращает адрес отправителя, подлежащий
декодированию.
В примере 17.2 показан небольшой сервер UDP, который просто ожидает со-
общений. Каждый раз, когда приходит очередное сообщение, мы выясняем, кто
его послал, и отправляем в ответ сообщение с принятым текстом, после чего со-
храняем новое сообщение.
Пример 17.2. udpqotd
#!/usr/bin/perl -w
# udpqotd - сервер сообщений UDP
use strict:
use 10::Socket:
my($sock. $oldmsg, $newmsg, $hisaddr, $hishost. $MAXLEN. $PORTNO):
$MAXLEN = 1024:
$PORTNO = 5151:
$sock = 10:-.Socket:: INET->new( Local Port => $PORTNO, Proto => 'udp')
or die "socket: $0":
print "Awaiting UDP messages on port $PORTNO\n":
$oldmsg = "This is the starting message.":
while ($sock->recv($newmsg. $MAXLEN)) {
my($port. $ipaddr) = sockaddr_in($sock->peername):
$hishost = gethostbyaddr($ipaddr. AF_INET):
print "Client $hishost said "$newmsg‘'\n":
$sock->send($oldmsg):
$oldmsg = "[$hishost] $newmsg":
}
die "recv: $!":
716
Глава 17. Сокеты
С использованием модуля 10:: Socket программа получается проще, чем с низ-
коуровневым модулем Socket. Нам не приходится указывать, куда отправить
сообщение, поскольку библиотека сама определяет отправителя последнего со-
общения и сохраняет его в объекте Ssock. Метод peername извлекает данные для
декодирования.
Общаться с этим сервером через telnet невозможно, для этого необходим
специальный клиент. Один из вариантов приведен в примере 17.3.
Пример 17.3. udpmsg
#!/usr/Ыn/perl -w
# udpmsg - отправка сообщения серверу udpquotd
use 10::Socket:
use strict:
my($sock. $server_host, $msg, $port. $1 paddr. $hishost,
SMAXLEN. SPORTNO, STIMEOUT):
SMAXLEN = 1024;
SPORTNO = 5151:
STIMEOUT = 5;
$server_host = shift;
Smsg = "@ARGV":
Ssock = 10::Socket::INET->new(Proto => 'udp'.
PeerPort => SPORTNO.
PeerAddr => $server_host)
or die "Creating socket; $!\n";
$sock->send($msg) or die "send: S’";
eval {
local $SIG{ALRM} = sub { die "alarm time out" }:
alarm STIMEOUT;
$sock->recv($msg. SMAXLEN) or die "recv; S’":
alarm 0:
1: # Нормальное возвращаемое значение eval
} or die "recv from $server_host timed out after STIMEOUT seconds.\n";
(Sport. Sipaddr) = sockaddr_in($sock->peername);
Shishost = gethostbyaddr(Si paddr. AF_INET);
print "Server Shishost responded "$msg''\n";
При создании сокета мы с самого начала указываем хост и номер порта, что
позволяет опустить эти данные при вызовах send.
Тайм-аут (alarm) был добавлен на случай, если сервер не отвечает или вооб-
ще не работает. Поскольку recv является блокирующей системной функцией,
выход из которой может и не произойти, мы включаем ее в стандартный блок
eval для прерывания блокировки по тайм-ауту.
См. также
Описание функций send, recv и alarm в perlfunc(l); документация по стан-
дартным модулям Socket и 10::Socket; раздел «Message passing» perlipc(l); ре-
цепт 16.21; рецепт 17.4.
17.6. Использование сокетов UNIX
717
17.6. Использование сокетов UNIX
Проблема
Вы хотите обмениваться данными с другими процессами, находящимися исклю-
чительно на локальном компьютере.
Решение
Воспользуйтесь сокетами Unix. При этом можно использовать программы и прие-
мы, приводившиеся в предыдущих рецептах для сокетов Интернета, со следую-
щими изменениями:
О Вместо socketaddrjn используется socketaddr_un.
О Вместо 10:: Socket:: INET используется 10:: Socket:: UN IX, а вместо PeerAddr/
PeerPort и LocalAddr/LocalPort — Peer и Local.
О Вместо PF_INET используется PFJJNIX, а при вызове socket в последнем аргу-
менте передается PFJJNSPEC.
О Клиенты SOCK_STREAM не обязаны вызывать bind для локального адреса перед
вызовом connect.
Комментарий
Имена сокетов Unix похожи на имена файлов в файловой системе. Фактически
в большинстве систем они реализуются в виде специальных файлов; именно это
и делает оператор Perl -S — он проверяет, является ли файл сокетом UNIX.
Передайте имя файла в аргументе Peer при вызове 10::Socket::UNIX->new или
закодируйте его функцией sockaddrjjn и передайте его connect. Посмотрим, как
создаются серверные и клиентские сокеты Unix в модуле 10::Socket::UNIX:
use 10::Socket:
unlink "/trnp/mysock":
$server = 10::Socket::UNIX->new(LocalAddr => "/trnp/mysock".
Type => SOCK_STREAM.
Listen => 5 )
or die $0:
$c!1ent = 10::Socket::UNIX->new(PeerAddr => "/trnp/mysock".
Type => SOCK_STREAM.
Timeout => 10 )
or die $0:
Пример использования традиционных функций для создания потоковых со-
кетов выглядит так:
use Socket:
socket(SERVER. PFJJNIX. SOCK_STREAM. 0):
unlink "/trnp/mysock":
718
Глава 17. Сокеты
bi nd(SERVER. sockaddr_un("/tmp/mysock"))
or die "Can't create server: $!";
socket(CL I ENT. PFJJNIX. SOCK_STREAM, 0):
connect(CLIENT. sockaddr_un("/tmp/mysock"))
or die "Can't connect to /tmp/mysock: $!":
Если вы не уверены полностью в правильном выборе протокола, присвойте
аргументу Proto при вызове 10: :Socket::UNIX->new значение 0 для сокетов PFJJNIX.
Сокеты Unix могут быть как дейтаграммными (SOCKJDGRAM), так и потоковыми
(SOCK_STREAM), сохраняя при этом семантику аналогичных сокетов Интернета.
Изменение области не меняет характеристик типа сокета.
Поскольку многие системы действительно создают специальный файл в фай-
ловой системе, вы должны удалить этот файл перед попыткой привязки сокета
функцией bi nd. Хотя при этом возникает «ситуация перехвата» (между вызова-
ми unlink и bind кто-то может создать файл с именем вашего сокета), это не вы-
зывает особых погрешностей в системе безопасности, поскольку bl nd не переза-
писывает существующие файлы.
См. также
Рецепты 17.1-17.5.
17.7. Идентификация другого конца сокета
Проблема
Имеется сокет. Вы хотите идентифицировать компьютер, находящийся на дру-
гом конце.
Решение
Если вас интересует только IP-адрес удаленного компьютера, поступите сле-
дующим образом:
use Socket:
$other_end = getpeername(SOCKET)
or die "Couldn't identify other end: $!\n":
($port. $iaddr) = unpack_sockaddr_in($other_end):
$ip_address = inet_ntoa($iaddr):
Имя хоста определяется несколько иначе:
use Socket:
$other_end = getpeername(SOCKET)
or die "Couldn't identify other end: $!\n":
(Sport. Siaddr) = unpack_sockaddr_in($other_end):
Sactualjp = inet_ntoa($iaddr):
17.7. Идентификация другого конца сокета
719
$clalmed_hostname = gethostbyaddr($1addr. AF_INET):
@name_lookup = gethostbyname($claimed_hostname)
or die "Could not look up $claimed_hostname : $!\n":
@resol vedjps = map { inet_ntoa($_) }
@name_lookup[ 4 .. $#ips_for_hostname ];
Комментарий
В течение долгого времени задача идентификации подключившихся компьюте-
ров считалась более простой, чем на самом деле. Функция getpeername возвраща-
ет IP-адрес удаленного компьютера в упакованной двоичной структуре (или undef
в случае ошибки). Распаковка выполняется функцией inetjrtoa. Если вас интере-
сует имя удаленного компьютера, достаточно вызвать gethostbyaddr и поискать
его в таблицах DNS, не так ли?
Не совсем. Это лишь половина решения. Поскольку поиск по имени выпол-
няется на сервере DNS владельца имени, а поиск по IP-адресу — на сервере DNS
владельца адреса, приходится учитывать, что компьютер, к которому вы подключи-
лись, возможно выдает неверные имена. Например, компьютер evil .crackers.org
может принадлежать злобным киберпиратам, которые сказали своему серверу
DNS, что их IP-адрес (1.2.3.4) следует идентифицировать как trusted.dod.gov. Если
ваша программа доверяет trusted.dod.gov, то при подключении с evil .crackers.org
функция getpeername вернет правильный IP-адрес (1.2.3.4), однако gethostbyaddr
вернет ложное имя.
Чтобы справиться с этой проблемой, мы берем имя (возможно, ложное),
полученное от gethostbyaddr, и снова вызываем для него функцию gethostbyname.
В примере с evil .crackers.org поиск для trusted.dod.gov будет выполняться на
сервере DNS dod.gov и вернет настоящий IP-адрес (адреса) trusted.dod.gov.
Поскольку многие компьютеры имеют несколько IP-адресов (очевидный при-
мер — многоканальные веб-серверы), мы не можем использовать упрощенную
форму gethostbyname:
$packed_ip = gethostbyname($name) or die "Couldn't look up $name : $!\n":
$ip_address = inet_ntoa($packed_ip);
До настоящего момента предполагалось, что мы рассматриваем приложение
с сокетами Интернета. Функцию getpeername также можно вызвать для сокета
UNIX. Если на другом конце была вызвана функция bind, вы получите имя фай-
ла, к которому была выполнена привязка. Однако если на другом конце функ-
ция bind не вызывалась, то getpeername может вернуть пустую (неупакованную)
строку, упакованную строку со случайным мусором, или undef как признак ошиб-
ки... или ваш компьютер перезагрузится (варианты перечислены по убыванию
вероятности и возрастанию неприятностей). В нашем компьютерном деле это
называется «непредсказуемым поведением».
Но даже этого уровня паранойи и перестраховки недостаточно. При желании
можно обмануть сервер DNS, не находящийся в вашем непосредственном распо-
ряжении, поэтому при идентификации и аутентификации не следует полагаться
на имена хостов. Настоящие параноики и мизантропы обеспечивают безопас-
ность с помощью криптографических методов.
720
Глава 17. Сокеты
См. также
Описание функций gethostbyaddr, gethostbyname и getpeername в perlfunc(l)} опи-
сание функции inetjitoa в стандартном модуле Socket; документация по стан-
дартным модулям 10::Socket и Net: :hostnet.
17.8. Определение вашего имени и адреса
Проблема
Требуется узнать ваше (полное) имя хоста.
Решение
Сначала получите свое (возможно, полное) имя хоста. Воспользуйтесь либо
стандартным модулем Sys::Hostname:
use Sys::Hostname:
$hostname = hostnameO:
либо функцией uname модуля POSIX:
use POSIX qw(uname);
($kernel. $hostname, $release, $version, $hardware) = unameO:
$hostname = (uname)[l]: # Только одно значение
Затем превратите его в IP-адрес и преобразуйте в каноническую форму:
use Socket: # Для AF_INET
$address = gethostbyname($hostname)
or die "Couldn't resolve $hostname : $!":
$hostname = gethostbyaddr($address, AF_INET)
or die "Couldn't re-resolve $hostname : $!":
Комментарий
Для улучшения переносимости модуль Sys:: Hostname выбирает оптимальный
способ определения имени хоста, руководствуясь сведениями о вашей системе.
Он пытается получить имя хоста несколькими различными способами, но часть
из них связана с запуском других программ. Это может привести к появлению
меченых данных (см. рецепт 19.1).
Тем не менее, POSIX::uname работает только в POSIX-совместимых системах
и не гарантирует получения полезных данных в интересующем нас поле nodename.
Впрочем, на многих компьютерах это значение все же приносит пользу и не стра-
дает от проблемы меченых данных, в отличие от Sys:: Hostname.
Однако после получения имени хоста следует учесть возможность того, что
в нем отсутствует имя домена. Например, Sys::Hostname вместо guanaco.camelids.org
может вернуть просто guanaco. Чтобы исправить ситуацию, преобразуйте имя
17.9. Закрытие сокета после разветвления
721
в IP-адрес функцией gethostbyname, а затем — снова в имя функцией gethostbyaddr.
Привлечение DNS гарантирует получение полного имени.
См. также
Описание функций gethostbyaddr и gethostbyname в perlfunc{\)\ документация по
стандартным модулям Net: :hostnet и Sys::Hostname.
17.9. Закрытие сокета после разветвления
Проблема
Ваша программа разветвилась, и теперь на другой конец необходимо сообщить
о завершении отправки данных. Вы попытались вызвать close для сокета, но
удаленный конец не получает ни EOF, ни SIGPIPE.
Решение
Воспользуйтесь функцией shutdown:
shutdown(SOCKET, 0): # Прекращается чтение данных
shutdown(SOCKET, 1): # Прекращается запись данных
shutdown(SOCKET, 2): # Прекращается работа с сокетом
Используя объект 10:: Socket, также можно написать:
$socket->shutdown(0): # Прекращается чтение данных
Комментарий
При разветвлении (forking) процесса потомок получает копии всех открытых
файловых манипуляторов родителя, включая сокеты. Вызывая close для файла
или сокета, вы закрываете только копию манипулятора, принадлежащую теку-
щему процессу. Если в другом процессе (родителе или потомке) манипулятор
остался открытым, то операционная система не будет считать файл или сокет
закрытым.
Рассмотрим в качестве примера сокет, в который посылаются данные. Если
он открыт в двух процессах, то один из процессов может закрыть его, и операци-
онная система все равно не будет считать сокет закрытым, поскольку он остается
открытым в другом процессе. До тех пор пока он не будет закрыт другим процес-
сом, процесс, читающий из сокета, не получит признак конца файла. Это может
привести к недоразумениям и взаимным блокировкам.
Чтобы избежать затруднений, либо вызовите close для незакрытых манипу-
ляторов, либо воспользуйтесь функцией shutdown. Функция shutdown является
более радикальной формой close — она сообщает операционной системе, что
даже несмотря на наличие копий манипулятора у других процессов он должен
быть помечен как закрытый, а другая сторона должна получить признак конца
файла при чтении или SIGPIPE при записи.
722
Глава 17. Сокеты
Числовой аргумент shutdown позволяет указать, какие стороны соединения
закрываются. Значение 0 говорит, что чтение данных закончено, а другой конец
сокета при попытке передачи данных должен получить SIGPIPE. Значение 1 гово-
рит о том, что закончена запись данных, а другой конец сокета при попытке чте-
ния данных должен получать признак конца файла. Значение 2 говорит о завер-
шении как чтения, так и записи.
Представьте себе сервер, который читает запрос своего клиента до конца
файла и затем отправляет ответ. Если клиент вызовет close, сокет станет недос-
тупным для ввода/вывода, поэтому ответ от сервера не доберется до клиента.
Вместо этого клиент должен вызвать shutdown, чтобы закрыть соединение на-
половину.
print SERVER "my request\n"; # Отправить данные
shutdown(SERVER. 1); # Отправить признак конца данных;
# запись окончена.
Sanswer = <SERVER>: # хотя чтение все еще возможно.
См. также
Описание функций close и shutdown в perlfunc(l); страница руководства shutdown(2)
вашей системы (если есть).
17.10. Написание двусторонних клиентов
Проблема
Вы хотите написать полностью интерактивный клиент, в котором можно ввести
строку, получить ответ, ввести другую строку, получить новый ответ и т. д. —
словом, нечто похожее на telnet.
Решение
После того как соединение будет установлено, разветвите процесс. Один из
близнецов только читает ввод и передает его серверу, а другой читает выходные
данные сервера и копирует их в поток вывода.
Комментарий
В отношениях «клиент/сервер» бывает трудно определить, чья сейчас очередь
«говорить». Однозадачные решения, в которых используется версия select с че-
тырьмя аргументами, трудны в написании и сопровождении. Однако нет при-
чин игнорировать многозадачные решения, а функция fork кардинально упро-
щает эту проблему.
После подключения к серверу, с которым вы будете обмениваться данными,
вызовите fork. Каждый из двух идентичных (или почти идентичных) процессов
17.10. Написание двусторонних клиентов
723
выполняет простую задачу. Родитель копирует все данные, полученные из соке-
та, в стандартный вывод, а потомок одновременно копирует все данные из стан-
дартного ввода в сокет.
Исходный текст программы приведен в примере 17.4.
Пример 17.4. biclient
#’/usr/Ыn/perl -w
# biclient - двусторонний клиент с разветвлением
use strict;
use 10::Socket;
my (Shost, Sport, Skidpid. Shandie, Sline);
unless (@ARGV == 2) { die "usage: $0 host port" }
(Shost. Sport) = OARGV:
# Создать tcp-подключение для заданного хоста и порта
Shandie = 10::Socket::INET->new(Proto => "top".
PeerAddr => Shost.
PeerPort => Sport)
or die "can't connect to port Sport on Shost: $!":
$handle->autoflush(l): # Запретить буферизацию
print STDERR "[Connected to Shost:$port]\n":
# Разделить программу на два идентичных процесса
die "can't fork: $!" unless defined(Skidpid = forkO):
if (Skidpid) {
# Родитель копирует сокет в стандартный вывод
while (defined (Sline = <$handle>)) {
print STDOUT Sline:
}
kill("TERM" => Skidpid): # Послать потомку SIGTERM
}
else {
# Потомок копирует стандартный ввод в сокет
while (defined (Sline = <STDIN>)) {
print Shandie Sline;
}
}
exit:
Добиться того же эффекта с одним процессом намного труднее. Проще соз-
дать два процесса и поручить каждому простую задачу, нежели кодировать вы-
полнение двух задач в одном процессе. Стоит воспользоваться преимуществами
мультизадачности и разделить программу на несколько подзадач, как многие
сложнейшие проблемы упрощаются на глазах.
Функция kill в родительском блоке if нужна для того, чтобы послать сигнал
потомку (в настоящее время работающему в блоке else), как только удаленный
сервер закроет соединение со своего конца. Вызов kill в конце родительского
блока ликвидирует порожденный процесс с завершением работы сервера.
724
Глава 17. Сокеты
Если удаленный сервер передает данные по байтам, и вы хотите получать их
немедленно, без ожидания перевода строки (которого вообще может не быть),
замените цикл while родительского процесса следующей конструкцией:
my $byte:
while (sysread($handle, $byte. 1) == 1) {
print STDOUT $byte;
}
Вызов системной функции для каждого читаемого байта не очень эффекти-
вен (мягко говоря), но это самое простое и понятное решение, которое к тому же
неплохо работает.
См. также
Описание функций sysread и fork в perlfunc{\)\ документация по стандартному
модулю 10: :Socket; рецепт 16.5; рецепт 16.10; рецепт 17.11.
17.11. Разветвляющие серверы
Проблема
Требуется написать сервер, который для работы с очередным клиентом ответв-
ляет специальный подпроцесс.
Решение
Ответвляйте подпроцессы в цикле accept и используйте обработчик $SIG{CHLD}
для чистки потомков.
# Создать сокет SERVER, вызвать bind и прослушивать ...
use POSIX qw(: sys_wait_h):
sub REAPER {
1 until (-1 == waitpid(-l, WNOHANG)):
$SIG{CHLD} = \&REAPER: # если $] >= 5.002
}
$SIG{CHLD} = \&REAPER:
while ($hisaddr = accept(CL I ENT. SERVER)) {
next if $pid = fork: # Родитель
die "fork: $!" unless defined $pid: # Неудача
# otherwise child
close(SERVER): # He нужно для потомка
# ... Сделать что-то
exit: # Выход из потомка
} continue {
close(CLIENT): # Не нужно для родителя
}
17.12. Серверы с предварительным ветвлением
725
Комментарий
Подобный подход очень часто используется в потоковых (SOCK_STREAM) серверах
на базе сокетов Интернета и UNIX. Каждое входящее подключение получает
собственный дубликат сервера. Общая модель выглядит так:
1. Принять потоковое подключение.
2. Ответвить дубликат для обмена данными с этим потоком.
3. Вернуться к 1.
Такая методика не используется с дейтаграммными сокетами (SOCK_DGRAM)
из-за особенностей обмена данными в них. Из-за времени, затраченного на раз-
ветвление, эта модель непрактична для UDP-серверов. Вместо продолжительных
соединений, обладающих определенным состоянием, серверы SOCK_DGRAM работают
с непредсказуемым набором дейтаграмм, обычно без определенного состояния.
В этом варианте наша модель принимает следующий вид:
1. Принять дейтаграмму.
2. Обработать дейтаграмму.
3. Вернуться к 1.
Новое соединение обрабатывается порожденным процессом. Поскольку со-
кет SERVER никогда не будет использоваться этим процессом, мы немедленно за-
крываем его. Отчасти это делается из стремления к порядку, но в основном —
для того, чтобы серверный сокет закрывался при завершении родительского
(серверного) процесса. Если потомки не будут закрывать сокет SERVER, операци-
онная система будет считать его открытым даже после завершения родителя.
За подробностями обращайтесь к рецепту 17.9.
&SIG обеспечивает чистку таблицы процессов после завершения потомков
(см. главу 16).
См. также
Описание функций fork и accept в perlfunc(l); рецепт 16.15; рецепт 16.19; рецепт
17.12; рецепт 17.13.
17.12. Серверы с предварительным
ветвлением
Проблема
Вы хотите написать сервер, параллельно обслуживающий нескольких клиентов
(как и в предыдущем разделе), однако подключения поступают так быстро, что
ветвление слишком сильно замедлит работу сервера.
Решение
Организуйте пул заранее разветвленных потомков, как показано в примере 17.5.
726
Глава 17. Сокеты
Пример 17.5. preforker
# !/usr/Ы n/perl
# preforker - сервер с предварительным ветвлением
use 10::Socket:
use Symbol:
use POSIX:
# Создать сокет SERVER, вызвать bind и прослушивать порт.
$server = 10::Socket::INET->new(Local Port => 6969.
Type => SOCK_STREAM.
Proto => 'tcp'.
Reuse => 1.
Listen => 10 )
or die "making socket: $@\n":
# Глобальные переменные
$PREFORK =5: # Количество поддерживаемых потомков
$MAX_CLIENTS_PER_CHILD =5: # Количество клиентов, обрабатываемых
# каждым потомком.
^children = О; # Ключами являются текущие
# идентификаторы процессов-потомков
$ch1Idren =0: # Текущее число потомков
sub REAPER { # Чистка мертвых потомков
$SIG{CHLD} = X&REAPER:
my $p1d = wait:
$ch1Idren
delete $ch11dren{$p1d}:
}
sub HUNTSMAN { # Обработчик сигнала SIGINT
local($SIG{CHLD}) = 'IGNORE': # Убиваем своих потомков
kill 'INT' => keys ^children:
exit; # Корректно завершиться
}
# Создать потомков.
for (1 .. SPREFORK) {
make_new_ch11d():
}
# Установить обработчики сигналов.
$SIG{CHLD} = \&REAPER;
$SIG{INT} = X&HUNTSMAN:
# Поддерживать численность процессов.
while (1) {
sleep; # Ждать сигнала (например.
# смерти потомка).
for ($1 = $ch11dren: $1 < $PREFORK; $1++) {
make_new_ch11d(); # Заполнить пул потомков.
}
}
17.12. Серверы с предварительным ветвлением
727
sub make_new_child {
my $p1d:
my Sslgset:
# Блокировать сигнал для fork.
Sslgset = POSIX::SlgSet->new(SIGINT):
s1gprocmask(SIG_BL0CK. Sslgset)
or die "Can't block SIGINT for fork: $!\n";
die "fork: $!" unless defined ($p1d = fork):
If ($p1d) {
# Родитель запоминает рождение потомка и возвращается.
sigprocmask(SIG—UNBLOCK, $s1gset)
or die "Can't unblock SIGINT for fork: $!\n":
$ch11dren{$p1d} = 1:
$children++:
return:
} else {
# Потомок *не может* выйти из этой подпрограммы.
$SIG{INT} = 'DEFAULT': # Пусть SIGINT убивает процесс.
# как это было раньше.
# Разблокировать сигналы
sigprocmask(SIGJJNBLOCK. $s1gset)
or die "Can't unblock SIGINT for fork: $!\n";
# Обрабатывать подключения, пока их число не достигнет
# $MAX_CLIENTS_PER_CHILD.
for ($1=0: $1 < $MAX_CLIENTS_PER_CHILD: $1++) {
$c!1ent = $server->accept() or last:
# Сделать что-то с соединением.
}
# Корректно убрать мусор и завершиться.
# Этот выход ОЧЕНЬ важен, в противном случае потомок начнет
# плодить все больше и больше потомков, что в конечном счете
# приведет к переполнению таблицы процессов.
exit;
} }
Комментарий
Программа получилась большой, но ее логика проста: родительский процесс
никогда не работает с клиентами сам, а вместо этого ответвляет $PREFORK по-
томков. Родитель следит за количеством потомков и своевременно плодит
процессы, чтобы заменить мертвых потомков. Потомки завершаются после об-
работки $MAX_CLIENTS_PER_CHILD клиентов.
Пример 17.5 более или менее прямолинейно реализует описанную логику.
Единственная проблема связана с обработчиками сигналов: мы хотим, чтобы ро-
дитель перехватывал SIGINT и убивал своих потомков, и устанавливаем для этого
728
Глава 17. Сокеты
свой обработчик сигнала &HUNTSMAN. Но в этом случае нам приходится соблюдать
меры предосторожности, чтобы потомок не унаследовал тот же обработчик по-
сле ветвления. Мы используем сигналы модуля POSIX, чтобы заблокировать сиг-
нал на время ветвления (см. рецепт 16.20).
Используя этот код в своих программах, проследите, чтобы в make_new_child
никогда не использовался выход через return. В этом случае потомок вернется,
станет родителем и начнет плодить своих собственных потомков. Система перепол-
нится процессами, прибежит разъяренный системный администратор — и вы буде-
те долго и мучительно жалеть, что не обратили должного внимания на этот абзац.
В некоторых операционных системах (в первую очередь — Solaris) несколько
потомков не могут вызывать accept для одного сокета. Чтобы гарантировать, что
лишь один потомок вызывает accept в произвольный момент времени, придется
использовать блокировку файлов. Реализация этой возможности остается чита-
телю для самостоятельной работы.
См. также
Описание функции select в perlfunc(l); страница руководства fcntl(2) вашей
системы (если есть); документация по стандартным модулям Fcntl, Socket,
10: -.Select, 10: :Socket и Tie: :RefHash; рецепт 17.11; рецепт 17.12.
17.13. Серверы без ветвления
Сервер должен обрабатывать несколько одновременных подключений, но вы не
хотите ответвлять новый процесс для каждого соединения.
Решение
Создайте массив открытых клиентов, воспользуйтесь select для чтения инфор-
мации по мере ее поступления и работайте с клиентом лишь после получения
полного запроса от него, как показано в примере 17.6.
Пример 17.6. nonforker
#!/usr/Ыn/perl -w
# nonforker - мультиплексный сервер без ветвления
use POSIX:
use 10::Socket;
use 10::Seiect:
use Socket:
use Fcntl:
use Tie::RefHash:
$port = 1685:
# Замените по своему усмотрению
# Прослушивать порт.
$server = 10::Socket::INET->new(Local Port => $port.
Listen => 10 )
or die "Can't make server socket: $@\n";
17.13. Серверы без ветвления
729
# Начать с пустыми буферами
^inbuffer =();
^outbuffer = ():
^ready = О:
tie ^ready, 'Tie::RefHash':
nonblock($server):
$select = 10::Select->new($server);
# Главный цикл: проверка чтения/принятия, проверка записи,
# проверка готовности к обработке
while (1) {
my $c!1ent:
my $rv;
my $data:
# Проверить наличие новой информации на имеющихся подключениях
# Есть ли что-нибудь для чтения или подтверждения?
foreach $c!1ent ($select->can_read(l)) {
If ($c!1ent == $server) {
# Принять новое подключение
$c!1ent = $server->accept();
$select->add($c!1ent):
nonblock($c!1ent):
} else {
# Прочитать данные
$data = '':
$rv = $c!1ent->recv($data, POSIX::BUFSIZ. 0):
unless (defined($rv) && length $data) {
# Это должен быть конец файла, поэтому закрываем клиент
delete $1nbuffer{$cl1 ent};
delete $outbuffer{$cllent}:
delete $ready{$cl1 ent};
$select->remove($c!1ent):
close $c!1ent:
next:
}
$1nbuffer{$cllent} .= $data:
# Проверить, говорят ли данные в буфере или только что
# прочитанные данные о наличии полного запроса, ожидающего
# выполнения. Если да - заполнить $ready{$cl1 ent}
# запросами, ожидающими обработки.
while ($1nbuffer{$cl1 ent} =~ s/(.*\n)//) {
push( @{$ready{$cllent}}. $1 ):
}
}
продолжение &
730
Глава 17. Сокеты
Пример 17.6 (продолжение)
# Есть ли полные запросы для обработки?
foreach Scllent (keys Sready) {
handle($client):
}
# Сбрасываемые буферы ?
foreach Scllent (Sselect->can_wr1te(l)) {
# Пропустить этот клиент, если нам нечего сказать
next unless exists $outbuffer{$cl1 ent}:
$rv = $client->send($outbuffer{$client}, 0);
unless (defined $rv) {
# Пожаловаться, но следовать дальше.
warn "I was told I could write, but I can't.\n";
next:
}
If (Srv == length $outbuffer{$c!1ent} ||
{$! == POSIX::EWOULDBLOCK)
substr($outbuffer{$cl1ent}, 0, $rv) = ":
delete Soutbuffer{$cl1ent} unless length $outbuffer{$c!1ent}:
} else {
# He удалось записать все данные и не из-за блокировки.
# Очистить буферы и следовать дальше.
delete $1nbuffer{$cl1 ent}:
delete $outbuffer{$client}:
delete $ready{$c!1ent}:
Sselect->remove(Scllent):
close(Scllent):
next;
}
}
# Внеполосные данные?
foreach Scllent (Sselect->has_except1on(0)) { # аргумент - тайм-аут
# Обработайте внеполосные данные, если хотите.
}
}
# handlе(Ssocket) обрабатывает все необработанные запросы
# для клиента Scllent
sub handle {
# Запросы находятся в Sready{Scl1 ent}
# Отправить вывод в Soutbuffer{Scl1 ent}
my Scllent = shift:
my Srequest:
foreach Srequest (@{Sready{Scl1 ent}}) {
# Srequest - текст запроса
# Занести текст ответа в Soutbuffer{Scl1 ent}
}
delete $ready{$cllent}:
}
17.13. Серверы без ветвления
731
# nonblock($socket) переводит сокет в неблокирующий режим
sub nonblock {
my $socket = shift:
my $flags:
$flags = fcntl($socket, F_GETFL, 0)
or die "Can't get flags for socket: $!\n":
fcntl($socket, F_SETFL. Sflags | O_NONBLOCK)
or die "Can't make socket nonblocking: $’\n":
}
Комментарий
Как видите, одновременно обрабатывать несколько клиентов в одном процессе
сложнее, чем ответвлять специальные процессы-дубликаты. В итоге вам прихо-
дится выполнять много работы за операционную систему, например, делить
время между разными подключениями и следить, чтобы чтение осуществлялось
без блокировки.
Функция select сообщает, в каких подключениях есть данные, ожидающие
чтения, какие подключения позволяют записать данные или имеют непрочитан-
ные внеполосные данные. Мы могли бы использовать встроенную функцию Perl
select, но это усложнит работу с манипуляторами. Поэтому мы используем стан-
дартный модуль 10: .-Select.
Модуль fcntl используется для включения неблокирующего режима для сер-
верного сокета. В противном случае заполнение буферов сокета одного клиента
привело бы к приостановке работы сервера до очистки буферов. Однако при-
менение неблокирующего ввода/вывода означает, что нам придется разбираться
с неполными операциями чтения/записи. Мы не сможем просто использовать
оператор <>, устанавливающий блокировку до того, как станет возможным чтение
всей записи, или print для вывода всей записи. Буфер ^inbuffer содержит непол-
ные команды, полученные от клиентов, ^outbuffer — неотправленные данные,
a ^ready — массивы необработанных сообщений.
Чтобы использовать этот код в своей программе, выполните три действия.
Во-первых, измените вызов 10::Socket::INET и включите в него порт своего сер-
вера. Во-вторых, измените код, который переносит записи из inbuffer в очередь
ready. В настоящее время каждая строка (текст, заканчивающийся \п) рассмат-
ривается как запрос. Если ваши запросы не являются отдельными строками,
внесите необходимые изменения.
while ($inbuffer{$client} =~ s/(.*\n)//) {
push( @{Sready{$client}}. $1 ):
}
Наконец, измените середину цикла в handler так, чтобы в ней действительно
создавался ответ на запрос. В простейшей программе эхо-вывода это выглядит так:
Soutbuffer{$client} .= $request:
Обработка ошибок предоставляется читателю в качестве упражнения для са-
мостоятельной работы. На данный момент предполагается, что любая ошибка
при чтении или записи завершает подключение клиента. Вероятно, это слишком
732
Глава 17. Сокеты
сурово, поскольку «ошибки» вроде EINTR или EAGAIN не должны приводить к раз-
рыву соединения (впрочем, при использовании select вы никогда не должны по-
лучать EAGAIN).
См. также
Описание функции select в perlfunc(l); страница руководства fcntl(2) вашей систе-
мы (если есть); документация по стандартным модулям Fcntl, Socket, 10::Select,
10: :Socket и Tie: :RefHash; рецепт 17.11; рецепт 17.12.
17.14. Многопоточный сервер
Проблема
Требуется написать сервер, который бы обслуживал нескольких клиентов из од-
ного процесса за счет использования программных потоков (threads) операци-
онной системы.
Решение
Воспользуйтесь модулем threads.рш в Perl версии 5.8.1 и выше:
use threads:
use 10::Socket:
my Slisten = 10::Socket::INET->new(
Local Port => $SERVER_PORT,
ReuseAddr => 1,
Listen => 10.
):
sub handle_connection {
my Ssocket = shift:
my Soutput = shift || Ssocket:
my Sexit = 0;
while (<$socket>) {
# Работать c $_.
# Выводить данные в Soutput.
# При завершении подключения присвоить Sexit значение true,
last if Sexit:
while (my Ssocket = $1isten->accept) {
async(\&handle_connection. Ssocket)->detach:
Комментарий
Многопоточные средства Perl еще находятся на стадии развития, но в версии 5.8.1
они стали работоспособными. Настоящее Решение не будет работать в более
ранних версиях Perl — хотя бы из-за того, что в них применялась совсем иная
17.15. Написание многопоточного сервера с использованием РОЕ
733
потоковая модель, отличная от модели «программных потоков интерпретатора»,
подразумеваемой threads.pm.
Вся рутинная работа по обработке подключений выполняется в процедуре
handle_connecti’on. Эта процедура получает клиентский сокет в качестве парамет-
ра и может использовать блокирующие конструкции типа <$socket>, поскольку
она работает в отдельном программном потоке. Если один поток блокируется
при чтении, остальные потоки продолжают работать.
Главный поток программы создает сокет и принимает подключения. При под-
ключении нового клиента вызов async порождает новый программный поток для
обработки данного подключения. Поток завершает работу при выходе из проце-
дуры (в данном случае — handle_connection).
Мы вызываем detach для созданного потока, чтобы при завершении его пере-
менные были уничтожены уборщиком мусора (с закрытием сокета). Без вызова
detach в нашем процессе будут накапливаться мертвые потоки до тех пор, пока
в какой-то момент попытка создания нового потока окончится неудачей.
См. также
Документация по стандартному модулю threads.pm; рецепт 17.15.
17.15. Написание многопоточного сервера
с использованием РОЕ
Проблема
Требуется написать сервер, который бы обслуживал нескольких клиентов из од-
ного процесса, но при этом обходился бы без поддержки программных потоков
в Perl 5.8. или сложностей асинхронного ввода/вывода.
Решение
Постройте сервер с использованием библиотеки кооперативной многозадачности
РОЕ (из архива CPAN) и прилагаемого к ней модуля РОЕ: Component::Server::TCP:
#!/usr/Ы n/perl
use warnings:
use strict;
use POE qw(Component::Server::TCP):
# Запустить сервер TCP. Клиентский ввод регистрируется на консоли
# и возвращается клиенту по одной строке.
РОЕ:Component::Server::TCP->new
( Port => $PORT_NUMBER,
Clientinput => \&handle_1nput.
):
# Порт для прослушивания
# Метод, вызываемый для обработки ввода
734
Глава 17. Сокеты
# Запуск сервера.
$poe_kernel->run( );
exit 0:
sub handlejnput {
my ( $sess1on, $heap. $1nput ) = SESSION. HEAP, ARGO ];
# $sess1on - объект POE::Sess1on. уникальный для данного подключения,
# $heap - область памяти данного подключения.
# Новые данные от клиента хранятся в $1nput с удалением переводов строк.
# Эхо-возврат данных клиенту:
$heap->{cl 1 ent}->put($1nput):
# Регистрация на консоли
print "client ", $sess1on->ID, ": $1nput\n":
}
Решение
POE — библиотека поддержки кооперативной многозадачности для Perl, по-
строенная исключительно из программных компонентов. Для работы с РОЕ вам
не придется перекомпилировать интерпретатор Perl, но к проектированию про-
грамм нужно будет подходить с новой точки зрения, основанной на использова-
нии событий и обратных вызовов. Документация по этой библиотеке доступна
по адресу http://poe.perl .огд/.
Библиотеку РОЕ удобно рассматривать как операционную систему: в ней
имеется ядро (объект, ответственный за выбор следующего выполняемого фраг-
мента кода) и процессы (сеансы, также реализованные в виде объектов). РОЕ
хранит объект ядра в переменной $poe_kernel, автоматически импортируемой
в ваше пространство имен. У каждого процесса в операционной системе имеется
куча (heap) — память, в которой хранятся переменные данного процесса. У сеан-
сов тоже имеются кучи. В операционной системе библиотеки ввода/вывода
обеспечивают буферизованный ввод/вывод. В РОЕ колесо (wheel) обеспечивает
поступление данных от отправителя и их передачу получателю.
Существуют десятки готовых сеансов (называемых компонентами) для сер-
веров, клиентов, очередей, баз данных и других стандартных задач. Компоненты
выполняют всю черновую работу по распознаванию протоколов и форматов дан-
ных, а программисту остается лишь писать действительно интересный код: ре-
шать, какие данные поставлять или как их обрабатывать.
Пи использовании РОЕ: -.Component::Server::TCP компонент решает задачи по
созданию сервера, прослушиванию, приему подключений и получению данных
от клиента. Для каждого полученного бита данных компонент обращается к ва-
шему коду посредством обратного вызова. Ваш код отвечает за разбор запроса
и построение ответа.
При вызове конструктора РОЕ: Component::Server::TCP параметр Port определяет
прослушиваемый порт, а параметр СИ entinput — код обработки ввода. Также
поддерживается множество других параметров и функций обратного вызова,
в том числе Address для определения адреса конкретного прослушиваемого ин-
терфейса и ClIentFIlter для замены стандартного модуля разбора.
Процедура обработки ввода вызывается с несколькими параметрами, из ко-
торых мы используем только три: объект сеанса РОЕ, представляющий подклю-
чение, кучу данного сеанса и последний фрагмент ввода от клиента. Первые два
17.16. Написание многоканального сервера
735
параметра являются стандартными и передаются РОЕ для всех сеансовых вызо-
вов, тогда как последний предоставляется компонентом сервера.
Странное присваивание в начале handle_1nput просто создает срез с исполь-
зованием констант для определения позиций аргументов сеанса, кучи и первого
фактического аргумента. Эта идиома РОЕ позволяет ядру РОЕ менять фактиче-
ские параметры метода и их порядок без нарушения работы кода, написанного
до внесения таких изменений.
my ( Ssesslon, $heap, $1nput ) = SESSION. HEAP. ARGO ];
Куча, принадлежащая сеансу, содержит интерфейсный объект для обмена
данными с клиентом: $heap->{cl 1 ent}. Метод put этого объекта передает данные
клиенту. IP-адрес клиента может быть получен в виде $heap->{remote_1p}.
Если операция, выполняемая посредством обратного вызова, занимает много
времени и замедляет обмен данными с другими клиентами, подключенными к
серверу, подумайте об использовании сеансов РОЕ. Сеанс управляется события-
ми: длительная задача разбивается на более мелкие (как подразумевается — бо-
лее быстрые) фрагменты, каждый из которых реализован в виде функции обрат-
ного вызова. С каждой функцией обратного вызова связано одно или несколько
событий, по которым она вызывается.
Функция обратного вызова должна сообщить ядру о постановке в очередь до-
полнительных событий, которые, в свою очередь, передают управление следующей
функции обратного вызова (например, в конце функции «подключения к базе
данных» вы сообщаете ядру о необходимости вызвать функцию «выборки данных
из базы»). Даже если разбить операцию не удается, ее можно выполнить асин-
хронно в другом процессе при помощи РОЕ:: Wheel: :Run или РОЕ: Component:: Chi Id.
Библиотека РОЕ содержит неблокирующие таймеры, мониторы ввода/выво-
да и другие ресурсы, которые могут использоваться для вызова функций об-
ратного вызова по внешним условиям. Колеса (Wheel) и компоненты (Component)
в конечном итоге тоже строятся из этих базовых ресурсов.
Информация по программированию для РОЕ (в том числе список учебни-
ков) находится на сайте http://poe.prl .org. К специфике программирования для
РОЕ нужно привыкнуть, но в области программирования с применением асин-
хронных событий (в частности, графических приложений и сетевых серверов)
найти другое решение, превосходящее РОЕ по переносимости и широте возмож-
ностей, будет довольно трудно.
См. также
Документация по модулям CPAN РОЕ, РОЕ::Sesslon, РОЕ: :Wheel и РОЕ::Component:
:Server: :ТСР, http://poe.perl .org/; рецепт 17.14.
17.16. Написание многоканального сервера
Проблема
Требуется написать сервер для компьютера с несколькими IP-адресами, чтобы
он мог выполнять различные операции для каждого адреса.
736
Глава 17. Сокеты
Решение
Не привязывайте сервер к определенному адресу. Вместо этого вызовите bi nd с ар-
гументом INADDR_ANY. После того как подключение будет принято, вызов getsockname
для клиентского сокета позволяет узнать, к какому адресу он подключился:
use Socket;
socket(SERVER. PF_INET, SOCK_STREAM. getprotobyname('tcp'));
setsockopt(SERVER. SOL_SOCKET, SO_REUSEADDR. 1):
b1nd(SERVER. sockaddr_in($server_port. INADDR_ANY))
or die "Binding: $!\n";
# Цикл принятия подключений
while (accept(CLIENT, SERVER)) {
$my_socket_address = getsockname(CLIENT);
(Sport. Smyaddr) = sockaddr_in($my_socket_address);
Комментарий
Если функция getpeername (см. рецепт 17.7) возвращает адрес удаленного конца
сокета, то функция getsockname возвращает адрес локального конца. При вызове
bind с аргументом INADDR_ANY принимаются подключения для всех адресов дан-
ного компьютера, поэтому для определения адреса, к которому подключился
клиент, можно использовать функцию getsockname.
При использовании модуля 10::Socket:: INET программа будет выглядеть так:
Sserver = 10::Socket::INET->new(LocalPort => $server_port,
Type => SOCK_STREAM.
Proto => 'tcp',
Listen => 10)
or die "Can't create server socket: $@\n":
while (Scllent = $server->accept()) {
$my_socket_address = Sclient->sockname():
(Sport. Smyaddr) = sockaddr_in($my_socket_address);
# ...
Если не указать локальный порт при вызове 10: :Socket: :INET->new, привязка
сокета будет выполнена для INADDR_ANY.
Если вы хотите, чтобы при прослушивании сервер ограничивался конкрет-
ным виртуальным хостом, не используйте INADDR_ANY. Вместо этого следует вы-
звать bi nd для конкретного адреса хоста:
use Socket:
Sport = 4269: # Порт
Shost = "specific.host.com": # Виртуальный хост
socket(Server, PF_INET, SOCK_STREAM. getprotobynameftcp"))
or die "socket: $!":
bind(Server. sockaddr_in($port, inet_aton($host)))
17.17. Создание сервера-демона
737
or die "bind: $!":
while ($client_address = accept(Client. Server)) {
# ...
}
См. также
Описание функции getsockname в perlfunc(\)\ документация по стандартным мо-
дулям Socket и 10: :Socket; раздел «Sockets» в perlipc(l).
17.17. Создание сервера-демона
Проблема
Вы хотите, чтобы ваша программа работала в качестве демона.
Решение
Если вы — параноик с правами привилегированного пользователя, для начала
вызовите ch root для безопасного каталога:
chroot("/var/daemon")
or die "Couldn't chroot to /var/daemon: $!";
Вызовите fork и завершите родительский процесс.
$pid = fork:
exit If Spid:
die "Couldn't fork: $!" unless deflned(Spld):
Закройте три стандартных файловых манипулятора, открыв их заново для
/dev/nul1:
for my Shandie (*STDIN, *STD0UT. *STDERR) {
open(Shandie, "/dev/nul1")
|| die "can't reopen Shandie to /dev/null: $!":
}
Разорвите связь с управляющим терминалом, с которого был запущен процесс, --
при этом процесс перестает входить в группу процессов, к которой он принадлежал,
use POSIX:
POSIX::sets1d()
or die "Can't start a new session: $!";
Перехватывайте фатальные сигналы и устанавливайте флаг, означающий, что
мы хотим корректно завершиться:
St1me_to_d1e = 0:
sub s1gnal_handler {
St1me_to_d1e = 1:
738
Глава 17. Сокеты
$SIG{INT} = $SIG{TERM} = $SIG{HUP} = \&s1gnal_handler;
# Перехватить или игнорировать $SIG{PIPE}
Реальный код сервера включается в цикл следующего вида:
until ($t1me_to_d1e) {
# ...
}
Комментарий
До появления стандарта POSIX у каждой операционной системы были свои
средства, с помощью которых процесс говорил системе: «Я работаю сам по себе;
пожалуйста, не мешайте мне». Появление POSIX внесло в происходящее отно-
сительный порядок. Впрочем, это не мешает вам использовать любые специфи-
ческие функции вашей операционной системы.
К числу этих функций принадлежит chroot, которая изменяет корневой ката-
лог процесса (/). Например, после вызова chroot "/var/daemon" при попытке прочи-
тать файл /etc/passwd процесс в действительности прочитает файл /var/daemon/
etc/passwd. Конечно, при вызове функции chroot необходимо скопировать все
файлы, с которыми работает процесс, в новый каталог. Например, процессу может
потребоваться файл /var/daemon/Ыn/csh. По соображениям безопасности вызов
chroot разрешен только привилегированным пользователям. Он выполняется на
серверах FTP при анонимной регистрации. На самом деле становиться демоном
необязательно.
Операционная система предполагает, что родитель ожидает смерти потомка.
Для нашего процесса-демона это не нужно, поэтому мы разрываем наследствен-
ные связи. Для этого программа вызывает fork и exit, чтобы потомок не был
связан с процессом, запустившим родителя. Затем потомок закрывает все фай-
ловые манипуляторы, полученные от родителя (STDIN, STDERR и STDOUT), переот-
крывая их для /dev/nul 1, и вызывает POSIX::setsld, чтобы обеспечить полное от-
соединение от родительского терминала.
Если вы хотите гарантировать закрытие дескрипторов с более высокими но-
мерами, воспользуйтесь записью +<&=ЧИСЛО для связывания существующего сис-
темного дескриптора с файловым манипулятором Perl, а затем вызовите close
для этого манипулятора. Например, следующий фрагмент распространяется на
все дескрипторы в интервале от 2 до 256:
for (my $fd = 3: $fd < 256: $fd++) {
open(my $handle. "+<&=$fd"); # XXX: без проверки ошибок
close $handle: # XXX: без проверки ошибок
}
Все почти готово. Сигналы типа SIGINT не должны немедленно убивать наш
процесс (поведение по умолчанию), поэтому мы перехватываем их с помощью
XSIG и устанавливаем флаг завершения. Далее главная программа работает по
принципу: «Пока не убили, что-то делаем».
Сигнал SIGPIPE — особый случай. Получить его нетрудно (достаточно запи-
сать что-нибудь в манипулятор, закрытый с другого конца), а по умолчанию он
ведет себя довольно сурово (завершает процесс). Вероятно, его желательно либо
17.18. Перезапуск сервера по требованию
739
проигнорировать ($SIG{ PI РЕ] = ' IGNORE'), либо определить собственный обработ-
чик сигнала и организовать его обработку.
См. также
Страницы руководства setsid(T) и chroot(V) вашей системы (если есть); описа-
ние функции chroot в perlfunc(l).
17.18. Перезапуск сервера по требованию
Проблема
При получении сигнала HUP сервер должен перезапускаться, по аналогии с inetd
или httpd.
Решение
Перехватите сигнал SIGHUP. Внутри обработчика установите безвредные обра-
ботчики сигналов, разблокируйте сигналы и перезапустите свою программу:
use POSIX qw(:signal_h sigprocmask):
my $SELF = "/path/to/my/program";
my @ARGS = @ARGV: # Сохранить на будущее
$SIG{HUP} = \&phoenix;
# Ваша программа
sub phoenix {
# Обезвредить сигналы
for my $nal (qw[ALRM CHLD HUP INT PIPE TERM]) {
$SIG{$nal} = sub {}:
# Снова разрешить
my $s = POSIX::SigSet->new;
my $t = POSIX::SigSet->new;
sigprocmask(SIG_BLOCK, $s, $t);
# и перезапуститься
print "RestartingXn";
exec $SELF => OARGS;
die "Couldn't exec $SELF => @ARGS\n";
}
Комментарий
Внешне все выглядит просто («получил сигнал HUP — перезапустись»), но на са-
мом деле проблем хватает. Вы должны знать имя своей программы, а определить
его непросто. Конечно, можно воспользоваться переменной $0 модуля FlndBln.
740
Глава 17. Сокеты
Для нормальных программ этого достаточно, но важнейшие системные утилиты
должны проявлять большую осторожность, поскольку правильность $0 не гаран-
тирована. Имя программы и аргументы можно жестко закодировать в програм-
ме, как это сделано в нашем примере. Однако такое решение не всегда удобно,
поэтому имя и аргументы можно читать из внешнего файла (защищая подлин-
ность его содержимого на уровне файловой системы).
Обработчик сигнала обязательно должен устанавливаться после определения
SSELF и @ARGS, в противном случае может возникнуть «ситуация перехвата» —
SIGHUP потребует перезапуска, а вы не будете знать, что запускать. Это приведет
к гибели вашей программы.
Сигналы — штука хитрая. При перезапуске программы с использованием ехес
«возрожденная» версия наследует набор заблокированных сигналов от своего роди-
теля. Внутри обработчика сигнала этот сигнал блокируется. Следовательно, если об-
работчик сигнала просто вызовет ехес, в новом процессе сигнал SIGHUP окажется за-
блокированным. Получается, что перезапустить программу можно только один раз!
Однако задача не решается простым разблокированием SIGHUP функцией
sigaction модуля POSIX. Заблокированными также могут быть другие сигналы (ALRM,
CHLD и другие, указанные в процедуре phoenix в Решении). Если просто снять с них
блокировку, обработчик SIGHUP может быть прерван по доставке этих сигналов,
поэтому этим сигналам необходимо сначала назначить безвредные обработчики.
Некоторые серверы при получении SIGHUP не должны перезапускаться — они
всего лишь заново читают свой конфигурационный файл:
$CONFIG_FILE = "/usr/1ocal/etc/myprog/server_conf.pl":
$SIG{HUP} = \&read_conf1g;
sub read_conf 1g {
do $CONFIG_FILE:
Некоторые умные серверы даже автоматически перезагружают свои конфи-
гурационные файлы в случае их обновления. Вам даже не придется ни о чем
сигнализировать.
См. также
Описание функции ехес в perlfunc(\)\ рецепт 8.16; рецепт 8.17; рецепт 16.15.
17.19. Управление несколькими
потоками ввода
Проблема
Следующая порция входных данных для вашей программы может поступить из
разных файловых манипуляторов, но вы не знаете, откуда именно. Можно вос-
пользоваться функцией selectO, но тогда вам придется перейти на небуферизо-
ванный ввод/вывод, а это слишком хлопотно (и к тому же очень усложнит вашу
программу).
17.19. Управление несколькими потоками ввода
741
Решение
Воспользуйтесь модулем CPAN 10:: Mui ti pl ex. Модуль вызывает функцию mux_
input О при получении ввода через сокет и выполняет буферизацию ввода и вы-
вода за вас:
use 10::Muitipl ex:
$mux = 10::Multiplex->new( ):
$mux->add($FHl):
$mux->add($FH2): # ... и т.д. для всех манипуляторов
$mux->set_callback_object(_PACKAGE_): # или объект
$mux->Loop( ):
sub muxjnput {
my ($package, $mux. $fh. $input) =
# $input - ссылка на буфер ввода манипулятора
# ...
}
Комментарий
Хотя для управления вводом, поступающим из нескольких источников, можно
воспользоваться функцией select, такое решение скрывает множество ловушек
и фокусов. Например, строки входных данных не могут читаться функцией <>,
поскольку никогда нельзя быть уверенным в том, что клиент отправил полную
строку (или вообще когда-нибудь отправит ее). Вывод в сокет функцией print
создает риск переполнения выходного буфера и блокировки процесса. Вам придет-
ся использовать неблокирующий ввод/вывод и поддерживать собственные буфе-
ры. Соответственно, программа быстро усложняется и выходит из-под контроля.
К счастью, существует другой способ упростить работу программиста — исполь-
зование модулей. Модуль CPAN 10:: Mui ti pl ex сам обеспечивает выполнение не-
блокирующего ввода/вывода и вызовы select. Ему нужно сообщить, за какими
манипуляторами нужно следить, а он сообщает о поступлении новых данных.
Вы даже можете осуществлять вывод командой print; модуль буферизует данные
и осуществляет неблокирующий вывод. Объект 10:: Mui ti pl ex ведет пул файло-
вых манипуляторов.
Метод add модуля 10:: Mui ti pl ex включает манипулятор в список отслеживае-
мых. Вызов этого метода активизирует неблокирующий ввод/вывод и подавляет
буферизацию stdio. При получении данных по одному из отслеживаемых файло-
вых манипуляторов 10::Mui tipl ex вызывает метод muxjnput объекта или класса
по вашему выбору. Чтобы задать принадлежность mux_i nput, передайте имя пакета
(если функция обратного вызова является методом класса) или значение объек-
та (если функция является методом объекта) методу set_callback_object модуля
10:: Mui ti pl ex. В примере, приведенном в Решении, передается текущее имя паке-
та; это означает, что 10:: Mui ti pl ex будет вызывать метод muxjnput текущего пакета.
Функция обратного вызова muxj nput получает четыре параметра: имя объекта
или пакета, переданное set_callback_object; объект 10:: Mui ti pl ex, осуществивший
диспетчеризацию; файловый манипулятор, из которого были получены данные;
742
Глава 17. Сокеты
ссылка на буфер ввода. Функция обратного вызова должна удалить обработан-
ные данные из буфера. Например, обработка может производиться в построчном
режиме:
sub muxjnput {
my (Sobj. $mux, Sfh, Sbuffer) =
my (SHne) = SSbuffer =~ s{x(.*)\n}{ } or return;
# ...
}
Модуль 10:: Mui ti pl ex также обеспечивает прием входящих подключений на сер-
верных сокетах. После привязки сокета и перевода на прослушивание (см. ре-
цепт 17.2) передайте его методу listen объекта 10:: Mui ti pl ex:
use 10::Socket:
Sserver = 10::Socket::INET->new(LocalPort => SPORT, Listen => 10)
or die SO;
$mux->listen(Sserver);
Поступление новых входящих подключений обрабатывается функцией об-
ратного вызова mux_connection. Существуют и другие функции обратного вызова
(например, для полного или частичного закрытия манипулятора, установки
тайм-аута и т. д.). Полный список методов управления объектом 10:: Mui ti pl ex
и его функций обратного вызова приведен в документации 10:: Mui ti pl ex.
В примере 17.7 представлен примитивный чат-сервер на базе 10:: Mui ti pl ex.
Он прослушивает порт 6901 по адресу локального хоста и реализует очень про-
стой протокол обмена данными. У каждого клиента (см. пример 17.8) есть свое
«имя», которое можно сменить командой вида /nick новое_имя. Остальные вхо-
дящие строки текста рассылаются на все подключенные компьютеры с префик-
сом из имени клиента, отправившего данное сообщение.
Чтобы протестировать этот пример, запустите сервер в одном окне, а затем
запустите несколько клиентов в других окнах. Попробуйте ввести какое-нибудь
сообщение в одном клиентском окне и проследите за тем, как оно появляется
в остальных окнах.
Пример 17.7. chatserver
#!/usr/bin/perl -w
# chatserver - очень простой чат-сервер
use 10::Muiti pl ex:
use 10::Socket:
use strict:
my £Name;
my SServer = 10::Socket::INET->new(LocalAddr => "localhost:6901".
Listen => 10. Reuse => 1.
Proto => 'tcp') or die $0;
my SMux = 10::Multi plex->new( );
my $Person_Counter = 1:
SMux->li sten(SServer):
SMux->set_cal 1 back_ob ject (_PACKAGE_);
$Mux->loop( ):
exit:
sub mux_connection {
my (Spackage. Smux. Sfh) = @ ;
17.19. Управление несколькими потоками ввода
743
$Name{$fh} = [ $fh. "Person " . $Person_Counter++ ];
}
sub mux_eof {
my (Spackage, $mux. Sfh) =
delete SName{Sfh}:
}
sub muxjnput {
my (Spackage, Smux, Sfh, Sinput) =
my Sline:
my Sname:
SSInput =~ s{J.*)\n+}{ } or return:
Sline = SI:
if (Sline =~ m{x/nick\s+(\S+)\s*}) {
my Soldname = $Name{$fh}:
$Name{Sfh} = C Sfh, $1 ];
Sline = "Soldname->[1] is now known as SI":
} else {
Sline = "<SName{$fh}[l]> Sline":
}
foreach my Sconn_struct (values £Name) {
my Sconn = $conn_struct->[0]:
$conn->print("$line\n"):
}
}
Пример 17.8. chatclient
#I/usr/bin/perl -w
# chatclient - клиент для чат-сервера
use 10: Multiplex:
use IO::Socket:
use strict:
my Ssock = 10::Socket::INET->new(PeerAddr => "localhost:6901",
Proto => "tcp") or die $0:
my SMux = 10::Multiplex->new( ):
$Mux->add(Ssock):
$Mux->add(*STDIN):
$Mux->set_callback_object(___PACKAGE___):
SMux->loop( ):
exit:
sub muxjnput {
my (Spackage, Smux, Sfh, Sinput) =
my Sline:
Sline = SSinput:
SSinput = "";
if (fileno(Sfh) = = fileno(STDIN)) {
print Ssock Sline:
} else {
print Sline:
}
)
См. также
Документация по модулю CPAN 10:: Mui tipi ex; рецепты 17.1, 17.2, 17.20 и 17.21.
744
Глава 17. Сокеты
17.20. Программа: backsniff
Программа backsniff регистрирует попытки подключения к портам. Она использу-
ет модуль Sys::Syslод с уровнем регистрации LOG_NOTICE и подсистемой LOG_DAEMON.
Функция getsockname идентифицирует порт, к которому произошло подключение,
a getpeername — компьютер, установивший соединение. Функция getservbyport
преобразует локальный номер порта (например, 7) в название службы (напри-
мер, "echo").
В системном журнале появляются записи:
Мау 25 15:50:22 coprolith sniffer: Connection from 207.46.131.141 to
207.46.130.164 .-echo
В файл Inetd.conf включается строка следующего вида:
echo stream tcp nowait nobody /usr/scrlpts/snfsqrd sniffer
Исходный текст программы приведен в примере 17.9.
Пример 17.9. backsniff
# !/usr/Ыn/perl -w
# backsniff - регистрация попыток подключения к определенным портам
use Sys::Syslog:
use Socket:
# Идентифицировать порт и адрес
Ssockname = getsockname(STDIN)
or die "Couldn't Identify myself: $!\n";
(Sport. Sladdr) = sockaddr_1n($sockname):
$my_address = 1net_ntoa($1addr):
# Получить имя службы
Sservlce = (getservbyport (Sport, "tcp"))[O] || Sport:
# now Identify remote address
Ssockname = getpeername(STDIN)
or die "Couldn't Identify other end: $!\n";
(Sport, Sladdr) = sockaddr_1n($sockname):
$ex_address = 1net_ntoa(Sladdr):
# Занести информацию в журнал
openlog("sniffer", "ndelay", "daemon"):
syslog("notice", "Connection from £s to £s:£s\n", $ex_address,
$my_address, Sservlce):
closelogO:
exit:
17.21. Программа: fwdport
Предположим, у вас имеется защитный брандмауэр (firewall). Где-то в окру-
жающем мире есть сервер, к которому обращаются внутренние компьютеры, но
доступ к серверу разрешен лишь процессам, работающим на брандмауэре. Вы не
хотите, чтобы при каждом обращении к внешнему серверу приходилось заново
регистрироваться на компьютере брандмауэра.
17.21. Программа: fwdport
745
Например, такая ситуация возникает, когда поставщик услуг Интернета вашей
компании позволяет читать новости при поступлении запроса с брандмауэра, но
отвергает все подключения NNTP с остальных адресов. Вы как администратор
брандмауэра не хотите, чтобы на нем регистрировались десятки пользователей —
лучше разрешить им читать и отправлять новости со своих рабочих станций.
Программа fwdport из примера 17.10 содержит общее решение этой пробле-
мы. Вы можете запустить любое количество экземпляров, по одному для каждо-
го внешнего запроса. Работая на брандмауэре, она общается с обоими мирами.
Когда кто-то хочет воспользоваться внешней службой, он связывается с нашим
прокси-сервером, который далее действует по его поручению. Для внешней
службы подключение устанавливается с брандмауэра и потому является допус-
тимым. Затем программа ответвляет два процесса: первый читает данные с внеш-
него сервера и передает их внутреннему клиенту, а второй читает данные от
внутреннего клиента и передает их внешнему серверу.
Например, командная строка может выглядеть так:
% fwdport -s nntp -1 fw.oursite.com -г news.b1gorg.com
Это означает, что программа выполняет функции сервера NNTP, прослуши-
вая локальные подключения на порте NNTP компьютера fw.ours1te.com. При по-
ступлении запроса она связывается с news.b1gorg.com (на том же порте) и органи-
зует обмен данными между удаленным сервером и локальным клиентом.
Рассмотрим другой пример:
% fwdport -1 myname:9191 -г news.b1gorg.com:nntp
На этот раз мы прослушиваем локальные подключения на порте 9191 хоста
myname и связываем клиентов с удаленным сервером news.b1gorg.com через порт
NNTP.
В некотором смысле fwdport действует и как сервер, и как клиент. Для внешне-
го сервера программа является клиентом, а для компьютеров за брандмауэром —
сервером. Эта программа завершает данную главу, поскольку в ней продемонст-
рирован практически весь изложенный материал: серверные операции, клиент-
ские операции, удаление зомби, разветвление и управление процессами, а также
многое другое.
Пример 17.10. fwdport
#!/usr/Ыn/perl -w
# fwdport - прокси-сервер для внешних служб
use strict: use Getopt::Long: # Обязательные объявления # Для обработки параметров
use Net::hostent: use 10::Socket: # Именованный интерфейс для информации о хосте # Для создания серверных и клиентских сокетов
use POSIX ":sys_wa1t_h": # Для уничтожения зомби
ту (
^Children,
$REM0TE,
$L0CAL.
# Хэш порожденных процессов
# Внешнее соединение
# Для внутреннего прослушивания
продолжение &
746
Глава 17. Сокеты
Пример 17.10 (продолжение)
SSERVICE. $proxy_server. SME. ): # Имя службы или номер порта # Сокет, для которого вызывается accept 0 # Базовое имя программы
(SME = $0) =~ s..*/..: # Сохранить базовое имя сценария
check_args(); # Обработать параметры
start_proxy(); # Запустить наш сервер
service_clients(): # Ждать входящих подключений
die "NOT REACHED": # Сюда попасть невозможно
# Обработать командную строку с применением расширенной версии
# библиотеки getopts.
sub check_args {
GetOptlons(
"reniote=s" => \$REMOTE.
"local=s" => \$LOCAL.
"service=s" => \$SERVICE.
) or die «EOUSAGE:
usage: $0 [ --remote host ] [ --local Interface ] [ --service service ]
EOUSAGE
die "Need remote" unless $REMOTE;
die "Need local or service" unless SLOCAL || SSERVICE:
}
# Запустить наш сервер
sub start_proxy {
my @proxy_server_config = (
Proto => 'tcp'.
Reuse => 1.
Listen => SOMAXCONN.
):
push @proxy_server_config. LocalPort => SSERVICE if $SERVICE:
push @proxy_server_config. LocalAddr => SLOCAL if SLOCAL:
$proxy_server = 10::Socket::INET->new(@proxy_server_config)
or die "can't create proxy server: $0";
print "EProxy server on ". (SLOCAL || SSERVICE). " initialized.]\n":
}
);
sub service_clients {
my (
$local_client. # Клиент, обращающийся к внешней службе
$lc_info. # Имя/порт локального клиента
$remote_server. # Сокет для внешнего соединения
@rs_config. # Временный массив параметров удаленного сокета
$rs_info. # Имя/порт удаленного сервера
Skidpid. # Порожденный процесс для каждого подключения
$SIG{CHLD} = \&REAPER: # Уничтожить зомби
accept!ng():
17.21. Программа: fwdport
747
# Принятое подключение означает, что внутренний клиент
# хочет выйти наружу
while ($local_client = $proxy_server->accept()) {
$lc_info = peerinfo($local_client):
set_state("servicing local $lc_info"):
printf "[Connect from $lc_info]\n":
@rs_config = (
Proto => 'tcp',
PeerAddr => $REM0TE,
):
push(@rs_config. PeerPort => $SERVICE) if $SERVICE:
print "[Connecting to $REMOTE...";
set_state("connecting to $REMOTE"): # См. ниже
$remote_server = 10:iSocket::INET->new(@rs_config)
or die "remote server: $0";
print "done]\n";
$rs_info = peerinfo($remote_server):
set_state("connected to $rs_info");
$kidpid = forkO:
die "Cannot fork" unless defined $kidpid:
if ($kidpid) {
$Chi 1 dren{$kidpid} = timeO: # Запомнить время запуска
close $remote_server: # He нужно главному процессу
close $local_client: # Тоже
next: # Перейти к другому клиенту
}
# В этой точке программа представляет собой ответвленный
# порожденный процесс, созданный специально для входящего
# клиента, но для упрощения ввода/вывода нам понадобится близнец.
close $proxy_server: # Не нужно потомку
Skidpid = forkO;
die "Cannot fork" unless defined $kidpid:
# Теперь каждый близнец сидит на своем месте и переправляет
# строки данных. Видите, как многозадачность упрощает алгоритм?
# Родитель ответвленного процесса, потомок главного процесса
if ($kidpid) {
set_state("$rs_info --> $lc_info"):
select($local_client): $| = 1;
print while <$remote_server>;
killC'TERM', $kidpid); # Работа закончена,
} # убить близнеца
# Потомок потомка, внук главного процесса
else {
set_state("$rs_info <-- $lc_info");
select($remote_server): $| = 1;
print while <$local_client>;
продолжение &
748
Глава 17. Сокеты
Пример 17.10 (продолжение)
kilK'TERM', getppidO): # Работа закончена,
} # убить близнеца
exit: # Тот, кто еще жив, умирает
} continue {
accepting():
}
}
# Вспомогательная функция для получения строки в формате ХОСТ:ПОРТ
sub peerinfo {
my Ssock = shift;
my Shostinfo = gethostbyaddr($sock->peeraddr):
return sprintf("£s:£s",
$hostinfo->name || $sock->peerhost.
$sock->peerport):
}
# Сбросить $0, при этом в некоторых системах "ps" выдает
# нечто интересное: строку, которую мы присвоили $0!
sub set_state { $0 = "SME }
# Вспомогательная функция для вызова set_state
sub accepting {
set_state("accepting proxy for " . (SREMOTE || $SERVICE)):
}
# Кто-то умер. Уничтожать зомби, пока они остаются.
# Проверить время их работы.
sub REAPER {
my $child:
my $start:
while ((Schild = waitpid(-l.WNOHANG)) > 0) {
if (Sstart = SChi1dren{Schi1d}) {
my Sruntime = time() - Sstart:
printf "Child Schild ran £dm£ss\n",
Sruntime / 60, Sruntime % 60:
delete SChi1dren{Schi1d};
} else {
print "Bizarre kid Schild exited $?\n":
}
}
# Если бы мне пришлось выбирать между System V и 4.2.
# я бы уволился. - Питер Ханиман
$SIG{CHLD} = UREAPER:
}:
См. также
Getopt::Long(3), Net::hostent(3\ IO::Socket(3) и POSIX(3y рецепт 16.19; рецепт 17.10.
Протоколы Интернета
«Так называемый „телефон" обладает слишком
многими недостатками, что не позволяет серь-
езно рассматривать его как средство связи. Для
нас это устройство совершенно бесполезно».
Служебная записка Western Union, 1876 г.
18.0. Введение
Правильная работа с сокетами — лишь часть программирования сетевых комму-
никаций. Даже если вы организовали обмен данными между двумя программа-
ми, все равно вам понадобится определенный протокол. С помощью протокола
каждая сторона узнает, когда передаются или принимаются данные и кто имен-
но отвечает за данный аспект службы.
Наиболее распространенные протоколы Интернета перечислены в табл. 18.1.
Таблица 18.1. Основные протоколы Интернета
Протокол Расшифровка Описание
FTP File Transfer Protocol Копирование файлов между удаленными компьютерами
telnet Удаленное подключение к компьютеру
rsh и rep Remote shell and Remote Copy Удаленная регистрация и копирование файлов
NNTP Network News Transfer Protocol Чтение и отправка новостей Usenet
HTTP Hypertext Transfer Protocol Пересылка документов по Веб
SMTP Simple Mail Transfer Problem Отправка почты
POP3 Post Office Protocol Чтение почты
Даже такая относительно простая задача, как подключение к удаленному
компьютеру, требует довольно сложных переговоров между клиентом и серве-
рам. Если бы при каждой попытке воспользоваться сетевой службой вам прихо-
дилось писать код Perl с реализацией этих протоколов, ничего хорошего бы не
вышло — программы содержали бы неимоверное количество ошибок.
К счастью, в Perl имеются модули для всех протоколов. Большинство модулей
реализует клиентскую, а не серверную сторону протокола. Следовательно, про-
750
Глава 18. Протоколы Интернета
грамма сможет использовать эти модули для отправки почты, но не для выполне-
ния функций почтового сервера, к которому подключаются другие клиенты. Впро-
чем, в архиве CPAN можно найти модули для серверов FTP (Net: :FTPServer), HTTP
(HTTP::Daemon, POE: Component::Server:-.HTTP), SMTP (POE:Component::Server::SMTP)
и IRC (POE: Component::Server:: IRC).
Большинство этих модулей принадлежит иерархии Net::; общее подмножест-
во этой иерархии включается в стандартную поставку Perl, начиная с версии 5.8.
Модуль Net::FTP используется для отправки и приема файлов по FTP; модуль
Net:: NNTP — для чтения и отправки новостей Usenet; модуль CPAN Net:: Tel net —
для имитации подключения к другому компьютеру; модуль Net::Ping — для про-
верки связи с компьютером, а модули Net:: POP3 и (CPAN) Mall:: Mall er — для от-
правки и получения почты. Протокол CGI рассматривается в главе 19 «Програм-
мирование CGI», а протокол HTTP — в главе 20 «Автоматизация в Веб».
В последние годы динамично развивается сектор веб-служб, то есть сервиса,
доступ к которому осуществляется через протокол HTTP. WWW более подроб-
но рассматривается в главах 19, 20 и 21, но веб-службы будут описаны в этой
главе. Работа с ними осуществляется с использованием трех основных механиз-
мов: XML-RPC, SOAP и REST.
XML-RPC является простым средством удаленного вызова процедур. Запросы
XML-RPC («я хочу вызвать такой-то метод с такими-то аргументами») и ответы
на них («произошел такой-то сбой» или «метод вернул следующие данные»)
передаются через такие протоколы, как HTTP, SMTP, Jabber и т. д. Модули
XMLRPC: :L1te обеспечивают трансляцию вызовов функций Perl и представлений
XML, передаваемых по каналам связи.
Протокол SOAP сложнее XML-RPC, он обладает расширенными объектно-
ориентированными средствами и поддержкой исключений. Кроме того, он под-
держивает «режим документа», в котором ответ представляется в виде докумен-
та XML вместо встроенной структуры данных; например, вы можете отправить
заказ и получить подтверждение в формате XML. SOAP поддерживает больше
встроенных типов данных, чем XML-RPC, и позволяет определять нестандарт-
ные типы данных с использованием схемы W3C. SOAP, как и XML-RPC, ра-
ботает поверх разных протоколов. В поставку SOAP-Lite включены реализации
как SOAP, так и XML-RPC.
Механизм REST (Representational State Transfer) реализует другой подход
к использованию веб-служб. Вместо вызова удаленных процедур и декодирова-
ния аргументов, требующих знания реализации, REST позволяет отделить реали-
зацию от работы с ресурсом со стороны клиента. В REST URL определяет адрес
объекта. Методы GET, POST, PUT и DELETE используются для выборки данных, изме-
нения состояния, создания, обновления и удаления. Такой подход ориентирует-
ся не столько на конкретные API и программирование, сколько на философию
проектирования, поэтому здесь мы его не рассматриваем.
Большинство упоминавшихся модулей написал Грэхем Барр, автор модулей
10:: Socket, использовавшихся в низкоуровневых сетевых коммуникациях в гла-
ве 17 «Сокеты». Он написал Net:: FTP, Net:: NNTP, Net:: POP3 и Mall:: Mall er. Джей
Роджерс написал Net: Telnet, а Пол Кульченко — инструментарий SOAP-Lite.
Благодаря им вам не придется заново изобретать велосипед!
18.1. Простой поиск в DNS
751
18.1. Простой поиск в DNS
Проблема
Требуется определить IP-адрес хоста или преобразовать IP-адрес в имя. Сете-
вые серверы решают эту задачу в процессе аутентификации своих клиентов,
а клиенты — когда пользователь вводит имя хоста, но для библиотеки сокетов
Perl нужен IP-адрес. Более того, многие серверы регистрируют в файлах журна-
лов IP-адреса, но пользователям и аналитическим программам удобнее работать
с именами хостов.
Решение
Для получения всех IP-адресов по имени хоста (например, www.perl .com) вос-
пользуйтесь функцией gethostbyname:
use Socket;
©addresses = gethostbyname($name) or die "Can't resolve $name; $!\n":
(^addresses = map { 1net_ntoa($_) } @addresses[4 .. $#addresses];
# ^addresses - список IP-адресов ("208.201.239.48". "208.201.239.48")
Если вам нужен только первый адрес, воспользуйтесь функцией 1net_aton:
use Socket;
$address = 1net_ntoa(1net_aton($name));
# $address - один IP-адрес ("208.201.239.48")
Для получения имени хоста по строке с IP-адресом (например, "208.201.239.48")
воспользуйтесь следующим фрагментом:
use Socket:
$name = gethostbyaddr(1net_aton($address). AF_INET)
or die "Can' resolve $address: $!\n";
# $name - имя хоста ("www.perl.com")
Комментарий
Наша задача усложняется тем, что функции Perl являются простыми оболочка-
ми для системных функций С, поэтому IP-адреса приходится преобразовывать
из ASCII-строк ("208.201.239.48") в структуры С. Стандартный модуль Socket
содержит функцию 1net_aton для перехода от ASCII к упакованному числовому
формату и функцию 1net_ntoa, выполняющую обратное преобразование:
use Socket;
$packed_address = 1net_aton("208.146.140.1");
$ascii_address = 1net_ntoa($packed_address);
Функция gethostbyname получает строку, содержащую имя хоста (или 1Р-ад-
рес). В скалярном контексте она возвращает IP-адрес удаленного хоста, который
752
Глава 18. Протоколы Интернета
можно передать 1net_ntoa (или undef в случае ошибки). В списковом контексте
она возвращает список, состоящий по крайней мере из пяти элементов (или пус-
той список в случае ошибки). Список состоит из следующих элементов:
Индекс Значение
0 Официальное имя хоста
1 Синонимы (строка, разделенная пробелами)
2 Тип адреса (обычно AFJNET)
3 Длина структуры адреса (не имеет значения)
4, 5... Структуры адресов
Имени хоста может соответствовать несколько IP-адресов; в частности, это
происходит на сильно загруженных веб-серверах, где для снижения загрузки
на разных компьютерах размещаются идентичные страницы. В подобных ситуа-
циях сервер DNS, предоставляющий адреса, чередует их, обеспечивая сбаланси-
рованную нагрузку на сервер. Если вы хотите выбрать IP-адрес для подключе-
ния, просто возьмите первый адрес в списке (а если он не работает, попробуйте
остальные адреса):
Specked = gethostbyname(Shostname)
or die "Couldn't resolve address for Shostname: S!\n";
Saddress = 1net_ntoa(Spacked):
print "I will use Saddress as the address for $hostname\n":
Используя имена хостов для разрешения или отказа в обслуживании, будь-
те осторожны. Любой желающий может настроить свой сервер DNS так, чтобы
его компьютер идентифицировался как www.wh1tehouse.gov,www.yahoo.com или
th 1 s. 1 s. not. funny. Нельзя сказать, действительно ли ему принадлежит то имя, на
которое он претендует, пока вы не вызовете gethostbyname и не проверите исход-
ный адрес по адресному списку для данного имени.
# Saddress - проверяемый IP-адрес (например. "128.138.243.20")
use Socket:
Sname = gethostbyaddr(1net_aton(Saddress), AF_INET)
or die "Can’t look up Saddress : $!\n";
@addr = gethostbyname(Sname)
or die "Can’t look up Sname : $!\n";
Sfound = grep { Saddress eq 1net4_ntoa($_) } @addr[4. .S#addr]:
Оказывается, даже такой алгоритм не дает полной уверенности в полученном
имени, поскольку существуют разнообразные обходные пути. Даже IP-адрес, из
которого вроде бы поступают пакеты, может быть поддельным, и в процессе ау-
тентификации не следует полагаться на сетевой уровень. В действительно важ-
ных ситуациях всегда выполняйте аутентификацию сами (с помощью паролей
или криптографических методов), поскольку сеть IPv4 не проектировалась для
соблюдения безопасности.
Информация о хосте не ограничивается адресами и синонимами. Чтобы пол-
ноценно работать с дополнительными данными, воспользуйтесь модулем CPAN
Net::DNS. Пример 18.1 показывает, как получить записи MX (mail exchange) для
произвольного хоста.
18.1. Простой поиск в DNS
753
Пример 18.1. mxhost
#!/usr/Ыn/perl -w
# mxhost - поиск записей mx для хоста
use Net::DNS:
use strict:
my (Shost. Sres. @mx);
Shost = shift or die "usage: SO hostname\n":
Sres = Net::DNS::Resolver->new():
@mx = mx($res. Shost)
or die "Can't find MX records for Shost (".Sres->errorstr1ng.")\n":
foreach my Srecord (@mx) {
print $record->preference. " ". $record->exchange. "\n":
}
Примерный вывод выглядит так:
% mxhost cnn.com
10 atlmaill.turner.com
10 atlmail4.turner.com
20 atlmail2.turner.com
30 nymaill.turner.com
Функция inet_aton, как и gethostbyname, получает строку с именем хоста или
IP-адресом, однако она возвращает только первый IP-адрес для данного хоста.
Чтобы узнать все IP-адреса, приходится писать дополнительный код. Модуль
Net::hostent поддерживает соответствующие средства доступа по имени. При-
мер 18.2 показывает, как это делается.
Пример 18.2. hostaddrs
#!/usr/Ыn/perl -w
# hostaddrs - канонизация имени и вывод адресов
use Socket:
use Net::hostent:
use strict:
my (Sname. Shent. ^addresses):
Sname = shift || die "usage: $0 hostname\n":
If (Shent = gethostbyname(Sname)) {
Sname = $hent->name; # Если отличается
my $addr_ref = Shent->addr_11st:
^addresses = map { 1net_ntoa($_) } @$addr_ref:
print "Sname => @addresses\n";
Примерный результат выглядит так:
% hostaddrs www.oreilly.com
www.oreilly.com => 208.201.239.37 208.201.239.36
% hostaddrs www.wh1tehouse.gov
al289.g.akamai.net => 216.241.36.232 216.241.36.230
См. также
Описание функций gethostbyname и gethostbyaddr в perlfunc(l); документация по мо-
дулю CPAN Net:: DNS; документация по стандартным модулям Socket и Net:: hostent.
754
Глава 18. Протоколы Интернета
18.2. Клиентские операции FTP
Проблема
Вы хотите подключиться к серверу FTP, чтобы отправить или принять с него
файлы. Например, вы решили автоматизировать разовую пересылку многих фай-
лов или автоматически создать зеркальную копию целого раздела сервера FTP.
Решение
Воспользуйтесь модулем CPAN Net:: FTP:
use Net::FTP;
Sftp = Net::FTP->new("ftp.host.com") or die "Can't connect: S@\n":
$ftp->login($username, Spassword) or die "Couldn't login\n":
$ftp->cwd($directory) or die "Couldn't change directory\n"
Sftp->get(Sfilename) or die "Couldn't get $filename\n":
Sftp->put(Sfilename) or die "Couldn't put $filename\n":
Комментарий
Работа с модулем Net:: FTP состоит из трех шагов: подключение к серверу, иден-
тификация и аутентификация и пересылка файлов. Все операции с сервером
FTP реализуются методами объекта Net::FTP. При возникновении ошибки методы
возвращают undef в скалярном контексте и пустой список в списковом контексте.
Подключение осуществляется конструктором new. В случае ошибки пере-
менной $@ присваивается сообщение об ошибке, a new возвращает undef. Первый
аргумент определяет имя хоста сервера FTP и может сопровождаться необяза-
тельными параметрами:
Sftp = Net::FTP->new("ftp.host.com".
Timeout => 30.
Debug => 1)
or die "Can't connect: S@\n":
Параметр Timeout определяет промежуток времени в секундах, после которо-
го любая операция считается неудачной. Параметр Debug устанавливает уро-
вень отладки (при значении, отличном от нуля, копии всех команд отправляются
в STDERR). Строковый параметр Firewall определяет компьютер, являющийся про-
кси-сервером FTP. Параметр Port задает альтернативный номер порта (по умол-
чанию используется 21, стандартный номер порта FTP). Наконец, если параметр
Passive равен true, все пересылки выполняются в пассивном режиме (требова-
ние некоторых брандмауэров и прокси-серверов). Параметры Firewall и Passive
переопределяют переменные окружения FTP_FIREWALL и FTP_PASSIVE.
Следующим после подключения шагом является аутентификация. Обычно
функция login вызывается с тремя аргументами: именем пользователя, паролем
и учетной записью (account).
$ftp->login()
or die "Couldn't authenticate.\n":
18.2. Клиентские операции FTP
755
$ftp->login(Susername)
or die "Still couldn't authenticate.\n":
Sftp->1ogin(Susername, Spassword)
or die "Couldn't authenticate, even with explicit username
and password.\n":
Sftp->1ogin(Susername, Spassword. Saccount)
or die "No dice. It hates me.\n":
Если вызвать login без аргументов, Net::FTP с помощью модуля Net::Netrc
определяет параметры хоста, к которому вы подключились. Если данные не най-
дены, делается попытка анонимной регистрации (пользователь anonymous, пароль
-anonymous^). Если при имени пользователя anonymous пароль не задан, в качестве
пароля передается почтовый адрес пользователя. Дополнительный аргумент
(учетная запись) в большинстве систем не используется. При неудачной аутен-
тификации функция login возвращает undef.
После завершения аутентификации стандартные команды FTP выполняются
с помощью методов, вызываемых для объекта Net:: FTP. Методы get и put прини-
мают и отправляют файлы. Отправка файла выполняется так:
Sftp->put($1 ocal fl 1 е, Sremotef11е)
or die "Can't send Slocalflle: $!\n";
Если второй аргумент отсутствует, имя удаленного файла совпадает с име-
нем локального файла. Передаваемые данные также можно брать из файлового
манипулятора (в этом случае имя удаленного файла передается в качестве вто-
рого аргумента):
Sftp->put(*STDIN. Sremoteflle)
or die "Can't send from STDIN: $!\n";
Если пересылка прерывается, удаленный файл не уничтожается автоматиче-
ски. Метод put возвращает удаленное имя файла при успешном завершении или
undef в случае ошибки.
Метод get, используемый для приема файлов, возвращает локальное имя
файла или undef в случае ошибки:
Sftp->get(Sremotef11е, SIocalfl 1е)
or die "Can't fetch Sremoteflle : S!\n";
Метод get тоже может использоваться для приема файла в манипулятор; он
возвращает манипулятор (или undef в случае ошибки):
$ftp->get(Sremoteflle, *STDOUT)
or die "Can't fetch Sremoteflle: S!\n";
Необязательный третий аргумент get, смещение в удаленном файле, иниции-
рует пересылку с заданного смещения. Принятые байты дописываются в конец
локального файла.
Метод type изменяет режим трансляции файла. Если передать ему строку ("А",
"I", "Е" или "L"), возвращается предыдущий режим трансляции. Методы ascii,
binary, ebcdlc и byte вызывают type с соответствующей строкой. При возникнове-
756
Глава 18. Протоколы Интернета
нии ошибок (например, если сервер FTP не поддерживает EBCDIC) type и вспо-
могательные методы возвращают undef.
Методы cwd($remotedi г) и pwd используются для установки и определения
текущего удаленного каталога. Оба метода возвращают true в случае успеха
и false в противном случае. При вызове cwd("..") вызывается метод cdup для пе-
рехода в родительский каталог текущего каталога. Вызов cwd без аргументов вы-
полняет переход в корневой каталог.
$ftp->cwd("/pub/perl/CPAN/lmages/g-rated");
print "I'm In the directory ", $ftp->pwd(), "\n":
Методы mkd1r($remoted1r) и rmd1r($remoted1r) создают и, соответственно, уда-
ляют каталоги на удаленном компьютере. Для создания и удаления каталогов на
локальном компьютере применяются встроенные функции mkdir и rmdir. Чтобы
создать все промежуточные каталоги на пути к указанному, передайте mkdir
второй аргумент, равный true. Например, чтобы создать каталоги /pub, /pub/gnat
и pub/gnat/perl, воспользуйтесь следующим вызовом:
$ftp->mkd1r("/pub/gnat/perl", 1)
or die "Can't create /pub/gnat/perl recursively: $!\n":
При успешном выполнении функция mkdi г возвращает полный путь к только
что созданному каталогу. При неудаче mkd 1 г возвращает undef.
Методы 1 s и di г возвращают список содержимого удаленного каталога. Тради-
ционно dlr выводит более подробную информацию, чем 1s, но в обоих случаях
стандартного формата не существует. Большинство серверов FTP выводит резуль-
таты команд 1s и Is -1, но нельзя гарантировать, что это правило будет соблю-
даться всеми серверами. В списковом контексте эти методы возвращают список
строк, возвращенных сервером. В скалярном контексте возвращается ссылка
на массив.
@11nes = $ftp->ls("/pub/gnat/perl")
or die "Can't get a list of files In /pub/gnat/perl: $!":
$ref_to_11nes = $ftp->d1r("/pub/perl/CPAN/src/latest.tar.gz")
or die "Can't check status of latest.tar.gz: $!\n":
Для корректного завершения работы с FTP используется метод quit:
$ftp->qu1t() or warn "Couldn't quit. Oh wellAn":
Другие методы переименовывают удаленные файлы, меняют владельца и пра-
ва доступа, проверяют размер удаленных файлов и т. д. За подробностями обра-
щайтесь к документации по модулю Net::FTP.
Если вы хотите организовать зеркальное копирование файлов между компь-
ютерами, воспользуйтесь превосходной программой ml rror, написанной на Perl
Ли Маклафлином (http://suns1te.doc.1c.ac.uk/packages/m1rror/).
См. также
Страницы руководства/ф(1) и ftpd(8) вашей системы (если есть); документа-
ция по модулю CPAN Net::FTP.
18.3. Отправка почты
757
18.3. Отправка почты
Проблема
Ваша программа должна отправлять почту. Некоторые программы следят за
системными ресурсами, например, свободным местом на диске, и рассылают
сообщения о том, что ресурс достиг опасного предела. Авторы сценариев CGI
часто делают так, чтобы при нарушениях работы базы данных программа не со-
общала об ошибке пользователю, а отправляла сообщение о проблеме админи-
стратору базы данных.
Решение
Воспользуйтесь модулем CPAN Mall:: Mail er:
use Mall::Mai 1 er;
Smaller = Mall::Ma11er->new("sendma11"):
Smaller->open({ From => $from_address.
To => $to_address,
Subject => Ssubject,
})
or die "Can't open: $!\n";
print Smaller Sbody:
Sma11er->close():
Также можно напрямую воспользоваться программой sendmal 1:
openCSENDMAIL. "|/usr/1Ib/sendmall -ol -t -odq")
or die "Can't fork for sendmal1: S!\n":
print SENDMAIL «"EOF":
From: User Originating Mall <me\@host>
To: Final Destination <you\@otherhost>
Subject: A relevant subject line
Body of the message goes here, In as many lines as you like.
EOF
close(SENDMAIL) or warn "sendmall didn't close nicely":
Комментарий
Существует три варианта отправки почты из программы. Во-первых, можно
воспользоваться внешней программой, которая обычно применяется пользо-
вателями для отправки почты, например, Mall или mallx; такие программы
называются пользовательскими почтовыми агентами (MUA, Mail User Agents).
Во-вторых, существуют почтовые программы системного уровня (например,
sendmall); они называются транспортными почтовыми агентами (МТА, Mail
Transport Agents). Наконец, можно подключиться к серверу SMTP (Simple Mail
Transfer Protocol). К сожалению, стандартной программы пользовательского уров-
ня не существует, для sendmall не определено стандартного местонахождения,
758
Глава 18. Протоколы Интернета
а протокол SMTP довольно сложен. Модуль CPAN Mall:: Mall er избавляет вас
от этих сложностей.
Создайте объект Mall::Mailer конструктором Mall::Mailer->new. При вызове
конструктора без аргументов используется метод отправки почты по умолчанию
(вероятно, с помощью внешней программы типа mall). Аргументы new позволя-
ют выбрать альтернативный способ отправки сообщений. Первый аргумент оп-
ределяет способ отправки ("mail" для пользовательских почтовых агентов Unix,
"sendmail" для программы sendmai 1 и "smtp" для подключения к серверу SMTP).
Необязательный второй аргумент определяет путь к программе.
Например, следующая команда приказывает Mall::Mailer использовать sendmail
вместо способа отправки, принятого по умолчанию:
Smaller = Mail:: Mai ler->new( "sendmai Г):
В следующем примере вместо mail используется почтовая программа /u/gnat/
bi n/funkymai 1 er:
Smaller = Mail;:Mailer->new("mail", "/u/gnat/bin/funkymai1 er");
Подключение к серверу SMTP mail .myisp.com выполняется так:
Smaller = Mail:;Mailer->new("smtp". "mail.myisp.com");
При возникновении ошибки в любой части Mail::Mailer вызывается die. Сле-
довательно, для проверки ошибок следует включить код отправки почты в блок
eval, после чего проверить переменную $@:
eval {
Smaller = Mail;:Mailer->new("bogus". "arguments");
# ...
}:
if ($0) {
# Неудачный вызов eval
print "Couldn't send mail; $@\n";
} else {
# Успешный вызов eval
print "The authorities have been notifiedAn";
}
Если конструктор new не понимает переданные аргументы или не имеет спо-
соба по умолчанию при отсутствии аргументов, он инициирует исключение.
Модуль Mail:;Mailer запускает почтовую программу или подключается к серверу
SMTP лишь после вызова метода open для заголовков сообщения:
Smai1er->open( 'From' => 'Nathan Torkington <gnat@frii.com>'.
'To' => 'Tom Christiansen <tchrist@perl.com>'.
'Subject' => 'The Perl Cookbook' );
Если попытка запустить программу или подключиться к серверу завершилась
неудачно, метод open инициирует исключение. После успешного вызова open
переменную Smaller можно интерпретировать как файловый манипулятор и вы-
вести в нее основной текст сообщения:
print Smaller <<EO_SIG;
Мы когда-нибудь закончим эту книгу?
18.3. Отправка почты
759
Жена грозится уйти от меня.
Она говорит, что я люблю EMACS больше, чем ее.
Что делать?
Нат
EO_SIG
Завершив отправку текста, вызовите функцию close для объекта Mall:: Mall er:
close($ma11 er) or die "can't close mailer: $!";
Впрочем, с программой sendmall можно общаться и напрямую:
open(SENDMAIL. "|/usr/sbln/sendmal1 -ol -t -odq")
or die "Can't fork for sendmall: $!\n";
print SENDMAIL «"EOF":
From: Fancy Chef <chef@example.com>
To: Grubby Kitchenhand <hand@example.com>
Subject: Re: The Perl Cookbook
(1) Мы никогда не закончим эту книгу.
(2) Тот. кто работает с EMACS. не заслуживает любви.
(3) Переходи на vl.
Том
EOF
close(SENDMAIL):
Перед нами тривиальный пример использования функции open для запус-
ка другой программы (см. рецепт 16.4). Нам приходится указывать полный путь
к sendmall, поскольку местонахождение этой программы меняется от компьютера
к компьютеру. Обычно она находится в каталоге /usr/11 b или /usr/sblп. Флаги,
передаваемые sendmall, говорят о том, что программа не должна завершаться при
чтении строки, состоящей из одной точки (-01); что адресат сообщения опреде-
ляется по данным заголовка (-t); а также о том, что вместо немедленной достав-
ки сообщение должно помещаться в очередь (-odq). Последний параметр важен
лишь при отправке больших объемов почты — без него компьютер быстро захлеб-
нется в многочисленных процессах sendmall. Чтобы сообщение доставлялось не-
медленно (например, во время тестирования или при срочной доставке почты),
удалите -odq из командной строки.
Мы выводим функцией print все сообщение — заголовки и основной текст,
разделяя их пустой строкой. Не существует специальных служебных символов
для вставки новых строк (как в некоторых пользовательских почтовых програм-
мах), поэтому весь текст интерпретируется буквально. Sendmall добавляет заго-
ловки Date и Message-ID (которые все равно не следует генерировать вручную).
Некоторые версии Perl (особенно для Windows и Мас) не имеют аналогов
sendmall или mall. В таких случаях отправка почты осуществляется через сервер
SMTP.
См. также
Описание функции open в perlfunc(iy рецепт 16.4; рецепт 16.10; рецепт 16.19; ре-
цепт 19.5; определение протокола SMTP в документе RFC 821, а также допол-
нения в последующих RFC; документация по модулю CPAN Mall::Mai 1 er.
760
Глава 18. Протоколы Интернета
18.4. Чтение и отправка новостей Usenet
Проблема
Вы хотите подключиться к серверу новостей Usenet для чтения и отправки но-
востей. Ваша программа может периодически отправлять материалы1, собирать
статистику по конференции или идентифицировать новичков, чтобы отправить
им приветственное сообщение.
Решение
Воспользуйтесь модулем Net::NNTP:
use Net::NNTP;
Sserver = Net::NNTP->new("news.host.dom")
or die "Can't connect to news server: $@\n":
(Snartlcles, Sfirst. Slast. Sname) = $server->group( "mlsc.test" )
or die "Can't select m1sc.test\n";
Sheaders = Sserver->head($f1rst)
or die "Can't get headers from article Sfirst In $name\n":
Sbodytext = Sserver->body($f1rst)
or die "Can't get body from article Sfirst In $name\n":
Sartlcle = Sserver->art1cle($f1rst)
or die "Can't get article Sfirst from $name\n":
$server->postok()
or warn "Server didn't tell me I could postAn":
$server->post( [ @11nes ] )
or die "Can't post: $!\n":
Комментарий
Usenet представляет собой распределенную систему электронных конференций.
Обмен сообщениями между серверами обеспечивает одинаковое содержимое всех
находящихся на них конференций. Каждый сервер устанавливает собственный
критерий, определяющий максимальный срок хранения сообщений. Клиентские
программы подключаются к выделенному серверу (обычно принадлежащему их
организации, Интернет-провайдеру или университету), получая возможность
читать существующие или отправлять новые сообщения.
Каждое сообщение (или статья) состоит из набора заголовков и основного
текста, разделенных пустой строкой. Сообщения идентифицируются двумя спосо-
бами: заголовком идентификатора сообщения и номером сообщения в конференции.
Идентификатор сообщения хранится внутри самого сообщения. Он заведомо ос-
тается уникальным независимо от того, с какого сервера Usenet было прочитано
1 В этом случае обязательно присмотритесь к программе Яна Клуфта auto-faq по адресу
http://www.novia.net/~pschleck/auto-faq/.
18.4. Чтение и отправка новостей Usenet
761
сообщение. Если сообщение ссылается на другие сообщения, оно также использует
их идентификаторы. Идентификатор сообщения представляет собой строку вида:
<O4Ol@jpl-devvax.JPL.NASA.GOV>
Также возможна идентификация сообщений по конференции и номеру внутри
конференции. Каждый сервер Usenet присваивает своим сообщениям собствен-
ные номера, поэтому правильность ссылок гарантирована лишь для того сервера
Usenet, с которого они были получены.
Конструктор Net::NNTP подключается к заданному серверу Usenet. Если со-
единение не удается установить, он возвращает undef и присваивает переменной
$@ сообщение об ошибке. Если соединение было успешно установлено, new воз-
вращает новый объект Net:: NNTP:
Sserver = Net::NNTP->new("news.mycompany.com")
or die "Couldn't connect to news.mycompany.com: $@\n":
После установки соединения метод 11 st возвращает список конференций в виде
ссылки на хэш, ключи которого соответствуют именам конференций. Ассоцииро-
ванные значения представляют собой ссылки на массивы, содержащие первый
допустимый номер сообщения в конференции, последний допустимый номер сооб-
щения в конференции и строку флагов. Флаги обычно равны "у" (отправка разре-
шена), но также могут быть равны "т" (модерируемая конференция) или =ИМЯ
(данная конференция дублирует конференцию ИМЯ). На сервере могут хранить-
ся свыше 60 000 конференций, поэтому выборка всего списка требует некоторо-
го времени.
Sgroupllst = $server->l1 st()
or die "Couldn't fetch group 11st\n":
foreach $group (keys ^Sgroupllst) {
If (Sgroupl1st->{$group}->[2] eq 'y') {
# Отправка в $group разрешена
}
}
По аналогии с концепцией текущего каталога в FTP, протокол NNTP (NetNews
Transfer Protocol) поддерживает концепцию текущей конференции. Назначение
текущей конференции выполняется методом group:
(Snartlcles, $f1rst. $last. Sname) = $server->group("comp.lang.perl.mlsc")
or die "Can't select comp.lang.perl.mlsc\n":
Метод group возвращает список из четырех элементов: количество сообщений
в конференции, номер первого сообщения, номер последнего сообщения и назва-
ние конференции. Если конференция не существует, возвращается пустой список.
Содержимое сообщений можно получить двумя способами: вызвать метод
article с идентификатором сообщения или выбрать конференцию методом group,
а затем вызвать article с номером сообщения. В скалярном контексте метод воз-
вращает ссылку на массив строк, а в списковом контексте возвращается список
строк. При возникновении ошибки article возвращает false:
@11nes = Sserver->art1cle($message_1d)
or die "Can't fetch article Sart1cle_number: $!\n":
762
Глава 18. Протоколы Интернета
Для получения заголовка и основного текста сообщения используются соот-
ветственно методы head и body. Как и article, они вызываются для идентифика-
тора или номера сообщения и возвращают список строк или ссылку на массив:
Ogroup = $server->group("comp.lang.perl .misc")
or die "Can't select group comp.lang.perl.misc\n";
@lines = $server->head($group[lj)
or die "Can't get headers from first article in comp.lang.perl.misc\n";
Метод post отправляет новое сообщение. Он получает список строк или ссыл-
ку на массив строк и возвращает true при успешной отправке или false в случае
неудачи:
$server->post(@message)
or die "Can't post\n";
Метод postok позволяет узнать, разрешена ли отправка сообщений на данный
сервер Usenet:
unless ($server->postok()) {
warn "You may not postAn";
}
Полный список методов приведен на странице руководства модуля Net:: NNTP.
См. также
Документация по модулю Net::NNTP; RFC 977, «Network News Transport Protocol»;
страницы руководства tm(l) и innd(8) вашей системы (если есть).
18.5. Чтение почты на серверах POP3
Проблема
Требуется принять почту с сервера POP3. Например, программа может полу-
чать данные о непрочитанной почте, перемещать ее с удаленного сервера в ло-
кальный почтовый ящик или переключаться между Интернетом и локальной
почтовой системой.
Решение
Воспользуйтесь модулем Net:: POP3:
$рор = Net::P0P3->new($mail_server)
or die "Can’t open connection to $mail_server : $!\n";
$pop->login($username, $password)
or die "Can't authenticate: $!\n":
$messages = $pop->list
or die "Can't get list of undeleted messages: $!\n":
foreach $msgid (keys ^messages) {
$message = $pop->get($msgid):
18.5. Чтение почты на серверах POP3
763
unless (defined Smessage) {
warn "Couldn't fetch $msg1d from server: $!\n":
next:
}
# Smessage - ссылка на массив строк
$pop->delete(Smsgid):
}
Комментарий
Традиционно в доставке почты участвовало три стороны: МТ А (транспортный
почтовый агент — системная программа типа sendmall) доставляет почту в нако-
питель (spool), а затем сообщения читаются с помощью MUA (пользовательские
почтовые агенты — программы типа mall). Такая схема появилась в те времена,
когда почта хранилась на больших серверах, а пользователи читали сообщения
на простейших терминалах. По мере развития PC и сетевых средств появилась
потребность в MUА (таких, как Pine), которые бы работали на пользовательских
компьютерах (а не на том компьютере, где находится накопитель). Протокол
POP (Post Office Protocol) обеспечивает эффективное чтение и удаление сооб-
щений во время сеансов TCP/IP.
Модуль Net::POP3 обслуживает клиентскую сторону POP. Иначе говоря, он
позволяет программе на Perl выполнять функции MUA. Работа с Net::POP3 на-
чинается с создания нового объекта Net:: POP3. Конструктору new передается имя
сервера POP3:
Spop = Net::POP3->new( "pop.my1sp.com" )
or die "Can't connect to pop.my1sp.com: $!\n":
При возникновении ошибок все функции Net::POP3 возвращают undef или
пустой список в зависимости от контекста вызова. При этом переменная $ ’ может
содержать осмысленное описание ошибки (а может и не содержать).
Кроме того, конструктору new можно передать дополнительные аргументы
и определить тайм-аут (в секундах) для сетевых операций:
Spop = Net::P0P3->new( "pop.my1sp.com",
Timeout => 30 )
or die "Can't connect to pop.my1sp.com : $!\n":
Метод login выполняет аутентификацию на сервере POP3. Он получает два
аргумента — имя пользователя и пароль, но оба аргумента являются необязатель-
ными. Если пропущено имя пользователя, используется текущее имя. Если пропу-
щен пароль, Net::POP3 пытается определить пароль с помощью модуля Net: :Netrc:
defined ($рор->1ogln("gnat", "S33krlT Pa55wOrD"))
or die "Hey, my username and password didn't work!\n";
defined ($pop->log1n( "midget" )) # Искать пароль с помощью Net::Netrc
or die "Authentication failed.\n";
defined (Spop->log1nO) # Текущее имя пользователя и Net::Netrc
or die "Authentication failed. Miserably.\n":
764
Глава 18. Протоколы Интернета
При вызове метода login пароль пересылается по сети в виде обычного тек-
ста. Это нежелательно, поэтому при наличии модуля MD5 от CPAN можно вос-
пользоваться методом арор. Он полностью идентичен login за исключением того,
что пароль пересылается в текстовом виде:
$рор->арор( Susername, Spassword )
or die "Couldn't authenticate: $!\n";
После аутентификации методы list, get и delete используются для работы
с накопителем. Метод 1 1 st выдает список неудаленных сообщений, хранящихся
в накопителе. Он возвращает хэш, в котором ключом является номер сообще-
ния, а ассоциированным значением — размер сообщения в байтах:
^undeleted = $pop->list();
foreach Smsgnum (keys ^undeleted) {
print "Message Smsgnum is $undeleted{Smsgnum} bytes longAn":
}
Чтобы принять сообщение, вызовите метод get с нужным номером. Метод
возвращает ссылку на массив строк сообщения:
print "Retrieving Smsgnum : ";
Smessage = $pop->get(Smsgnum):
if (Smessage) {
# Успешно
print "\n":
print @$message; # Вывести сообщение
} else {
# Неудача
print "failed ($!)\n":
}
Метод delete помечает сообщение как удаленное. При вызове метода quit, за-
вершающего сеанс POP3, помеченные сообщения удаляются из почтового ящи-
ка. Метод reset отменяет все вызовы delete, сделанные во время сеанса. Если
сеанс завершается из-за того, что объект Net:: POP3 уничтожен при выходе из
области действия, метод reset будет вызван автоматически.
Возможно, вы заметили, что мы ничего не сказали об отправке почты. POP3
поддерживает только чтение и удаление существующих сообщений. Новые
сообщения приходится отправлять с помощью программ типа mail или sendmail
или протокола SMTP. Другими словами, рецепт 18.3 все равно пригодится.
Основная задача POP3 — подключение почтовых клиентов к почтовым сер-
верам — также выполняется протоколом IMAP. IMAP обладает более широки-
ми возможностями и чаще используется на очень больших узлах.
См. также
Документация по модулю Net::POP3; RFC 1734, «POP3 AUTHentication com-
mand»; RFC 1957, «Some Observations on Implementations of the Post Office
Protocol».
18.6. Программная имитация сеанса telnet
765
18.6. Программная имитация сеанса telnet
Проблема
Вы хотите обслуживать подключение telnet в своей программе — регистриро-
ваться на удаленном компьютере, вводить команды и реагировать на них. Такая
задача имеет много практических применений — от автоматизации на компью-
терах с доступом telnet, но без поддержки сценариев или rsh, до обычной про-
верки работоспособности демона telnet на другом компьютере.
Решение
Воспользуйтесь модулем CPAN Net:: Tel net:
use Net::Tel net:
$t = Net::Telnet->new( Timeout => 10.
Prompt => '/%/',
Host => Shostname ):
$t->log1n($username, $password):
@f 11 es = $t->cmd("ls"):
$t->print("top"):
(undef. $process_str1ng) = $t->waitfor('/\d+ processes/');
$t->close:
Комментарий
Модуль Net:: Tel net поддерживает объектно-ориентированный интерфейс к про-
токолу telnet. Сначала вы устанавливаете соединение методом Net: :Telnet->new,
а затем взаимодействуете с удаленным компьютером, вызывая методы получен-
ного объекта.
Метод new вызывается с несколькими параметрами, передаваемыми в хэш-по-
добной записи (параметр => значение). Мы упомянем лишь некоторые из многих
допустимых параметров. Самый важный, Host, определяет компьютер, к кото-
рому вы подключаетесь. По умолчанию используется значение local host. Чтобы
использовать порт, отличный от стандартного порта telnet, укажите его в пара-
метре Port. Обработка ошибок выполняется функцией, ссылка на которую пере-
дается в параметре Errmode.
Еще один важный параметр — Prompt. При регистрации или выполнении ко-
манды модуль Net:: Tel net по шаблону Prompt определяет, завершилась ли регист-
рация или выполнение команды. По умолчанию Prompt совпадает со стандартны-
ми приглашениями распространенных командных интерпретаторов:
/[Ш#>] $/
Если на удаленном компьютере используется нестандартное приглашение, вам
придется определить собственный шаблон. Не забудьте включить в него символы /.
Параметр Timeout определяет продолжительность (в секундах) тайм-аута при
сетевых операциях. По умолчанию тайм-аут равен 10 секундам.
766
Глава 18. Протоколы Интернета
Если в модуле Net:: Tel net происходит ошибка или тайм-аут, по умолчанию
инициируется исключение. Если не перехватить его, исключение выводит сооб-
щение в STDERR и завершает работу программы. Чтобы изменить это поведение,
передайте в параметре Errmode ссылку на подпрограмму. Если вместо ссылки
Errmode содержит строку "return", то при возникновении ошибок методы возвра-
щают undef (в скалярном контексте) или пустой список (в списковом контек-
сте); при этом сообщение об ошибке можно получить с помощью метода errmsg:
Stelnet = Net::Telnet->new( Errmode => sub { main::log(@_) }. ... );
Метод login передает имя пользователя и пароль на другой компьютер.
Успешное завершение регистрации определяется по шаблону Prompt; если хост
не выдал приглашения, происходит тайм-аут:
$telnet->login($username, $password)
or die "Login failed: @{[ $telnet->errmsg() ]}\n";
Для запуска программы и получения ее вывода применяется метод emd. Он
получает командную строку и возвращает выходные данные программы. В списко-
вом контексте возвращается список, каждый элемент которого соответствует от-
дельной строке. В скалярном контексте возвращается одна длинная строка. Перед
возвратом метод ожидает выдачи приглашения, определяемого по шаблону Prompt.
Пара методов print и waltfor позволяет отделить отправку команды от полу-
чения ее выходных данных, как это было сделано в Решении. Метод waltfor по-
лучает либо набор именованных аргументов, либо одну строку с регулярным
выражением Perl:
$telnet->wa1tfor('/--more--/')
Параметр Timeout определяет новый тайм-аут, отменяя значение по умолча-
нию. Параметр Match содержит оператор совпадения (см. выше), a String — иско-
мую строковую константу:
$telnet->wa1tfor(Strlng => 'greasy smoke'. Timeout => 30)
В скалярном контексте waltfor возвращает true, если шаблон или строка
были успешно найдены. В противном случае выполняется действие, определяе-
мое параметром Errmode. В списковом контексте метод возвращает две строки:
весь текст до совпадения и совпавший текст.
См. также
Документация по модулю CPAN Net:: Tel net; RFC 854-856 и дополнения в по-
следующих RFC.
18.7. Проверка удаленного компьютера
Проблема
Требуется проверить доступность сетевого компьютера. Сетевые и системные
программы часто используют для этой цели программу pl ng.
18.7. Проверка удаленного компьютера
767
Решение
Воспользуйтесь стандартным модулем Net:: PI ng:
use Net::PI ng:
$p = Net::Ping->new()
or die "Can't create new ping object: $!\n":
print "Shost is alive" if $p->ping($host):
$p->close:
Комментарий
Проверить работоспособность компьютера сложнее, чем кажется. Компьютер может
реагировать на команду pi ng даже при отсутствии нормальной функциональности;
это не только теоретическая возможность, но, как ни печально, распространенное
явление. Лучше рассматривать утилиту pi ng как средство для проверки доступности
компьютера, а не выполнения им своих функций. Чтобы решить последнюю зада-
чу, вы должны попытаться обратиться к его демонам (Telnet, FTP, web, NFS и т. д.).
В форме, показанной в Решении, модуль Net:: Pi ng пытается подключиться
к эхо-порту UDP (порт 7) на удаленном компьютере, отправить дейтаграмму
и получить эхо-ответ. Метод ping возвращает true, если компьютер доступен,
и false в противном случае.
Чтобы использовать другой протокол, достаточно передать его имя при вызо-
ве new. Допустимыми являются протоколы tcp, udp, syn и i cmp (записываются в ниж-
нем регистре). При выборе протокола UDP программа пробует подключиться
к эхо-порту (порт 7) удаленного компьютера, отправляет дейтаграмму и пытает-
ся прочитать ответ. Компьютер считается недоступным, если к нему не удается
подключиться, если не была получена ответная дейтаграмма или если ответ от-
личается от исходной дейтаграммы. При выборе i cmp будет использован прото-
кол ICMP, как в команде pmg(8). На компьютерах Unix протокол ICMP может
быть выбран только привилегированным пользователем:
# Использовать ICMP при наличии привилегий и TCP в противном случае
Spong = Net::Ping->new( $> ? "tcp" : "icmp" );
(defined Spong)
or die "Couldn't create Net::Ping object: $!\n":
if ($pong->ping("kingkong.com")) {
print "The giant ape 11ves!\n";
} else {
print "All hail mighty Camera, friend of children!\n":
}
Проверка с использованием SYN выполняется асинхронно; вы отправляете
сразу несколько запросов, а потом получаете ответы многократным вызовом ack.
Метод возвращает список с именем хоста, временем кругового оборота сообще-
ния и IP-адресом, от которого поступил ответ:
Snet = Net::Ping->new('syn'):
foreach Shost (@hosts) {
$net->ping($host):
768
Глава 18. Протоколы Интернета
while ((Shost, Srtt. Sip) = $net->ack()) {
printf "Response from %s Us) In И\п", Shost, Sip, Srtt:
}
Конечно, на большинстве компьютеров на создание подключения TCP требует-
ся меньше секунды, иначе браузеры работали бы до отвращения медленно. Чтобы
время кругового оборота сообщения в этом тесте было отлично от нуля, измерение
времени должно производиться с большей гранулярностью. Метод hires измеря-
ет время АСК при помощи модуля Time::Hi Res (см. рецепт 3.9). В следующем
фрагменте активизируются таймеры высокого разрешения (измененный код вы-
делен жирным шрифтом):
Snet = Net::P1ng->new(’syn’):
Snet->hires(); # Активизация таймеров высокого разрешения
foreach Shost (@hosts) {
Snet->p1ng($host):
}
while ((Shost, Srtt, Sip) = Snet->ackO) {
printf "Response from £s Us) in ^.2f\n", Shost, Sip, Srtt;
}
Значение Srtt по-прежнему задается в секундах, но оно может иметь дроб-
ную часть, измеряемую с точностью до миллисекунд.
Чтобы проверять доступность компьютера при помощи TCP, следует задать
порт, используемый Net:: Pi ng. Впрочем, любая система сбора информации про-
мышленного уровня также проверит, отвечает ли заданный порт на запросы:
Stest = Net::P1ng->new(’tcp’):
$test->{port_num} = getservbynameU'ftp", "tcp"):
If (! $test->ping($host)) {
warn "Shost Isn't serving FTP!\n":
Ни один из этих способов не является абсолютно надежным. Маршрутизато-
ры некоторых узлов отфильтровывают протокол ICMP, поэтому Net:: Pi ng сочтет
такие компьютеры недоступными даже при возможности подключения по дру-
гим протоколам. Многие компьютеры запрещают эхо-сервис TCP и UDP, что
приводит к неудачам при опросе через TCP и UDP. Запрет службы или фильт-
рацию протокола невозможно отличить от неработоспособности компьютера.
См. также
Документация по модулю Net:: Pi ng; страницы руководства ping(8), tcp(3), udp{^)
и icmp(4) вашей системы (если есть); RFC 792 и 950.
18.8. Обращение к серверу LDAP
Проблема
Требуется получить или изменить информацию на сервере LDAP (Lightweight
Directory Access Protocol). Допустим, у вас имеется список адресов электронной
почты сотрудников вашей организации, и вы хотите узнать имена тех людей,
которым эти адреса принадлежат.
18.8. Обращение к серверу LDAP
769
Решение
Воспользуйтесь модулем CPAN Net:: LDAP. Например, поиск выполняется так:
use Net::LDAP:
$ldap = Net::LDAP->new("ldap.example.com") or die $@;
$ldap->bind():
$mesg = $ldap->search(base => $base_dn,
filter => $FILTER):
$mesg->code() && die $mesg->error;
foreach Sresult ($mesg->algentries) {
# Сделать что-то c Sresult
}
$ldap->unbind():
Комментарий
Модуль Net:: LDAP управляет сеансом взаимодействия с сервером LDAP. Он напи-
сан исключительно на Perl, поэтому для его установки не потребуется компиля-
тор С. Однако для эффективного использования необходимо хотя бы немно-
го разбираться в LDAP вообще и в синтаксисе запросов в частности. Если вы
никогда не работали с LDAP, рекомендуем почитать статьи по адресу http://
www.onlamp.com/topi cs/apache/1 dap.
Сеанс работы с сервером LDAP делится на четыре этапа: подключение, ау-
тентификация, обмен данными и отключение. На этапе обмена данными выпол-
няются операции поиска, добавления, удаления и модификации записей.
Метод connect устанавливает связь с сервером LDAP, сразу же за ним следует
вызов метода bi nd. Если bi nd вызывается без аргументов, регистрация на сервере
LDAP производится анонимно. Для выполнения аутентификации можно пере-
дать полное имя DN (Distinguished Name) и пароль:
$1 daр->bind("cn=directory manager.ou=gurus.dc=orei1ly.dc=com".
password => "timtoady") or die
Имя пользователя и пароль пересылаются по каналу связи в незащищенном
формате. Чтобы защитить передаваемую информацию, задайте при вызове bind
в параметре sasl объект Authen::SASL, используемый для аутентификации.
Метод search возвращает объект с набором элементов. Возможна выборка как
всех элементов сразу (all_entries, как в Решении), так и по одному элементу:
$num_entries = $mesg->count():
for ($i=0; Si < $num_entries: $i++) {
my Sentry = $mesg->entry($i);
# ...
}
Поддерживается даже удаление элементов из стека результатов:
while (my Sentry = $mesg->shift_entry) {
# ...
}
770
Глава 18. Протоколы Интернета
Каждый элемент представляет собой объект с методами для получения атри-
бутов:
foreach Sattr ($errtry->attri butes) {
@values = $entry->get(Sattr);
print "Sattr : @values\n";
}
Полный список поддерживаемых методов приведен в документации
Net::LDAP::Entry. DN не является атрибутом элемента, поэтому чтобы получить
DN для элемента, воспользуйтесь методом dn:
Sdn = $entry->dn;
Основными компонентами поиска являются база и фильтр. База отмечает
вершину искомого дерева, а фильтр определяет критерий отбора записей:
Smesg = $1 dap->search(base => "o=oreilly.com",
filter => "uid=gnat"):
Дополнительный параметр scope позволяет ограничить часть дерева, просмат-
риваемую при поиске. Если присвоить этому параметру значение "base", то по-
иск ограничивается базовым узлом дерева. Значение "one" ищет данные в узлах,
расположенных непосредственно под указанным узлом. По умолчанию исполь-
зуется значение "sub", определяющее все узлы ниже заданного.
Работа с сервером LDAP не ограничивается поиском; также возможно вы-
полнение административных операций. Так, метод add создает в базе данных
LDAP новую запись:
Sres = $ldap->add("cn=Sherlock Holmes. o=Sleuths В Us, c=gb",
attr => [ cn => ["Sherlock Holmes", "S Holmes"],
sn => "Holmes",
mail => 'sherlock@221b.uk',
objectclass => [qw(top person organizational Person
inetOrgPerson)] ]);
$res->code && warn "Couldn't add record: " . $res->error:
Также возможно удаление записей:
Sres = $ldap->delete($DN);
Sres && warn "Couldn't delete: " . $res->error:
Мощный метод modi fy позволяет вносить существенные изменения в инфор-
мацию, относящуюся к конкретному DN. За дополнительной информацией обра-
щайтесь к документации по модулю Net:: LDAP:
Sres = $ldap->modify("cn=Sherlock Holmes, o=Sleuths В Us, c=gb",
add => { phone => '555 1212' }.
replace => { mail => 'sholmes@braintrust.uk' },
delete => { cn => [ 'S Holmes' ] });
См. также
Документация по модулю CPAN Net:: LDAP; домашняя страница Net:: LDAP по ад-
ресу http://perl-ldap.sourceforge.net/.
18.9. Отправка вложений по электронной почте
771
18.9. Отправка вложений
по электронной почте
Проблема
Требуется отправить по электронной почте сообщение, содержащее вложения
(attachments); например, вы хотите переслать документ в формате PDF.
Решение
Воспользуйтесь модулем CPAN MIME: : Li te. Сначала создайте объект MIME::Lite,
который представляет сообщение, состоящее из нескольких частей:
use MIME::Lite:
$msg = MIME::LIte->new(From => 'sender@example.com',
To => 'rec1pient@example.com'.
Subject => 'My photo for the brochure'.
Type => 'multipart/mixed');
Затем включите в него содержимое методом attach:
$msg->attach(Type => 'image/jpeg'.
Path => '/Users/gnat/Photoshopped/nat.jpg'.
Filename => 'gnat-face.jpg');
$msg->attach(Type => 'TEXT'.
Data => 'I hope you can use this!'):
Наконец, отправьте сообщение с указанием способа отправки:
$msg->send(): # default is to use sendmall(1)
# alternatively
$msg->send('smtp'. 'mailserver.example.com');
Комментарий
Модуль MIME: :Lite создает и отправляет сообщения, содержащие вложения в ко-
дировке MIME (Multimedia Internet Mail Extensions). MIME является стандарт-
ным средством присоединения файлов и документов к сообщениям. Тем не ме-
нее модуль не позволяет извлекать вложения из почтовых сообщений; эта тема
рассматривается в рецепте 18.10.
При создании объекта MIME::Lite и добавлении в него содержимого парамет-
ры передаются в виде списка пар «имя/значение». К их числу относятся как
стандартные заголовки почтовых сообщений (например, From, То, Subject), так
и параметры, специфические для MIME::Lite. Как правило, заголовки сообщения
должны передаваться с завершающим двоеточием:
$msg = MIME::Lite->new('X-Song-Playing:' => 'Natchez Trace');
Тем не менее MIME::LIte также принимает некоторые заголовки без завершаю-
щего двоеточия (табл. 18.2). Метасимвол * обозначает произвольную последова-
772
Глава 18. Протоколы Интернета
тельность символов, поэтому Content-* включает Content-Type и Content-ID, но не
Dis-Content.
Таблица 18.2. Заголовки MIME::Lite
Approved Encrypted Received Sender
Вес From References Subject
Cc Keywords Reply-To To
Comments Message-ID Resent-* X-*
Content-* MIME-Version Return-Path
Date Organization
Полный список параметров MIME: :L1te приведен в табл. 18.3.
Таблица 18.3. Параметры MIME::Lite
Data FH Read Now
Datestamp Filename Top
Disposition Id Type
Encoding Length
Filename Path
Параметры MIME: :L1te управляют тем, какие данные (и как) присоединяются
к сообщению:
О Path — файл, содержащий присоединяемые данные;
О Filename — стандартное имя, под которым файл должен сохраняться програм-
мой чтения почты. По умолчанию совпадает с именем файла, определяемым
параметром Path (если этот параметр был задан);
О Data — присоединяемые данные;
О Туре — Content-Туре присоединяемых данных;
О Disposition — одно из двух значений, Inline или attachment. Первое означает,
что программа чтения должна отображать данные как часть сообщения, а не
как вложение. Второе значение указывает на то, что почтовая программа пред-
лагает пользователю декодировать и сохранить данные (впрочем, это в луч-
шем случае рекомендация, а не обязательное требование);
О FH — открытый файловый манипулятор, из которого читаются данные вложения.
На практике часто применяются следующие типы содержимого:
О TEXT — сокращение для используемого по умолчанию типа text/plain;
О BINARY — аналогичное сокращение для appllcatlon/octet-stream;
О multipart/mlxed — используется для сообщения, содержащего вложения;
О appllcatlon/msword — файлы Microsoft Word;
О appllcatlon/vnd.ms-excel — файлы Microsoft Excel;
18.9. Отправка вложений по электронной почте
773
О appllcatlon/pdf — файлы PDF;
О image/gif, Image/jpeg и Image/png — графические файлы в форматах GIF, JPEG
и PNG соответственно;
О audlo/mpeg — файлы MP3;
О video/mpeg — видеофайлы в формате MPEG;
О video/quicktlme — видеофайлы в формате Quicktime (.mov).
Существуют два способа отправки сообщений: с использованием sendmail или
Net::SMTP. Чтобы выбрать второй вариант, вызовите send с первым аргументом
"smtp". Оставшиеся аргументы являются параметрами конструктора Net::SMTP:
# 30-секундный тайм-аут
$msg->send("smtp", "ma11.example.com", Timeout => 30);
Если вы планируете создать несколько объектов MIME: :L1te, учтите, что вызов
send в качестве метода класса изменяет способ отправки сообщений по умолчанию:
MIME::L1te->send("smtp", "mall.example.com");
$msg = MIME::L1te->new(%opts):
# ...
$msg->send(); # Отправка с использованием SMTP
При обработке нескольких сообщений также обратите внимание на параметр
ReadNow. Он указывает, что данные вложения должны быть прочитаны из файла
или файлового манипулятора немедленно, а не при отправке сообщения, записи
или его преобразовании в строку.
Впрочем, операции с сообщениями не исчерпываются их отправкой. Вы так-
же можете получить окончательный текст сообщения в строковом виде:
$text = $msg->as_string:
Метод print выводит строковую форму сообщения в файловый манипулятор:
$msg->pr1nt($S0ME_FILEHANDLE):
Программа в примере 18.3 пересылает файлы, имена которых передаются
в командной строке, в виде вложений.
Пример 18.3. mail-attachment
# !/usr/Ыn/perl -w
# mall-attachment - отправка файлов в виде вложений
use MIME::LIte;
use Getopt::Std;
my $SMTP_SERVER = 'smtp.example.com': # ИЗМЕНИТЬ!
my $DEFAULT_SENDER = 'sender@example.com'; # ИЗМЕНИТЬ!
my $DEFAULT_RECIPIENT = 'redp1ent@example.com':# ИЗМЕНИТЬ!
MIME::L1te->send('smtp'. $SMTP_SERVER, T1meout=>60):
my (%o, $msg);
# Обработать параметры продолжение J
774
Глава 18. Протоколы Интернета
Пример 18.3 (продолжение)
getopts(*hf:t:s: ’, Uo);
$0{f} ||= $DEFAULT_SENDER:
$o{t} I|= $DEFAULT_RECIPIENT:
$o{s} ||= 'Your binary file, sir*:
if ($o{h) or !@ARGV) {
die "usage:\n\t$0 [-h] [-f from] [-t to] [-s subject] file . .An";
}
# Построить и отправить сообщения
$msg = new MIME::Lite(
From => $o{f},
To => $o{t},
Subject => $o{s},
Data => "Hi",
Type => "multipart/mixed",
):
while (@ARGV) {
$msg->attach('Type' => 'application/octet-stream',
'Encoding' => 'base64',
'Path' => shift @ARGV):
}
$msg->send();
См. также
Документация по модулю MIME::Lite.
18.10. Извлечение вложений из сообщений
Проблема
Имеется одно или несколько сообщений, содержащих вложения MIME. Требу-
ется обработать эти сообщения в программе Perl, извлечь из них файлы или вы-
полнить с вложениями другие операции.
Решение
Воспользуйтесь пакетом CPAN MIME-Tools:
use MIME::Parser:
Sparser = MIME::Parser->new():
$parser->output_to_core(l): # He записывать вложения на диск
18.10. Извлечение вложений из сообщений
775
Smessage = $parser->parse_data($MESSAGE); # die() при неудаче
# ИЛИ
Smessage = $parser->parse(SFILEHANDLE); # dleO при неудаче
Shead = $message->head():
Spreamble = $message->preamble;
Sepllogue = $message->epilogiie;
# объект - см. документацию
# ссылка на массив строк
# ссылка на массив строк
$niim_parts = $message->parts:
for (my $1=0; $1 < $niim_parts; S1++) {
my Spart = $message->parts($1);
my $content_type = $part->mime_type;
my Sbody = Spart->as_str1ng;
Комментарий
Формально сообщение MIME состоит из двух частей: заглавия (содержащего
заголовки типа From и Subject) и тела (собственно сообщение в отличие от его
метаданных). Однако тело сообщения тоже состоит из трех частей: преамбулы
(текста до первого вложения), серии частей (вложений) и эпилога (текста за по-
следним вложением). Строение сообщения изображено на рис. 18.1.
Head
Рис. 18.1. Структура сообщения в формате MIME
В приведенном Решении мы подавляем стандартное поведение модуля
MIME::Parser, который записывает вложения на диск. Такой подход увеличивает
затраты памяти, поскольку декодированные сообщения должны храниться в па-
мяти, однако он избавляет от необходимости удалять временные файлы и ката-
логи после завершения работы с вложениями.
Чтобы записать вложения в файл, замените вызов output_to_core вызовами
методов с указанием каталога, в котором хранятся вложения, и именами файлов.
Метод output_under задает каталог, в котором для каждого сообщения будет соз-
дан собственный подкаталог; в этих подкаталогах будут храниться декодирован-
ные вложения:
$parser->output_under("/tmp"):
# В результате создаются файлы вида /tmp/msg-1048509652-16134-0/foo.png
776
Глава 18. Протоколы Интернета
Возможен и другой вариант — задать каталог для хранения всех файлов вло-
жений методом output_d1 г:
$parser->output_d1r("/tmp"):
# В результате обработки создаются файлы вида /tmp/foo.png
Чтобы удалить временные файлы после завершения обработки, выполните
команду
$parser->filter->purge;
В результате разбора сообщений могут произойти исключения. Чтобы вы-
полнить зачистку и в этом случае, организуйте перехват исключений:
eval { $message = $parser->parse($FILEHANDLE) }:
# ...
$parser->fi1er->purge:
Независимо от того, создаются файлы на диске или нет, вложения можно ин-
терпретировать как файлы, вызывая метод open для каждой отдельной части:
for (my $1=0: $1 < $num_parts; $1++) {
my $part = $message->parts($1):
my $fh = $part->open("r") or die "Can't open for reading: $!\n":
while (<$fh>) {
# Чтение строк из текущего вложения
}
}
На самом деле существуют шесть разных классов, образующих часть пакета
MIME-Tools, и каждый из них хорошо документирован. Начните со страницы
руководства MIME::Tools и займитесь дальнейшими исследованиями.
См. также
Страница руководства MIME::Tools и другая документация по пакету MIME-Tools.
18.11. Написание сервера XML-RPC
Проблема
Требуется написать сервер для веб-службы XML-RPC.
Решение
Воспользуйтесь пакетом CPAN SOAP-Lite, поддерживающим XML-RPC. Сер-
вер может быть как автономным:
use XMLRPC:transport::HTTP;
$daemon = XMLRPC:transport::HTTP::Daemon
->new(Local Port => SPORT)
18.11. Написание сервера XML-RPC
777
->dispatch_to(’ClassName’)
->handle();
так и оформленным в виде сценария CGI:
use XMLRPC:transport::HTTP;
$daemon = XMLRPC:transport::HTTP::CGI
->dispatch_to('ClassName')
->handle();
Комментарий
Модули пакета SOAP-Lite обеспечивают преобразование «родных» структур дан-
ных Perl и их представление в формате XML. Тем не менее, вы сами решаете,
какой метод должен выбираться сервером при поступлении запроса. Процесс со-
поставления запроса XML-RPC с функцией Perl называется диспетчеризацией.
Все эти цепочечные вызовы методов в Решении выглядят несколько странно.
При задании значений методы XMLRPC:: LIte возвращают свой объект вызова, что
позволяет использовать цепочечный вызов вместо того, чтобы снова и снова по-
вторять Sdaemon:
$daemon = XMLRPC:transport::HTTP::Daemon;
$daemon->new(Local Port => SPORT):
$daemon->d1spatch_to('ClassName');
$daemon->handle();
Конструктор new также принимает параметры конструктора 10::Socket::INET,
поэтому ему, например, можно передать ReuseAddr=>l.
При передаче методу d1spatch_to имени класса (как это сделано в Решении)
сервер XML-RPC ищет методы в указанном классе. Если сервер в Решении по-
лучит запрос на метод ClassName.hasBeen, он вызовет метод ClassName->has been.
Если методу dispatch_to передается имя метода или список имен методов
(возможно — уточненных именем пакета), вы сообщаете Perl, что вызываться
должны только эти методы. Например, следующая команда гарантирует, что до-
пустимыми будут считаться только методы hasBeen и will Be пакета main, а также
метод canDo класса MonkeySea:
$daemon->d1spatch_to('hasBeen'. 'willBe'. 'MonkeySea::canDo')
Наконец, если d1spatch_to передается путь, XMLRPC::LIte будет загружать мо-
дули по мере необходимости из заданного каталога:
$daemon->d1spatch_to('/path/to/exposed/modules'. 'MyClass::API'):
Эта команда означает, что все модули в /path/to/exposed/modul es и MyClass::API
могут вызываться через XML-RPC. MyClass::API загружается предварительно или
ищется в ©INC. Обратите внимание: команда не означает «выполнять диспетче-
ризацию только для MyClass::API, находящемся в /path/to/exposed/modules».
См. также
Рецепт 18.12; рецепт 18.13.
778
Глава 18. Протоколы Интернета
18.12. Написание клиента XML-RPC
Проблема
Требуется написать клиент для службы XML-RPC.
Решение
Воспользуйтесь модулем XMLRPC:: LI te из пакета SOAP-Lite:
use XMLRPC::Lite:
Sserver = XMLRPC::Lite->proxy("http://server.example.com/path"):
Sresult = $server->call(1 ClassName.handler’. @ARGS):
die Scali->faultstring if Scali->fault:
print Scali->result;
Комментарий
Один сервер XML-RPC может обеспечивать работу нескольких служб, разли-
чаемых по имени метода: ClassName.handler соответствует ClassName->handler на
стороне сервера; А.В.method соответствует A: :B->method, а вызов call для handler
соответствует main->handler.
Метод proxy определяет фактический URL сервера. При использовании сер-
вера CGI вызов proxy выглядит примерно так:
$server->proxy("http://server.example.com/path/to/server.cgi")
Удаленные методы могут вызываться тремя способами. В первом способе ме-
тод call используется для объекта XMLRPC:-.Lite. Первый аргумент call задает
имя удаленного метода, а остальные аргументы — значения его параметров:
Sreturned = Sserver
- > callC'getRecordByNumber". 12. { format => "CSV" })
- > result:
Второй способ вызова удаленного метода заключается в вызове этого метода для
объекта XMLRPC: :L1te. Он работает только в том случае, если имя удаленного метода
не совпадает с именем метода, предоставляемым объектом XMLRPC: :L1te. Пример:
Sreturned = Sserver
- > getRecordByNumber(12. { format => "CSV" })
- > result:
Последний способ основан на использовании автоматической диспетчериза-
ции, преобразующей невостребованные вызовы функций и методов в программе
Perl в запросы XML-RPC. Автоматическая диспетчеризация включается так:
use XMLRPC::Lite +autodispatch =>
proxy => "http://server.example.com/path":
Sreturned = getRecordByNumber(12. { format => "CSV" });
Принципиальное отличие автоматической диспетчеризации от других спосо-
бов заключается в том, что она автоматически преобразует результат в значение
18.13. Написание сервера SOAP
779
Perl. Чтобы декодировать ответ XML-RPC в значение Perl при использовании
объекта XMLRPC: :Lite, необходимо явно вызвать метод result.
См. также
Рецепт 18.11; рецепт 18.14.
18.13. Написание сервера SOAP
Проблема
Требуется написать веб-службу, использующую SOAP в качестве транспортного
протокола.
Решение
Воспользуйтесь пакетом CPAN SOAP-Lite. Сервер может быть как автономным:
use SOAP:transport::HTTP:
$daemon = SOAP:transport::HTTP::Daemon
->new(Local Port => SPORT)
->dispatch_to('ClassName')
->handle():
так и оформленным в виде сценария CGI:
use SOAP:transport::HTTP:
Sdaemon = SOAP:transport::HTTP::CGI
->dispatch_to(’ClassName’)
->handle():
В обоих случаях клиентам SOAP разрешается вызывать только методы клас-
сов, имена которых передаются в аргументах dispatch_to:
package ClassName:
sub handler {
my (Sclass, $arg_hash_ref) =
# ...
}
Комментарий
Пакет SOAP-Lite содержит модули SOAP и XML-RPC. Написание службы SOAP
сходно с написанием службы XML-RPC; то же можно сказать и об управлении
диспетчеризацией в SOAP. За подробностями обращайтесь к рецепту 18.11.
См. также
Рецепт 18.14; рецепт 18.11.
780
Глава 18. Протоколы Интернета
18.14. Написание клиента SOAP
Проблема
Требуется написать клиент для веб-службы SOAP.
Решение
Воспользуйтесь модулем SOAP::Lite из пакета SOAP-Lite:
use SOAP::LIte:
Sserver = SOAP::LIte
-> url("http://localhost/Namespace")
-> proxy("http://server.example.com/path"):
Sresult = $server->call('ClassName.handler’. @ARGS):
die Seal 1->faultstrlng If Seal 1->fault:
print Seal 1->result:
Комментарий
Один сервер SOAP способен обеспечивать удаленный доступ к методам многих
классов. Клиент указывает класс, методы которого он хочет вызвать, в парамет-
ре url. Имя хоста в аргументе несущественно, важен только путь (имя класса).
Например, следующие два URI эквивалентны:
http://modacryl1с.clue.com/GImpyMod
http://weenles.mlt.edu/Gi mpyMod
Как и в случае с XML-RPC, URL сервера определяется аргументом proxy. На-
пример, если сервер SOAP реализован в виде сценария BGI, то вызов proxy
выглядит примерно так:
$server->proxy("http://server.examplе.com/path/to/server.cgi"):
Удаленные методы также вызываются по аналогии с XML-RPC, либо мето-
дом call:
Sreturned = Sserver
- > call("getRecordByNumber", 12. { format => "CSV" })
- > result:
либо прямым вызовом метода для объекта SOAP::LIte:
Sreturned = Sserver
- > getRecordByNumber(12, { format => "CSV" })
- > result;
либо с использованием автоматической диспетчеризации:
use SOAP::Lite +autod1spatch =>
url => "http://1dent1f1er.example.com/Namespace",
proxy => "http://server.example.com/path":
Sreturned = getRecordByNumber(12, { format => "CSV" });
18.15. Программа: rfrm
781
Также возможно использование объектно-ориентированного синтаксиса:
$returned = Some::Remote::Module->getRecordByNumber(12, { format=>"CSV" }):
См. также
Рецепт 18.11; рецепт 18.13.
18.15. Программа: rfrm
Следующая программа принимает с сервера POP3 список хранящихся сообще-
ний и выводит краткую сводку:
# ./rfrm
Nathan Torkington Re: YAPC
Rob Brown
Rael Dornfest
Re: Net::Ping syn round trip time
Re: Book Proposal • Blosxom in a Nutshell
spam@example.com Extend your ping times 6331!!!!
Информация о сервере POP3, а также имени и пароле для аутентификации
передается программе в файле ~/. rfrmrc, примерное содержимое которого вы-
глядит так:
SERVER=pop3.exampl е.com
USER=gnat
PASS=I(heart)Perl
Программа убеждается в том, что запись и чтение файла . rfrmrc запрещены
всем, кроме вас, и если проверка дает отрицательный результат — она прекраща-
ет свою работу.
Исходный текст программы приведен в примере 18.4.
Пример 18.4. rfrm
# !/usr/bin/perl -w
# rfrm - получение списка почтовых сообщений,
# хранящихся на сервере POP
use Net::POP3:
use strict:
my ($Pop_host, $Pop_user, $Pop_pass) = read_conf() or usageO:
my $pop = Net::P0P3->new($Pop_host)
or die "Can't connect to $Pop_host: $!\n":
defined ($pop->login($Pop_user. $Pop_pass))
or die "Can't authenticated":
my $messages = $pop->list
or die "Can't get a list of messages\n":
foreach my $msgid (sort { $a <=> $b } keys ^messages) {
продолжение &
782
Глава 18. Протоколы Интернета
Пример 18.4 (продолжение)
my (Smsg. Ssubject. Ssender. Sfrom);
$msg = $pop->top(Smsgid, 0); # Возвращает ссылку на массив
Smsg = join ”\n", @Smsg; # Теперь это одна большая строка
# Извлечь строки From и Subject, сократить From.
Ssubject = Ssender = '';
if (Smsg =~ /^Subject: (,*)/m) { Ssubject = $1 }
if (Smsg =~ /^From: (.*)/m) { Ssender = $1 }
(Sfrom = Ssender) =~ s{<.*>}{ };
if (Sfrom =~ m{\(.*\)}) { Sfrom = $1 }
Sfrom ||= Ssender;
# Вывести краткую информацию о данном сообщении
printf("£-20.20s £-58.58s\n", Sfrom. Ssubject);
sub usage {
die «EOF ;
usage; rfrm
Configure with -/.rfrmrc thus;
SERVER=pop.mydoma in.com
USER=myusername
PASS=mypassword
EOF
}
sub read_conf {
my (Sserver. Suser, Spass. @stat);
open(FH. "< $ENV{HOME}/.rfrmrc") or return;
# Проверка для параноиков
@stat = stat(FH) or die "Can't stat -/.rfrmrc: $!\n";
if ($stat[2] & 177) {
die "-/.rfrmrc should be mode 600 or tighter\n";
# Чтение конфигурационного файла
while (<FH>) {
if (/SERVERS.*)/) { Sserver = $1 }
if (/USER=(.*)/) {Suser =$1}
if (/PASS=(.*)/) {Spass =$1}
close FH;
# Должны быть заданы все три значения
return unless Sserver && Suser && Spass;
return (Sserver. Suser. Spass);
18.16. Программа: ехрп и vrfy
783
18.16. Программа: ехрп и vrfy
Следующая программа общается с сервером SMTP при помощи Net:: SMTP и прове-
ряет адрес с помощью команд EXPN и VRFY. Она не идеальна, поскольку ее рабо-
та зависит от получения осмысленной информации с удаленного сервера командами
EXPN и VRFY — эта возможность часто используется спамерами для сбора адре-
сов электронной почты, поэтому на многих серверах она отключается. Программа
использует модуль Net:: DNS, если он присутствует, но может работать и без него.
Программа узнает, как она была вызвана, с помощью переменной $0 (имя про-
граммы). При запуске под именем ехрп используется команда EXPN; при запус-
ке под именем vrfy используется команда VRFY. Установка команды под двумя
разными именами осуществляется с помощью ссылок (в системах, в которых ссыл-
ки не поддерживаются, просто скопируйте код программы из примера 18.5):
% cat > ехрп
#!/usr/Ыn/perl -w
"D
% In ехрп vrfy
Передайте программе адрес электронной почты, и она сообщит результаты
проверки адреса командой EXPN или VRFY. Если у вас установлен модуль
Net::DNS, программа проверяет все хосты пересылки почты (mail exchangers), пе-
речисленные в записи DNS данного адреса.
Без Net:: DNS результаты выглядят так:
% ехрп gnat@fr11.com
Expanding gnat at frii.com (gnat@frii.com):
calisto.frii.com Hello coprolith.frii.com [207.46.130.14],
pleased to meet you
<gnat@mail.frii.com>
При установленном модуле Net:: DNS проверка того же адреса дает следующий
результат:
% ехрп gnat@fr11.com
Expanding gnat at mail.frii.net (gnat@frii.com):
deimos.frii.com Hello coprolith.frii.com [207.46.130.14],
pleased to meet you
Nathan Torkington <gnat@deimos.frii.com>
Expanding gnat at mxl.frii.net (gnat@frii.com):
phobos.frii.com Hello coprolith.frii.com [207.46.130.14],
pleased to meet you
<gnat@mai1.frii.com>
Expanding gnat at mx2.frii.net (gnat@frii.com):
europa.frii.com Hello coprolith.frii.com [207.46.130.14],
pleased to meet you
<gnat@mai1.fri i.com>
Expanding gnat at mx3.frii.net (gnat@frii.com):
ns2.winterlan.com Hello coprolith.frii.com [207.46.130.14],
pleased to meet you
550 gnat... User unknown
Исходный текст программы приведен в примере 18.5.
784
Глава 18. Протоколы Интернета
Пример 18.5. ехрп
#!/usr/Ыn/perl -w
# ехрп - расширение адресов через SMTP
use strict:
use Net::SMTP:
use Sys::Hostname:
my $fetch_mx = 0:
# Попытаться загрузить модуль, но не огорчаться в случае неудачи
eval {
require Net::DNS:
Net::DNS->1mport('mx'):
$fetch_mx = 1:
my Sselfname = hostnameO:
die "usage: $0 address\@host . .An" unless ©ARGV;
# Определить имя программы - "vrfy" или "ехрп".
my SVERB = ($0 =~ /ve?r1?fy$/1) ? 'VRFY1 : ’EXPN’:
my Smultl = @ARGV > 1:
my $remote:
# Перебрать адреса, указанные в командной строке
foreach my Scombo (©ARGV) {
my (Sname, Shost) = sp!1t(/\©/. Scombo):
my @hosts:
Shost ||= 'localhost':
@hosts = map { $_->exchange } mx(Shost) If Sfetchjnx:
@hosts = (Shost) unless @hosts:
foreach my Shost (@hosts) {
print SVERB eq 'VRFY' ? "Verify" : "Expand".
"Ing Sname at Shost (Scombo):":
Sremote = Net::SMTP->new(Shost, Hello => Sselfname):
unless (Sremote) {
warn "cannot connect to $host\n";
next:
print "\n":
If (SVERB eq * VRFY') {
Sremote->ver1fy($name):
} elslf (SVERB eq 'EXPN') {
$remote->expand(Sname):
last If $remote->code = = 221:
next If $remote->code = = 220:
print $remote->message:
Sremote->qu1t:
print "\n" If Smultl:
19
Нммм Иву
Программирование CGI
«Хорош тот инструмент, который может использо-
ваться для целей, неожиданных для его создателя».
Стивен Джонсон
19.0. Введение
Резкие изменения окружающей среды приводят к тому, что некоторые виды
животных лучше других добывают пропитание или избегают хищников. Многие
ученые полагают, что миллионы лет назад при столкновении кометы с Землей
в атмосферу поднялось огромное облако пыли. За этим последовали радикаль-
ные изменения окружающей среды. Некоторые организмы, например динозав-
ры, не смогли справиться с ними, что привело к их вымиранию. Другие виды
(в частности, млекопитающие) нашли новые источники пищи и места обитания
и продолжили борьбу за существование.
Подобно тому как комета изменила среду обитания доисторических живот-
ных, развитие Веб изменило ситуацию в современных языках программиро-
вания и открыло новые горизонты. Хотя некоторые языки так и не прижились
в «новом мировом порядке», Perl выдержал испытание. Благодаря своим силь-
ным сторонам — обработке текстов и объединению системных компонентов —
Perl легко приспособился к задачам пересылки информации с использованием
текстовых протоколов.
Архитектура
В основе Веб лежит обычный текст. Веб-серверы общаются с браузерами с по-
мощью текстового протокола HTTP (Hypertext Transfer Protocol). Многие пе-
ресылаемые документы кодируются специальной разметкой, которая называет-
ся HTML (Hypertext Markup Language). Текстовая ориентация внесла немалый
вклад в гибкость, широту возможностей и успех Веб. Единственным исключе-
нием на этом фоне является протокол SSL (Secure Socket Layer) — он шифрует
другие протоколы (например, HTTP) в двоичные данные, защищенные от пере-
хвата. Веб-страницы идентифицируются по так называемым URL (Universal
Resource Locator). URL выглядят так:
http://www.perl.сот/CPAN/
http://www.perl.com:8001/bad/mojo.html
ftp://gatekeeper.dec.com/pub/mi sc/netl1b.tar.Z
786
Глава 19. Программирование CGI
ftp://anonymous@myplасе:gatekeeper.dec.com/pub/mlsc/netl1b.tar.Z
file:///etc/motd
Первая часть (http, ftp, file) называется схемой (scheme) и определяет спо-
соб получения файла. Вторая (://) означает, что далее следует имя хоста, интер-
претация которого зависит от схемы. За именем хоста следует путь, идентифи-
цирующий документ. Путь также называется частичным URL.
Веб является системой «клиент/сервер». Клиентские браузеры (например,
Netscape или Lynx) запрашивают документы (идентифицируемые по частичным
URL) у веб-серверов — таких, как Apache. Диалог браузера с сервером определяет-
ся протоколом HTTP. В основном сервер просто пересылает содержимое некото-
рого файла. Однако иногда веб-сервер запускает другую программу для отправ-
ки документа, который может представлять собой HTML-текст, графическое
изображение или иной тип данных.
Диалог сервера с программой может быть организован двумя способами. Код
обработки запроса либо является непосредственной частью процесса веб-серве-
ра, либо веб-сервер запускает внешнюю программу, генерирующую ответ. Пер-
вый вариант взят за основу в сервлетах Java и mod perl (см. главу 21). Второй
вариант определяется протоколом CGI (Common Gateway Interface), а запус-
каемая сервером программа называется программой CGI, или сценарием CGI.
Данная глава будет посвящена программам CGI.
Сервер сообщает программе CGI, какая страница была затребована, какие
значения были переданы в HTML-формах, откуда поступил запрос, какие данные
использовались при аутентификации и многое другое. Ответ программы CGI
состоит из двух частей: заголовка, говорящего: «Я передаю документ HTML»,
«Я передаю изображение формата GIF» или «Я вообще ничего не передаю,
обращайся на такую-то страницу», и тела документа (возможно, содержащего
данные GIF, обычный текст или код HTML).
Правильно реализовать протокол CGI нелегко, а ошибиться проще простого,
поэтому мы рекомендуем использовать превосходный модуль CGI .pm Линкольна
Штейна. Модуль содержит удобные функции для обработки информации, по-
лученной от сервера, и подготовки ответов CGI, ожидаемых сервером. Этот
чрезвычайно полезный модуль был включен в стандартную поставку Perl вместе
со вспомогательными модулями (например, CGI::Carp или CGI::Fast). Использо-
вание модуля демонстрируется в рецепте 19.1.
Некоторые веб-серверы содержат встроенный интерпретатор Perl, что позво-
ляет генерировать документы на Perl без запуска нового процесса. Системные
издержки на чтение неизменившейся страницы пренебрежимо малы для стра-
ниц с редкими обращениями (даже порядка нескольких обращений в секунду).
Однако вызовы CGI существенно замедляют компьютер, на котором работает
веб-сервер. В главе 21 показано, как работать с mod perl, встроенным интерпре-
татором Perl веб-сервера Apache, чтобы пользоваться преимуществами программ
CGI без издержек, связанных с ними.
За кулисами
Программы CGI вызываются каждый раз, когда веб-серверу требуется сгене-
рировать динамический документ. Необходимо понимать, что программа CGI не
работает постоянно, с обращениями к ее различным частям со стороны браузера.
19.0. Введение
787
При каждом запросе частичного URL, соответствующего программе, запускает-
ся ее новая копия. Программа генерирует страницу для данного запроса и за-
вершается.
Браузер может запросить документ несколькими способами, которые называ-
ются методами (не путайте методы HTTP с методами объектно-ориентирован-
ного программирования!). Чаще всего встречается метод GET, который обозна-
чает простой запрос документа. Метод HEAD используется в том случае, если
браузер хочет получить сведения о документе без фактической загрузки. Метод
POST применяется при передаче заполненных форм.
Значения полей форм также могут кодироваться в методах GET и POST.
В методе GET значение кодируется прямо в URL, что приводит к появлению
уродливых URL следующего вида:
http://www.perl.com/cgl-bln/program?name=Johann&born=1685
В методе POST значения находятся в другой части запроса HTTP — не той,
которую браузер отправляет серверу. Если бы в приведенном выше URL значе-
ния полей отсылались методом POST, то пользователь, сервер и сценарий CGI
видели бы обычный URL:
http://mox.perl.com/cgl-bin/program
Методы GET и POST также отличаются свойством идемпотентности. Проще
говоря, однократный или многократный запрос GET для некоторого URL дол-
жен давать одинаковые результаты. Это объясняется тем, что в соответствии со
спецификацией протокола HTTP запрос GET может кэшироваться браузером,
сервером или промежуточным прокси-сервером. Запросы POST кэшироваться
не могут, поскольку каждый запрос считается самостоятельным и не зависимым
от других. Как правило, запросы POST влияют на состояние сервера или зави-
сят от него (обращение или обновление базы данных, отправка почты).
Большинство серверов регистрируют запросы в файле (ведут журнал обраще-
ний) для их последующего анализа веб-мастером. Ошибки в программах CGI тоже
по умолчанию не передаются браузеру. Вместо этого они регистрируются в фай-
ле (журнал ошибок), а браузер просто получает сообщение «500 Server Error»,
которое означает, что программа CGI не справилась со своей задачей.
Сообщения об ошибках полезны в процессе отладки любой программы, но
особенно полезны они в сценариях CGI. Однако авторы программ CGI не всегда
имеют доступ к журналу ошибок или не знают, где он находится. Перенаправле-
ние ошибок рассматривается в рецепте 19.2, а исправление — в рецепте 19.3.
В рецепте 19.8 показано, как узнать, что в действительности говорят друг
другу браузер с сервером. К сожалению, некоторые браузеры не реализуют спе-
цификацию HTTP в полной мере. Рецепт поможет выяснить, что является при-
чиной возникших трудностей — программа или браузер.
Безопасность
Сценарии CGI позволяют запускать программы на вашем компьютере кому
угодно. Конечно, программу выбираете вы, но анонимный пользователь может
передать ей неожиданные значения и обмануть ее, заставляя сделать нечто не-
хорошее. Безопасности в Веб уделяется большое внимание.
788
Глава 19. Программирование CGI
На некоторых сайтах проблема решается простым отказом от программ CGI.
Там, где без мощи и возможностей программ CGI не обойтись, приходится искать
средства обезопасить их. В рецепте 19.4 приведен список рекомендаций по напи-
санию безопасных сценариев CGI, а также кратко рассмотрен механизм пометки,
защищающий от случайного применения ненадежных данных. В рецепте 19.5 по-
казано, как организовать безопасный запуск других программ из сценария CGI.
HTML и формы
Теги HTML позволяют создавать экранные формы. В этих формах пользователь
вводит значения, передаваемые серверу. Формы состоят из элементов (widgets),
например текстовых полей и флажков. Программы CGI обычно возвращают
HTML-код, поэтому в модуле CGI предусмотрены вспомогательные функции
создания HTML-кода для чего угодно, от таблиц до элементов форм.
В дополнение к рецепту 19.6 в этой главе также имеется рецепт 19.10. В нем по-
казано, как создать форму, сохраняющую свои значения между вызовами. В рецеп-
те 19.11 продемонстрировано создание одного сценария CGI, который создает и об-
рабатывает целый набор страниц, например, в системе приема заказов по каталогу.
Ресурсы, посвященные программированию для Веб
Разумеется, лучшую информацию о программировании для Веб можно найти
непосредственно в Веб:
О безопасность Веб — http://www.w3.org/Secur1ty/Faq/;
О общие сведения о Веб — http://www.boutell.com/faq/;
О CGI — http://www.webth1ng.com/tutorials/cg1faq.html;
О спецификация HTTP — http://www.w3.org/pub/WWW/Protocols/HTTP/;
О спецификация HTML — http://www.w3.org/TR/REC-html40/, http://www.w3.org/pub/
WWW/MarkUp/;
О спецификация CGI — http://www.w3.org/CGI/;
О безопасность CGI — http://www.go2net.com/people/paulp/cg1-secur1ty/safe-cg1.txt.
19.1. Написание сценария CGI
Проблема
Требуется написать сценарий CGI для обработки содержимого HTML-формы.
В частности, вы хотите работать со значениями полей формы и выдавать нуж-
ные выходные данные.
Решение
Сценарий CGI представляет собой программу, работающую на сервере и запус-
каемую веб-сервером для построения динамического документа. Он получает
19.1. Написание сценария CGI
789
кодированную информацию от удаленного клиента (пользовательского браузе-
ра) через STDIN и переменные окружения и выводит в STDOUT правильные заго-
ловки и тело запросов HTTP. Стандартный модуль CGI (см. пример 19.1) обес-
печивает удобное преобразование ввода и вывода.
Пример 19.1. hiweb
# !/usr/Ыn/perl -w
# hiweb - загрузить модуль CGI для расшифровки
# данных, полученных от веб-сервера
use strict;
use CGI qw(standard escapeHTML);
# Получить параметр от формы
my Svalue = param('PARAM_NAME');
# Вывести документ
print headerO, start_html("Howdy there!").
p("You typed: ". tt(escapeHTML($value))).
end_html();
Комментарий
CGI — всего лишь протокол, формальное соглашение между веб-сервером и от-
дельной программой. Сервер кодирует входные данные клиентской формы, а про-
грамма CGI декодирует форму и генерирует выходные данные. В спецификации
протокола ничего не сказано о языке, на котором должна быть написана про-
грамма. Программы и сценарии, соответствующие протоколу CGI, могут быть
написаны в командном интерпретаторе, на С, Rexx, C++, VMS DCL, Smalltalk,
Tel, Python и, конечно, на Perl.
Полная спецификация CGI определяет, какие данные хранятся в тех или иных
переменных окружения (например, входные параметры форм) и как они коди-
руются. Теоретически декодирование входных данных в соответствии с прото-
колом не должно вызывать никаких проблем, но на практике задача оказывается
на удивление хитрой. Именно поэтому мы настоятельно рекомендуем исполь-
зовать превосходный модуль CGI Линкольна Штейна. Вся тяжелая работа по
правильной обработке требований CGI выполнена заранее; вам остается лишь
написать содержательную часть программы без нудных сетевых протоколов.
Сценарии CGI вызываются двумя основными способами, которые называют-
ся методами — но не путайте методы HTTP с методами объектов Perl! Метод
GET используется для получения документов в ситуациях, когда идентичные
запросы должны давать идентичные результаты, например, при поиске в слова-
ре. В методе GET данные формы хранятся внутри URL. Это позволяет сохра-
нить запрос на будущее, но ограничивает общий размер запрашиваемых данных.
Метод POST отправляет данные отдельно от запроса. Он не имеет ограниче-
ний на размер, но не позволяет сохранять запросы. Формы, обновляющие ин-
формацию на сервере (например, при отправке ответного сообщения или моди-
фикации базы данных), должны использовать метод POST. Клиентские браузеры
790
Глава 19. Программирование CGI
и промежуточные прокси-серверы могут кэшировать и обновлять результаты
запросов GET незаметно для пользователя, но запросы POST не кэшируются.
Метод GET надежен лишь для коротких запросов, ограничивающихся чтением
информации, тогда как метод POST надежно работает для форм любого раз-
мера, а также подходит для обновления и ответов в схемах с обратной связью.
По умолчанию модуль CGI использует POST для всех сгенерированных форм.
За небольшими исключениями, связанными с правами доступа к файлам и ре-
жимами повышенной интерактивности, сценарии CGI делают практически все
то же, что и любая другая программа. Они могут возвращать результаты во многих
форматах: обычный текст, документы HTML, файлы XML, звуковые файлы, гра-
фика и т. д. в зависимости от заголовка HTTP. Помимо вывода простого текста
или HTML-кода, они также могут перенаправлять клиентский браузер в другое
место, задавать значения cookie на стороне сервера, требовать аутентификации
или сообщать об ошибках.
Модуль CGI поддерживает два интерфейса — процедурный для повседневно-
го использования и объектно-ориентированный для компетентных пользовате-
лей с нетривиальными потребностями. Практически все сценарии CGI должны
использовать процедурный интерфейс, но, к сожалению, в большей части доку-
ментации по CGI.pm приведены примеры для исходного объектно-ориентирован-
ного подхода. Если вы хотите использовать упрощенный процедурный интер-
фейс, то для обеспечения обратной совместимости вам придется явно запросить
его с помощью тега : standard. О тегах рассказано в главе 12 «Пакеты, библиоте-
ки и модули».
Чтобы прочитать входные данные пользовательской формы, передайте функ-
ции param имя нужного поля. Например, если на форме имеется поле с именем
«favorite», то вызов param("favorite") вернет его значение. В некоторых элемен-
тах форм (например, в списках) пользователь может выбрать несколько значе-
ний. В таких случаях param возвращает список значений, который можно при-
своить массиву.
Например, следующий сценарий получает значения трех полей формы, по-
следнее из которых может возвращать несколько значений:
use CGI qw(:standard):
$who = param("Name");
$phone = param("Number"):
@picks = param("Choices"):
При вызове без аргументов param возвращает список допустимых параметров
формы в списковом контексте или количество параметров формы в скалярном
контексте.
Вот и все, что нужно знать о пользовательском вводе. Делайте с ним что хо-
тите, а потом генерируйте выходные данные в нужном формате. В этом тоже нет
ничего сложного. Помните, что в отличие от обычных программ, выходные дан-
ные сценария CGI должны форматироваться определенным образом: сначала
набор заголовков, за ними — пустая строка, и лишь потом нормальный вывод.
Как видно из Решения, модуль CGI упрощает не только ввод, но и вывод дан-
ных. Он содержит функции для генерации заголовков HTTP и HTML-кода.
19.2. Перенаправление сообщений об ошибках
791
Функция header строит текст заголовка. По умолчанию она генерирует заголовки
для документов text/html, но вы можете изменить тип содержимого и передать
другие необязательные параметры:
print header( -TYPE => ’text/plain’.
-EXPIRES => '+3d' ):
Модуль CGI .pm также применяется для генерации HTML-кода. Звучит триви-
ально, но модуль CGI проявляется во всем блеске при создании динамических
форм с сохранением состояния (например, страниц, предназначенных для оформ-
ления заказов). В нем даже имеются функции для построения форм и таблиц.
При выводе элементов формы символы &, < > и " в выходных данных HTML
автоматически заменяются своими эквивалентами. В пользовательских выходных
данных этого не происходит. Именно поэтому в Решении импортируется и ис-
пользуется функция escapeHTML — даже если пользователь введет специальные
символы, это не вызовет ошибок форматирования в HTML.
Полный список функций вместе с правилами вызова приведен в документа-
ции по модулю CGI. pm.
См. также
Документация по стандартному модулю CGI; http://www.w3.org/CGI/; рецепт 19.6.
19.2. Перенаправление сообщений
об ошибках
Проблема
У вас возникли трудности с отслеживанием предупреждений и ошибок вашего
сценария, или вывод в STDERR из сценария приводит сервер в замешательство.
Решение
Воспользуйтесь модулем CGI: :Сагр из стандартной поставки Perl, чтобы все со-
общения, направляемые в STDERR, снабжались префиксом — именем приложения
и текущей датой. При желании предупреждения и ошибки также можно сохра-
нять в файле или передавать браузеру.
Комментарий
Задача отслеживания сообщений в сценариях CGI пользуется дурной славой.
Даже если вам удалось найти на сервере журнал ошибок, вы все равно не смо-
жете определить, когда и от какого сценария поступило то или иное сообщение.
Некоторые недружелюбные веб-серверы даже прерывают работу сценария, если
он неосторожно выдал в STDERR какие-нибудь данные до генерации заголовка
Content-Туре — а это означает, что выдача предупреждений может навлечь беду.
792
Глава 19. Программирование CGI
На сцене появляется модуль CGI::Carp. Он замещает warn и die, а также функ-
ции carp, croak и confess обычного модуля Carp более надежными и содержатель-
ными версиями. При этом данные по-прежнему отсылаются в журнал ошибок
сервера.
use CGI::Carp;
warn "This is a complaint":
die "But this one is serious":
В следующем примере использования CGI::Carp ошибки перенаправляются
в файл по вашему выбору. Все это происходит в блоке BEGIN, что позволяет пере-
хватывать предупреждения на стадии компиляции:
BEGIN {
use CGI::Carp qw(carpout):
open(LOG. "»/var/local/cgi-logs/mycgi-log")
or die "Unable to append to mycgi-log: $!\n";
carpout(*LOG);
}
Фатальные ошибки могут даже возвращаться клиентскому браузеру — это
удобно при отладке, но может смутить рядового пользователя.
use CGI::Carp qw(fatalsToBrowser):
die "Bad error here":
Даже если ошибка произойдет до вывода заголовка HTTP, модуль попыта-
ется избежать ужасной ошибки 500 Server Error. Нормальные предупреждения
по-прежнему направляются в журнал ошибок сервера (или туда, куда вы от-
правили их функцией carpout) с префиксом из имени приложения и текущего
времени.
См. также
Документация по стандартному модулю CGI::Carp; описание BEGIN в рецепте 12.3.
19.3. Исправление ошибки 500 Server Error
Проблема
Сценарий CGI выдает ошибку 500 Server Error.
Решение
Воспользуйтесь рекомендациями, приведенными ниже.
Комментарий
Следующие советы ориентированы на аудиторию Unix, однако общие принци-
пы относятся ко всем системам.
19.3. Исправление ошибки 500 Server Error
793
Убедитесь, что сценарий может
выполняться веб-сервером
Проверьте владельца и права доступа командой Is -1. Чтобы сценарий мог
выполняться сервером, для него должны быть установлены необходимые права
чтения и исполнения. Сценарий должен быть доступен для чтения и исполне-
ния для всех пользователей (или по крайней мере для того, под чьим именем
сервер выполняет сценарии). Используйте команду chmod 0755 имя-сценария, если
сценарий принадлежит вам, или chmod 0555 имя-сценария, если он принадлежит
анонимному пользователю Веб, а вы работаете как этот или привилегированный
пользователь. Бит исполнения также должен быть установлен для всех катало-
гов, входящих в путь (если у вас нет доступа к командному интерпретатору на
сервере, многие клиенты FTP позволяют сменить права доступа для передавае-
мых файлов).
Проследите, чтобы сценарий идентифицировался веб-сервером как сцена-
рий. Большинство веб-серверов имеет общий для всей системы каталог cgi-bin,
и все файлы данного каталога считаются сценариями. Некоторые серверы иден-
тифицируют сценарий CGI как файл с определенным расширением, например
. cgi или .рсх. Параметры некоторых серверов разрешают доступ только методом
GET, а не методом POST, который, вероятно, используется вашей формой. Обра-
щайтесь к документации по веб-серверу, конфигурационным файлам, веб-масте-
ру и (если ничего не помогает) в службу технической поддержки.
Если вы работаете в Unix, проверьте, правильно ли задан путь к исполняемому
файлу Perl в строке #!. Она должна быть первой в сценарии, перед ней даже не
разрешаются пустые строки. Некоторые операционные системы устанавливают
смехотворно низкие ограничения на размер этой строки — в таких случаях следу-
ет использовать ссылки (допустим, из /home/richh/perl на /opt/1 nstal 1 ed/third-
party/software/perl -5.004/bin/perl — взят вымышленный патологический пример).
Если вы работаете в Win32, посмотрите, правильно ли вы связали свои сце-
нарии с исполняемым файлом Perl? А если ваш сервер использует строки #!, то
правильно ли в них задан путь?
Проверьте наличие необходимых прав у сценария
Проверьте пользователя, с правами которого работает сценарий, с помощью про-
стого фрагмента из примера 19.2.
Пример 19.2. webwhoami
#!/usr/Ы n/perl
# webwhoami - вывод идентификатора пользователя
print "Content-Type: text/plain\n\n":
print "Running as ", scalar getpwuid($>), "\n":
Сценарий выводит имя пользователя, с правами которого он работает.
Определите ресурсы, к которым обращается сценарий. Составьте список фай-
лов, сетевых соединений, системных функций и т. д., требующих особых приви-
легий. Затем убедитесь в их доступности для пользователя, с правами которого
работает сценарий. Действуют ли дисковые или сетевые квоты? Обеспечивает
794
Глава 19. Программирование CGI
ли защита файла доступ к нему? Не пытаетесь ли вы получить зашифрованный
пароль с помощью getpwent в системе со скрытыми паролями (обычно скрытые
пароли доступны только для привилегированного пользователя)?
Для всех файлов, в которые сценарий выполняет запись, установите права
доступа 0666, а еще лучше — 0644, если эти файлы принадлежат тому пользовате-
лю, с чьими правами выполняется сценарий. Если сценарий создает новые фай-
лы или перемещает/удаляет старые, потребуются также права записи и испол-
нения для каталога с ними.
Не содержит ли сценарий ошибок Perl?
Попытайтесь запустить его в командной строке. Модуль CGI.pm позволяет запус-
кать и отлаживать сценарии из командной строки или из стандартного ввода.
В следующем фрагменте — вводимый вами признак конца файла:
% perl -wc cgi-script # Простая компиляция
% perl -w cgi-script # Параметры из stdin
(offline mode: enter name=value pairs on standard input)
name=joe
number=10
"D
% perl -w cgi-script name=joe number=10 # Запустить с входными
# данными формы
% perl -d cgi-script name=joe number=10 # To же в отладчике
# Сценарий с методом POST в csh
% (setenv HTTP_METHOD POST: perl -w cgi-script name=joe number=10)
# Сценарий с методом POST в sh
% HTTP_METHOD=POST perl -w cgi-script name=joe number=10
Проверьте журнал ошибок сервера. Большинство веб-серверов перенаправ-
ляет поток STDERR для процессов CGI в файл. Найдите его (попробуйте /usr/
local/etc/httpd/logs/error_log, /usr/1 ocal /www/logs/error_log или спросите у админи-
стратора) и посмотрите, есть ли в нем предупреждения или сообщения об ошибках.
Не устарела ли ваша версия Perl? Ответ даст команда perl -v. Если у вас не
установлена версия 5.004 или выше, вам или вашему администратору следует
подумать об обновлении, поскольку 5.003 и более ранние версии не были защи-
щены от переполнения буфера, из-за чего возникали серьезные проблемы без-
опасности.
Не используете ли вы старые версии библиотек? Выполните команду grep
-i version для библиотечного файла (вероятно, находящегося в /usr/1 ib/perl5/,
/usr/1 ocal/1 ib/perl5/, /usr/lib/per!5/site_perl или похожем каталоге). Для CGI.pm
(а фактически — для любого модуля) версию можно узнать и другим способом:
% perl -MCGI -le ’print CGI->VERSION’
2.49
Используете ли вы последнюю версию веб-сервера? Хотя такое происходит
редко, но все же в веб-серверах иногда встречаются ошибки, мешающие работе
сценариев.
19.3. Исправление ошибки 500 Server Error
795
Используете ли вы флаг -w? С этим флагом Perl начинает жаловаться на не-
инициализированные переменные, чтение из манипулятора, предназначенного
только для записи, и т. д.
Используете ли вы флаг -Т? Если Perl жалуется на небезопасные действия,
возможно, вы допустили какие-то неверные предположения относительно вход-
ных данных и рабочей среды вашего сценария. Обеспечьте чистоту данных, и вы
сможете спокойно спать по ночам, а заодно и получите рабочий сценарий (ме-
ченые данные и их последствия для программ рассматриваются в рецепте 19.4
и на странице руководства perlsec] в списке FAQ по безопасности CGI описаны
конкретные проблемы, которых следует избегать).
Используете ли вы директиву use strict? Она заставляет объявлять перемен-
ные перед использованием и ограничивать кавычками строки, чтобы избежать
возможной путаницы с подпрограммами, и при этом находит множество ошибок.
Проверяете ли вы возвращаемые значения всех системных функций? Многие
люди наивно полагают, что любой вызов open, system, rename или unlink всегда
проходит успешно. Они возвращают значение, по которому можно проверить
результат их работы — так проверьте!
Находит ли Perl используемые вами библиотеки? Напишите маленький сце-
нарий, который просто выводит содержимое @INC (список каталогов, в которых
ищутся модули и библиотеки). Проверьте права доступа к библиотекам (должно
быть разрешено чтение для пользователя, с правами которого работает сценарий).
Не пытайтесь копировать модули с одного компьютера на другой — многие из
них имеют скомпилированные и автоматически загружаемые компоненты, нахо-
дящиеся за пределами библиотечного каталога Perl. Установите их с нуля.
Выдает ли Perl предупреждения или сообщения об ошибках? Попробуйте ис-
пользовать CGI::Carp (см. рецепт 19.2), чтобы направить предупреждения и ошиб-
ки в браузер или доступный файл.
Соблюдает ли сценарий протокол CGI?
Перед возвращаемым текстом или изображением должен находиться заголовок
HTTP. Не забывайте о пустой строке между заголовком и телом сообщения.
Кроме того, STDOUT, в отличие от STDERR, не очищается автоматически. Если ваш
сценарий направляет в STDERR предупреждения или ошибки, веб-сервер может
увидеть их раньше, чем заголовок HTTP, и на некоторых серверах это приводит
к ошибке. Чтобы обеспечить автоматическую очистку STDOUT, вставьте в начало
сценария следующую команду (после строки #!):
$| = 1;
Никогда не пытайтесь декодировать поступающие данные формы, самостоя-
тельно анализируя окружение и стандартный ввод, — возникает слишком много
возможностей для ошибок. Воспользуйтесь модулем CGI и проводите время за
творческим программированием или чтением Usenet вместо того, чтобы возить-
ся с поиском ошибок в доморощенной реализации мудреного протокола.
Справочная информация
Обратитесь к спискам FAQ и другим документам, перечисленным в конце
Введения этой главы. Возможно, вы допустили какую-нибудь распространен-
ную ошибку для своей системы — прочитайте соответствующий FAQ, и вам не
796
Глава 19. Программирование CGI
придется краснеть за вопросы типа: «Почему моя машина не ездит без бензина
и масла?»
Спросите других. Почти у каждого есть знакомый специалист, к которому
можно обратиться за помощью. Вероятно, ответ найдется намного быстрее, чем
при обращении в Сеть.
Если ваш вопрос относится к сценариям CGI (модуль CGI, декодирование
cookies, получение данных о пользователе и т. д.), пишите в comp.Infosystems.
www.authoring.misc.
См. также
Рецепт 19.2; сведения о буферизации во Введении к главе 8 «Содержимое фай-
лов»; CGI FAQ по адресу http://www.webthing.com/tutorials/cgifaq.html.
19.4. Написание безопасных программ CGI
Проблема
Поскольку сценарий CGI позволяет внешнему пользователю запускать програм-
мы на недоступном для него компьютере, любая программа CGI представляет
потенциальную угрозу для безопасности. Вам хотелось бы свести эту угрозу
к минимуму.
Решение
Воспользуйтесь режимом пометки (флаг -Т в строке #!).
О Не снимайте пометку с данных (см. ниже).
О Проверяйте все, в том числе возвращаемые значения всех элементов формы,
даже скрытые элементы и значения, сгенерированные кодом JavaScript. Многие
наивно полагают — раз они приказали JavaScript проверить значения полей
формы перед отправкой данных, то значения действительно будут провере-
ны. Ничего подобного! Пользователь может тривиально обойти ограниче-
ния — запретить JavaScript в своем браузере, загрузить форму и модифици-
ровать JavaScript или работать на уровне HTTP без браузера (см. главу 20
«Автоматизация Веб»).
О Проверяйте значения, возвращаемые системными функциями.
О Помните о возможной «ситуации перехвата» (см. ниже).
О Используйте флаг -w и директиву use strict, чтобы застраховаться от непра-
вильных допущений со стороны Perl.
О Никогда не запускайте сценарий со сменой прав, если только это не вызвано
абсолютной необходимостью. Подумайте, не будет ли достаточно сменить
идентификатор группы. Любой ценой избегайте запуска с правами админи-
стратора. Если вам приходится использовать setuid или setgid, используйте
19.4. Написание безопасных программ CGI
797
интерфейсные «обертки» (исключение составляют случаи, когда на вашей
машине можно безопасно запускать setuid-сценарии Perl и вы точно знаете,
что это такое).
О Всегда шифруйте пароли, номера кредитных карт, номера социального страхо-
вания и все остальное, что обычно не печатается на первых страницах местных
газет. При работе с такими данными следует использовать безопасный про-
токол SSL. Простейшая проверка того, что программа будет использоваться
только через защищенный протокол HTTPS, может выглядеть так:
croak "This CGI works only over HTTPS”
if $ENV{’SERVER-PORT’} && !$ENV{'HTTPS’};
О Более того, конфиденциальные данные никогда не следует пересылать по
электронной почте. Если вам потребуется отправить кому-то защищенную
информацию, отправьте ее в виде https-URL страницы, на которой эта ин-
формация отображается лишь при вводе правильного пароля, не пересылав-
шегося по незащищенным протоколам типа HTTP или электронной почты.
Храните конфиденциальную информацию лишь тогда, когда она действи-
тельно нужна; подумайте, может ли эта информация попасть в посторонние
руки и к каким последствиям это приведет.
Комментарий
Многие из этих рекомендаций подходят для любых программ — флаг -w и провер-
ка значений, возвращаемых системными функциями, пригодятся и в тех ситуа-
циях, когда безопасность не является первоочередной заботой. Флаг -w застав-
ляет Perl выводить предупреждения о сомнительных конструкциях (например,
когда неопределенная переменная используется так, словно ей присвоено закон-
ное значение, или при попытке записи в манипулятор, доступный только для
чтения).
Самая распространенная угроза безопасности (не считая непредвиденных
вызовов командного интерпретатора) кроется в передаче форм. Кто угодно может
сохранить исходный текст формы, отредактировать HTML-код и передать изме-
ненную форму. Даже если вы уверены, что поле может возвращать только "yes"
или "по", его всегда можно отредактировать и заставить возвращать "maybe".
Даже скрытые поля, имеющие тип HIDDEN, не защищены от вмешательства извне.
Если программа на другом конце слепо полагается на значения полей, ее можно
заставить удалять файлы, создавать новые учетные записи пользователей, выво-
дить информацию из баз данных паролей или кредитных карт и совершать мно-
жество других злонамеренных действий. Вот почему нельзя слепо доверять дан-
ным (например, информации о цене товара), хранящимся в скрытых полях при
написании приложений CGI для электронных магазинов.
Еще хуже, если сценарий CGI использует значение поля формы как основу
для выбора открываемого файла или выполняемой команды. Ложные значения,
переданные сценарию, заставят его открывать произвольные файлы. Именно из-
за таких ситуаций в Perl появился режим помеченных данных. Если программа
798
Глава 19. Программирование CGI
выполняет setuid или имеет активный флаг -Т, то любые данные, получаемые
ею в виде аргументов, переменных окружения, списков каталогов или файлов,
считаются ненадежными и не могут прямо или косвенно воздействовать на
внешний мир.
В этом режиме Perl настаивает на том, чтобы переменная пути специально
задавалась в программе, даже если при запуске программы указывается полный
путь. Дело в том, что нельзя быть уверенным в том, что выполняемая команда
не вызовет другую программу по относительному имени. Кроме того, для надеж-
ности вы должны снимать пометку со всех внешних данных.
Например, при выполнении в режиме пометки фрагмента:
#!/usr/Ыn/perl -Т
open(FH. "> SARGVEOJ") or die:
Perl выдает следующее предупреждение:
Insecure dependency In open while running with -T switch at ...
Это объясняется тем, что значение $ARGV[0] (поступившее в программу извне)
считается не заслуживающим доверия. Единственный способ снять пометку с не-
надежных данных — использовать обратные ссылки в регулярных выражениях:
Sfile = SARGVEO1; # Sfile помечена
unless (Sfile =~ m#x([\w.-]+)$#) { # C SI снята пометка
die "filename 'Sfile' has invalid charactersAn";
}
Sfile = SI; # C Sfile снята пометка
Помеченные данные могут поступать из любого источника, находящегося вне
программы, например, из аргументов или переменных окружения, из резуль-
татов чтения файловых или каталоговых манипуляторов, от команды stat или
данных о локальном контексте. К числу операций, которые считаются ненадеж-
ными с помеченными данными, относятся: system( С7РО/(А), ехес (СТРОКА), glob,
open в любом режиме, кроме «только для чтения», unlink, mkdiг, rmdiг, chown, chmod,
umask, link, symlink, флаг командной строки -s, kill, require, eval, truncate, ioctl,
fcntl, socket, socketpair, bind, connect, chdir, chroot, setgrp, setpriority и syscall.
Один из распространенных видов атаки связан с так называемой ситуацией
перехвата. Ситуация перехвата возникает тогда, когда нападающий вмешивает-
ся между двумя вашими действиями и вносит какие-то изменения, нарушающие
работу программы. Печально известная ситуация перехвата возникала при работе
setuid-сценариев в старых ядрах Unix. Между чтением файла и выбором нужного
интерпретатора ядром, и чтением файла интерпретатором после setuid злонаме-
ренный чужак мог подставить свой собственный сценарий.
Ситуации перехвата возникают даже во внешне безобидных местах. Допус-
тим, у вас одновременно выполняется не одна, а сразу несколько копий следую-
щего кода:
unless (-е Sfilename) { # НЕВЕРНО!
open(FH, "> Sfilename");
# ...
}
19.5. Выполнение команд без обращений к командному интерпретатору
799
Между проверкой существования файла и его открытием для записи возни-
кает возможность перехвата. Аналогичная опасность возникает и в таких стан-
дартных ситуациях, как чтение данных из файла, обновление данных и последу-
ющая запись в файл.
Что еще хуже, если при перехвате файл будет заменен ссылкой на что-ни-
будь важное (например, на ваш личный конфигурационный файл), предыдущий
фрагмент сотрет этот файл. Правильным решением является неразрушающее
создание функцией sysopen (см. рецепт 7.1).
Setuid-сценарий CGI работает с другими правами, нежели веб-сервер. Так он
получает возможность работать с ресурсами (файлами, скрытыми базами дан-
ных паролей и т. д.), которые иначе были бы для него недоступны. Это может
быть удобно, но может быть и опасно. Из-за недостатков setuid-сценариев хаке-
ры могут получить доступ не только к файлам, доступным для веб-сервера с его
низкими привилегиями, но и к файлам, доступным для пользователя, с правами
которого работает сценарий. Плохо написанный сценарий, работающий с права-
ми системного администратора, позволит кому угодно изменить пароли, удалить
файлы, прочитать данные кредитных карт и совершить иные злодеяния. По этой
причине программа всегда должна работать с минимальным возможным уровнем
привилегий, как правило — со стандартными для веб-сервера правами nobody.
Наконец, принимайте во внимание физический путь вашего сетевого трафи-
ка (возможно, это самая трудная из всех рекомендаций). Передаете ли вы неза-
шифрованные пароли? Не перемещаются ли они по ненадежному каналу? Поле
формы PASSWORD защищает лишь от тех, кто подглядывает из-за плеча. При работе
с паролями всегда используйте SSL. Если вы серьезно думаете о безопасности,
беритесь за браузер и программу перехвата пакетов, чтобы узнать, легко ли рас-
шифровать ваш сетевой трафик.
См. также
Perlsec(i)', спецификации CGI и HTTP, а также список FAQ по безопасности
CGI, упомянутые во Введении; раздел «Avoiding Denial of Service Attacks» в стан-
дартной документации по модулю CGI; рецепт 19.5.
19.5. Выполнение команд без обращений
к командному интерпретатору
Проблема
Пользовательский ввод должен использоваться как часть команды, но вы не хо-
тите, чтобы пользователь заставлял командный интерпретатор выполнять дру-
гие команды или обращаться к другим файлам. Если просто вызвать функцию
system или '...' с одним аргументом (командной строкой), то для выполнения
может быть использован командный интерпретатор, а это небезопасно.
800
Глава 19. Программирование CGI
Решение
В отличие от одноаргументной версии, списковый вариант функции system на-
дежно защищен от обращений к командному интерпретатору. Если аргументы
команды содержат пользовательский ввод от формы, никогда не используйте
вызовы вида:
system("command $1nput ©files"): # НЕНАДЕЖНО
Воспользуйтесь следующей записью:
system("command", $1nput, ©files); # НАДЕЖНЕЕ
Комментарий
Поскольку Perl разрабатывался как «язык-клей», в нем легко запустить другую
программу — в некоторых ситуациях даже слишком легко.
Если вы просто пытаетесь выполнить команду оболочки без сохранения ее
вывода, вызвать system в многоаргументной версии достаточно просто. Но что
делать, если вы используете команду в '...' или она является аргументом функции
open? Возникают серьезные трудности, поскольку эти конструкции, в отличие от
system, не позволяют передавать несколько аргументов. Возможное решение
(в версиях, предшествующих 5.8, — см. ниже) — вручную создавать процессы
с помощью fork и ехес. Работы прибавится, но, по крайней мере, непредвиден-
ные обращения к командному интерпретатору не будут портить вам настроение.
Обратные апострофы используются в сценариях CGI лишь в том случае,
если передаваемые аргументы генерируются внутри самой программы:
chomp($now = 'date'):
Но если команда в обратных апострофах содержит пользовательский ввод —
например:
@output = 'grep $1nput ©files';
приходится действовать намного осторожнее.
die "cannot fork: $!" unless defined ($p1d = open(SAFE_KID, "|-")):
If ($p1d == 0) {
execCgrep’, $1nput, ©files) or die "can’t exec grep: $!";
} else {
@output = <SAFE_KID>:
close SAFE_KID: # $? содержит информацию состояния
}
Такое решение работает, поскольку ехес, как и system, допускает форму вызова,
свободную от обращений к командному интерпретатору. При передаче списка
интерпретатор не используется, что исключает возможные побочные эффекты.
При выполнении команды функцией open также потребуются немного потру-
диться. Начнем с открытия функцией open конвейера для чтения. Вместо нена-
дежного кода:
open(KID_TO_READ, "Sprogram ©options @args |"): # НЕНАДЕЖНО
19.5. Выполнение команд без обращений к командному интерпретатору
801
используется более сложный, но безопасный код:
# Добавить обработку ошибок
die "cannot fork: $!" unless def1ned($pid = open(KID_TO_READ. "-|")):
If ($p1d) { # Родитель
while (<KID_TO_READ>) {
# Сделать что-то интересное
}
close(KID_TO_READ) or warn "kid exited. $?":
} else { # Потомок
# Переконфигурировать, затем
exec($program. (^options, @args) or die "can't exec program: $!":
}
Безопасный конвейерный вызов open существует и для записи. Ненадежный
вызов:
open(KID_TO_WRITE. "|$program Soptlons @args"): # НЕНАДЕЖНО
заменяется более сложным, но безопасным кодом:
die "cannot fork: $!" unless def1ned($p1d = open(KID_TO_WRITE, "|-")):
$SIG{PIPE} = sub { die "whoops, Sprogram pipe broke" }:
If ($p1d) { # Родитель
for (@data) { print KID_TO_WRITE $_ }
close(KID_TO_WRITE) or warn "kid exited $?";
} else { # Потомок
# Переконфигурировать, затем
exec($program. Ooptlons, @args) or die "can't exec program: $!":
}
Там, где комментарий гласит, «Переконфигурировать», предпринимаются
дополнительные меры безопасности. Вы находитесь в порожденном процессе,
и вносимые изменения не распространяются на родителя. Можно изменить
переменные окружения, сбросить временный идентификатор пользователя или
группы, сменить каталог или маску umask и т. д.
Если в процессе-потомке дополнительная переконфигурация не нужна, и при
этом вы используете Perl версии 5.8 и выше, open поддерживает вызов со списком
раздельных параметров, который работает по аналогии с system и ехес с передачей
списка; другими словами, он полностью обходится без обращений к командному
интерпретатору. В этом случае два вызова, приведенные выше, принимают вид:
open(KID_TO_READ, Sprogram, ©options. @args)
|| die "can't run Sprogram: $!":
и
open(KID_TO_WRITE, "|-", Sprogram, Soptlons, @args)
|| die "can't run Sprogram: $!";
Разумеется, все это не поможет при запуске setuid-программы. Например,
почтовая программа sendmal 1 является setuid-программой, часто запускаемой из
сценариев CGI. По крайней мере вы должны хорошо понимать риск, связанный
с запуском sendmal 1 или любой другой setuid-программы.
802
Глава 19. Программирование CGI
См. также
Описание функций system, ехес и open в perlfunc(l)', perlsec(l\, рецепт 16.1; ре-
цепт 16.2; рецепт 16.3.
19.6. Форматирование списков
и таблиц средствами HTML
Проблема
Требуется сгенерировать несколько списков и таблиц. Нужны вспомогательные
функции, которые бы упростили вашу работу.
Решение
Модуль CGI содержит вспомогательные функции HTML, которые получают
ссылку на массив и автоматически применяются к каждому элементу массива:
print о1( 11([ qw(red blue green)]) );
<OL><LI>red</LI> <LI>blue</LI> <LI>green</LI></OL>
@names = qw(Larry Moe Curly);
print ul( 11 ({ -TYPE => "disc" }. \@names) ):
<UL><LI TYPE="disc">Larry</LI> <LI TYPE=,,disc">Moe</LI>
<LI TYPE=,,disc">Curly</LI></UL>
Комментарий
Функции CGI.pm, генерирующие HTML-код, заметно упрощают процесс построе-
ния списков и таблиц. При передаче простой строки эти функции просто выдают
HTML-код для данной строки. Но при передаче ссылки на массив они применя-
ются ко всем строкам.
print 11("alpha"):
<LI>alpha</LI>
print 11( [ "alpha", "omega"] );
<LI>alpha</LI> <LI>omega</LI>
Вспомогательные функции для списков загружаются при использовании тега
импортирования standard, но для получения вспомогательных функций для
работы с таблицами необходимо явно запросить :htm!3. Кроме того, возникает
конфликт между тегом <TR>, которому должна соответствовать функция tr(),
и встроенным оператором Perl tr///. Следовательно, для построения строк таб-
лицы следует использовать функцию Тг().
Следующий пример генерирует таблицу HTML по хэшу массивов. Ключи
хэша содержат заголовки строк, а массивы значений — столбцы.
use CGI qw(standard :html3);
%hash = (
"Wisconsin" => [ "Superior", "Lake Geneva". "Madison" ].
19.6. Форматирование списков и таблиц средствами HTML
803
"Colorado" => [ "Denver", "Fort Collins". "Boulder" ].
"Texas" => [ "Plano", "Austin", "Fort Stockton" ],
"California" => [ "Sebastopol", "Santa Rosa", "Berkeley" ],
$\ = "\n";
print "<TABLE> <CAPTI0N>C1ties I Have Known</CAPTION>":
print Tr(th [qw(State Cities)]):
for $k (sort keys %hash) {
print Tr(th($k), td( [ sort @{$hash{$k}} ] ));
print "</TABLE>":
Генерируется следующий текст:
<TABLE> <CAPTION>Cities I Have Known</CAPTION>
<TR><TH>State</TH> <TH>Ci ties</TH></TR>
<TR><TH>California</TH> <TD>Berkeley</TD> <TD>Santa Rosa</TD>
<TD>Sebastopol</TD> </TR>
<TR><TH>Colorado</TH> <TD>Boulder</TD> <TD>Denver</TD>
<TD>Fort Collins</TD> </TR>
<TR><TH>Texas</TH> <TD>Austin</TD> <TD>Fort Stockton</TD>
<TD>P1ano</TD></TR>
<TR><TH>Wisconsin</TH> <TD>Lake Geneva</TD> <TD>Madison</TD>
<TD>Superi or</TD></TR>
</TABLE>
Те же результаты можно получить всего одной командой print, хотя это не-
сколько сложнее, поскольку вам придется создавать неявный цикл с помощью шар.
Следующая команда print выдает результат, идентичный приведенному выше:
print table
capt1on(’Cities I have Known’),
Tr(th [qw(State Cities)]),
map { Tr(th($_). td( [ sort @{$hash{$_}} ] )) } sort keys ^hash;
Эти функции особенно удобны при форматировании результатов запроса
к базе данных, как показано в примере 19.3 (см. главу 14 «Базы данных»).
Пример 19.3. salcheck
#!/usr/Ы n/perl
# salcheck - проверка жалования
use DBI;
use strict;
use CGI qw(standard :htm!3);
my $11m1t = param("LIMIT");
print headerO, start_html("Salary Query"),
hl("Search"),
start_form().
pCEnter minimum salary". textfieldC'LIMIT")),
submitO,
end_form();
продолжение &
804
Глава 19. Программирование CGI
Пример 19.3 (продолжение)
If (defined Sllmlt) {
my Sdbh = DBI->connect("dbi:mysql:somedb:server.host.dom:3306".
"username", "password")
or die "Connecting: SDBI::errstr":
my Ssth = $dbh->prepare("SELECT name.sal ary FROM employees
WHERE salary > Sllmlt")
or die "Preparing: ". $dbh->errstr:
$sth->execute
or die "Executing: ". $sth->errstr:
print hlC’Results"). "<TABLE BORDER=1>":
while (my Srow = $sth->fetchrow_arrayref()) {
print Tr( td( Srow ) ):
print "</TABLE>\n":
Ssth->f1nlsh;
Sdbh->d1sconnect:
}
print end_html();
См. также
Документация по стандартному модулю CGI; рецепт 14.9.
19.7. Перенаправление клиентского браузера
Проблема
Требуется сообщить клиентскому браузеру о том, что страница находится в дру-
гом месте.
Решение
Вместо обычного заголовка выведите перенаправление и завершите программу.
Не забудьте о дополнительной пустой строке в конце заголовка:
Suri = "http://www.perl.com/CPAN/":
print "Location: $url\n\n":
exit:
Комментарий
Иногда программа CGI не генерирует документ сама, а лишь сообщает клиенту
о том, что ему следует получить другой документ. В этом случае заголовок
HTTP содержит слово Location, за которым следует новый URL. Обязательно ис-
пользуйте абсолютный, а не относительный URL.
19.7. Перенаправление клиентского браузера
805
Прямолинейного решения, показанного выше, обычно вполне хватает. Но если
модуль CGI уже загружен, воспользуйтесь функцией redirect. В примере 19.4 эта
возможность применяется при построении cookie.
Пример 19.4. oreobounce
# !/usr/Ыn/perl -w
# oreobounce - установить cookie и перенаправить браузер
use CGI qw(:cgi);
$oreo = cook1e( -NAME => 'filling'.
-VALUE => "vanilla creme'.
-EXPIRES => ’+3M’, # M - месяц, m - минута
-DOMAIN => '.perl.com');
Swhither = "http://somewhere.perl.com/nonesuch.html";
print redirect -URL => Swhlther.
-COOKIE => Soreo):
Результат выглядит так:
Status: 302 Moved Temporarily
Set-Cookie: filling=vanilla%20cr%E4me; domain^.perl.com;
expires=Mon, 21-Jul-2003 11:58:55 GMT
Date: Mon, 21 Apr 2003 11:55:55 GMT
Locatlon: http://somewhere.perlcom/nonesuch.html
Content-Type: text/html
B«blank line here»
В примере 19.5 приведена законченная программа, которая определяет имя
клиентского браузера и перенаправляет его на страницу «Файла Жаргона» Эри-
ка Реймонда, где говорится о соответствующей операционной системе. Кроме
того, в программе хорошо продемонстрирован альтернативный подход к созда-
нию конструкций switch в Perl (см. рецепт 10.17).
Пример 19.5. os_snipe
# !/usr/Ы n/perl
# os_snipe - перенаправить в статью Файла Жаргона.
# посвященную текущей операционной системе
$d1г = 'http://www.wins.uva.nl/%7Emes/jargon':
for ($ENV{HTTP_USER_AGENT)) {
Spage = /Мас/ && 'm/Macintrash.html'
| | /Win(dows )?NT/ && 'e/evilandrude.html'
| j /WIn|MSIЕ|WebTV/ && 'm/MicroslothWindows.html
| | /Linux/ && '1/Linux.html'
| | /НР-UX/ && ’h/HP-SUX.html'
| | /SunOS/ && 's/ScumOS.html'
1 } | 'a/AppendixB.html':
print "Location: $dir/$page\n\n":
В программе os snipe использовано динамическое перенаправление, по-
скольку разные пользователи отсылаются на разные страницы. Если перена-
правление всегда ведет к одному месту, разумнее включить статическую строку
806
Глава 19. Программирование CGI
в конфигурационный файл сервера — это обойдется дешевле, чем запуск сцена-
рия CGI для каждого перенаправления.
Сообщить клиентскому браузеру, что вы не собираетесь выдавать никаких
данных — далеко не то же самое, что перенаправить его «в никуда»:
use CGI qw(:standard):
print header( -STATUS => '204 No response' );
Результат выглядит так:
Status: 204 No response
Content-Type: text/html
<blank line here>
Например, этот вариант используется в ситуации, когда от пользователя при-
ходит запрос, а вы не хотите, чтобы его страница изменилась или даже просто
обновилась.
Выглядит немного глупо — сначала мы указываем тип содержимого, а потом
говорим, что содержимого не будет, — но модуль поступает именно так. При
ручном кодировании это бы не понадобилось (хотя пустая строка все равно долж-
на присутствовать).
#!/bi n/sh
cat «ЕОСАТ
Status: 204 No response
ЕОСАТ
См. также
Документация по стандартному модулю CGI.
19.8. Отладка на уровне HTTP
Проблема
Сценарий CGI странно ведет себя с браузером. Вы подозреваете, что в заголовке
HTTP чего-то не хватает. Требуется узнать, что именно браузер посылает серве-
ру в заголовке HTTP.
Решение
Создайте фиктивный веб-сервер (см. пример 19.6) и подключитесь к нему в сво-
ем браузере.
Пример 19.6. dummyhttpd
# '/usr/Ыn/perl -w
# dummyhttpd - запустить демон HTTP и выводить данные,
# получаемые от клиента
19.8. Отладка на уровне HTTP
807
use strict;
use LWP 5.32: # Минимальная допустимая версия
use HTTP::Daemon;
my Sserver = HTTP::Daemon->new(Timeout => 60, LocalPort => 8989);
print "Please contact me at: <URL:". $server->url. ">\n";
while (my Scllent = $server->accept) {
CONNECTION:
while (my Sanswer = Sell ent->get_request) {
print Sanswer->as_str1ng;
Scl1ent->autoflush;
RESPONSE:
while (<STDIN>) {
last RESPONSE If $_ eq "An";
last CONNECTION If $_ eq ". An";
print Scllent $_:
}
print "\nEOF\n":
}
print "CLOSE: ". Scl1ent->reason, "\n":
Scl1ent->close;
undef Scllent:
}
Комментарий
Трудно уследить за тем, какие версии тех или иных браузеров все еще содержат
ошибки. Фиктивная программа-сервер может спасти от многодневных напряжен-
ных раздумий, поскольку иногда неправильно работающий браузер посылает
серверу неверные данные. На своем опыте нам приходилось видеть, как браузеры
теряли cookies, неверно оформляли URL, передавали неверную строку состоя-
ния и совершали менее очевидные ошибки.
Фиктивный сервер лучше всего запускать на том же компьютере, что и на-
стоящий. При этом браузер будет отправлять ему все cookies, предназначенные
для этого домена. Вместо того чтобы направлять браузер по обычному URL:
http://somewhere.com/cgl-bln/whatever
воспользуйтесь альтернативным портом, указанным в конструкторе new. При
использовании альтернативного порта необязательно быть привилегированным
пользователем, чтобы запустить сервер.
http://somewhere.com:8989/eg1-bln/whatever
Если вы решите, что клиент ведет себя правильно, и захотите проверить сервер,
проще всего воспользоваться программой tel net для непосредственного общения
с удаленным сервером.
% telnet www.perl.com 80
GET /bogotic НТТР/1.0
«blank line here»
HTTP/1.1 404 File Not Found
Date: Tue. 21 Apr 1998 11:25:43 GMT
Server: Apache/1.2.4
Connection: close
Content-Type: text/html
808
Глава 19. Программирование CGI
<HTML><HEAD>
<TITLE>404 File Not Found</TITLE>
</HEAD><BODY>
<Hl>File Not Found</Hl>
The requested URL /bogotic was not found on this server.<P>
</BODY></HTML>
Если в вашей системе установлены модули LWP, вы сможете использовать си-
ноним GET для программы Iwprequest. При этом будут отслеживаться все цепочки
перенаправлений, что может пролить свет на вашу проблему. Например:
% GET -esuSU http://mox.perl.com/perl/bogotic
GET http://language.perl .com/bogotic
Host: mox.perl.com
User-Agent: lwp-request/1.32
GET http://mox.perl.com/perl/bogotic --> 302 Moved Temporarily
GET http://www.perl.com/perl/bogotic --> 302 Moved Temporarily
GET http://language.perl.com/bogotic --> 404 File Not Found
Connection: close
Date: Mon. 21 Apr 2003 11:29:03 GMT
Server: Apache/1.2.4
Content-Type: text/html
Client-Date: Mon, 21 Apr 2003 12:29:01 GMT
Client-Peer: 208.201.239.47:80
Title: Broken perl.com Links
<HTML>
<HEAD><TITLE>An Error Occurred</TITLE></HEAD>
<BODY>
<Hl>An Error Occurred</hl>
404 File Not Found
</BODY>
</HTML>
См. также
Документация по стандартному модулю CGI; рецепт 19.9; Iwp-request(l).
19.9. Работа с cookie
Проблема
Вы хотите получить или создать cookie для хранения параметров сеанса или на-
строек пользователя.
Решение
В модуле CGI .pm получение существующих cookie выполняется так:
$preference_value = cookie("preference name"):
19.9. Работа с cookie
809
Cookie создаются следующим образом:
$packed_cookie = cookie( -NAME => "preference name",
-VALUE => "whatever you'd like",
-EXPIRES => "+2y");
Чтобы сохранить cookie в клиентском браузере, необходимо включить его
в заголовок HTTP (вероятно, с помощью функций header или redirect):
print header(-COOKIE => $packed_cook1e);
Комментарий
Cookie используются для хранения информации о клиентском браузере. Если
вы работаете с Netscape в Unix, просмотрите файл .netscape/cookles, хотя в нем
содержатся не все cookie, а лишь те, которые присутствовали на момент последнего
выхода из браузера. Cookie можно рассматривать как пользовательские настрой-
ки уровня приложения или как средство упростить обмен данными. Преимуще-
ства cookie заключаются в том, что они могут совместно использоваться не-
сколькими разными программами и даже сохраняются между вызовами браузера.
Однако cookie также применяются и для сомнительных штучек типа анализа
трафика. Нервные пользователи начинают гадать, кто и зачем собирает их лич-
ные данные. Кроме того, cookie привязаны к одному компьютеру. Если вы рабо-
таете с браузером у себя дома или в другом офисе, в нем не будет cookie из брау-
зера, находящегося у вас на работе. По этой причине не следует ожидать, что
каждый браузер примет cookie, которые вы ему даете. А если этого покажется
недостаточно, браузеры могут уничтожать cookie по своему усмотрению. Ниже
приведена выдержка из документа RFC 2109 «Механизм управления состояни-
ем HTTP» (HTTP State Management Mechanism):
«Поскольку пользовательские агенты обладают ограниченным пространством
для хранения cookie, они могут удалять старые cookie, чтобы освободить место
для новых, например, используя алгоритм удаления по сроку последнего исполь-
зования в сочетании с ограничением максимального числа cookie, создаваемых
каждым сервером».
Теоретически браузер может в любой момент удалять cookie по своему усмот-
рению, однако пользователи вряд ли одобрят подобное поведение по отношению
к сеансовым или недавно использовавшимся cookie.
Cookie ненадежны, поэтому на них не стоит чрезмерно полагаться. Приме-
няйте их для простых транзакций с четко определенным состоянием. Избегайте
анализа трафика, это может быть принято за вмешательство в личные дела
пользователей.
В примере 19.7 приведена законченная программа, которая запоминает по-
следний выбор пользователя.
Пример 19.7. ic_cookies
#!/usr/Ыn/perl -w
# 1c_cook1es - пример сценария CGI с использованием cookie
use CGI qw(standard):
use strict:
продолжение &
810
Глава 19. Программирование CGI
Пример 19.7 (продолжение)
my Scookname = "favorite Ice cream";
my Sfavorlte = param("flavor");
my Stasty = cookie(Scookname) || 'mint';
unless (Sfavorlte) {
print headerO, start_html("Ice Cookies"), hlC'Hello Ice Cream"),
hr(), start_form().
pCPlease select a flavor: ", text fl eld ("flavor" .Stasty)).
end_form(), hr():
exit:
my Scookle = cookie(
-NAME => Scookname.
-VALUE => Sfavorlte,
-EXPIRES => "+2y".
):
print header(-COOKIE => Scookle).
start_html("Ice Cookies, #2"),
hlC'Hello Ice Cream"),
pC'You chose as your favorite flavor 'Sfavorlte'."):
Другое, более универсальное решение заключается в создании cookie с уни-
кальным, практически случайным идентификатором сеанса (например, sprlntf
'lx-%x-%x",t1me(),$$,1nt rand 0x10000) и его последующем отображении на файл
(или запись базы данных) на сервере, содержащий полную информацию о со-
стоянии сеанса. Главное — проследите за тем, чтобы операции с файлом или за-
писью не создавали опасности перехвата (см. рецепт 19.4). Также не забывайте
время от времени удалять старые сеансовые файлы на сервере и обеспечивать
корректную обработку сеансовых cookie, прекративших свое существование.
В настоящее время уже существуют модули Perl для подобных операций с сер-
верными данными, например CGI::Session.
См. также
Документация по стандартному модулю CGI; документация по модулю CGI::Session;
рецепт 19.4; RFC 2109.
19.10. Создание устойчивых элементов
Проблема
Вы хотите, чтобы по умолчанию в полях формы отображались последние исполь-
зованные значения. Например, вы хотите создать форму для поисковой системы
наподобие Google (http://www.google.com), где над результатами отображаются
искомые ключевые слова.
19.10. Создание устойчивых элементов
811
Решение
Создайте форму с применением вспомогательных функций HTML модуля CGI. pm,
которые автоматически заносят в поле предыдущее значение:
print textfield("SEARCH"): # Предыдущее значение SEARCH
# используется по умолчанию
Комментарий
В примере 19.8 приведен простой сценарий для получения списка пользовате-
лей, зарегистрированных в настоящее время.
Пример 19.8. who.cgi
# !/usr/bin/perl -wT
# who.cgi - вызвать who(l) для пользователя и отформатировать результат
$ENV{IFS}=";
$ENV{PATH}=,/bin:/usr/bin';
use CGI qw(standard);
# Вывести поисковую форму
print headerO, start_html ("Query Users"), hl ("Search");
print start_form(), pCWhich user?", text field ("WHO")): submitO, end_form();
# Вывести результаты поиска
Sname = param("WHO");
if (Sname) {
print hlU'Results");
Shtml = '';
# Вызвать who и построить текст ответа
foreach ('who') {
next unless /^$name\s/o: # Только строки, совпадающие c Sname
s/&/&/g;
s/</</g;
s/>/>/g:
Shtml
}
# Если пользователь не найден, вывести сообщение
Shtml = Shtml || "Sname is not logged in";
print pre($html);
}
print end-htmlO;
Функция textfield генерирует HTML-код для текстового поля с именем пара-
метра WHO. После вывода формы мы проверяем, было ли присвоено значение пара-
метру WHO, и если было — ищем в результатах who строки данного пользователя.
См. также
Документация по стандартному модулю CGI; рецепт 19.4; рецепт 19.6.
812
Глава 19. Программирование CGI
19.11. Создание многостраничного
сценария CGI
Проблема
Требуется написать сценарий CGI, который бы возвращал браузеру несколько
страниц. Допустим, вы хотите написать сценарий CGI для работы с базой дан-
ных продуктов. Он должен выводить несколько форм: общий список продуктов,
формы для добавления новых и удаления существующих продуктов, для редак-
тирования текущих атрибутов продуктов и т. д. Многостраничный сценарий
CGI образует простейший вариант «электронного магазина».
Решение
Сохраните информацию о текущей странице в скрытом поле.
Комментарий
Модуль CGI позволяет легко генерировать устойчивые скрытые поля. Функция
hidden возвращает HTML-код скрытого элемента и использует его текущее зна-
чение в том случае, если ей передается только имя элемента:
use CGI qw(:standard);
print hidden("bacon");
Отображаемая страница («Общий список продуктов», «Список заказанных
продуктов», «Подтверждение заказа» и т. д.) выбирается по значению скрытого
поля. Мы назовем его . State, чтобы избежать возможных конфликтов с именами
других полей. Для перемещения между страницами используются кнопки, ко-
торые присваивают .State имя новой страницы. Например, кнопка для перехода
к странице «Checkout» создается так:
print submit(-NAME => ".State", -VALUE => "Checkout");
Для удобства можно создать вспомогательную функцию:
sub to_page { return submitC -NAME => ".State", -VALUE => shift ) }
Чтобы выбрать отображаемый код, достаточно проверить параметр . State:
$page = param(".State") || "Default":
Код, генерирующий каждую страницу, размещается в отдельной подпрограм-
ме. Вообще говоря, нужную подпрограмму можно выбирать длинной конструк-
цией if.. .elslf.. .elslf:
if ($page eq "Default") {
front_page();
} elslf ($page eq "Checkout") {
checkout();
} else {
no_such_page(); # Если .State ссылается на несуществующую страницу
}
19.11. Создание многостраничного сценария CGI
813
Получается некрасивое, громоздкое решение. Вместо этого следует использо-
вать хэш, ассоциирующий имя страницы с подпрограммой. Это еще один из ва-
риантов реализации С-подобной конструкции switch на Perl.
^States = (
'Default' => \&front_page,
'Shirt' => \&shirt,
'Sweater' => \&sweater,
'Checkout' => \&checkout,
'Card' => \&credit_card.
'Order' => \&order.
'Cancel' => \&front_page.
):
if ($States{$page}) {
$States{$page}->(): # Вызвать нужную подпрограмму
} else {
no_such_page():
}
На каждой странице найдется несколько устойчивых элементов. Например,
страница для заказа футболок должна сохранить количество заказанных това-
ров, даже если пользователь переходит на страницу для заказа кроссовок. Для
этого подпрограмма, генерирующая страницу, вызывается с параметром, кото-
рый определяет, является ли данная страница активной. Если страница не яв-
ляется активной, возвращаются лишь значения скрытых полей для любых устой-
чивых данных:
while (($state, $sub) = each ^States) {
$sub->( $page eq $state ):
}
Оператор сравнения eq возвращает true, если страница является активной,
и false в противном случае. Подпрограмма, генерирующая страницу, принимает
следующий вид:
sub t_shirt {
my $active = shift:
unless ($active) {
print hiddenC'size"). hiddenC'color"):
return:
}
print pC'You want to buy a t-shirt?"):
print pC'Size: ". popup_menu('size'. [ qw(XL L M S XS) ])):
print pC'Color:", popup_menu('color'. [ qw(Black White) ])):
print p( to_page("Shoes"). to_page("Checkout") ):
}
Поскольку все подпрограммы генерируют HTML-код, перед вызовом необходи-
мо вывести заголовок HTTP и начать выводить HTML-документ и форму. Это
позволит использовать стандартные заголовки и завершители всех страниц, если
814
Глава 19. Программирование CGI
мы захотим. Следующий фрагмент предполагает, что у нас имеются процедуры
standard_header и standard_footer для вывода заголовков и завершителей страниц:
print header("Program Title"), begin_htmlО:
print standard_header(). begin_form():
while (($state, $sub) = each ^States) {
$sub->( $page eq $state ):
print standard_footer(). end_form(), end_html():
Кодирование цены в форме будет ошибкой. Вычисляйте цены на основании
значений скрытых элементов и как можно чаще проверяйте информацию. Напри-
мер, сравнение со списком существующих продуктов позволяет отбросить явно
неразумные заказы. Объекты могут идентифицироваться произвольными строка-
ми, будь то текстовые строки вида "sweater xl_plain", играющие роль ключей
в хэше цен, или коды продуктов, используемые для поиска во внешней базе данных.
Скрытые данные обладают большими возможностями, чем cookie, поскольку
вы не можете твердо рассчитывать на поддержку cookie или на то, что браузер
согласится принять их. Более полная информация приведена в рецепте 19.9.
Однако использование скрытых данных означает, что ссылки, с которыми рабо-
тает пользователь, должны оформляться в виде кнопки отправки данных вместо
обычных гиперссылок.
В конце главы приведена программа chemi serie — простейшее приложение
для обслуживания электронного магазина.
См. также
Документация по стандартному модулю CGI.
19.12. Сохранение формы в файле или канале
Проблема
Сценарий CGI должен сохранить все содержимое формы в файле или передать
его в канал.
Решение
Для сохранения формы воспользуйтесь функцией save_parameters или методом
save модуля CGI; их параметром является файловый манипулятор. Сохранение
в файле выполняется так:
# Сначала открыть и монопольно заблокировать файл
open(FH, "»/tmp/formlog") or die "can't append to formlog: $!":
flock(FH, 2) or die "can't flock formlog: $!";
# Используется процедурный интерфейс
use CGI qw(standard):
19.12. Сохранение формы в файле или канале
815
save_parameters(*FH): # CGI::save
# Используется объектный интерфейс
use CGI:
$query = CGI->new():
$query->save(*FH):
close(FH) or die "can't close formlog: $’";
Или форма сохраняется в канале, например, соединенном с процессом sendmail:
use CGI qw(standard):
open(MAIL, "|/usr/11b/sendmal1 -oi -t") or die "can't fork sendmail: $!":
print MAIL «EOF:
From: $0 (your cgi script)
To: hisname\@hishost.com
Subject: mailed form submission
EOF
save_parameters(*MAIL):
close(MAIL) or die "can't close sendmail: $!":
Комментарий
Иногда данные формы сохраняются для последующего использования. Функ-
ция save_parameters и метод save модуля CGI .pm записывают параметры формы
в открытый манипулятор. Манипулятор может быть связан с открытым фай-
лом (желательно — открытым в режиме дополнения и заблокированным, как
в Решении) или с каналом, другой конец которого подключен к почтовой про-
грамме.
Данные сохраняются в файле в виде пар переменная=значение, служебные
символы оформляются по правилам URL. Записи разделяются строками, состоя-
щими из единственного символа =. Как правило, чтение осуществляется методом
CGI->new с аргументом-манипулятором, что обеспечивает автоматическое восста-
новление служебных символов (см. ниже).
Если вы хотите перед сохранением включить в запрос дополнительную ин-
формацию, вызовите функцию param (или метод, если используется объектно-
ориентированный интерфейс) с несколькими аргументами и установите нужное
значение (или значения) параметра формы. Например, текущее время и полное
состояние окружения сохраняется следующим образом:
param("_timestamp". scalar local time):
param("_environs". £ENV):
После сохранения формы в файле дальнейшая работа с ней ведется через
объектно-ориентированный интерфейс.
Чтобы загрузить объект-запрос из файлового манипулятора, вызовите метод
new с аргументом-манипулятором. При каждом вызове возвращается закончен-
ная форма. При достижении конца файла будет возвращена форма, не имеющая
параметров. Следующий фрагмент показывает, как это делается. Он накаплива-
ет сумму всех параметров "items request", но лишь в том случае, если форма
816
Глава 19. Программирование CGI
поступила не с сайта perl .com. Напомним, что параметры _environs и _timestamp
были добавлены при записи файла.
use CGI:
open(FORMS. "< /tmp/formlog") or die "can't read formlog: S’";
flock(FORMS. 1) or die "can't lock formlog: $!":
while (Squery = CGI->new(*FORMS)) {
last unless $query->param(): # Признак конца файла
%his_env = $query->param('_environs');
Scount += $query->param('items requested')
unless Shis_env{REMOTE_HOST} =~ /(^|\.)per1\.com$/
print "Total orders: $count\n":
Как всегда при создании файлов в сценариях CGI, важную роль играют пра-
ва доступа и права владельца файла.
См. также
Рецепт 18.3; рецепт 19.3.
19.13. Программа: chemiserie
Сценарий CGI из примера 19.9 предназначен для заказа футболок и свитеров
через Веб. В нем использованы приемы, описанные в рецепте 19.11. Вывод не
отличается особой элегантностью или красотой, но продемонстрировать много-
страничную работу в короткой программе слишком сложно, чтобы заботиться
об эстетике.
Процедуры shirt и sweater проверяют значения соответствующих элементов
формы. Если цвет или размер окажется неправильным, в элемент заносится пер-
вое значение из списка допустимых цветов или размеров.
Пример 19.9. chemiserie
#!/usr/bin/perl -w
# chemi serie - простой сценарий CGI для заказа футболок и свитеров
use strict:
use CGI qw(:standard):
use CGI::Carp qw(fatalsToBrowser);
my ^States: # Хэш состояний - связывает страницы
# с функциями
my SCurrent-Screen: # Текущий экран
croak "This CGI works only over HTTPS"
if $ENV{'SERVER_PORT'} && !$ENV{'HTTPS'}:
# Поскольку в приложении используются конфиденциальные данные (например
# номера кредитных карт).
# Хэш страниц и функций.
^States = (
19.13. Программа: chemiserie
817
'Default' => \&front_page,
'Shirt' => \&shirt,
'Sweater' => \&sweater,
'Checkout' => \&checkout,
'Card' => \&credit_card,
'Order' => \&order.
'Cancel' => \&front_page,
):
$Current_Screen = param(".State") || "Default":
die "No screen for $Current_Screen" unless $States{$Current_Screen}:
# Сгенерировать теку1цую страницу.
standard_header():
while (my($screen_name, $function) = each ^States) {
$function->($screen_name eq $Current_Screen);
}
standard_footer():
exit;
// // и ii и и и и и и и и и и и it // и и и и и и и и и и //## //##### // // // //#####
# Заголовки и завершители формы, функции меню
// IIIIIIIIII If IIII11-U-44-//## // //## // If II /А# // If II Il-Il IIIIII If If II If If IIIIИ-Ц-И-И-М
KniTiririiKuuKiriiunuKKuuiriiKnuuKuKnuKiiTrinnTvuuKnunirir
sub standard-header {
print headerO, start_html(-Title => "Shirts". -BGC0L0R=>"White"):
print start_form(): # start_multipart_form() if file upload
}
sub standard-footer { print end_form(), end_html() }
sub shopjnenu {
print p(defaults("Empty My Shopping Cart").
to_page("Shirt").
to_page("Sweater").
to_page("Checkout")):
}
шшшшшшштшш
# Процедуры для каждой страницы
//.// // ////// // // // // // // // // // // // // // // // // // а а а а а
1Т1Гп'Т1Т1иЛГн1Т1Т7Т1ТИ1Т1Т1Т1Т~ТГп1Т~ТГ1Т1Т~ТГ1Гг^^^^1Т1ГГГ1Г
# Страница по умолчанию.
sub front-page {
my $active = shift;
return unless $active:
print "<Hl>Hi!</Hl>\n":
print "Welcome to our Shirt Shop! Please make your selection from ":
print "the menu below.\n";
shopjnenuO:
} продолжение &
818
Глава 19. Программирование CGI
Пример 19.9 (продолжение)
# Страница для заказа футболок.
sub shirt {
my $active = shift;
my @sizes = qw(XL L M S);
my ^colors = qw(Black White);
my ($size, $color, $count) =
(param("shirt_size"). param("shirt_color"). param("shirt_count"));
# Проверка
if ($count) {
$color = $colorsE0] unless grep { $_ eq $color } ^colors;
$size = $sizes[0] unless grep { $_ eq $size } @sizes;
param("shirt_color". $color):
param("shirt_size". $size);
}
unless ($active) {
print hidden("shirt_size") if $size;
print hidden("shirt_color") if $color;
print hidden("shirt_count") if $count;
return;
}
print hl("T-Shirt");
print pC’What a shirt! This baby is decked out with all the options.",
"It comes with full luxury interior, cotton trim, and a collar",
"to make your eyes water! Unit price; \$33.00");
print h2("Options");
print pC'How Many?", textfield("shirt_count")):
print pC'Size?", popup_menu("shirt_size", \@sizes ),
"Color?", popup_menu("shirt_color", \@colors));
shop_menu();
}
# Страница для заказа свитеров.
sub sweater {
my $active = shift;
my Qsizes = qw(XL L M);
my Qcolors = qw(Chartreuse Puce Lavender);
my ($size, $color, $count) =
(param("sweater_size"), param("sweater_color"), param("sweater_count"));
# Проверка
if ($count) {
$color = $colors[0] unless grep { $_ eq $color } Qcolors;
$size = $sizes[0] unless grep { $_ eq $size } @sizes:
param("sweater_color", $color);
param("sweater_size", $size);
}
unless ($active) {
print hidden("sweater_size") if $size;
19.13. Программа: chemiserie
819
print hidden("sweater_color") if $color:
print hidden("sweater_count") if $count:
return:
}
print hl("Sweater"):
print pU'Nothing implies pretty elegance more than this fine",
"sweater. Made by peasant workers from black market silk,",
"it slides onto your lean form and cries out V'Take me,",
"for I am a god!\". Unit price: \$49.99."):
print h2("Options"):
print pU'How Many?", textfield("sweater-Count")):
print pU'Size?", popup_menu("sweater_size", \@sizes));
print pU'Color?", popup_menu("sweater_color", \@colors)):
shopjnenuO:
}
# Страница для подтверждения текущего заказа.
sub checkout {
my $active = shift:
return unless $active:
print hlU'Order Confirmation"):
print p("You ordered the following:"):
print order_text():
print p("Is this right? Select ’Card’ to pay for the items",
"or 'Shirt' or 'Sweater' to continue shopping."):
print p(to_page("Card"),
to_page("Shirt"),
to_page("Sweater")):
# Страница для ввода данных кредитной карты.
sub credit_card {
my $active = shift:
my @widgets = qw(Name Addressl Address2 City Zip State Phone Card Expiry):
unless ($active) {
print map { hidden($_) } @widgets:
return:
}
print pre(p("Name: ", textfieldCName"))
p("Address: ", textfield("Addressl")).
p(" ", textfield("Address2")),
pCCity: ", textfieldCCity")),
pC'Zip: ". textfieldC'Zip")),
p("State: ". textfield("State")).
p("Phone: ", textfield("Phone")),
p("Credit Card #: ", textfieldU'Card")).
p("Expiry: ", textfieldCExpiry"))):
print pU'Click on 'Order' to order the items. Click on 'Cancel'
to return shopping."): n
продолжение
820
Глава 19. Программирование CGI
Пример 19.9 (продолжение)
print p(to_page("Order"), to_page("Cancel")):
}
# Страница подтверждения заказа.
sub order {
my $active = shift:
unless ($active) {
return:
# Проверка данных кредитной карты
print hl("Ordered!"):
print p("You have ordered the following toppings:"):
print order_text():
print p(defaults("Begin Again")):
}
# Возвращает HTML-код текущего заказа ("Вы заказали ...")
sub order_text {
my $html = ";
if (param("shirt_count")) {
$html .= p("You have ordered ", param("shirt_count"),
" shirts of size ", param("shirt_size"),
" and color ", param("shirt_color"), "."):
}
if (param("sweater_count")) {
$html .= p("You have ordered ", param("sweater_count"),
" sweaters of size ", param("sweater_size"),
" and color ", param("sweater_color"), "."):
$html = p("Nothing!") unless $html:
$html .= pC'For a total cost of ", calculate_price()):
return $html:
}
sub calculate_price {
my $shirts = param("shirt_count") || 0:
my $sweaters = param("sweater_count") || 0:
return sprintf("\$r2f", $shirts*33 + $sweaters * 49.99):
}
sub to_page { subm1t(-NAME => ".State", -VALUE => shift) }
Автоматизация в Веб
«...Сеть одновременно чувственная и логиче-
ская, элегантная и изобилующая смыслом —
это стиль, это основа литературного искусства».
Роберт Льюис Стивенсон, «О некоторых
технических элементах стиля в литературе»
20.0. Введение
В главе 19 «Программирование CGI» основное внимание уделяется ответам на
запросы браузеров и генерации документов с применением CGI. В этой главе
программирование для Веб рассматривается с другой стороны: вместо того,
чтобы общаться с браузером, вы сами притворяетесь браузером, генерируете
запросы и обрабатываете возвращаемые документы. Для упрощения этого про-
цесса мы будем широко использовать модули, поскольку правильно реализовать
низкоуровневые сетевые протоколы и форматы документов непросто. Поручая
всю трудную работу готовым модулям, вы концентрируетесь на самом интерес-
ном — вашей собственной программе.
Упоминаемые модули находятся по следующему URL:
http://search.cpan.org/modl1st/World_W1 de_Web
Здесь хранятся модули для вычисления контрольных сумм кредитных карт,
взаимодействия с API Netscape или сервером Apache, обработки графических
карт (image maps), проверки HTML и работы с MIME. Однако самые большие
и важные модули этой главы входят в комплекс модулей libwww-perl, объеди-
няемых общим термином LWP. Ниже описаны лишь некоторые модули, входя-
щие в LWP (табл. 20.1).
Модули HTTP:: и LWP:: позволяют запрашивать документы с сервера. В част-
ности, модуль LWP::Simple обеспечивает простейший способ получения докумен-
тов. Однако LWP::Simple не хватает возможности обращаться к отдельным компо-
нентам ответов HTTP. Для работы с ними используются модули HTTP::Request,
HTTP: Response и HTTP: :UserAgent. Оба набора модулей демонстрируются в рецеп-
тах 20.1, 20.2 и 20.10.
Модули HTML:: находятся в близкой связи с LWP, но не распространяются
в составе этого пакета. Они предназначены для анализа HTML-кода. В частно-
сти, они заложены в основу рецептов 20.5, 20.4, 20.6, 20.3, 20.7, программ htmlsub
и hrefsub.
822
Глава 20. Автоматизация в Веб
Таблица 20.1. Модули LWP
Имя модуля Назначение
LWP::UserAgent Класс пользовательских агентов WWW
LWP::RobotUA Разработка приложений-роботов
LWP "Protocol Интерфейс для различных схем протоколов
LWP::Authen::Basic Обработка ответов 401 и 407
LWP::MediaTypes Конфигурация типов MIME (text/html и т. д.)
LWP::Debug Отладочный модуль
LWP::Simple Простой процедурный интерфейс для часто используемых функций
HTTP:: Headers Заголовки стилей MIME/RFC822
HTTP:: Message Сообщение в стиле HTTP
HTTP:: Request Запрос HTTP
HTTP:: Response Ответ HTTP
HTTP:: Daemon Класс сервера HTTP
HTTP:: Status Коды статуса HTTP (200 ОК и т. д.)
HTTP:: Date Модуль обработки даты для форматов дат HTTP
HTTP:: Negotiate Согласование содержимого HTTP
WWW::RobotRules Анализ файлов robots.txt
File:: Listing Анализ списков содержимого каталогов
В рецепте 20.12 приведено регулярное выражение для декодирования полей
в файлах журналов веб-сервера, а также показано, как интерпретировать эти
поля. Мы используем это регулярное выражение с модулем Logfile::Apache в ре-
цепте 20.13, чтобы продемонстрировать два подхода к обобщению данных в жур-
налах веб-серверов.
20.1. Обращение по URL из сценария Perl
Проблема
Требуется обратиться из сценария по некоторому URL.
Решение
Воспользуйтесь функцией get модуля CPAN LWP:: Simple, входящего в LWP.
use LWP::Simple:
Scontent = get(SURL):
20.1. Обращение no URL из сценария Perl
823
Комментарий
Правильный выбор библиотек заметно упрощает работу, а модули LWP идеаль-
но подходят для поставленной задачи. Как будет показано в Решении, при ис-
пользовании LWP эта задача решается тривиально.
Функция get модуля LWP:: Simple в случае ошибки возвращает undef, поэтому
ошибки следует проверять так:
use LWP: .-Simple:
unless (defined (Scontent = get SURD) {
die "could not get $URL\n":
Однако в этом случае вы не сможете определить причину ошибки. В этой
и других нетривиальных ситуациях возможностей LWP::Simple оказывается не-
достаточно.
В примере 20.1 приведена программа выборки документа по URL. Если
попытка оказывается неудачной, программа выводит строку с кодом ошибки.
В противном случае печатается название документа и количество строк в его со-
держимом. Мы используем три модуля, два из которых входят в LWP.
О LWP: :UserAgent. Модуль создает виртуальный браузер. Объект, полученный при
вызове конструктора new, используется для дальнейших запросов. Мы задаем
для своего агента имя «Schmozilla/v9.14 Platinum», чтобы веб-мастер му-
чился от зависти при просмотре журнала. Такая возможность может приго-
диться при работе с противными веб-серверами, которые без необходимости
проверяют строку пользовательского агента и решают, стоит ли вернуть стра-
ницу или раздражающее сообщение типа «Для просмотра этого сайта необ-
ходим Internet Navigator версии 12 и выше».
О HTTP: Response. Тип объекта, возвращаемый при фактическом выполнении за-
проса пользовательским объектом. Проверяется на предмет ошибок и для
получения искомого содержимого.
О URI::Heuristic. Занятный маленький модуль использует Netscape-подобные
алгоритмы для расширения частичных URL. Например:
Частичный URL Предположение
perl http: //www. perl. com
www.oreilly.com http://www.oreilly.com
ftp.funet.fi ftp://ftp.funet.fi
/etc/passwd file:/etc/passwd
Хотя строки в левом столбце не являются формально правильными URL
(цх формат не отвечает спецификации URI), Netscape пытается угадать, каким
URL они соответствуют. То же самое делают и многие другие браузеры.
Исходный текст программы приведен в примере 20.1.
824
Глава 20. Автоматизация в Веб
Пример 20.1. titlebytes
# !/usr/Ыn/perl -w
# titlebytes - определение названия и размера документа
use strict;
use LWP::UserAgent:
use HTTP:Response:
use URI::Heurlst1c:
my $raw_url = shift or die "usage: $0 url\n":
my $url = URI::HeurlStic::uf_urlstr($raw_url);
$|=1: # Немедленный вывод следующей строки
printf "%s =>\n\t", $url;
# Вымышленный пользовательский агент
my $ua = LWP::UserAgent->new();
Sua->agent("Schmoz111a/v9.14 Platinum"):
# Чтобы озадачить программы анализа журнала
my Sresponse = $ua->get($url, Referer => "http://wizard.yellowbrick.oz");
If ($response->1s_error()) {
printf " %s\n", $response->status_lIne;
} else {
my Scontent = $response->content();
my Sbytes = length Scontent;
my Scount = (Scontent =~ tr/\n/\n/);
printf *7s (%d lines, %d bytes)\n".
$response->t1tle() || "(no title)", Scount, Sbytes;
}
Программа выдает результаты следующего вида:
% titlebytes http://www.tpj.com/
http://www.tpj.com/ =>
The Perl Journal (109 lines, 4530 bytes)
Обратите внимание: вместо правильного английского «referrer» используется
вариант написания referer. Ошибка была допущена разработчиками стандарта
при выборе имени HTTP_REFERER.
Первый аргумент метода get определяет URL, а остальные пары аргумен-
тов содержат заголовки и их значения.
См. также
Документация по модулю CPAN LWP::Simple и страницы руководства Iwpcook(l)
и Iwptut(l), прилагаемая к LWP; документация по модулям LWP::UserAgent,
HTTP: Response и URI::HeurlStic; рецепт 20.2.
20.2. Автоматизация отправки формы
Проблема
Вы хотите передать сценарию CGI значения полей формы из своей программы.
Допустим, вы пишете программу, которая ищет данные в Amazon и сообщает
о появлении новых книг определенного автора (или новых книг, содержащих
некоторые ключевые слова в названиях, и т. д.).
20.2. Автоматизация отправки формы
825
Решение
Если значения передаются методом GET, воспользуйтесь методом get объекта
LWP::UserAgent:
use LWP::Simple:
use URI::URL:
my Suri = url(’http://www.amazon.com/exec/obldos/search-handle-url/1ndex=books’);
$url->query_form("field-author" => "Larry Wall"):
Scontent = get(Suri):
Если вы используете метод POST, создайте собственный пользовательский
агент и закодируйте содержимое:
use LWP::UserAgent:
Sua = LWP::UserAgent->new():
my Sresp = $ua->post("www.amazon.com/exec/obidos/search-handle-form",
{ "url" => "index-books",
"field-keywords" => "perl" }):
Scontent = $resp->content:
Комментарий
Для простых операций хватает процедурного интерфейса модуля LWP::Simple. Для
менее тривиальных ситуаций модуль LWP: :UserAgent предоставляет объект вирту-
ального браузера, работа с которым осуществляется посредством вызова методов.
Строка запроса имеет следующий формат:
П0ЛЕ1=ЗНАЧЕНИЕ1&П0ЛЕ2=ЗНАЧЕНИЕ2М0ЛЕЗ=ЗНАЧЕНИЕЗ
В запросах GET информация кодируется в запрашиваемом URL:
sc г ipt.cgi ?fi eldl=valuel&fi eld2=value2&fi eld3=val ue3
Служебные символы в полях должны быть соответствующим образом преоб-
разованы, поэтому присваивание параметру arg строки "this isn't <EASY> and
<FUN>" выглядит так:
http://www.site.com/path/to/
scri pt.cgi ?arg=%22thi s+i sn*27t+*3CEASY*3E+*26+*3CFUN*3E*22
Метод query_form, вызываемый для объекта URL, преобразует служебные
символы формы за вас. Кроме того, можно вызвать URI::Escape: :uri_escape или
CGI :escape_html по собственной инициативе. В запросах POST строка параметров
входит в тело HTML-документа, передаваемого сценарию CGI.
Для передачи данных в запросе GET можно использовать модуль LWP::Simple,
однако для запросов POST не существует аналогичного интерфейса LWP::Simple.
Вместо этого метод $ua->post создает и сразу отправляет запрос.
Если запрос должен проходить через прокси-сервер, сконструируйте свой
пользовательский агент и прикажите ему использовать прокси:
$ua->proxy('http* => * http://proxy.myorg.com:808Г):
826
Глава 20. Автоматизация в Веб
Если прокси-сервер обслуживает сразу несколько протоколов, в первом аргу-
менте передается ссылка на массив:
$ua->proxy(С * http *. 'ftp'] => * http://proxy.myorg.com:8081’):
Это означает, что запросы HTTP и FTP для данного пользовательского аген-
та должны маршрутизироваться через прокси-сервер на порте 8081 по адресу
proxy.myorg.com.
См. также
Документация по модулям CPAN LWP:: Simple, LWP: :UserAgent, HTTP::Request::Common,
URI: -.Escape и URI::URL; рецепт 20.1.
20.3. Извлечение URL
Проблема
Требуется извлечь все URL из HTML-файла. Допустим, вы загрузили страницу
со списком всех файлов в формате MP3, размещенных на некотором сайте. Те-
перь нужно извлечь URL этих файлов, отфильтровать список и написать про-
грамму для приема нужных файлов.
Решение
Воспользуйтесь модулем CPAN HTML::LinkExtor:
use HTML::LinkExtor;
Sparser = HTML::LinkExtor->new(undef, $base_url);
Sparser->parse_file(Sfilename):
©links = $parser->11nks:
foreach Slinkarray (©links) {
my ^element = @$1Inkarray:
my $elt_type = shift ^element: # Тип элемента
# Проверить, тот ли это элемент, который нас интересует
while (^element) {
# Извлечь следующий атрибут и его значение
my ($attr_name. $attr_value) = splice(@element. 0. 2):
# ... Сделать что-то ...
} }
Комментарий
Модуль HTML::LinkExtor можно использовать двумя способами: либо вызвать
links для получения списка всех URL в документе после его полного разбора,
либо передать ссылку на функцию в первом аргументе new. Указанная функция
будет вызываться для каждого URL, найденного во время разбора документа.
20.3. Извлечение URL
827
Метод links очищает список ссылок, поэтому для каждого анализируемого
документа он вызывается лишь один раз. Метод возвращает ссылку на массив
элементов. Каждый элемент сам по себе представляет ссылку на массив, в начале
которого находится объект HTML::Element, а далее следует список пар «имя атри-
бута/значение». Например, для следующего HTML-фрагмента:
<А HREF="http://www.perl.сот/">Home page</A>
<IMG SRC="1mages/b1g.g1f" L0WSRC="1mages/b1g-lowres.g1f">
возвращается структура данных:
C a. href => "http://www.perl.com/" ].
С Irng. src =>"1mages/b1g.glf".
lowsrc => "Images/blg-lowres.gif" ]
В следующем фрагменте демонстрируется пример использования $elt_type
и $attr_name:
If ($elt_type eq *a* && $attr_name eq 'href') {
print "ANCHOR: $attr_value\n"
If $attr_value->scheme =~ /http|ftp/:
}
If ($elt_type eq 'Irng* && $attr_name eq 'src') {
print "IMAGE: $attr_value\n":
}
Следующий фрагмент отфильтровывает из списка файлы в формате MP3:
foreach my $1 Inkarray (01 Inks) {
my ($elt_type. %attrs) = @$1Inkarray:
If ($elt_type eq *a* && $attrs{'href*} =~ /\.mp3$/1) {
# Сделать что-то c Sattr{'href. URL файла в формате mp3
} }
Программа из примера 20.2 получает в качестве аргументов URL (например,
fl 1 е:///tmp/testlng.html или http://www.ora.com/) и выдает в стандартный вывод
отсортированный по алфавиту список уникальных ссылок из него.
Пример 20.2. xurl
#!/usr/Ыn/perl -w
# xurl - получение отсортированного списка ссылок с URL
use HTML::LInkExtor:
use LWP::Simple:
$base_url = shift:
Sparser = HTML::LinkExtor->new(undef. $base_url);
$parser->parse(get($base_url))->eof:
@11nks = $parser->llnks:
foreach $1 inkarray (01 Inks) {
my ^element = @$1Inkarray:
my $elt_type = shift ^element:
while (^element) {
продолжение
828
Глава 20. Автоматизация в Веб
Пример 20.2 (продолжение)
my ($attr_name , $attr_value) = spl1ce(@element, 0, 2):
$seen{$attr_value}++;
}
for (sort keys %seen) { print "\n" }
У программы xurl имеется существенный недостаток: если в get или $base_url
используется перенаправление, все ссылки будут рассматриваться для исходно-
го, а не для перенаправленного URL. Возможное решение: получите документ
с помощью LWP: :UserAgent и проанализируйте код ответа, чтобы узнать, про-
изошло ли перенаправление. Определив URL после перенаправления (если он
есть), конструируйте объект HTML: :L1nkExtor.
Примерный результат выглядит так:
%xurl http://www.perl.com/CPAN
ftp://ftp@ftp.perl.com/CPAN/CPAN.html
http://1anguage.perl.com/mi sc/CPAN.cgi
http://1anguage.perl.com/mi sc/cpan_module
http://1anguage.perl.com/mi sc/getcpan
http://1anguage.perl.com/i ndex.html
http://1anguage.perl.com/gi fs/1cb.xbm
В почте и сообщениях Usenet часто встречаются URL вида:
<URL:http://www.per1.com>
Это упрощает выборку URL из сообщений:
@URLs = (Smessage =~ /<URL:(.*?)>/g);
См. также
Документация по модулям CPAN LWP::Simple, HTML: :L1nkExtor и HTML::Entitles;
рецепт 20.1.
20.4. Преобразование ASCII в HTML
Проблема
Требуется преобразовать ASCII-текст в HTML (например, чтобы вывести на
веб-странице текст почтового сообщения).
Решение
Воспользуйтесь простым кодирующим фильтром из примера 20.3.
Пример 20.3. text2html
# !/usr/Ыn/perl -w -pOO
# text2html - простейшее html-кодирование обычного текста
# -p означает, что сценарий применяется для каждой записи.
20.5. Преобразование HTML в ASCII
829
# -00 означает, что запись представляет собой абзац
use HTML: Entities:
$_ = encode_entities($_, "\200-\377”):
If (/A\s/) {
# Абзацы, начинающиеся с пропусков, заключаются в <PRE>
s{(.*)$} {<PRE>\n$l</PRE>\n}s: # Оставить отступы
} else {
s{A(>.*)} {$l<BR>}gm: # Цитируемый текст
s{<URL:(.*?)>} {<А HREF="$r’>$l</A>}gs # Внутренние URL(xopowo)
II
s{(http:\S+)} {<A HREF="$r>$l</A>}gs; # Предполагаемые URL(nnoxo)
s{\*(\S+)\*} {<STRONG>$l</STRONG>}g: # ^Полужирный*
s{\b_(\S+)\_\b} {<EM>$l</EM>}g: # _Курсив_
s{A) {<P>\n}: # Добавить тег абзаца
}
Комментарий
Задача преобразования произвольного текста в формат HTML не имеет общего
решения, поскольку существует много разных, противоречащих друг другу спо-
собов форматирования обычного текста. Чем больше вам известно о входных
данных, тем лучше вы их отформатируете.
Например, если вы знаете, что исходным текстом будет почтовое сообщение,
можно добавить следующий блок для форматирования почтовых заголовков:
BEGIN {
print "<TABLE>":
$_ = encode_entities(scalar <>):
s/\n\s+/ /g: # Строки продолжения
while ( /A(\S+?:)\s*(.*)$/gm ) { # Анализ заголовков
print "<TR><TH ALIGN=,LEFT,>$l</TH><TD>$2</TD></TR>\n":
}
print "</TABLE><HR>":
}
В модуле CPAN HTML: :TextToHTML предусмотрены средства настройки форма-
тирования заголовков, завершителей, отступов, таблиц и т. д.
См. также
Документация по модулям CPAN HTML::Entities и HTML: :TextToHTML.
20.5. Преобразование HTML в ASCII
Проблема
Требуется преобразовать HTML-файл в отформатированный ASCII-текст. Допус-
тим, вы хотите переслать веб-документ по электронной почте.
830
Глава 20. Автоматизация в Веб
Решение
Если у вас есть внешняя программа форматирования (например, lynx), восполь-
зуйтесь ей:
$asd1 = 'lynx -dump Sfilename';
Если вы хотите сделать все в своей программе и не беспокоитесь о том, что
HTML: :FormatText еще не умеет обрабатывать таблицы и фреймы, сделайте сле-
дующее:
use HTML::FormatText 3:
Sascii = HTML::FormatText->format_file(
Sfilename,
leftmargin => 0, rightmargin => 50
):
Комментарий
В обоих примерах предполагается, что HTML-текст находится в файле. Если он
хранится в переменной, то для применения lynx необходимо записать его в файл.
При работе с HTML: :FormatText воспользуйтесь методом format_string:
use HTML::FormatText 3:
Sascii = HTML::FormatText->format_string(
Sfilename.
leftmargin => 0, rightmargin => 50
):
Если вы используете Netscape, команда Save As с типом Text отлично справля-
ется с таблицами.
См. также
Документация по модулям CPAN HTML::TreeBui 1 der и HTML: :FormatText; страница
руководства 1упх(Г) вашей системы; рецепт 20.6.
20.6. Удаление тегов HTML
Проблема
Требуется удалить из строки теги HTML и оставить в ней обычный текст. До-
пустим, вы индексируете документ, но не хотите, чтобы в алфавитный указатель
вошли «слова» <В> и <body>.
Решение
Следующее решение встречается часто, но работает неверно (за исключением
простейшего HTML-кода):
($plain_text = $html_text) =~ s/<O]*>//gs; #НЕВЕРНО
20.6. Удаление тегов HTML
831
Правильный, но медленный и более сложный способ связан с применением
методики из рецепта 20.5:
use HTML::FormatText 2;
$plain_text = HTML::FormatText->format_strIng(Shtml_text):
Комментарий
Как обычно в Perl, поставленную задачу можно решить несколькими спосо-
бами. Каждое решение пытается выдержать баланс между скоростью и универ-
сальностью. Для простейшего HTML-кода работает даже самая элементарная
командная строка:
% perl -ре *s/<[x>]*>//g’ ФАЙЛ
Однако это решение не подходит для файлов, в которых теги пересекают гра-
ницы строк:
<IMG SRC = "foo.gif"
ALT = "Flurp!">
Поэтому иногда встречается следующее решение:
% perl -0777 -ре *s/<r>]*>//gs* ФАЙЛ
или его сценарный эквивалент:
{
local $/; # Временный режим чтения всего файла
Shtml = <FILE>:
Shtml =~ s/<[x>]*>//gs:
Но даже этот вариант работает лишь для самого примитивного HTML-кода,
не содержащего никаких «изюминок». В частности, он пасует перед следующи-
ми примерами допустимого HTML-кода (не говоря о многих других):
<IMG SRC = "foo.gif" ALT = "A > B">
<!-- <Комментарий> -->
<scr1pt>1f (a<b && a>c)</scrlpt>
<# Просто данные #>
<![INCLUDE CDATA [ »»»»»» ]]>
Проблемы возникают и в том случае, если комментарии HTML содержат
другие теги:
<!-- Раздел закомментирован.
<В>Меня не видно!</В>
Единственное надежное решение — использовать алгоритмы анализа HTML-
кода из CPAN. Эта методика продемонстрирована во втором фрагменте, приве-
денном в Решении.
832
Глава 20. Автоматизация в Веб
Чтобы сделать анализ более гибким, субклассируйте HTML::Parser и записы-
вайте только найденные текстовые элементы:
package MyParser;
use HTML::Parser;
use HTML;:Entitles qw(decode_ent1t1es):
@ISA = qw(HTML::Parser):
sub text {
my($self, $text) =
print decode_ent1t1es($text):
}
package main;
MyParser->new->parse_f11e(*F);
Если вас интересуют лишь простые теги, не содержащие вложенных тегов,
возможно, вам подойдет другое решение. Следующий пример извлекает назва-
ние несложного HTML-доку мента:
($title) = ($html =~ m#<TITLE>\s*(.*?)\s*</TITLE>#1s):
Как говорилось выше, подход с регулярными выражениями имеет свои не-
достатки. В примере 20.4 показано более полное решение, в котором HTML-код
обрабатывается с использованием LWP.
Пример 20.4. htitle
#!/usr/Ы n/perl
# htitle - Получить название HTML-документа из URL
use LWP;
die "usage: $0 url ..An" unless @ARGV;
foreach $url (@ARGV) {
$ua = LWP::UserAgent->new();
$res = $ua->get($url);
print "$url: " If @ARGV > 1;
If ($res->1s_success) {
print $res->t1tle, "\n":
} else {
print $res->status_lIne, "\n";
}
}
Приведем пример вывода:
% htitle http://www.ora.com
www.oreilly.com -- Welcome to O’Reilly & Associates!
% htitle http://www.perl.com/ http://www.perl.com/nullvo1d
http://www.perl.com/: The www.perl.com Home Page
http://www.perl.com/nullvoid: 404 File Not Found
См. также
Документация по модулям CPAN HTML: :TreeBu1 Ider, HTML: :Parser, HTML::Entitles
и LWP: :UserAgent; рецепт 20.5.
20.7. Поиск устаревших ссылок
833
20.7. Поиск устаревших ссылок
Проблема
Требуется узнать, содержит ли документ устаревшие ссылки.
Решение
Воспользуйтесь методикой, описанной в рецепте 20.3, для получения всех ссы-
лок и проверьте их существование функцией head модуля LWP::Simple.
Комментарий
Следующая программа является прикладным примером методики извлечения
ссылок из HTML-доку мента (пример 20.5). На этот раз мы не ограничиваемся
простым выводом ссылок и вызываем для нее функцию head модуля LWP::Simple.
Метод HEAD получает метаданные удаленного документа и определяет его статус,
не загружая самого документа. Если вызов закончился неудачно, значит, ссылка
не работает, и мы выводим соответствующее сообщение.
Поскольку программа использует функцию get из LWP::Simple, она должна
получать URL, а не имя файла. Если вы хотите поддерживать обе возможности,
воспользуйтесь модулем URI::Heuristic (см. рецепт 20.1).
Пример 20.5. churl
#!/usr/Ыn/perl -w
# churl - проверка URL
use HTML::L1nkExtor:
use LWP::Slmple;
$base_url = shift
or die "usage: $0 <start_url>\n";
Sparser = HTML::LInkExtor->new(undef, $base_url):
Shtml = get($base_url):
die "Can't fetch $base_url" unless deflned(Shtml):
$parser->parse($html):
@links = $parser->lInks:
print "$base_url: \n":
foreach Slinkarray (©links) {
my ^element = @$1Inkarray:
my $elt_type = shift ^element:
while (^element) {
my ($attr_name . $attr_value) = spl1ce(@element. 0, 2);
If ($attr_value->scheme =~ /\b(ftp|https?|f11e)\b/) {
print " $attr_value: ", head($attr_value) ? "OK" : "BAD", "\n":
}
}
}
Примерный результат выглядит так:
% churl http://www.w1zards.com
httр://www.wi za rds.com:
Frontpage/FP_Color.gif: OK
834
Глава 20. Автоматизация в Веб
FrontPageZFP_BW.gif: BAD
#FP_Map: OK
Games_Li brary/Wel come.html: OK
Для программы действуют те же ограничения, что и для программы, исполь-
зующей HTML: :L1 nkExtor, из рецепта 20.3.
См. также
Документация по модулям CPAN HTML: :L1 nkExtor, LWP::S1mple, LWP::UserAgent
и HTTP: Response; рецепт 20.8.
20.8. Поиск недавно обновлявшихся ссылок
Проблема
Имеется список URL. Вы хотите узнать, какие из них изменялись позже других.
Допустим, вы хотите отсортировать свой список закладок браузера так, чтобы
недавно обновлявшиеся ссылки находились в его верхней части.
Решение
Программа из примера 20.6 читает URL из стандартного ввода, упорядочивает
их по времени последней модификации и выводит в стандартный вывод с пре-
фиксами времени.
Пример 20.6. surl
#!/usr/Ыn/perl -w
# surl - сортировка URL по времени последней модификации
use strict:
use LWP::UserAgent:
use HTTP::Request:
use URI::URL qw(url):
my Wate:
my Sua = LWP::UserAgent->new():
while ( my Surl = url(scalar <>) ) {
my Sans:
next unless $url->scheme =~ Zx(f1le|https?)$/:
Sans = $ua->head($url);
If ($ans->1s_success) {
$Date{$url} = Sans->last_mod1fled || 0: # unknown
} else {
warn("$url: Error $ans->code, "] ", $ans->message, "!\n");
}
}
foreach my Surl ( sort { $Date{$b} <=> $Date{$a} } keys Wate ) {
printf "V25s %s\n", $Date{$url} ? (scalar localtime $Date{$url})
: "<NONE SPECIFIED>". Surl:
}
20.9. Создание шаблонов HTML
835
Комментарий
Сценарий surl больше похож на традиционную программу-фильтр. Он построчно
читает URL из стандартного ввода (на самом деле данные читаются из <ARGV>,
что по умолчанию совпадает с STDIN при пустом массиве @ARGV). Время послед-
ней модификации каждого URL извлекается с помощью запроса HEAD. Время со-
храняется в хэше, где ключами являются URL. Затем простейшая сортировка
хэша по значению упорядочивает URL по времени. При выводе внутренний
формат времени преобразуется в формат local time.
В следующем примере программа xurl из предыдущего рецепта извлекает спи-
сок URL, после чего выходные данные этой программы передаются на вход surl.
% xurl http://use.perl.org/~gnat/journal | surl | head
Mon Jan 13 22:58:16 2003
Sun Jan 12 19:29:00 2003
Sat Jan 11 20:57:03 2003
Sat Jan 11 09:46:19 2003
Tue Jan 7 20:27:30 2003
Tue Jan 7 20:27:30 2003
Tue Jan 7 20:27:30 2003
Tue Jan 7 20:27:30 2003
Tue Jan 7 20:27:30 2003
Tue Jan 7 20:27:30 2003
http://www.nanowrimo.org/
http://www.cost!k.com/gamespek.htmlhttp://www.cpan.org/ports/i ndex.html
http://Jakarta.apache.org/gump/
http://use.perl.org/images/menu_gox.gi f
http://use.perl.org/images/menu_bgo.gi f
http://use.perl.org/images/menu_gxg.gi f
http://use.perl.org/i mages/menu_ggx.gi f
http://use.perl.org/i mages/menu_gxx.gif
http://use.perl.org/images/menu_gxo.gi f
Маленькие программы, которые выполняют свою узкую задачу и могут объ-
единяться в более мощные конструкции, — верный признак хорошего програм-
мирования. Более того, можно было бы заставить xurl работать с файлами и ор-
ганизовать фактическую выборку содержимого URL в Веб другой программой,
которая бы передавала свои результаты xurl, churl или surl. Вероятно, эту
программу следовало бы назвать gurl, но программа с таким именем уже суще-
ствует: в комплекс модулей LWP входит программа Iwp-request с синонимами
HEAD, GET и POST для выполнения этих операций в сценариях командного интер-
претатора.
См. также
Документация по модулям CPAN LWP: :UserAgent, HTTP::Request и URI: :URL; ре-
цепт 20.7.
20.9. Создание шаблонов HTML
Проблема
Вы хотите сохранить параметризованный шаблон во внешнем файле, прочитать
его в сценарий CGI и подставить собственные переменные вместо заполните-
лей, находящихся в тексте. Это позволяет отделить программу от статических
частей документа.
836
Глава 20. Автоматизация в Веб
Решение
Если вы ограничиваетесь заменой ссылок на переменные, используйте функцию
template:
sub template {
my (Sfllename. Sflllings) =
my Stext:
local $/; # Режим поглощающего ввода (undef)
open(my Sfh. "<". Sfilename) or return:
Stext = <$fh>: # Прочитать весь файл
close(Sfh): # Игнорировать код возврата
# Заменить конструкции %%...%% значениями из хэша Willings
Stext =~ s{ %% ( .*? ) %% }
{ existsC $f1111ngs->{$l} )
? $f1111ngs->{$1}
}gsex:
return Stext:
}
В этом случае используемые данные выглядят так:
<!-- simple.tempi ate для внутренней функции templateO -->
<HTML><HEAD><TITLE>Report for %£username£2S</TITLE></HEAD>
<BODY><Hl>Report for №sernameH</Hl>
Husername^ logged in ИсоипШ times, for a total of HtotalH minutes.
Для расширения полноценных выражений используйте модуль CPAN Text:
Template, если вы можете гарантировать защиту данных от постороннего вмеша-
тельства. Файл данных для Text:: Tempi ate выглядит так:
<!-- fancy, tempi ate for Text:-.Template -->
<HTML><HEAD><TITLE>Report for {Suser}</TITLE></HEAD>
<BODY><Hl>Report for {Suser}</Hl>
{ lcfirst(Suser) } logged in {Scount} times, for a total of
{ 1nt($seconds / 60) } minutes.
Если этого окажется недостаточно, обращайтесь к модулю Template семейства
Template Toolkit, в котором реализованы сценарные средства и обеспечивается
интеграция с mod_perl. Эта тема рассматривается в рецепте 21.17.
Комментарий
Параметризованный вывод в сценариях CGI хорош по многим причинам. Отде-
ление программы от данных дает возможность другим людям (например, ди-
зайнерам) изменять код HTML, не трогая программы. Еще лучше то, что две
программы могут работать с одним шаблоном, поэтому стилевые изменения
шаблона немедленно отразятся на обеих программах.
Предположим, вы сохранили в файле первый шаблон из Решения. Ваша про-
грамма CGI содержит определение функции template (см. выше) и соответствую-
щим образом задает значения переменных Swhats_h1s_name, Slog1n_count и Sm1nute_
used. Шаблон заполняется просто:
^fields = (
username => $whats_his_name.
count => $login_count.
20.9. Создание шаблонов HTML
837
total => $minute_used,
):
print tempiate("/home/httpd/templates/simple.tempi ate", \%f1 el ds):
Файл шаблона содержит ключевые слова, окруженные двойными символами
% (%%КЛЮЧЕВ0Е-СЛОВО%%). Ключевые слова ищутся в хэше Willings, ссылка на ко-
торый передается template во втором аргументе. В примере 20.7 приведен более
близкий к реальности пример, использующий базу данных SQL.
Пример 20.7. userrepl
# !/usr/bin/perl -w
# userrepl - вывод данных о продолжительности работы пользователей
# с применением базы данных SQL
use DBI:
use CGI qw(standard):
# Функция tempiate() определена в Решении (см. выше)
Suser = param("username") or die "No username":
$dbh = DBI->connect("dbi:mysqlconnections:mysql.domain.com:3306".
"connections", "seekritpassword") or die "Couldn't connect\n":
Ssth = $dbh->prepare(«"END_OF_SELECT") or die "Couldn't prepare SQL":
SELECT COUNT(duration).SUM(duration)
FROM logins WHERE username='Suser'
END_OF_SELECT
# Теперь предполагается, что продолжительность задается в секундах,
if (Orow = $sth->fetchrow()) {
(Scount, Sseconds) = Orow:
} else {
(Scount, Sseconds) = (0,0):
}
$sth->finish():
$dbh->disconnect:
print headerO:
print tempiate("report.tpl", {
'username' => Suser,
'count' => $count,
'total' => Stotal
}):
Если вам потребуется более изощренное и гибкое решение, рассмотрите вто-
рой шаблон Решения, основанный на модуле CPAN Text:: Tempi ate. Содержимое
пар фигурных скобок, обнаруженных в файле шаблона, интерпретируется как
код Perl. Как правило, расширение сводится к простой подстановке переменных:
You owe: {$total}
но в фигурных скобках также могут находиться полноценные выражения:
The average was {$count ? (Stotal/Scount) : 0}.
Возможное применение этого шаблона продемонстрировано в примере 20.8.
838
Глава 20. Автоматизация в Веб
Пример 20.8. userrep2
# !/usr/Ыn/perl -w
# userrep2 - вывод данных о продолжительности работы пользователей
# с применением базы данных SQL
use Text::Tempi ate;
use DBI;
use CGI qw(;standard);
$tmpl = "/home/httpd/templates/fancy.tempi ate";
$template = Text::Tempiate->new(-type => "file", -source => $tmpl);
$user = param("username") or die "No username":
$dbh = DBI->connect("dbi:mysql:connect!ons:mysql.domain.com",
"connections", "secret passwd") or die "Couldn't db connect\n";
$sth = $dbh->prepare(«"END_OF_SELECT") or die "Couldn't prepare SQL";
SELECT COUNT(duratlon).SUM(duratlon)
FROM logins WHERE username='$user'
END_OF_SELECT
$sth->execute() or die "Couldn't execute SQL";
If (Orow = $sth->fetchrow_array()) {
($count, $total) = Orow;
} else {
$count = $total = 0;
}
$sth->f1nlsh();
$dbh->d1sconnect;
print headerO;
print $template->f111_1n();
При более широких возможностях этого подхода возникают определенные
проблемы безопасности. Любой, кому разрешена запись в файл шаблона, сможет
вставить в него код, выполняемый вашей программой. В рецепте 8.17 рассказано
о том, как снизить этот риск.
См. также
Документация по модулям CPAN Text; :Tempi ate и Template; рецепт 8.16; рецепт 14.9.
20.10. Зеркальное копирование веб-страниц
Проблема
Вы хотите поддерживать локальную копию веб-страницы.
Решение
Воспользуйтесь функцией mirror модуля LWP::Simple:
use LWP::Simple;
m1rror($URL, $1 oca1_f11 ename);
20.11. Создание робота
839
Комментарий
Несмотря на тесную связь с функцией get, описанной в рецепте 20.1, функция
ml rror не выполняет безусловной загрузки файла. В создаваемый ею запрос GET
включается заголовок If-Modified-Siпсе, чтобы сервер передавал лишь недавно
обновленные файлы.
Функция mi rror копирует только одну страницу, а не целое дерево. Для копи-
рования набора страниц следует использовать ее в сочетании с рецептом 20.3. Хо-
роший вариант зеркального копирования целого удаленного дерева приведен в про-
грамме w3mir, также доступной в архиве CPAN, и в программе wget из ftp.gnu.org.
Будьте осторожны! Можно (и даже просто) написать программу, которая
сходит с ума и начинает перекачивать все веб-страницы подряд. Это не только
дурной тон, но и бесконечный труд, поскольку некоторые страницы генерируют-
ся динамически. Кроме того, у вас могут возникнуть неприятности с теми, кто
не желает, чтобы их страницы загружались еп masse.
См. также
Документация по модулю CPAN LWP:: Simple; спецификация HTTP по адресу
http://www.w3.org/pub/WWW/Protocols/HTTP/.
20.11. Создание робота
Проблема
Требуется написать сценарий, который самостоятельно работает в Веб (то есть
робота). При этом желательно уважать правила работы удаленных узлов.
Решение
Вместо модуля LWP::UserAgent используйте в роботе модуль LWP: :RobotUA:
use LWP::RobotUA;
$ua = LWP::RobotUA->new('websnuff ler/O.Г. 'me@wherever.com');
Комментарий
Чтобы жадные роботы не перегружали серверы, на узлах рекомендуется созда-
вать файл с правилами доступа robots.txt. Если ваш сценарий получает лишь
один документ, ничего страшного, но при получении множества документов с од-
ного сервера вы легко перекроете пропускную способность узла.
Создавая собственные сценарии для работы в Веб, важно помнить о правилах
хорошего тона. Во-первых, не следует слишком часто запрашивать документы
с одного сервера. Во-вторых, соблюдайте правила, описанные в файле robots.txt.
Самый простой выход заключается в создании агентов с применением модуля
LWP::RobotUA вместо LWP::UserAgent. Этот агент автоматически «снижает обороты»
при многократных обращениях к одному серверу. Кроме того, он просматривает
840
Глава 20. Автоматизация в Веб
файл robots.txt каждого узла и проверяет, не пытаетесь ли вы принять файл,
размер которого превышает максимально допустимый. В этом случае возвраща-
ется ответ вида:
403 (Forbidden) Forbidden by robots.txt
Следующий пример файла robots. txt получен программой GET, входящей в ком-
плекс модулей LWP:
% GET http://www.webtechniques.com/robots.txt
User-agent: *
Disallow: /stats
Disallow: /db
Disallow: /logs
Disallow: /store
Disallow: /forms
Disallow: /gifs
Disallow: /wais-src
Disallow: /scripts
Disallow: /config
Более интересный и содержательный пример находится по адресу http://
www.cnn.com/robots.txt. Этот файл настолько велик, что его даже держат под кон-
тролем RCS!
% GET http://www.cnn.com/robots.txt | head
# robots, scram
# $1 d : robots.txt,v 1.2 1998/03/10 18:27:01 mreed Exp $
User-agent: *
Disallow: /
User- agent: Mozi11a/3.01 (hotwi red-test/0.1)
Disallow: /cgi-bin
Disallow: /TRANSCRIPTS
Disallow: /development
См. также
Документация по модулю CPAN LWP:: RobotUA; описание правил хорошего тона
для роботов по адресу http://info.webcrawler.com/mak/projects/robots/robot.html.
20.12. Анализ файла журнала веб-сервера
Проблема
Вы хотите извлечь из файла журнала веб-сервера лишь интересующую вас ин-
формацию.
Решение
Разберите содержимое файла журнала следующим образом:
while (<LOGFILE>) {
my (Scllent, $1 dentuser. $authuser. $date. Stlme. Stz. $method.
20.12. Анализ файла журнала веб-сервера
841
$url, $protocol. $status, $bytes) =
/4\S+) (\S+) (\S+) \[([x:]+): (\d+:\d+:\d+) (Ex\]]+) "(\S+) (.*?) (\S+)"
(\S+) (\S+)$/:
# ...
}
Комментарий
Приведенное выше регулярное выражение разбирает записи формата Common
Log Format — неформального стандарта, которого придерживается большинство
веб-серверов. Значения отдельных полей приводятся в табл. 20.2.
Таблица 20.2. Поля стандарта Common Log Format
Поле Описание
client IP-адрес или имя домена для браузера
identuser Результаты команды IDENT (RFC 1413), если она использовалась
authuser Имя пользователя при аутентификации по схеме «имя/пароль»
date Дата поступления запроса (01/Маг/1997)
time Время поступления запроса (12:55:36)
tz Часовой пояс (-0700)
method Метод запроса: GET, POST, PUT
url Запрашиваемый URL (/~user/index.html)
protocol HTTP/1.0 или HTTP/1.1
status Возвращаемый статус (200 — все в порядке, 500 — ошибка сервера)
bytes Количество возвращаемых байтов (может быть равно для ошибок,
перенаправлений и операций, не сопровождаемых пересылкой документа)
В другие форматы также включаются данные о внешней ссылке и агенте. Це-
ной минимальных изменений можно заставить этот шаблон работать с другим
форматом журнала. Обратите внимание: пробелы в URL не экранируются. Это
означает, что для извлечения URL нельзя использовать конструкцию \S* так
как . * заставит регулярное выражение совпасть с целой строкой, а затем возвра-
щаться до тех пор, пока не будет найдено соответствие для остатка шаблона. Мы
используем .*? и фиксируем шаблон в конце строки с помощью $, чтобы меха-
низм поиска не устанавливал совпадения и последовательно добавлял символы
до тех пор, пока не будет найдено совпадение для всего шаблона.
См. также
Спецификация CLF по адресу http://www.w3.org/Daemon/User/Config/Logging.html.
842
Глава 20. Автоматизация в Веб
20.13. Обработка серверных журналов
Проблема
Требуется обобщить данные в серверном журнале, но у вас нет специальной
программы с возможностью настройки параметров.
Решение
Анализируйте журнал с помощью регулярных выражений или воспользуйтесь
модулями CPAN Logfile.
Комментарий
В примере 20.9 приведен образец генератора отчетов для журнала Apache.
Пример 20.9. sumwww
# !/usr/Ыn/perl -w
# sumwww - обобщение данных об операциях веб-сервера
$lastdate = ;
dailyjogs О;
summary О;
exit;
# Читать файлы CLF и запоминать обращения с хоста и на URL
sub dailyjogs {
while (<>) {
($type, $what) = /"(GET|POST)\s+(\S+?) \S+"/ or next:
($host, undef. undef. $datet1me) = split;
($bytes) = /\s(\d+)\s*$/ or next;
($date) = ($datet1me =~ /\[([A:]*)/):
$posts += ($type eq POST);
$home++ If m. / .:
If ($date ne Slastdate) {
If ($lastdate) { wr1te_report() }
else { $lastdate = $date }
}
$count++;
$hosts{$host}++;
$what{$what}++;
$bytesum += $bytes;
}
write_report() if $count;
}
# Ускорить копирование за счет создания синонимов
# глобальных переменных вида *typeglob
sub summary {
$lastdate = "Grand Total";
*count = *sumcount;
*bytesum = *bytesumsum:
*hosts = *allhosts;
*posts = *allposts;
20.13. Обработка серверных журналов
843
*what = *allwhat;
*home = *а11 home;
write;
}
# Вывести сведения по хостам и URL с применением специального формата
sub write_report {
write;
# Включить в сводные данные
$lastdate = $date:
$sumcount += $count;
$bytesurnsurn += $bytesum:
$allposts += $posts;
$allhome += $home;
# Сбросить данные за день
$posts = $count » $bytesum = $home = 0;
@allwhat{keys $what} = keys £what;
@al1 hosts{keys Ghosts} = keys Ghosts:
Ghosts = £what = ();
}
format STDOUTJOP =
@1111111111 @111111 @1111111 @1111111 @111111 @111111 @1111111111111
"Date". "Hosts". "Accesses". "Unidocs". "POST", "Home". "Bytes"
format STDOUT =
@>»»»»> @>»»> @»»»> @»»»> @>»»> @>»»> @»»»»»»>
$lastdate. scalar(keys Ghosts),
$count, scalar(keys Wiat),
$posts, $home. $bytesum
Пример вывода выглядит так:
Date Hosts Accesses Uni docs POST Home Bytes
19/Мау/2003 353 6447 3074 352 51 16058246
20/Мау/2003 1938 23868 4288 972 350 61879643
21/Мау/2003 1775 27872 6596 1064 376 64613798
22/Мау/2003 1680 21402 4467 735 285 52437374
23/Мау/2003 1128 21260 4944 592 186 55623059
Grand Total 6050 100849 10090 3715 1248 250612120
Модуль CPAN Logfile;;Apache (см. пример 20.10) позволяет написать анало-
гичную, но менее специализированную программу. Этот модуль распространя-
ется вместе с другими модулями Logfile в единой поставке Logfile (на момент
написания книги — Logfile-0.115.tar.gz).
Конструктор new читает файл журнала и строит индексы. В параметре File
передается имя файла, а в параметре Group — индексируемые поля. Возможные зна-
чения — Date (дата), Hour (время получения запроса), File (запрашиваемый файл),
User (имя пользователя, извлеченное из запроса), Host (имя хоста, запросившего
документ) и Domain (Host, преобразованный в строку типа "France", "Germany" и т. д.).
844
Глава 20. Автоматизация в Веб
Пример 20.10. aprept
#!/usr/bin/perl -w
# aprept - отчет по журналам Apache
use Logfile::Apache:
$1 = Logfile::Apache->new(
File =>
Group => [ Domain, File ]):
# STDIN
$1->report(Group => Domain, Sort => Records):
$l->report(Group => File, List => [Bytes.Records]):
Вывод отчета в STDOUT осуществляется методом report. В параметре Group пе-
редается используемый индекс, а также дополнительно — способ сортировки
(Records — по количеству обращений, Bytes — по количеству переданных байтов)
и способ дальнейшей группировки данных (по количеству байтов или количеству
обращений).
Приведем примеры вывода:
Domain
US Commercial 222 38.47*
US Educational 115 19.93*
Network 93 16.12*
Unresolved 54 9.36*
Australia 48 8.32*
Canada 20 3.47*
Mexi co 8 1.39*
United Kingdom 6 1.04*
File Bytes Records
/ 13008 0.89* 6 1.04*
/cgi-bin/MxScreen 11870 0.81* 2 0.35*
/cgi-bin/pickcards 39431 2.70* 48 8.32*
/deckmaster 143793 9.83* 21 3.64*
/deckmaster/admin 54447 3.72* 3 0.52*
См. также
Документация по модулю CPAN Logfile::Apache;perlform(V).
20.14. Работа c cookie
Проблема
Вы хотите загружать веб-страницы, но сервер следит за своими пользователями
при помощи cookie. Например, некоторые сайты сохраняют в cookie информа-
цию о том, что пользователь прошел аутентификацию. Без отправки правильно-
го cookie вы не попадете дальше страницы регистрации.
20.15. Загрузка страниц, защищенных паролем
845
Решение
Поручите работу с cookie модулю LWP::UserAgent. Поддержку cookie можно вклю-
чить только для текущего запуска программы:
$ua->cookiejar({ }):
Кроме того, cookie можно хранить в файле между вызовами:
$ua->cookiejar({ file => "$ENV{HOME}/.cookies" }):
Комментарий
По умолчанию LWP::Agent никогда не посылает заголовок Cookie:, даже когда
сервер предлагает cookie в ответ. Чтобы cookie принимались и отправлялись по
мере необходимости, объекту пользовательского агента следует передать специ-
альный объект HTTP::Cookies, предназначенный для хранения cookie («хранили-
ще cookie» — cookie jar).
Методу cookie jar передается либо объект HTTP:: Cookies, в котором будут хра-
ниться cookie, либо ссылка на хэш, содержимое которого сохраняется в новом
объекте HTTP::Cookies.
Без параметров объект HTTP::Cookies хранит cookie в памяти, поэтому при завер-
шении программы эти объекты становятся недоступными. Параметр file метода
cookie jar определяет имя файла, который используется для инициализации хра-
нилища cookie, сохранения обновленных и новых cookie. Так жизнь cookie про-
длевается за пределы одного запуска программы.
Чтобы запретить использование cookie, вызовите cookie jar без параметров:
$ua->cookiejar();
См. также
Документация по модулям CPAN LWP::UserAgent и HTTP::Cookie.
20.15. Загрузка страниц, защищенных
паролем
Проблема
Требуется использовать LWP для получения веб-страниц или отправки форм,
но веб-сервер требует аутентификации.
Решение
Имя пользователя и пароль для некоторой области аутентификации (realm) за-
дается методом credentials пользовательского агента:
$ua->credentials('http://www.perlcabal.com/cabal_only/',
'Secret Perl Cabal Files'.
'username' => 'password'):
846
Глава 20. Автоматизация в Веб
Комментарий
Чтобы обратиться к странице, защищенной базовыми средствами аутентифика-
ции, браузер должен передать имя пользователя и пароль для соответствующей
области аутентификации. Область аутентификации представляет собой обыч-
ную строку, идентифицирующую имя пользователя и пароль, которые должны
быть предоставлены пользователем. Метод credentials указывает пользователь-
скому агенту отправить имя пользователя и пароль для определенной области
аутентификации.
В другом, халтурном решении имя пользователя и пароль включаются пря-
мо в URL:
http://user:password@www.example.com/prlvate/pages/
Такое решение названо «халтурным», потому что имя пользователя и пароль
не будут кодироваться в ссылках, содержащихся в возвращаемом документе. Ре-
шения, основанные на кодировке аутентификационных данных в URL, быстро
вырождаются и создают массу проблем. В конечном счете обычно выясняется,
что было проще с самого начала использовать credentials.
См. также
Документация по модулю CPAN LWP::UserAgent.
20.16. Загрузка веб-страниц https://
Проблема
Требуется работать с веб-сервером по защищенному каналу (SSL). Допустим,
вы хотите автоматизировать процесс заказа товаров для вашей компании из
электронного магазина, который благоразумно защищает свои транзакции при
помощи SSL.
Решение
Установите Crypt::SSLeay, и LWP автоматически начнет работать с https:-URL.
Переустанавливать LWP при этом не придется.
Комментарий
Отправляя запрос серверу https, LWP проверяет, установлен ли в системе модуль
поддержки SSL. LWP может использовать следующие два модуля (в порядке
предпочтения): Crypt::SSLeay и 10::Socket::SSL. Из этих двух модулей Crypt::SSLeay
обладает более широкими возможностями, но требует наличия библиотек OpenSSL
(http://www.openssl.org).
20.17. Продолжение загрузки по команде HTTP GET
847
См. также
Документация по модулю CPAN Crypt: :SSLeay; файл README.SSL из поставки
llbwww-perl.
20.17. Продолжение загрузки
по команде HTTP GET
Проблема
Имеется часть файла. Требуется продолжить загрузку файла без повторной вы-
борки уже имеющегося содержимого. Предположим, первая попытка загрузки
была прервана, и вы хотите принять оставшуюся часть файла.
Решение
Используйте заголовок HTTP 1.1 Range в запросе GET:
use LWP;
$have = length($file);
$response = $ua->get($URL,
'Range'. "bytes=$have-");
# $response->content содержит остаток файла
Комментарий
Заголовок Range позволяет указать, какие байты файла должна вернуть команда
HTTP GET. Первому байту файла присваивается нулевой индекс, поэтому при
задании интервала bytes=O- производится выборка всего файла.
Также интервалы могут задаваться двумя конечными точками: например, ин-
тервал 0-25 определяет первые 26 байт файла. Также возможна загрузка внут-
ренних интервалов вида 26-99.
Некоторые серверы не поддерживают интервалы, хотя и заявляют о поддерж-
ке HTTP 1.1. В этом случае вместо запрошенного интервала будет отправлен
весь файл. Чтобы обнаружить эту ситуацию, определите размер файла при по-
мощи команды HEAD, а затем загрузите остаток файла командой GET. Если
размер содержимого ответа GET по длине совпадает с размером исходного фай-
ла, значит, интервальный запрос был проигнорирован.
Ниже приведен полный список интервалов, поддерживаемых в специфика-
ции HTTP 1.1.
[start-]- Начиная co start (включительно)
[start-]-[end] От start до end (включительно)
-[num] Последние num байт
[num] Начиная со смещения num
0-0 Первый байт
-1 Последний байт
848
Глава 20. Автоматизация в Веб
Спецификация HTTP также допускает списки интервалов (например, 0-5,10-
15,20-). В результате команда возвращает ответ, состоящий из нескольких частей.
См. также
Документация по LWP; спецификация HTTP по адресу http://www.ietf.org/
rfc/rfc2616.txt
20.18. Разбор кода HTML
Проблема
Требуется извлечь сложную информацию из веб-страницы или набора страниц.
Допустим, вы хотите извлечь тексты статей с сайтов CNN.com или news.bbc.co.uk.
Решение
Используйте регулярные выражения для легко идентифицируемых данных:
# Статьей считаются все символы от <!-- story --> до <!-- /story -->
if ($html =~ m{<!-- story -->(.*?)<!-- /story -->}s) {
my $story = $1:
# ...
} else {
warn "No story found in the page":
}
Для таблиц и данных, которые могут идентифицироваться только сложными
шаблонами HTML, следует использовать модуль лексического разбора:
use HTML::TokeParser:
my Sparser = HTML::TokeParser->new($FILENAME)
or die "Can't open SFILENAME: $!\n":
while (my Stoken = $parser->get token( )) {
my Stype = $token->[0]:
i f (Stype eq 'S') { .
elsif (Stype eq 'E') { .
elsif (Stype eq ’T') { .
elsif (Stype eq 'C) { .
elsif (Stype eq ’D') { .
elsif (Stype eq 'РГ) { .
else { die "Stype isn't a
}
. } # Начальный тег
. } # Конечный тег
. } # Текст
. } # Комментарий
. } # Объявление
. } # Инструкции по обработке
valid HTML token type" }
Комментарий
Регулярные выражения являются удобным средством извлечения информа-
ции из HTML. Тем не менее, с ростом сложности HTML и объемами извлекае-
мых данных сопровождение таких регулярных выражений становится все более
сложной задачей. Для нескольких четко определяемых полей регулярные выра-
20.18. Разбор кода HTML
849
жения подходят хорошо, но для всего остального лучше воспользоваться подхо-
дящим анализатором.
Применение регулярных выражений при обработке HTML будет рассмотре-
но на примере получения списка последних книг издательства O’Reilly. Список
находится по адресу http://www.oreilly.com/catalog/new.html, но на странице так-
же находятся вспомогательные ссылки для перемещения и список предстоящих
изданий, поэтому задача не решается простым извлечением всех ссылок.
Соответствующий код HTML-страницы выглядит примерно так:
<!-- New titles
<h3>New Titles</h3>
<ul><!1><a href="netwinformian/">.NET Windows Forms in a
Nutshel 1 </a> <em>(March)</em></li><li><a href="actscrptpr/">
Actionscript for Flash MX Pocket Reference</a> <em>(March)</em>
</li><1i><a href="abcancer/">After Breast Cancer</a> <em>(March)
<11><a href="samba2/">Using Samba. 2nd Edition</a> <em>(February)
</em></li><1i><a href="vbscriptian2/">VBScript in a Nutshell. 2nd
Edition</a> <em>(March)</em></li><li><a href="tpj2/">Web, Graphics
& Perl/Tk</a> <em>(March)</em></li></ul></td>
<td valign="top">
<!-- Upcoming titles -->
К счастью, поиск оказывается относительно простым. Сначала мы извлекаем
фрагмент кода HTML с названиями новых книг, а затем последовательно выбираем
ссылки на отдельные книги с привязкой регулярного выражения по пунктам списка:
($new_titles) = $html =~ m{<!-- New titles -->(.*?)<!-- Upcoming titles -->}s
or die "Couldn't find new titles HTML":
while (m{<!i> # Элемент списка
<a\ href="
([x\"]+) # Ссылка на книгу = $1 = все до следующей кавычки
\">
([х<]+) # Название книги = $2 = все до </а>
</а>\ <ет>\(
([х)]+) # Месяц = $3 = все в круглых скобках
}дх) {
printf("ft-1010sfts\n", $3. $2): # При желании можно использовать $1
Примерный вывод выглядит так:
March .NET Windows Forms in a Nutshell
March Actionscript for Flash MX Pocket Reference
March After Breast Cancer
February Using Samba. 2nd Edition
March VBScript in a Nutshell, 2nd Edition
March Web, Graphics & Perl/Tk
Однако решать эту задачу при помощи регулярных выражений неудобно, по-
скольку они заставляют вас работать на уровне отдельных символов. Модуль CPAN
HTML: :TokeParser интерпретирует HTML-файл как последовательность конструкций
HTML: начальных тегов, конечных тегов, текста, комментариев и т. д. Сущности
декодируются автоматически, поэтому вам не придется заменять &атр: на & вручную.
850
Глава 20. Автоматизация в Веб
Аргумент конструктора new модуля HTML: :TokeParser содержит имя файла, ма-
нипулятор (или любой объект с методом read) или ссылку на разбираемый текст
HTML:
Sparser = HTML::TokeParser->new("foo.html") or die:
Sparser = HTML::TokeParser->new(*STDIN) or die:
Sparser = HTML::TokeParser->new(\$html) or die;
При каждом вызове get_token для объекта анализатора возвращается ссылка
на массив. В первом элементе массива хранится строка, определяющая тип лек-
семы: начальный тег, конечный тег и т. д. Смысл остальных элементов массива
изменяется в зависимости от его типа. Как правило, программиста интересуют
четыре типа лексем: начальные теги, конечные теги, текст и комментарии.
Для начальных тегов массив содержит еще четыре значения: имя тега (в ниж-
нем регистре), ссылку на хэш атрибутов (ключом является имя атрибута в нижнем
регистре), ссылку на массив с именами атрибутов в порядке их перечисления
в теге и строку с начальным тегом в том виде, в котором он присутствует в теле
документа. Например, при разборе следующего фрагмента HTML:
<IMg SRc="/perl6.jpg" ALT="Steroidal Camel">
создается следующий массив:
[ 'S'.
'img'.
{ "src" => 7perl6.jpg",
"alt" => "Steroidal Camel"
}•
[ "src". "alt" ].
’<IMg SRc="/perl6.jpg" ALT="Steroidal Camel">'
]
Конечные теги обладают меньшими возможностями, чем начальные, поэтому
их лексемы имеют более простую структуру. Для конечного тега в массиве со-
держится строка "Е” (признак конечного тега), имя закрываемого тега в нижнем
регистре (например, “body”) и его вид в источнике (например, ”</BODY>”).
Для текста в массив помещаются три элемента: ”Т" (признак текстовой лексе-
мы), текст и признак декодирования сущностей (декодирование выполняется
только в том случае, если флаг равен false).
use HTML::Entities qw(decode_entities);
if ($token->[0] eq "T") {
Stext = Stoken->[1]:
decode_entities(Stext) unless $token->[2];
# Сделать что-то c Stext
}
С комментариями дело обстоит еще проще: массив содержит только строку ”С”
(признак комментария), за которой следует текст комментария.
См. также
Документация по модулю HTML: :TokeParser; документация по LWP.
20.19. Извлечение табличных данных
851
20.19. Извлечение табличных данных
Проблема
Имеются данные, хранящиеся в виде таблицы HTML. Требуется преобразовать
их в структуру данных Perl. Допустим, вы хотите отслеживать изменения в спи-
ске модулей CPAN для некоторого автора.
Решение
Воспользуйтесь модулем CPAN HTML::TableContentParser:
use HTML::TableContentParser:
$tcp = HTML::TableContentParser->new:
$tables = $tcp->parse($HTML):
foreach Stable (@$tables) {
^headers = map { $_->{data} } @{ $table->{headers} }:
# Атрибуты тега table являются ключами хзша
$table_width = $table->{width};
foreach $row (@{ $tables->{rows} }) {
# Атрибуты тега tr являются ключами хэша
foreach $col (@{ $row->{cols} }) {
# Атрибуты тега td являются ключами хэша
$data = $col->{data};
}
}
}
Комментарий
Модуль HTML::TableContentParser преобразует все таблицы в документе HTML
в структуру данных Perl. Как и в таблицах HTML, структура данных разделяет-
ся на три уровня: собственно таблица, строки и ячейки.
Каждый тег таблицы, строки и ячейки представляется ссылкой на хэш. Ключи
хэша соответствуют атрибутам тега, определяющего таблицу, строку или ячей-
ку. Кроме того, имеется специальный ключ, ассоциированный с содержимым
таблицы, строки или ячейки. В таблице значение ключа rows возвращает ссылку
на массив строк. В строке ключ cols указывает на массив ячеек. В ячейке ключ
data содержит HTML-код тега данных.
Для примера рассмотрим следующую таблицу:
<table width="100r bgcolor="#ffffff">
<tr>
<td>Larry Samp; Gloria</td>
<td>Mountain View</td>
<td>Cal1fornia</td>
</tr>
<tr>
<td><b>Tom</b></td>
<td>Boulder</td>
<td>Colorado</td>
</tr>
852
Глава 20. Автоматизация в Веб
<tr>
<td>Nathan &: Jen1ne</td>
<td>Fort Collins</td>
<td>Colorado</td>
</tr>
</table>
Метод parse возвращает следующую структуру данных:
Е
{
'width' => '100%',
'bgcolor' => '#ffffff',
'rows' => E
{
'cells' => E
{ 'data' => 'Larry & Gloria' }.
{ 'data' => 'Mountain View' },
{ 'data' => 'California' },
L
'data' => "\n
}.
{
'cells' => E
{ 'data' => '<b>Tom</b>' },
{ 'data' => 'Boulder' },
{ 'data' => 'Colorado' },
L
'data' => "\n
b
{
'cells' => E
{ 'data' => 'Nathan &: Jenine' },
{ 'data' => 'Fort Collins' },
{ 'data' => 'Colorado' },
L
'data' => "\n
}
]
}
Данные ячеек по-прежнему содержат внутренние теги и сущности. Если вы
захотите их удалить, сделайте это вручную, используя методику рецепта 20.6.
Пример 20.11 загружает авторскую страницу из CPAN и выводит список мо-
дулей. Она может рассматриваться как часть системы, оповещающей о появле-
нии в CPAN новых продуктов ваших любимых авторов.
Пример 20.11. Вывод модулей CPAN для конкретного автора
# !/usr/bin/perl -w
# dump-cpan-modules-for-author - display modules a CPAN author owns
use LWP::Simple;
use URI:
use HTML::TableContentParser;
use HTML: Entities:
use strict:
our SURL = shift || 'http://search.cpan.org/author/TOMC/':
my Stables = get_tables($URL):
my Smodules = $tables->[4]: # 5th table holds module data
20.20. Программа: htmlsub
853
foreach my $r (@{ $modules->{rows} }) {
my ($module_name, $modul eJink, Sstatus, $description) =
parse_module_row($r, $URL);
print "$module_name <$module_link>\n\t$status\n\t$description\n\n":
}
sub getjables {
my $URL = shift:
my $page = get($URL);
my $tcp = new HTML::TableContentParser;
return $tcp->parse($page);
}
sub parse_module_row {
my ($row, $URL) =
my ($module_html, $moduleJink, $module_name, Sstatus, $description):
# extract cells
$module_html = $row->{cel 1s}CO]{data}: # Ссылка и имя в HTML
Sstatus = $row->{cel1s}Cl]{data}; # Строка статуса и ссылка
Sdescription = $row->{cel1s}С2]{data}: # Только описание
$status =~ s{<.*?>}{ }g: # Наивное удаление ссылки, работает
# только для простейшего кода HTML
# Выделение из HTML ссылки на модуль и имени
($modulejink. $module_name) = $module_html =~ m{href="(.*?)".*?>(.*)<}!:
$modulejink = URI->new_abs($moduleJink, $URL): # resolve relative links
# Удаление тегов и сущностей
decode_entities($module_name):
decode_entities($description):
return ($module_name, $moduleJink, $status. $description):
}
См. также
Документация по модулю CPAN HTML::TableContentParser; http://search.cpan.org.
20.20. Программа: htmlsub
Программа выполняет замену в файлах HTML так, что изменения производят-
ся только в обычном тексте. Например, если у вас имеется файл scooby.html сле-
дующего содержания:
<HTML><HEAD><TITL Е>Н1!</ТITL Е></HEAD>
<BODY><Hl>Welcome to Scooby World!</Hl>
I have <A HREF="pictures.html">pictures</A> of the crazy dog
himself. Here's one!<P>
<IMG SRC="scooby.jpg" ALT="Good doggy!"><P>
<BLINK>He's my hero!</BLINK> I would like to meet him some day,
and get my picture taken with him.<P>
P.S. I am deathly ill. <A HREF=,,shergold.html">Please send
cards</A>.
</BODY></HTML>
то программа htmlsub может заменить каждое вхождение слова «picture » в тек-
сте документа на «photo». Новый документ выводится в STDOUT:
% htmlsub picture photo scooby.html
<HTML><HEAD><TITLE>Hi!</TITLE></HEAD>
<BODY><Hl>Welcome to Scooby World!</Hl>
I have <A HREF="pictures.html">photos</A> of the crazy dog
854
Глава 20. Автоматизация в Веб
himself. Here's one!<P>
<IMG SRC="scooby.jpg" ALT="Good doggy!"><P>
<BLINK>He's my hero!</BLINK> I would like to meet him some day,
and get my photo taken with him.<P>
P.S. I am deathly ill. <A HREF="shergold.html">P1ease send
cards</A>.
</BODY></HTML>
Исходный текст программы приведен в примере 20.12.
Пример 20.12. htmlsub
# !/usr/Ыn/perl -w
# htmlsub - замена в обычном тексте файлов HTML
# Автор - Gisle Aas <gis1e@aas.no>
sub usage { die "Usage: $0 <from> <to> <file>...\n" }
my $from = shift or usage:
my $to = shift or usage;
usage unless @ARGV;
# Субклассировать HTML:Ail ter для выполнения подстановок.
package MyFilter;
use HTML: Ail ter:
?ISA=qw(HTML:Ailter);
use HTML:Anti ties qw(decode_entities encode_entities);
sub text
{
my $self = shift;
my $text = decode_entities($_[0]):
$text =~ s/\Q$from/$to/go: # Самая важная строка
Sself->SUPER::text(encode_entities(Stext)):
}
# Использование класса.
package main;
foreach (@ARGV) {
MyFilter->new->parse_file($_):
}
20.21. Программа: hrefsub
Программа hrefsub выполняет подстановки в HTML-файлах так, что измене-
ния относятся только к тексту в полях тегов HREF <А HREF="... ">. Например,
если в предыдущем примере scooby.html файл shergold.html был переименован
в cards.html, достаточно указать:
% hrefsub shergold.html cards.html scooby.html
<HTML><HEAD><TITLE>Hi!</TITLE></HEAD><BODY>
<Hl>Welcome to Scooby World!</Hl>
I have <A HREF="pictures.html">pictures</A> of the crazy dog
himself. Here's one!<P>
<IMG SRC="scooby.jpg" ALT="Good doggy!"><P>
<BLINK>He's my hero!</BLINK> I would like to meet him some day,
and get my picture taken with him.<P>
P.S. I am deathly ill. <a href="cards.html">P1ease send
cards</A>.
</BODY></HTML>
20.21. Программа: hrefsub
855
На странице руководства HTML::Filter есть раздел BUGS, в котором сказано:
«Комментарии в объявлениях удаляются, а затем вставляются в виде отдельных
комментариев после объявления. При активизации str1ct_comment() комментарии
с внутренними делятся на несколько комментариев».
Данная версия hrefsub при выполнении замены всегда преобразует <а> и име-
на атрибутов в теге в нижний регистр. Если строка $foo содержит несколько
слов, то текст, передаваемый MyFI 1 ter->text, может быть разбит так, что эти сло-
ва разделятся, и подстановка не сработает. Вероятно, в HTML: -.Parser следует пре-
дусмотреть новый параметр, чтобы текст возвращался лишь после чтения всего
сегмента. Кроме того, кое-кто не любит, когда 8-битные символы кодировки
Latin-1 замещаются уродливыми эквивалентами, поэтому hrefsub справляется
и с этой проблемой (пример 20.13).
Пример 20.13. hrefsub
# !/usr/Ыn/perl -w
# hrefsub - замена в тегах <А HREF="..."> кода HTML
# Автор - Джайсл Aac <g1si e@aas.no>
sub usage { die "Usage: $0 <from> <to> <f11e>..An" }
my $from = shift or usage:
my Sto = shift or usage:
usage unless @ARGV:
# Субклассировать HTML::F11ter для выполнения подстановок.
package MyFIIter:
use HTML::Fl Iter;
@ISA=qw(HTML::F11ter);
use HTML:Entitles qw(encode_ent1t1es):
sub start {
my($self, Stag. Sattr. Sattrseq. Sorlg) = @_;
If (Stag eq 'a' && exists Sattr->{href}) {
If ($attr->{href} =~ s/\Q$from/$to/g) {
# must reconstruct the start tag based on Stag and Sattr.
# wish we Instead were told the extent of the 'href' value
# In Sorlg.
my Stmp = "<$tag":
for (@$attrseq) {
my Sencoded = encode_ent1t1es($attr->{$_}):
Stmp .= qq( $_="Sencoded "):
}
Stmp .= ">":
Sself->output(Stmp):
return:
}
}
$self->output($orig);
}
# Использование класса
package main:
foreach (@ARGV) {
MyF11ter->new->parse_f11e($_):
mod_perl
«Скорость хороша только тогда,
когда дорогу указывает мудрость».
Джеймс По
21.0. Введение
Проект modjperl (http://perl .apache.org/) интегрирует Perl с веб-сервером Apache.
Такая интеграция позволяет применять Perl для конфигурации Apache, обработ-
ки запросов, записи данных в журнальные файлы и для других целей.
Как правило, администраторы начинают использовать mod_perl для того,
чтобы избежать снижения эффективности, присущей CGI. При использовании
CGI веб-сервер запускает отдельный процесс для каждого запроса. В большин-
стве операционных систем это весьма дорогостоящая операция, которая требует
многочисленных операций со структурами данных ядра, а также файлового вво-
да/вывода для загрузки двоичного образа нового процесса. При большом ко-
личестве запросов операционная система может не справиться с запросами на
создание новых процессов, в результате чего веб-сервер (а скорее всего, весь
компьютер) перестанет работать.
Интеграция интерпретатора Perl в процесс Apache снимает необходимость
в создании отдельного процесса для построения динамического содержимого.
Модули Apache: Registry и Apache:: Perl Run создают среду CGI в этом встроенном
интерпретаторе Perl (и формируют основу для рецепта 21.12). Это существенно
повышает быстродействие по сравнению с CGI (иногда сообщают о росте быстро-
действия в 10-100 раз). Но чтобы в полной мере использовать все преимущества
от интеграции Perl с Apache, необходимо уметь создавать собственные обработчики.
Обработчики
Доступность Perl на всех стадиях обработки запроса Apache позволяет опреде-
лять фрагменты кода (обработчики) для каждой фазы цикла обработки. Суще-
ствует 13 таких фаз, причем у каждой фазы имеется обработчик по умолчанию
(так что вам не придется самостоятельно программировать обработчики).
Установка обработчика для конкретной фазы состоит из трех действий: вы
пишете код, загружаете его в mod_perl и указываете mod_perl вызвать этот код
в конкретной фазе.
21.0. Введение
857
Обработчики представляют собой обычные процедуры. При вызове в первом
аргументе им передается объект запроса Apache, из которого обработчик может
получить информацию о запросе или изменить ее, занести в журнал сообщения
об ошибках, сгенерировать запрос и т. д. По возвращаемому значению обработ-
чика Apache определяет результат — продолжение текущей фазы с другими об-
работчиками, успешное завершение и переход к другой фазе или завершение те-
кущей фазы с ошибкой. Возвращаемые значения представляют собой константы
из модуля Apache: Constants.
Хотя код обработчика можно разместить в файле httpd.conf, удобнее рабо-
тать с обработчиками, выделенными в отдельный модуль:
# in MyApp/Content.pm
package MyApp::Content:
use Apache:Constants ':common':
sub handler {
my $r = shift: # Получить объект запроса
# ...
return OK: # Например
}
Имя процедуры выбирается произвольно, но mod_perl позволяет удобно
назвать каждую процедуру-обработчик handler и хранить разные обработчики
в разных модулях. Таким образом, модуль MyApp::Content содержит обработчик,
генерирующий содержимое, a MyApp::Logging может содержать обработчик реги-
страции запросов.
Поскольку после обработки очередного запроса интерпретатор Perl продолжа-
ет работу, программирование для mod_perl требует осторожности. Это означает,
что вы должны использовать лексические (ту) переменные вместо глобальных
и закрывать файловые манипуляторы после завершения работы с ними (или
использовать лексические файловые манипуляторы). Незакрытые манипулято-
ры остаются открытыми до следующего выполнения сценария CGI процессом
(когда они открываются заново), а глобальные переменные, которым не было
присвоено значение undef, сохраняют свои значения при следующем выполне-
нии сценария CGI. На странице руководства modjperl_traps из поставки mod_perl
приводится дополнительная информация о других ошибках, часто встречающих-
ся при программировании для mod_perl.
Модуль обработчика загружается директивой Perl Module в файле httpd.conf:
Perl Module MyApp::Content
Директива делает то же, что директива use в сценарии Perl: она загружает
и запускает модуль. После того как код будет загружен, нужно указать Apache
вызывать его.
Установка обработчиков осуществляется следующими директивами httpd.conf:
Perl Chi1dlnitHandler
PerlPostReadRequestHandler
PerlInitHandler
PerlTransHandler
PerlHeaderParserHandler
PerlAccessHandler
858
Глава 21. mod perl
PerlAuthenHandler
PerlAuthzHandler
PerlTypeHandler
PerlFixupHandler
PeriHandler
PerlLogHandler
PerlCleanupHandler
Perl Chj1dExitHandler
PerlDispatchHandler
PerlRestartHandler
Фазы обработки запроса Apache
Чтобы понять, на какие фазы делится транзакция «запрос/ответ», необходимо
кое-что знать о том, как работает Apache и к каким последствиям приводит выбор
различных вариантов его конфигурации. Apache поддерживает пул серверных
процессов (потомков) для параллельной обработки запросов. Фазы Childlnit
и PerlChildExit представляют соответственно начало и конец работы потомка.
Обработчик Per 1 PostReadRequestHandl er вызывается сразу же после получения
Apache запроса от клиента. Apache извлекает URL и виртуальное имя хоста, но еще
не пытается определить, какому файлу соответствует запрос. Следовательно, этот
обработчик не может устанавливаться из файла .htaccess или секций <Location>,
<D1rectory> и <F11 es> (или их разновидностей с Match) файла httpd.conf.
В фазе трансляции (TransHandler) происходит декодирование входящего за-
проса и определение файла, соответствующего URL. На этой стадии организует-
ся обработка псевдонимов и перенаправление. После того как Apache будет знать
запрашиваемый URL и файл, он может проверить секции <Location>, <D1rectory>
и <F11 es> файла httpd.conf и начать поиски файлов .htaccess. Обработчик транс-
ляции устанавливается директивой Perl TransHandler.
Название фазы разбора заголовков (HeaderParserHandler) выбрано неудачно,
поскольку к этому моменту заголовки уже разобраны и сохранены в объекте за-
проса. Эта фаза позволяет выполнить некие действия на основании заголовков,
когда вы уже знаете файл, к которому относится URL. Заголовки также можно
проанализировать в фазе PostReadRequestHandler, однако файл в этой фазе еще
не известен. Фаза PostReadRequestHandler относится к уровню сервера, тогда
как фаза HeaderParserHandler может относиться к уровню локации, файла или
каталога. Это первая фаза цикла обработки запроса, на которой обработчик мо-
жет устанавливаться из любой части файла httpd.conf или .htaccess.
Обработчик Perl InitHandler является синонимом для «первого доступного
обработчика». В секциях <Locat1 on>, <Directory> и <Fi 1 es> файла httpd.conf и в фай-
ле .htaccess это обработчик PerlHeaderParserHandler, а в остальных местах —
PerlPostReadRequestHandler.
Далее следуют фазы аутентификации (AuthenHandler) и авторизации (Authz-
Handler). Обработчик PerlAccessHandl er позволяет ограничить доступ без указания
имени пользователя и пароля. Фаза аутентификации извлекает имя пользовате-
ля и пароль из запроса и проверяет действительность этих данных. Фаза автори-
зации определяет, разрешен ли пользователю доступ к запрашиваемому ресурсу.
В Apache аутентификация отделена от авторизации, что позволяет использовать
общую базу данных пользователей для разных областей веб-сайта, но предостав-
21.0. Введение
859
лять к ним разные уровни доступа. Написание обработчиков фаз аутентификации
и авторизации рассматривается в рецепте 21.1. Большинство администраторов
ограничивается базовой аутентификацией, при которой пароль просто шифру-
ется как часть заголовка запроса. Если вам потребуется более надежная схема
аутентификации, воспользуйтесь хэшированием (которое трудно реализовать
так, чтобы оно работало во всех браузерах) или просто зашифруйте весь запрос
с использованием https-URL защищенного сервера.
После того, как Apache установит, что клиенту разрешен доступ к запраши-
ваемому документу, наступает фаза определения типа (TypeHandler). В этой фазе
Apache проверяет файлы httpd.conf и .htaccess и выясняет, не задан ли для за-
прашиваемого файла конкретный тип содержимого. Если такой тип не задан, он
определяется по имени файла и соответствующему списку типов MIME. Установ-
ка обработчика PerlTypeHandler позволит определять собственные типы содержимого.
Затем Apache дает возможность внести завершающие изменения в запрос
в обработчике Perl Fi xupHandl er. Эта возможность используется в рецепте 21.10
для вставки части URL, удаленной ранее в обработчике PerlHeaderParserHandler.
В следующей фазе генерируется содержимое ответа. Это настолько распро-
страненное применение modjperl, что директива установки обработчика называ-
ется просто Perl Handler. После генерации содержимого начинается фаза регист-
рации (LogHandler), в которой обычно в журнал записывается информация об
обращении. Конечно, вы можете написать собственный код регистрации собы-
тия, заменяющий или дополняющий стандартный код Apache (например, сохра-
нить информацию в базе данных). Эта тема рассматривается в рецепте 21.9.
Фаза регистрации происходит перед закрытием клиентского подключения.
Вы также можете установить обработчик, выполняемый после отправки ответа,
директивой Per 1 Cl eanupHandl er. Поскольку медленный обработчик регистрации
оставляет открытое подключение (а следовательно — и ожидающего потомка),
в modjperl долгие операции регистрации (например, связанные с большим объ-
емом ввода/вывода) обычно выполняются в фазе зачистки. Случаи, в которых фаза
зачистки применяется действительно для деинициализации, встречаются редко.
На этом завершается основная последовательность фаз и обработчиков. На-
ряду с ними можно устанавливать и другие обработчики. Так, не используемый
в этой главе обработчик Perl Di spatchHandl er определяет альтернативный механизм
регистрации обработчиков для каждой фазы, а обработчик Perl Restarthandler по-
зволяет выполнять код при каждом перезапуске сервера Apache.
В самом начале работы с modjperl труднее всего понять, как же в нем выпол-
няется то, что вы уже умеете делать в CGI.pm. Кроме того, в «чистом» modjperl
довольно неудобно работать с cookie и параметрами форм, поэтому мы обсудим
эти вроде бы тривиальные темы в рецептах 21.2 и 21.3.
Дополнительная документация
В CPAN представлены многочисленные модули для modjperl, и мы всегда исполь-
зуем их, если предоставится такая возможность. Программисты обычно исполь-
зуют существующие модули до тех пор, пока не столкнутся с некоторыми огра-
ничениями, после чего расширяют или заменяют эти модули. Модули modjperl
принято снабжать префиксом Apache::, а их полный список можно получить по
адресу http://search.cpan.оrg/mod1ist/World_Wide_Web/Apache.
860
Глава 21. mod perl
Разумеется, поставка mod_perl содержит комплект документации. За инфор-
мацией о директивах обращайтесь к странице руководства mod_perl{\.}, а за ин-
формацией о методах объекта запроса Apache — к странице Apache(l). Прежде
чем приступать к переводу сценариев CGI на mod_perl, внимательно изучите
страницу modjperl_traps{\.). Если найти нужную информацию в документации
не удастся, список рассылки mod_perl поможет вам получить ответы на вопросы
и быть в курсе последних событий мира modjperl. За информацией о том, как
подписаться на список рассылки, обращайтесь по адресу http://apache.perl .org.
mod_perl 2
Когда эта книга готовилась к печати, разработчики вносили последние измене-
ния в modjperl 2.0, существенно измененную версию modjperl для Apache 2.0.
Различия между версиями 1.0 и 2.0 слишком многочисленны, чтобы перечис-
лять их здесь; прежде всего они относятся к конфигурационным директивам
и классам Perl. Модуль Apache: :compat эмулирует API обработчиков 1.0, но за
эмуляцию приходится расплачиваться (как и при эмуляции CGI с использова-
нием Apache: Registry). Оптимальное быстродействие и гибкость достигаются
модификацией модулей и переходом на API 2.0.
Одним из самых серьезных изменений в версии 2.0 стала поддержка много-
поточности. Теперь в системе могут параллельно работать не только несколько
процессов Apache, но и несколько программных потоков внутри каждого процес-
са. Многопоточность упрощает решение некоторых задач, а иногда и повышает
эффективность. Тем не менее в многопоточной модели труднее программировать
(а программировать правильно еще труднее).
За дополнительной информацией о modjperl 2.0 обращайтесь по адресу http://
perl.apache.org/docs/2.О/.
21.1. Аутентификация
Проблема
Требуется проверить имя пользователя и пароль, предоставленные для аутенти-
фикации.
Решение
Получите пароль в форме $r->get_basic_auth_pw, а имя пользователя — $г->
connect!on->user. Признаком успешной аутентификации является возврат кода 0К,
а признаком неудачи — вызов $r->note_basic_auth_failure и возврат кода AUTH_
REQUIRED.
package Your: Authentication::Package;
use Apache:Constants ':common';
sub handler {
my $r = shift:
21.1. Аутентификация
861
return OK unless $r->1s_main; # Пропускается для подзапросов
my ($res, $sent_pw) = $r->get_basic_auth_pw;
if (Sres != OK) {
$r->note_basi c_auth_fai1ure;
return Sres;
}
my Suser = $r->user;
# Проверить имя и пароль, установить Stalled при несоответствии
if (Stalled) {
$r->note_basi c_auth_fai1ure:
return AUTH_REQUIRED;
}
return OK;
}
Установка обработчика для каталога или набора файлов происходит так:
# Область
AuthName "Holiday Photos"
# Не изменяйте следующую строку!
AuthType Basic
PerlAuthenHandler Your:Authentication::Package
require valid-user
Комментарий
«Областью аутентификации» (realm) называется строка, отображаемая в брау-
зере при запросе имени пользователя и пароля. Например, если установить об-
ласть аутентификации «Holiday Photos», то пользователю будет предложено
«ввести имя и пароль для Holiday Photos». Для вызова обработчика аутентифи-
кации должна присутствовать как минимум одна директива require.
При вызове $r->get_basic_auth_pw Apache обрабатывает все данные аутентифика-
ции, переданные клиентом. Следовательно, вызов $r->user не может предшество-
вать вызову $r->get_basic_auth_pw (точнее, может, но вы ничего не получите в ответ).
Вызов $r->get_basic_auth_pw возвращает два значения: код статуса и пароль.
Если код статуса равен ОК, значит, браузер согласился выполнить аутентификацию
и предоставил информацию. При статусе DECLINED либо область не защищена меха-
низмом базовой аутентификации, либо в файле httpd.conf отсутствует директива
AuthType. При статусе SERVER_ERROR область аутентификации не определена, а при
статусе AUTH_REQUIRED браузер исказил или не предоставил данные базовой аутенти-
фикации. Если вы решите вернуть AUTH_REQUIRED, сначала вызовите $r->note_basic_
auth_failure, чтобы Apache отправил браузеру сведения об области аутентификации.
Код статуса, полученный при вызове $r->get_basic_auth_pw, сообщает, спосо-
бен ли браузер выполнить аутентификацию для данного запроса. Если браузер
не передает аутентификационные данные, следует отказать ему в доступе. Для
этого сохраните информацию о неудачной аутентификации и верните код AUTH_
REQUIRED, полученный от $r->get_basic_auth_pw.
Мы вызываем $r->is_main, чтобы узнать, происходит ли обработка основного
запроса. Apache часто выдает подзапросы, для которых нет смысла выполнять
862
Глава 21. mod perl
(теоретически медленную) процедуру аутентификации. Это не приведет к сниже-
нию уровня безопасности, так как в случае неудачи аутентификации для основно-
го запроса обработчик, генерирующий содержимое, не выполняется. Тем самым
предотвращаются хлопотные ситуации типа рекурсии или многократных попы-
ток разбора данных POST.
См. также
Документация Apache.pm.
21.2. Установка cookie
Проблема
Требуется передать cookie клиенту как часть ответа.
Решение
Воспользуйтесь модулем CPAN Apache::Cookie. Создайте новый элемент cookie
в основном обработчике содержимого и присоедините его к исходящим заголовкам:
use Apache::Cookie:
Scookle = Apache::Cookie->new($r,
-name => "cookie name".
-value => "Its value".
-expires => "+ld" ):
$cook1e->bake:
He забудьте отправить заголовки перед тем, как генерировать содержимое:
$r->send_http_header;
$r->pr1nt("..."):
Комментарий
Модуль Apache::Cookie создает строку, представляющую cookie. Срок действия
cookie задается в одном из следующих форматов:
+30s 30 секунд вперед
+10т 10 минут вперед
+lh 1 час вперед
-Id 1 час назад
now В настоящий момент
+ЗМ Три месяца вперед
+10у 10 лет вперед
Thursday, 25-Apr-1999 00:30:31 GMT До заданного момента
21.3. Получение значений cookie
863
Завершив настройку параметров cookie, вызовите метод bake. В результате
cookie в своем текущем состоянии включается в запланированный ответ mod_
perl. Изменения объекта cookie после вызова bake не отразятся в заголовке,
отправленном mod_perl.
Apache поддерживает два набора заголовков: заголовки ошибок (которые, как
ни странно, отправляются всегда, даже если код ответа не указывает на ошибку)
и обычные заголовки (отправляются только для успешных ответов). Apache::Cookie
устанавливает cookie в заголовках ошибок, поэтому информация будет переда-
ваться даже для ответов с перенаправлением.
Модуль CGI::Cookie представляет собой более медленную Рег1-реализацию
с идентичным интерфейсом. Он используется только в тех случаях, когда модуль
XS Apache::Cookie недоступен. Для этого замените Apache::Cookie на CGI::Cookie
во всем коде и удалите объект запроса из вызова new. Кроме того, вместо вызова
bake необходимо использовать конструкцию:
$r->err_headers_out->add("Set-Cook1e". $cookie->as_string):
Мы используем err_headers_out вместо err_header_out, поскольку первый метод,
в отличие от второго, позволяет передать несколько значений для заголовка.
Иначе говоря, err_headers_out позволяет постепенно строить заголовок, допол-
няя его существующее значение перед отправкой, как это могло бы потребовать-
ся при независимой установке трех cookie. Метод err_header_out всегда заменяет
существующие данные, не дополняя их.
См. также
Документация по модулям CPAN CGI::Cookie и Apache::Cookie; спецификация
cookie Netscape по адресу http://wp.netscape.com/newsref/std/cook1e_spec.html; до-
кументация Apache.pm.
21.3. Получение значений cookie
Проблема
Требуется проанализировать данные, переданные клиентом в cookie.
Решение
Воспользуйтесь модулем CPAN Apache::Cookie и заполните хэш объектов cookie
по заголовку, переданному клиентом:
use Apache: -.Cookie:
$ас = Apache::Cook1e->new($r):
%all_cook1es = $ac->parse():
После этого каждый элемент хэша представляет собой объект с описанием
одного cookie:
$one_cook1e = $all_cook1es{C00KIE_NAME}:
864
Глава 21. mod perl
Вызывая методы этого объекта, вы получаете значение cookie:
$one_cookie->value() $one_cookie->name()
$one_cookie->domai n() $one_cooki e->path()
$one_cookie->expires() $one_cookie->secure()
Комментарий
Чтобы проверить, отправил ли браузер cookie, вызовите exists для элемента хэша:
unless (exists $all_cookies{chocolate}) {
$r->header_out(Location => "http://www.site.com/login"):
return REDIRECT:
}
He ограничивайтесь простой проверкой истинности:
unless ($all_cookies{chocolate}) { # НЕВЕРНО
Пустая строка и 0 считаются допустимыми значениями cookie, тогда как с точ-
ки зрения Perl оба эти значения ложны. За дополнительной информацией обра-
щайтесь к Введению главы 1.
Модуль CGI::Cookie представляет собой заменитель Apache::Cookie. Его стра-
тегия получения хэша несколько отличается от стратегии, использованной
в Apache::Cookie:
use CGI::Cookie:
%all_cookies = CGI::Cookie->fetch:
Дальнейшие операции с хэшем выполняются так же, как и с Apache::Cookie.
См. также
Рецепт 20.14; документация Apache.pm; документация по модулям CPAN CGI::Cookie
и Apache: -.Cookie.
21.4. Перенаправление браузера
Проблема
Требуется вернуть браузеру команду на перенаправление.
Решение
Воспользуйтесь методом $r->header_out для задания заголовка Location и верни-
те REDIRECT:
$r->header_out(Location => "http://www.example.com/somewhere"):
return REDIRECT:
Комментарий
Если задать заголовок Location и вернуть REDIRECT, клиент получит адрес новой
страницы. Такой способ называется внешним перенаправлением, потому что запрос
21.5. Чтение информации из заголовков
865
новой страницы поручается браузеру (внешнему с точки зрения веб-сервера).
URL может быть только полным (с http и всем остальным), но не частичным.
При внутреннем перенаправлении Apache возвращает другую страницу с того
же сайта. Браузер вообще не узнает о том, что ему была возвращена другая стра-
ница, что может привести к нарушению работы относительных URL. Запрос на
внутреннее перенаправление выглядит так:
$r->internal_redirect($new_partial_url):
return OK:
Apache обрабатывает внутренние перенаправления практически так же, как
если бы они были новыми запросами. Каждая фаза цикла запроса повторяется для
нового запроса. В отличие от внешнего перенаправления с заголовками Location,
internal_redirect принимает только частичные URL. После вызова internal-
redi rect программа не должна делать ничего, кроме возврата ОК.
См. также
Рецепт 19.7; документация Apache.pm.
21.5. Чтение информации из заголовков
Проблема
Требуется узнать значение заголовка, переданного клиентом.
Решение
Используйте метод $r->header_in:
$value = $r->header_in("Header-name”):
Комментарий
Предположим, вы хотите узнать, какой язык предпочитает клиент (информация
передается в заголовке Accept-Language):
if ($r->header_in("Accept-Language") !~ /\ben-US\b/i) {
$r->pr1nt("No furriners!"):
return OK:
}
Если потребуется получить более одного заголовка, воспользуйтесь методом
$r->headers_in, который возвращает список пар «ключ/значение» для заголовков
запросов всех клиентов. Обычно этот список присваивается хэшу:
= $r->headers_in;
if ($h{"Accept-Language"} !~ /\ben-US\b/i) {
$r->print("No furriners!"):
return OK:
866
Глава 21. mod perl
См. также
Документация Apache.pm.
21.6. Работа с параметрами форм
Проблема
Требуется получить значения полей формы, введенные клиентом.
Решение
Для обращения к параметрам форм, переданным методом POST, используется
конструкция $r->content, а для обращения к параметрам GET, закодированным
в URL, — конструкция $r->args:
$post_parameters = $r->content;
$get_parameters = $r->args;
$r->content может вызываться только один раз для каждого запроса, потому что
первый вызов поглощает все отправленные данные.
Модуль CPAN Apache::Request предоставляет в ваше распоряжение метод $г->
param для обращения к параметрам форм независимо от способа их передачи
(GET или POST):
use Apache::Request:
sub handler {
my $r = Apache::Request->1nstance(shift):
my @param_names = $r->param;
my Svalue = $r->param("username"): # Одно значение
my Ovalues = $r->param("toppings"): # Несколько значений
# ...
}
Комментарий
Без применения Apache::Request при обработке параметров форм возникают труд-
ности с многократно повторяющимися значениями. Например, список SELECT
с включенным режимом множественного выделения (MULTIPLE) посылает повто-
ряющиеся элементы с одним именем параметра. При сохранении в хэше будет
записан только один из этих элементов. Модуль Apache::Request решает эту про-
блему посредством накопления таких элементов в массиве.
Проблемы также могут возникнуть с параметрами форм, переданными обработ-
чику методом POST. Apache устроен так, что после чтения таких данных одним
обработчиком другой обработчик уже не сможет вернуться к ним и прочитать ту
же информацию. Следовательно, если вы собираетесь обрабатывать параметры
21.7. Получение отправленных файлов
867
форм, переданные методом POST, лучше хранить декодированные параметры
на тот случай, если другой обработчик захочет обратиться к ним. Конструктор
Instance решает эту задачу за вас. Когда конструктор Instance вызывается в двух
обработчиках, второй обработчик получает объект Apache::Request, заполненный
первым обработчиком, с уже декодированными параметрами формы.
Интерфейс Apache::Request $r->param основан на интерфейсе разбора парамет-
ров модуля CGI.
См. также
Документация Apache.pm; документация по модулю Apache::Request; рецепт 20.2.
21.7. Получение отправленных файлов
Проблема
Требуется организовать обработку принятых файлов в mod_perl. Например, при-
ложение может загрузить в галерею принятые графические изображения.
Решение
Используйте методы $r->upload и $r->param модуля Apache::Request внутри обра-
ботчика (предполагается, что поле отправки файла называлось f 11 eParam):
use Apache::Request:
my $TEN_MEG = 10 * 2 ** 20: #10 Мбайт
sub handler {
my Sr = Apache::Request->new(shift.
DISABLE_UPLOADS => 0.
POST_MAX => $TEN_MEG):
$r->parse:
my $uploaded_file = Sr->upload(”f11eParam"):
my Sfilename = Suploaded_f11e->f11ename: # Имя файла
my Sfh = Suploaded_f11e->fh: # Манипулятор
my Sslze = Suploaded_f11e->size: # Размер в байтах
my Sinfo = $uploaded_file->info: # Заголовки
my Stype = Suploaded_f11e->type: # Тип содержимого
my Stempname # ... = $uploaded_file->tempname: # Временное имя
Комментарий
По умолчанию Apache::Request не обрабатывает данные переданных файлов. Это
объясняется тем, что файл приходится читать в память, которая может быть не
возвращена операционной системе после завершения запроса. Разрешая отправку
файлов (присваиванием DISABLEJJPLOADS => 0), необходимо ограничить макси-
868
Глава 21. mod perl
мальный размер принимаемых файлов. Тем самым вы помешаете злоумышлен-
нику-хакеру передать бесконечный поток данных и заполнить всю свободную
память вашей системы. Максимальный размер определяется параметром POST_MAX
и задается в байтах (10 Мбайт в приведенном Решении).
Метод $r->upl oad обрабатывает данные файла, отправленные методом POST,
и возвращает объект Apache::Upload. В следующей таблице перечислены методы
объекта, предназначенные для работы с информацией переданного файла.
Метод Возвращает
fh Манипулятор, из которого читаются полученные данные
filename Имя файла, предоставленное клиентом
info Объект Apache:-.Table с заголовками HTTP, отправленными клиентом
name Имя поля формы, с которого был отправлен файл
size Размер переданного файла в байтах
tempname Временное имя файла Apache::Request
type Тип содержимого переданного файла, указанный клиентом
Метод $r->upload может вызываться только один раз для каждого запроса,
поскольку первый же вызов поглощает все передаваемые данные. Иногда не-
сколько обработчиков должны работать с одним файлом, но координация их
действий вызывает трудности (то есть один обработчик должен прочитать файл
и сохранить его имя в другом месте, доступном для других обработчиков). В этом
случае каждый обработчик получает объект запроса методом $r->1nstance моду-
ля Apache::Request вместо того, чтобы извлекать его из списка аргументов:
use Apache::Request:
# ...
sub handler {
my $r = Apache::Request->1nstanceCshift.
DISABLE_UPLOADS => 0.
POST_MAX => 10 * 2**20):
# ...
}
См. также
Документация Apache.pm.
21.8. Ускорение операций с базой данных
Проблема
Вы используете модуль DBI в обработчике mod_perl, но подключение к серверу
базы данных для каждого запроса приводит к недопустимому замедлению веб-
приложения.
21.8. Ускорение операций с базой данных
869
Решение
Чтобы организовать прозрачное кэширование подключений к базе данных, за-
грузите модуль Apache::DBI раньше модуля DBI:
use Apache::DBI:
use DBI:
Комментарий
Многие сайты загружают модуль Apache::DBI из файла httpd.conf, чтобы он заве-
домо загружался раньше всех остальных модулей:
PerlModulе Apache::DBI
Модуль Apache::DBI перехватывает вызовы метода DBI->connect и возвращает
ранее открытый манипулятор, если его параметры подключения совпадают с па-
раметрами текущего запроса. Кроме того, он не позволяет $dbh->disconnect за-
крывать подключения. Это позволяет включить Apache::DBI в начало существую-
щей программы, не изменяя остального кода.
Модуль Apache::DBI использует открытое подключение к базе данных для всех
обращений во всех процессах-потомках Apache. Возможно, вам придется изме-
нить конфигурацию сервера базы данных и увеличить максимальное допусти-
мое количество подключений. В коммерческих СУБД даже может возникнуть
необходимость в приобретении дополнительных клиентских лицензий.
Из-за продления жизненного цикла подключений могут возникнуть ситуации,
в которых Apache::DBI не является оптимальным выбором. Например, если каж-
дый пользователь сайта при подключении к базе данных регистрируется заново,
то количество одновременных подключений будет равно количеству активных
пользователей, умноженному на количество работающих процессов httpd; эта
величина может превысить ту, которая поддерживается вашим сервером! Если
в системе параллельно работают большое количество потомков Apache, они так-
же могут открыть больше одновременных подключений к базе данных, чем под-
держивает ваш сервер.
Стратегия оптимизации доступа к базе данных строится на группировке запро-
сов. Например, если база данных используется для ведения журнала, данные стоит
накапливать и обновлять базу данных лишь после каждых 5 или 10 обращений.
Другая стратегия основана на кэшировании клиентской информации. Напри-
мер, если вы используете базу данных для отображения идентификаторов пользо-
вателей на их реальные имена, и это соответствие остается неизменным, создай-
те в обработчике хэш и храните в нем имена для идентификаторов, которые уже
встречались в прошлом. Тем самым предотвращается повторный поиск информа-
ции, оставшейся неизменной. Чтобы хэш не занимал слишком много памяти, вос-
пользуйтесь модулем CPAN Tie::Cache::LRU или реализуйте другую форму удале-
ния самых старых элементов при достижении хэшем заданного порогового размера.
См. также
Документация по модулям CPAN Apache::DBI и Tie::Cache::LRU; документация
Apache.pm.
870
Глава 21. mod perl
21.9. Настройка ведения журналов Apache
Проблема
Требуется изменить информацию, сохраняемую Apache в журналах запросов.
Допустим, вы хотите создать базу данных с URL и количеством обращений или
вести журналы на уровне отдельных пользователей.
Решение
Установите обработчик директивой Perl LogHandl er:
Perl Module Apache::MyLogger
PerlLogHandler Apache::MyLogger
В обработчике методы объекта запроса возвращают информацию об обрабо-
танном запросе. В следующем фрагменте $г — объект запроса, а $с — объект под-
ключения, полученный от $r->connect1on:
$r->the_request
$r->ur1
$r->header_1n("User-Agent”)
$r->header_1n("Referer")
$r->bytes_sent
$c->get_remote_host
$r->status_11ne
$r->server hostname
GET /roast/chlckens.html HTTP/1.1
/roast/chlckens.html
Mozl1la-XXX
http: //gargl e. com/?search=h0U20chi xOrz
1648
208.201.239.56
200 OK
www.myserver.com
Комментарий
Apache вызывает обработчики регистрации после отправки ответа клиенту. Об-
работчик получает доступ ко всем параметрам запросов и ответов — IP-адресу
клиента, заголовкам, статусу и даже содержимому. Для получения этой инфор-
мации следует вызвать методы объекта запроса.
Вероятно, перед записью значений в текстовый файл следует экранировать
некоторые символы, поскольку пробелы, переводы строк, кавычки и апострофы
могут нарушить форматирование файлов. В этом вам могут пригодиться следую-
щие две функции:
# Возвращает строку с экранированными переводами строк и кавычками
sub escape {
my $а = shift:
$а =~ s/([\n\"])/spr1ntf("$n02x". ord($l))/ge:
return $a:
# Возвращает строку с экранированными переводами строк.
# пробелами и кавычками
sub escape_plus {
my $а = shift:
$а =~ s/(L\n \"])/spr1ntf("TO02x”, ord($l))/ge:
return $a:
21.10. Прозрачное хранение данных в URL
871
В CPAN имеются два готовых модуля для ведения регистрационных журналов:
Apache::Traffic и Apache::DBILogger. Модуль Apache::Traffic позволяет назначать
пользовательские строки (имена пользователей, идентификаторы или просто про-
извольные строки) каталогам веб-сервера в httpd.conf. Модуль Apache::Traffic
заполняет базу данных DBM по мере того, как Apache предоставляет файлы из
этих каталогов. Для каждого пользователя в базу данных заносятся ежеднев-
ное количество обращений и объем данных в байтах, переданных при этих об-
ращениях.
В модуле Apache: :DBILogger используется более общий интерфейс — каждое
обращение регистрируется в новой записи таблицы. Таблица содержит такие
поля, как виртуальный хост, IP-адрес клиента, пользовательский агент (браузер),
дата, количество переданных байтов и т. д. Используя эту таблицу с соответст-
вующими индексами и запросами, можно получить ответы на практически любые
вопросы по трафику вашего сайта.
Поскольку обработчик регистрации выполняется перед тем, как Apache за-
кроет подключение к клиенту, не используйте его для выполнения медленных
операций. Вместо этого установите обработчик директивой Perl Cl eanupHandl er,
чтобы он выполнялся после закрытия подключения.
См. также
Документация по модулям CPAN Apache::Traffic и Apache: :DBILogger; докумен-
тация Apache.pm.
21.10. Прозрачное хранение данных в URL
Проблема
Требуется сохранить данные (например, идентификатор сеанса) в URL, но вы
не хотите разбираться в том, как обойти лишние данные при конструировании
относительных URL.
Решение
Сохраните идентификатор в начале URL:
http://www.example.com/ID/12345678/path/to/page
Извлеките его в обработчике PerlTransHandler и сохраните его в р-заметке
(pnote) — элементе хэша, доступном для других обработчиков Perl в этом запросе:
sub trans {
my $r = shift;
my $ur1 = $r->ur1():
If ($ur1 =~ s{/ID/(\d{8})}{ }) {
$r->pnotes("ID". $1);
}
$r->ur1($ur1):
return DECLINED:
}
872
Глава 21. mod perl
Восстановите URL в Perl Fl xupHandl er:
sub fixup {
my Sr = shift:
my Sid = $r->pnotes("ID"):
if (Sid) {
Sr->uri("/ID/Sid" . Sr->uri):
}
return DECLINED:
Получите значение идентификатора в обработчике содержимого:
use Apache::URI:
sub content {
my Sr = shift:
my Sid = Sr->pnotes("ID"):
unless (Sid) {
join((", map { int rand 10 } (1..8)):
my Suri = Apache::URI->parse(Sr):
Suri->path("ID/$id" . Suri->path):
$r->header_out(Location => Suri->unparse):
return REDIRECT:
}
# Использовать Sid
return OK:
Комментарий
Клиент считает, что ваши страницы имеют URL вида http://www.example.com/ID/
12345678/path/to/page. html. Ваш обработчик Perl TransHandler перехватывает входя-
щий запрос и удаляет /ID/12345678 до того, как Apache попытается преобразовать
запрос в местонахождение файла. Непосредственно перед выполнением обработ-
чика, генерирующего содержимое, Perl Fi xupHandl er снова вставляет идентификатор.
Наши обработчики Per 1 TransHandl er и Perl Fi xupHandl er возвращают DECLINED,
чтобы указать на необходимость выполнения всех остальных установленных об-
работчиков трансляции или завершающих исправлений. Если бы мы вернули ОК
из Perl TransHandler, то Apache не вызвал бы последующие обработчики трансля-
ции. В обработчиках Perl FixupHandler оба кода, DECLINED и ОК, означают, что ис-
правление прошло успешно и что также должны быть выполнены другие обра-
ботчики завершающих исправлений.
Приведенное решение не учитывает код HTML, сгенерированный обработчи-
ком, оно лишь сохраняет идентификатор в относительных ссылках. Если в коде
HTML будут использоваться абсолютные ссылки (HREF="/elsewhere/"), то иден-
тификатор будет потерян, и вам придется устанавливать его заново.
См. также
Рецепт 21.11.
21.12. Переход с CGI на mod perl
873
21.11. Взаимодействие между
mod_perl и PHP
Проблема
Требуется использовать при построении сайта как mod_perl, так и РНР. Напри-
мер, mod_perl будет использоваться для аутентификации и ведения журналов,
а РНР будет генерировать реальное содержимое. Однако такой подход означает,
что Perl и РНР должны использовать общий доступ к данным (например, чтобы
обработчик содержимого РНР знал, какие имена пользователя успешно прошли
аутентификацию в mod_perl).
Решение
Воспользуйтесь заметками (notes) Apache. В Perl это выглядит так:
Smaln = $r->main || $г:
$main->notes($KEY => SVALUE);
SVALUE = Smaln->notes(SKEY);
В PHP используется следующая запись:
apache_note($KEY, SVALUE);
SVALUE = apache_note(SKEY);
Комментарий
Заметкой называется строковое значение, присоединенное к запросу Apache. Это
идеальный механизм обмена информацией между обработчиками, даже напи-
санными на разных языках программирования. С каждым запросом связывается
собственный набор заметок, поэтому всегда идентифицируйте основной запрос
в Perl и используйте его для взаимодействия с кодом РНР.
Не путайте метод $r->notes с $r->pnotes. Последний метод доступен только
для модулей Perl.
См. также
Рецепт 21.10.
21.12. Переход с CGI на mod_perl
Проблема
Ваш сценарий CGI вызывается так часто, что это приводит к недопустимому
снижению быстродействия веб-сервера. Вы хотите использовать mod_perl, что-
бы ускорить его работу.
874
Глава 21. mod perl
Решение
Воспользуйтесь модулем Apache: Registry или Apache:: Perl Run:
Perl Module Apache::Registry
# or Apache::Perl Run
Perl Module CGI
PerlSendHeader On
Alias /perl/ /real/path/to/perl/scripts/
<Location /perl>
SetHandler perl-script
Perl Handl er Apache: Registry
# или Apache::Perl Run
Options ExecCGI
</Location>
Комментарий
Приведенное Решение сообщает Apache, что запросы с URL, начинающимися
с /perl/, относятся к /real/path/to/perl/scripts/ и выполняются модулем Apache:
Registry в среде CGI. Директива Perl Module CGI производит предварительную
загрузку модуля CGI, а директива PerlSendHeader On обеспечивает работу боль-
шинства сценариев CGI в mod_perL
После этой настройки /perl/ начинает работать аналогично /cgi-bin/. Чтобы
суффикс .perl интерпретировался как признак сценария CGI mod_perl (подоб-
но тому, как суффикс .cgi считается признаком обычных сценариев CGI), вклю-
чите следующий фрагмент в конфигурационный файл Apache:
<Files *.perl>
SetHand1 er perl-script
Perl Handl er Apache::Registry
Options ExecCGI
</Fi1es>
Поскольку интерпретатор Perl, выполняющий сценарий CGI, не завершает
работу при завершении сценария, как при его выполнении веб-сервером в виде
отдельной программы, вы не можете рассчитывать на то, что глобальные пере-
менные будут иметь неопределенные значения при повторных запусках. Дирек-
тивы warnings и strict выявляют многие распространенные ошибки в сценариях
такого рода. Впрочем, существуют и другие проблемы — обращайтесь к страни-
це руководства mod_perl_traps.
Обработчик Apache:: Perl Run способен обойти некоторые из этих ошибок. Он
похож на Apache: Registry, но в отличие от него, не кэширует откомпилированный
модуль. Если ваша программа CGI работает медленно, но обходится без инициа-
лизации переменных или закрытия манипуляторов, можно добиться некоторого
выигрыша по скорости, если отказаться от запуска нового процесса для каждого
запроса. Для этого следует заменить Apache: Registry на Apache: :Run.
Предварительная загрузка сценариев не выполняется, поэтому каждый процесс
веб-сервера работает с собственной копией. Чтобы организовать совместное ис-
пользование кода процессами, загрузите их на стадии конфигурации Apache при
помощи модуля Apache: :RegistryLoader, секций PerlModule файла httpd.conf или
файла startup.pl.
21.13. Передача информации между обработчиками
875
См. также
Документация Apache.pm; документация по модулям CPAN Bundle::Apache, Apache:
Registry, Apache: :RegistryLoader и Apache:: Perl Run; http://perl .apache.org; mod_perl
FAQ по адресу http://perl .apache.org/faq/; страницы руководства mod_perl(3)
и cgi_to_mod_perl{\} (если есть).
21.13. Передача информации
между обработчиками
Проблема
Требуется организовать совместное использование информации между обработ-
чиками, но глобальные переменные являются глобальными по отношению к про-
цессу и не уничтожаются автоматически после каждого запроса.
Решение
Воспользуйтесь р-заметками (Perl-заметками) Apache:
# В одном обработчике
Sr->pnotes("Name". Sname):
# В другом обработчике
Sname = Sr->pnotes("Name"):
Комментарий
Модули Apache взаимодействуют друг с другом при помощи заметок (см. ре-
цепт 21.11). Заметки Apache представляют собой своего рода хэш, связанный
с запросом, — один обработчик сохраняет в хэше значение с некоторым ключом,
по которому другой обработчик позднее это значение читает. Р<ег1>-заметки
(pnotes) также реализованы в виде хэша, связанного с объектом запроса, но они
доступны только для обработчиков Perl.
Чтобы задать значение р-заметки, передайте ключ и значение методу $r->pnotes.
Чтобы прочитать заметку, передайте только ключ. В р-заметках могут храниться
сложные структуры данных:
$r->pnotes("Person", { Name => "Nat".
Age => 30.
Kids => 2 }):
# Позднее
Sperson = Sr->pnotes("Person");
и даже объекты:
Sperson = new Person:
Sperson->name("Nat"):
Sperson->age(30);
876
Глава 21. mod perl
$person->k1ds(2):
$r->pnotes(Person => Sperson);
# later
Sperson = $r->pnotes("Person");
# Sperson - ссылка на тот же объект
См. также
Документация по модулю Apache::Table; описание метода pnote в документации
Apache.
21.14. Повторная загрузка
измененных модулей
Проблема
Вы обновили модули mod_perl, но чтобы изменения вступили в силу, необходи-
мо перезагрузить веб-сервер.
Решение
Используйте модуль Apache:: Stat INC (стандартный для mod_perl) для автомати-
ческой перезагрузки любого кода, изменяемого на диске:
PerlModule Apache::StatINC
PerlInitHandler Apache::Stat INC
Или воспользуйтесь методом CPAN Apache::Reload, если предпочитаете огра-
ничить отслеживание конкретными модулями:
PerlModule Apache::Reload
PerlInitHandler Apache::Reload
PerlSetVar ReloadAl1 Off
PerlSetVar ReloadModules "Example::0ne Example::Two Example::Three"
Комментарий
Модуль Apache:: Reload поддерживает функциональность Apache:: Stat INC. Простой
фрагмент
PerlModule Apache::Reload
Perl InitHandler Apache:-.Reload
фактически делает то же, что и Apache:: Stat INC. А именно: в начале обработки каж-
дого запроса Apache::Reload просматривает все модули, загруженные в настоящий
момент, и по временным пометкам находит измененные модули. Поскольку про-
верка каждого модуля при каждом запросе требует существенных затрат ресур-
сов, Apache::Reload также позволяет выбрать модули для проверки и перезагрузки.
21.15. Хронометраж приложений mod perl
877
См. также
Документация по модулям Apache::StatINC и Apache::Reload; руководство по mod —
perl http://perl.apache.org/guide.
21.15. Хронометраж приложений mod_perl
Проблема
Вы нашли способ ускорить работу приложения, но не уверены в том, что он
действительно работает.
Решение
Измерьте время выполнения обработчика содержимого при помощи модуля
Apache::Timeit:
PeriModule Apache::TImeit
PerlFixupHandler Apache::Timelt
Чтобы получить более подробную информацию, используйте модуль CPAN
Apache::DBProf:
Perl Module Apache::DProf
Комментарий
Модуль Apache: :Timeit доступен по адресу http://perl .apache.org/dist/contrib/
Ti melt .pm.
Этот модуль записывает в журнал ошибок время выполнения обработчика
содержимого. Анализ журнала с усреднением полученных чисел позволит узнать,
какие страницы генерируются дольше других. Далее следует подумать, почему
это происходит.
Чтобы провести углубленное профилирование кода и узнать, какие части об-
работчика содержимого занимают больше всего времени, можно воспользоваться
модулем Apache::DBProf. Этот модуль объединяет стандартный (для версии 5.8)
модуль Devel:: DProf с Apache и mod__perl.
Профайлер записывает время, затраченное на выполнение каждой процеду-
ры в процессе выполнения модуля Perl. Хронометражные данные записываются
в файл dprof/^^/tmon.out (где $$ — идентификатор процесса-потомка Apache)
каталога ServerRoot. В этом файле накапливаются данные обо всех процедурах
Perl, вызывавшихся на протяжении жизненного цикла процесса-потомка Apache.
Чтобы профилировать отдельный запрос, включите директиву MaxRequestsPerChi 1 d
в файл httpd.conf:
MaxRequestsPerChi Id 1
Вы должны сами создать этот каталог и задать права доступа к нему:
cd $APACHE_SERVER_ROOT
mkdir logs/dprof
chmod 777 logs/dprof
878
Глава 21. mod perl
Выходные данные анализируются программой dprofpp:
dprofpp -г dprof/13169/tmon.out
Total Elapsed Time = 89.93962 Seconds
Real Time = 89.93962 Seconds
Exclusive Times
Hime ExclSec CumulS #Cal1s sec/call Csec/c Name
0.01 0.010 0.010 1 0.0100 0.0100 Apache::Reload::handler
0.00 0.000 -0.000 1 0.0000 - Apache::DProf::handler
0.00 0.000 -0.000 1 0.0000 - MP002::trans
0.00 0.000 -0.000 1 0.0000 - MP002::fixup
0.00 0.000 -0.000 1 0.0000 - MP002::content
С ключом -г программа dprofpp выводит реальные затраты времени вместо
затрат процессорного времени, выводимых по умолчанию. Это различие сущест-
венно для приложений mod_perl, в которых ввод/вывод и другие задачи, не свя-
занные с особой загрузкой процессора, часто приводят к субъективно восприни-
маемым задержкам.
У программы dprofpp имеются многочисленные ключи, управляющие уточнени-
ем и обработкой хронометражных данных. Например, ключ -R выводит отдельные
хронометражные данные по каждой анонимной процедуре в пакете, вместо того,
чтобы группировать их; ключ -1 сортирует вывод по количеству вызовов (а не по
времени выполнения). Полный список ключей приведен в документации dprofpp.
См. также
Документация по модулю CPAN Apache::DProf; документация по стандартному
модулю Devel::DProf; страница руководства dprofpp(\).
21.16. Построение шаблонов
с использованием HTML::Mason
Проблема
Требуется отделить в вашей программе представление (форматирование HTML)
от логики (кода Perl). Веб-сайт содержит множество незначительно различаю-
щихся компонентов. Вы хотите выделить общие элементы и генерировать стра-
ницы с использованием шаблонов, обходясь без многочисленных проверок типа
«если я нахожусь на этой странице, вывести то; иначе, если я нахожусь на дру-
гой странице...» в одном основном шаблоне.
Решение
Воспользуйтесь компонентами и наследованием модуля HTML::Mason.
Комментарий
Модуль HTML::Mason (также называемый просто Mason) позволяет использовать
мощные возможности Perl в шаблонах. Базовой единицей веб-сайта, построен-
21.16. Построение шаблонов с использованием HTML::Mason
879
ного с применением Mason, является компонент — файл, генерирующий выход-
ные данные. Этот файл может содержать код HTML, Perl или их комбинацию.
Компоненты могут получать аргументы и выполнять произвольный код Perl.
Mason обладает многочисленными возможностями, описание которых можно
найти по адресу http://masonhq.com и http://masonbook.com.
Mason одинаково хорошо работает с CGI, mod_perl и обычными программами,
никак не связанными с Веб. Однако в контексте данного рецепта будет рассмот-
рено его применение с mod_perl. Приведенные примеры дают представление
о том, что можно сделать с помощью Mason и как происходит построение сайтов.
Конфигурация
Установите поставку HTML::Mason из архива CPAN и включите следующий фраг-
мент в файл httpd.conf:
PerlModule HTML::Mason::ApacheHandler
<Location /mason>
SetHandler perl-script
Perl Handl er HTML::Mason::ApacheHandler
DefaultType text/html
</Location>
Тем самым вы сообщаете mod_perl, что каждый URL, начинающийся с /mason,
будет обрабатываться Mason. Таким образом, при запросе /mason/hello.html файл
mason/hello.html в каталоге документов компилируется и выполняется как компо-
нент Mason. Директива DefaultType позволяет опускать расширение .html в име-
нах компонентов.
Затем создайте каталог, в котором Mason будет хранить откомпилированные
компоненты. Это делается для ускорения работы приложения:
cd $SERVER_ROOT
mkdir mason
Далее создается каталог mason для компонентов:
cd $DOCUMENT_ROOT
mkdir mason
Теперь все готово для выполнения классического примера «Hello, World».
Включите следующую команду в файл mason/hel 1 о:
Hello, <£ ("World", "Puny Human")[rand 2] %>
Запустите Apache и загрузите страницу mason, hell о. При перезагрузке будут
случайным образом чередоваться надписи «Hello, World» и «Hello, Puny Human».
Если этого не произойдет, обратитесь к списку FAQ (http://www.masonhq.com/docs/
faq/), в котором описаны наиболее распространенные проблемы.
Базовый синтаксис Mason
В компонентах Mason встречаются четыре типа новой разметки: подстановки,
код Perl, вызовы компонентов и блочные теги. Пример замены уже встречался
в примере «Hello, World»: конструкция <%...%> интерпретирует содержимое как
код Perl и подставляет результат в окружающий текст.
880
Глава 21. mod perl
Код Perl помечается знаком % в начале строки:
% $now = local time: # Встроенный код Perl
This page was generated on <% $now %>.
Поскольку в подстановках может использоваться практически любой код
Perl, то же самое можно записать проще:
This page was generated on <% scalar local time %>.
Если сохранить любую из этих версий в файле footer.mas, его можно вклю-
чить в компонент простой командой
<& footer.mas &>
Перед вами пример вызова компонента — Mason выполняет компонент и встав-
ляет результат в документ, из которого поступил вызов.
Блочные теги определяют различные части компонента. Так, конструкция
<^perl>...</^perl> определяет код Perl. Если % в начале строки указывает, что
только эта строка содержит код Perl, блоки <%perl > могут содержать произволь-
ное количество строк.
Блок <%лnit>...</^1 nit> напоминает блок INIT в Perl. Этот блок выполняется до
входа в основной код программы. В нем можно хранить определения, выполнять
инициализацию, подключаться к базам данных и т. д. из компонентов, в стороне
от основной логики программы.
Блок <#args>...<Aargs> позволяет определять аргументы для компонентов, а так-
же задавать им значения по умолчанию (хотя это необязательно). Для примера
рассмотрим файл greet.mas:
<£args>
$name => "Larry"
$town => "Mountain View"
</£args>
Hello, <£ $name £>. How's life in <£ $town £>?
Его вызов в виде
<& greet.mas &>
выводит следующий результат:
Hello, Larry. How's life in Mountain View?
Компоненты также могут вызываться с параметрами:
<& greet.mas, name => "Nat", town => "Fort Collins" &>
Результат:
Hello, Nat. How's life in Fort Collins?
Благодаря наличию значений по умолчанию можно задать лишь часть аргу-
ментов:
<& greet.mas, name => "Bob" &>
Результат:
Hello, Bob. How's life in Mountain View?
21.16. Построение шаблонов с использованием HTML::Mason
881
Аргументы также используются компонентами Mason для обращения к пара-
метрам форм. Рассмотрим следующую форму:
<form action="compliment">
How old are you? <input type="text" name="age"> <br />
<input type="submit">
</form>
Компонент, получающий введенное значение, выглядит так:
<£args>
$age
</£args>
Hi. Are you really <% $age %>? You don't look it!
Объекты
Во всех компонентах Mason доступна переменная $m, содержащая объект
HTML::Mason::Request. Методы этого объекта открывают доступ к различным воз-
можностям Mason. Например, можно произвести перенаправление:
$m->redirect($URL):
Переменная $г содержит объект запроса mod_perl, поэтому в обработчиках
Mason доступна вся информация и все функции Apache. Например, можно по-
лучить IP-адрес клиента:
$1р = $r->connection->remote_ip:
Автоматические обработчики
При запросе страницы Mason способен на большее, нежели простое выполнение
кода этой страницы. Mason просматривает все каталоги между корневым ката-
логом компонента и запрашиваемой страницей и ищет в них компоненты, кото-
рые называются автоматическими обработчиками. Так формируется цепочка,
начинающаяся с автоматического обработчика верхнего уровня и заканчиваю-
щаяся запрашиваемой страницей. Затем Mason выполняет код в начале цепоч-
ки. В каждом автоматическом обработчике можно потребовать: «Включить в это
место выходные данные следующего компонента в цепочке».
Представьте себе сайт некой газеты. Некоторые части сайта остаются неиз-
менными независимо от того, какую статью вы просматриваете в настоящий мо-
мент: начальный баннер, случайную подборку рекламы или список разделов на
левой панели. Тем не менее текст статей, естественно, изменяется. В Mason для
этого создается структура каталогов вида:
/sports
/sports/autohandler
/sports/storyl
/sports/story2
/sports/story3
Файлы статей содержат только текст самой статьи. Автоматический обработ-
чик строит страницу (баннер, рекламу, панель навигации), а когда потребуется
вставить содержимое статьи, в него просто включается вызов
% $m->call_next:
882
Глава 21. mod perl
Тем самым вы приказываете Mason вызвать следующий компонент в цепочке
(то есть получить текст статьи) и вставить его в текущую позицию.
Методика построения цепочек компонентов называется наследованием. Авто-
матические обработчики являются не единственным механизмом его реализации.
Например, следующая команда назначает родителя для компонента:
<К 1 ags>
inherit = 'parent.mas'
</K1ags>
Это позволяет хранить разные типы содержимого в одном каталоге так, что-
бы каждый компонент смог идентифицировать вмещающую страницу (то есть
своего родителя).
См. также
http://www.masonhq.com и http://masonbook.com.
21.17. Построение шаблонов
с использованием Template Toolkit
Проблема
Требуется отделить в вашей программе представление (форматирование HTML)
от логики (кода Perl). Предполагается, что шаблоны будут редактироваться веб-
дизайнерами и другими людьми, не владеющими Perl.
Решение
Воспользуйтесь Template Toolkit и модулем Apache: Template.
Комментарий
Template Toolkit (ТТ2) — обобщенная система построения шаблонов, которая
может использоваться не только для веб-страниц, но и для любых шаблонных
конструкций. Модуль Apache: Template представляет собой обработчик содер-
жимого Apache, использующий ТТ2 для построения возвращаемой страницы.
Главным преимуществом ТТ2 является наличие простого языка с переменны-
ми, циклами и структурами данных, который может использоваться вместо Perl
для логики представления. С этим простым языком могут работать даже люди,
не знающие Perl.
В настоящем рецепте описывается 2 Template Toolkit версии 2. Как и в случае
с HTML::Mason, пакет ТТ2 обладает широкими возможностями, которые невозмож-
но описать на нескольких страницах. Данный рецепт всего лишь дает начальное
представление о синтаксисе и функциональных возможностях ТТ 2. Хорошее
описание Template Toolkit имеется на сайте http://www.template-toolkit.org.
21.17. Построение шаблонов с использованием Template Toolkit
883
Конфигурация
Установите модули CPAN Template и Apache: template. Включите следующий
фрагмент в файл httpd.conf:
PerlModule Apache: template
TT2EvalPerl On
TT2Params all
TT2IncludePath /usr/local/apache/htdocs/tt2
<Location /tt2>
SetHandler perl-script
Perl Handl er Apache:template
DefaultType text/html
</Location>
Директива TT2EvalPerl позволяет использовать в шаблонах код Perl наряду
с языком ТТ2. Директива TT2Params указывает Apache: template предоставить
шаблонам доступ к параметрам форм, переменным окружения Apache, заметкам,
cookie и т. д. Директива TT2IncludePath указывает Template Toolkit, где искать
шаблоны, включаемые внутрь других шаблонов. Наконец, область /tt2 сервера
отводится для страниц, сгенерированных Template Toolkit.
Синтаксис
Шаблоны представляют собой обычные файлы HTML с директивами, заключен-
ными в теги [1.1]. Ограничители тегов можно изменить, но на практике это дела-
ется редко. Применение квадратных скобок вместо угловых означает, что шаблоны
можно изменять в редакторах HTML, не опасаясь, что директива будет перепу-
тана с тегом HTML.
Рассмотрим простой шаблон:
<b>This is how you count to three:</b>
[% FOREACH i = [1 .. 3] %]
[KH] ...
[% END %]
Wasn't that easy?
При выполнении этого шаблона ТТ2 выдает следующий результат:
<b>This is how you count to three:</b> 1 ... 2 ... 3 ... Wasn't that easy?
Сохраните приведенный фрагмент в файле tt2/count и введите эквивалент-
ный URL в браузере.
Цикл FOREACH является примером директивы ТТ2. Переменная 1 — счетчик
цикла, которая при каждой итерации принимает очередное значение из списка
справа от =. Циклы, как и все блоки ТТ2, завершаются директивой END. Перемен-
ные ТТ2 не имеют признаков типа (таких, как $, О и %).
Чтобы вывести значение переменной или выражения, просто заключите их в
теги [1.1]. Однако при этом не может быть использован код Perl — допускается
только синтаксис ТТ2.
884
Глава 21. mod perl
Код Perl
Для выполнения кода Perl используется директива PERL:
[% PERL %]
my ^numbers = (1 .. 3);
print join(" ... ". ^numbers);
[% END %]
Все данные, выводимые в блоке PERL, становятся частью завершающего доку-
мента. При выполнении блоков PERL действует директива use strict, поэтому
в них рекомендуется использовать лексические переменные.
Эти лексические переменные отличны от таких переменных ТТ2, как счетчик
цикла 1 из предыдущего примера. Чтобы переменная Perl стала доступна в коде
ТТ2 или наоборот, необходимо использовать накопитель (stash) — таблицу сим-
волических имен ТТ2. Обращение к накопителю производится через перемен-
ную Sstash, которая автоматически поддерживается в блоках PERL:
[% PERL %]
my ^numbers = (1 .. 3):
my Stext = join(" ... ". ^numbers);
$stash->set(counting => Stext):
[% END %]
Обычно код Perl используется для бизнес-логики (например, выборки зна-
чений из базы данных), а код ТТ2 — для логики представления (например, по-
строения таблиц). Код Perl присваивает переменным ТТ2 значения, получен-
ные в результате выполнения бизнес-логики (скажем, данные, прочитанные
из базы), поэтому логика представления располагает данными для занесения
в шаблон. На практике большинство администраторов предпочитает отключать
TT2Evel Perl, запрещая использование кода Perl в шаблонах. Столь жесткое отде-
ление бизнес-логики от логики представления означает, что для загрузки кода
Perl и помещения данных в накопитель необходима специализированная версия
Apache: template.
Переменные ТТ2 также могут инициализироваться в коде ТТ2:
[X text = "1 ... 2 ... 3" %] <!-- строка -->
names = [ "Larry", "Tom". "Tim" ] %] <!-- массив -->
[X language = { Larry => "Perl 6", Tom => "Perl 5". Tim => "Latin" } %] <!-- хэш -->
people = { Larry => { Language => "Perl 6". <!-- вложенная структура
Town => "Mountain Tom => { Language => "Perl 5". View" }.
Town => "Boulder" }}«
Аналогично происходит чтение данных ТТ2 из накопителя:
[% FOREACH i = [1 .. 3] Я]
[% PERL %]
my Snumber = $stash->get("i"):
$stash->set(doubled => 2*$number):
END %]
21.17. Построение шаблонов с использованием Template Toolkit
885
[X doubled X] ...
[X END X]
2 ... 4 ... 6 ...
В блоках PERL даже возможно использование модулей директивой use. Тем не
менее эффективнее загружать модули при запуске Apache, заменив директиву
use Some::Thing в блоке PERL директивой Perl Module Some: :Thing в файле httpd.conf.
Структуры данных
Через накопитель вы можете экспортировать скаляры, массивы, хэши и даже
процедуры в код ТТ2. Например, определение массива и последующее обраще-
ние к нему выглядит так:
[X names = [ "Nat", "Jenine", "William", "Raley" ] X]
The first person is [X names.О X].
The first person is Nat.
Имя структуры отделяется от поля точкой (.). Такой синтаксис поддержива-
ется для хэшей:
[% age = { Nat => 30, Jenine =>36, William => 3, Raley => 1.5 } X]
Nat is [X age.Nat X] (and he feels it!)
Nat is 30 (and feels it!)
В отличие от Perl, в коде ТТ2 индекс массива или ключ хэша, по которому
производится обращение, не заключается в [] или {}. Отчасти это объясняется
стремлением упростить код ТТ2, чтобы с ним могли легко работать даже непро-
фессиональные программисты. Кроме того, этот синтаксис помогает скрыть реа-
лизацию — конструкция age. 1 может быть легко реализована с использованием
массива, хэша или объекта без изменений в шаблоне.
Если индекс хранится в другой переменной, используйте префикс $:
[X age = { Nat => 30, Jenine => 36, William => 3, Raley => 1.5 } %]
[X name = "Nat" X]
Nat is [X age.$name X] (and he feels it)
Nat is 30 (and feels it!)
Перебор в массивах и хэшах осуществляется конструкцией FOREACH:
[X FOREACH name = names X]
Hi, [% name %]!
EX END X]
Hi, Nat! Hi, Jenine! Hi, William! Hi, Raley!
[X FOREACH person = age X]
[X person.key X] = EX person.value X].
EX END X]
Nat is 30. Jenine is 36. William is 3. Raley is 1.5.
Методы key и value, вызываемые для переменной цикла, возвращают текущий
ключ и значение соответственно. В циклах ТТ2 также доступна переменная 1 оор,
из которой можно узнать текущую позицию, определить, является ли она первой
или последней, и т. д. В табл. 21.1 приведены краткие описания методов пере-
менной loop.
886
Глава 21. mod perl
Таблица 21.1. Методы переменной loop
Метод Описание
size Количество элементов в списке
max Индекс последнего элемента (size-1)
index Индекс текущей итерации от 0 до max
count Счетчик итераций от 1 до size (то есть index+1)
first True, если текущая итерация является первой
last True, если текущая итерация является последней
prev Возвращает предыдущий элемент списка
next Возвращает следующий элемент списка
Например, таблица с чередующимися цветами строк создается так:
[Я folks = [ [ "Larry". "Mountain View" ].
[ "Tom". "Boulder" ].
[ "Jarkko". "Helsinki" ].
[ "Nat". "Fort Collins" ] ] S]
<table> [% FOREACH row = folks
<tr [% IF loop.index % 2 Я]
bgcolor="#ffffOO"
[% ELSE %]
bgcolor="#ffff80"
[% END %] >
[% FOREACH col = row %]
<td>L& col %]</td>
[% END %]
</tr>
[% END %]
</table>
Процедуры
Если вам вдруг потребуется строить большое количество похожих таблиц, этот
код следует выделить в процедуры. В синтаксисе ТТ2 процедуры оформляются
в виде блоков. Ниже приведен простой блок без параметров:
[% BLOCK greet %]
Hello, world!
END %]
Блок вызывается директивой INCLUDE:
[Я INCLUDE greet %]
Обобщенная процедура построения таблиц HTML записывается примерно так:
[% BLOCK table %]
<table>
[% FOREACH row = array %]
<tr [% IF loop.index % 2 %]
bgcolor="#ffffOO"
[% ELSE %]
bgcolor="#ffff80"
21.17. Построение шаблонов с использованием Template Toolkit
887
[% END %] >
[% FOREACH col = row %]
<td>C% col £J</td>
[% END
</tr>
[% END %]
</table>
END %]
Пример вызова этой процедуры с выводом содержимого массива folks:
[% INCLUDE table array=folks %]
Включение других шаблонов
Синтаксис вызова блока, определенного в том же шаблоне, может использовать-
ся для загрузки и выполнения другого файла:
[% INCLUDE "header.tt2" Я]
Включаемый файл интерпретируется как шаблон ТТ2. Если он не содержит
директивы ТТ2, вставка быстрее выполняется директивой INSERT:
[% INSERT "header.html" %]
Файлы, вставленные директивой INSERT, не обрабатываются ТТ2. Их содер-
жимое просто передается без обработки в генерируемый документ.
Параметры
Модуль Apache: template предоставляет в ваше распоряжение несколько пере-
менных ТТ2, представляющих разные части веб-окружения. В табл. 21.2 приве-
дены краткие описания этих переменных.
Таблица 21.2. Переменные Template Toolkit, поддерживаемые модулем Apache: :Template
Переменная Содержимое
uri Строка c URI текущей страницы
env Хэш переменных окружения
params Хэш параметров формы
pnotes Хэш р-заметок запроса Apache
cookies Хэш cookie
uploads Массив объектов Apache::Upload
Форма:
<form action="consult">
Whose city do you want to look up?
<select name="person">
<option value="larry">Larry</option>
<option value=,,tom">Tom</option>
<option value="nat">Nat</opt1on>
</select><p>
<1nput type="submit">
</form>
888
Глава 21. mod perl
Параметр формы person содержит выбранное имя. Шаблон consult выглядит так:
[% cities = { larry => "Mountain View",
tom => "Boulder",
nat => "Fort Collins" } %]
[% name = params.person %]
[% name %] lives In [% cities.$name %]
Подключаемые модули
В поставку Template Toolkit входит много подключаемых модулей (plug-ins).
Вероятно, самым полезным из них является модуль DBI:
[% USE DBI('dbi:mysql:library', 'user', ’pass') %]
[% FOREACH book = DBI.query( 'SELECT title,authors FROM books' )
[% book.authors %] wrote [% book.title £]<br>
[% END %]
После загрузки этого модуля директивой USE переменная ТТ2 DBI может ис-
пользоваться для создания запросов SQL. Метод query возвращает массив хэшей,
связывающих имена полей со значениями.
Также может пригодиться подключаемый модуль HTML, методы которого
предназначены для экранирования строк по правилам HTML:
[% USE HTML %]
[Я string = 'Over -> Here' %]
Look [% HTML.escape(strlng) %]
Look Over...> Here
См. также
Документация по модулям CPAN Template и Apache: -.Template; http://vw. termpl ate-
toolk1t.org.
XML
«...Я — малый мир; и во мне свились
Четыре стихии и ангельский дух».
Джон Донн, «Святые сонеты»
22.0. Введение
Стандарт языка XML (extensible Markup Language) был опубликован в 1998 году.
XML быстро превратился в стандартное средство представления и обмена практи-
чески любыми данными, от названий книг до параметров при вызове функций.
XML успешно справился с тем, что не удалось предыдущим «стандартным»
форматам данных, в том числе и его предку SGML (Standard Generalized Markup
Language). Успех XML объясняется тремя факторами: в нем используется тек-
стовое, а не двоичное представление данных; он скорее прост, чем сложен; нако-
нец, он сильно напоминает HTML.
О Текстовое представление. Еще за 30 лет до появления XML система Unix нагляд-
но показала, что люди предпочитают общаться с компьютерами на уровне текста.
Только текстовые файлы заведомо могут читаться и записываться в любой
системе. Поскольку язык XML является текстовым, программисты могут лег-
ко организовать выдачу отчетов в формате XML в унаследованных системах.
О Простота. Как вы вскоре убедитесь, с XML связано много сложностей, но
сам по себе стандарт XML очень прост. Документы XML создаются из очень
малого набора элементов, но из этих строительных блоков можно построить
исключительно сложную систему.
О HTML. XML не является HTML, однако у этих двух языков имеется общий
предок: SGML. Внешнее сходство означает, что миллионам программистов,
изучавших HTML для размещения данных в Веб, будет проще изучить (и вос-
принять) XML.
Синтаксис
В примере 22.1 приведен простой документ XML.
Пример 22.1. Простой документ XML
<?xml version="l.0" encoding="UTF-8,,?>
<books>
<!-- Programming Perl 3ed --> продолжение &
890
Глава 22. XML
Пример 22.1 (продолжение)
<book 1d='T’>
<title>Programm1ng Perl</t1tle>
<edi tion>3</ed1tion>
<authors>
<author>
<f1rstname>Larry</f1rstname>
<1astname>Wal1</lastname>
</author>
<author>
<f1rstname>Tom</f1rstname>
<1astname>Chr1st1ansen</lastname>
</author>
<author>
<f1rstname>Jon</f1rstname>
<1astname>Orwant</lastname>
</author>
</authors>
<1sbn>0-596-00027-8</1s bn>
</book>
<!-- Perl & LWP -->
<book 1d="2">
<t1tle>Perl & </t1tle>
<ed1t1on>l</ed1t1on>
<authors>
<author>
<f1rstname>Sean</f1rstname>
<1astname>Burke</1astname>
</author>
</authors>
<1sbn>0-596-00178-9</1sbn>
</book>
<book 1d=,,3">
<!-- Anonymous Perl -->
<t1tle>Anonymous Perl</t1tle>
<edit1on>l</edit1on>
<authors />
<1sbn>0-555-00178-0</1 sbn>
</book>
</books>
На первый взгляд XML имеет много общего с HTML: здесь также имеются
элементы (<book>, </Ьоок>), сущности (например, &атр: и &11;) и комментарии
(<! -- Perl & LWP Но в отличие от HTML, XML не определяет стандартного
набора элементов и ограничивается минимальным набором сущностей (для апо-
строфов, кавычек, знаков «меныпе»/«болыпе» и амперсанда). В стандарте XML
определяются только синтаксические «строительные блоки» типа угловых ско-
бок < и >, в которые заключаются элементы. За составление словаря (то есть
определение имен элементов и атрибутов типа books, authors и т. д. и их вложен-
ности) отвечает создатель документа.
Открывающие и закрывающие элементы XML знакомы нам по XML:
<book>
</book>
22.0. Введение
891
В XML добавлен альтернативный синтаксис для пустых элементов (не со-
держащих текста или других элементов между открывающим и закрывающим
тегами):
<author />
Элементы могут обладать атрибутами:
<book 1d='T">
В отличие от HTML, в XML учитывается регистр символов в элементах,
сущностях и атрибутах: теги <Воок> и <Ьоок> открывают два разных элемента. Все
атрибуты должны заключаться в апострофы или кавычки (1d=,r или 1б=,,Г').
В именах элементов и атрибутов разрешено использование символов Юникода,
символов подчеркивания, дефисов, точек и цифр, но первый символ имени обя-
зан быть буквой или символом подчеркивания. Двоеточия разрешены только
в пространствах имен (см. раздел «Пространства имен» этой главы).
С пропусками дело обстоит на удивление непросто. В спецификации XML
говорится, что все символы, не являющиеся символами разметки, являются
символами содержимого. Таким образом, (теоретически) переводы строк и про-
пуски между тегами в примере 22.1 являются текстовыми данными. Большинст-
во программ разбора XML предлагает выбор между сохранением пропусков и их
подавлением (например, игнорированием переводов строки и отступов).
Объявление XML
Первая строка примера 22.1 содержит объявление XML:
<?xml vers1on=,,1.0" encod1ng=,,UTF-8,,?>
Объявление не является обязательным — по умолчанию используются вер-
сия 1.0 и кодировка UTF-8. Атрибут encoding задает кодировку документа. Не-
которые программы способны работать с любыми разновидностями Юникода,
но большинство ограничивается ASCII и UTF-8. Чтобы обеспечить максималь-
ную переносимость, создавайте данные XML в кодировке UTF-8.
Инструкции по обработке
Инструкции по обработке предназначены для программ-процессоров XML, они
отчасти схожи с объявлениями. Пример:
<t1tle><?pdf font Helvetica 18pt?>XML In Perl</t1tle>
Общая структура инструкции по обработке выглядит так:
<?итог данные ... ?>
Встречая инструкцию по обработке, процессор XML проверяет итоговый
формат (итог). Неопознанные итоговые форматы игнорируются. Это позволяет
включить в один файл XML инструкции для нескольких разных процессоров.
Например, в исходном тексте этой книги в формате XML могли бы присутст-
вовать отдельные инструкции для программ, осуществляющих преобразование
к HTML и PDF.
892
Глава 22. XML
Комментарии
Синтаксис комментариев XML совпадает с их синтаксисом в HTML:
<!--
Текст комментария не может содержать поэтому вложение комментариев
недопустимо.
CDATA
Иногда требуется включить текст в документ XML, не беспокоясь о преобразо-
вании сущностей. Такие блоки литерального текста в XML называются блоками
CDATA и записываются в виде:
<!^литеральный текстУ\>
Уродство синтаксиса выдает происхождение XML от SGML. Все, что следует
после исходной последовательности <![CDATAE, но до ]], рассматривается как ли-
теральные данные, в которых символы разметки < и & не имеют специальной ин-
терпретации.
Например, в блоке CDATA можно разместить фрагмент, содержащий многочис-
ленные символы разметки XML:
<para>The code to do this is as follows:</para>
<code><! [CDATA[$x = $y « 8 & $z]>
Правильно сформированный документ XML
Любой документ XML должен удовлетворять минимальному набору требований,
гарантирующих возможность его разбора:
О Документ должен содержать один и только один элемент верхнего уровня
(например, books в примере 22.1).
О Каждый элемент, обладающий содержимым, должен иметь начальный и ко-
нечный теги.
О Все атрибуты должны иметь значения, заключенные в кавычки или апострофы.
О Элементы не должны перекрываться.
О Разметочные символы (<, > и &) должны использоваться только для опреде-
ления разметки. Иначе говоря, элемент <ti tl e>Perl & LWP</title> невозможен,
потому что & может использоваться только в ссылках на сущности. Единст-
венным исключением из этого правила являются секции CDATA.
Если документ XML удовлетворяет этим условиям, он называется «правиль-
но сформированным» (well-formed). Любая программа разбора XML, соответст-
вующая стандарту XML, должна быть способна разобрать правильно сформиро-
ванный документ.
Схемы
Любая программа, обрабатывающая документы XML, состоит из двух частей:
парсера, обрабатывающего разметку XML, и логики программы, которая иден-
тифицирует текст, элементы и их структуру. Принципы правильного формиро-
вания документов гарантируют, что парсер XML будет работать с документом,
но не правильность имен и вложения элементов.
22.0. Введение
893
Например, следующие два фрагмента XML кодируют одну и ту же информа-
цию разными способами:
<book>
<title>Pгogramming Perl</t1tle>
<ed1tion>3</ed1t1on>
<authors>
<author>
<fi rstname>Larry</f1rstname>
<1astname>Wal1</1astname>
</author>
<author>
<f1rstname>Tom</f1rstname>
<1astname>Chr1stlansen</lastname>
</author>
<author>
<f1rstname>Jon</f1rstname>
<1astname>Orwant</lastname>
</author>
</authors>
</book>
<work>
<wr1ters>Larry Wall, Tom Christiansen, and Jon Orwant</writers>
<name ed1t1on="3">Programming Perl</name>
</work>
Структура этих двух фрагментов различается, и код, написанный для выбор-
ки названия из первого фрагмента («получить содержимое элемента book, затем
найти внутри него содержимое элемента title»), совершенно не подойдет для
второго. По этой причине обычно создается спецификация элементов, атрибу-
тов, сущностей и способов их использования. Такая спецификация гарантирует,
что ваша программа никогда не столкнется с кодом XML, который она не смо-
жет обработать. Существуют два формата таких спецификаций: DTD и схемы.
DTD — более старый и ограниченный формат, унаследованный XML от сво-
его предка SGML. DTD не записываются на XML, поэтому для работы с ними
нужен отдельный (притом достаточно сложный) парсер. Наконец, для многих
целей они вообще не подходят — даже простые концепции вида «элемент book
должен содержать по одному элементу title, edition, author и Isbn в произволь-
ном порядке» выражаются на удивление сложно.
По этой причине большинство современных спецификаций содержимого до-
кумента составляется в форме схем (schema). Консорциум W3C (World Wide
Web Consortium), ответственный за XML и другие стандарты того же направления,
разработал стандарт «XML Schema» (http://www.w3.org/TR/xmlschema-0/). Это самый
распространенный язык схем, используемый в наши дни, однако он сложен и не
лишен недостатков. Постепенно набирает силу его конкурент, RelaxNG группы
OASIS; за дополнительной информацией обращайтесь по адресу http://www.oasis-
open .org/commlttees/relax-ng/spec-20011203.html.
Для работы co схемами в Perl написаны специальные модули. И все же самой
важной операцией, выполняемой со схемами, является проверка действитель-
ности документа XML по схеме. В рецепте 22.5 показано, как это сделать при
помощи модуля XML:: LIbXML. Модуль XML:: Parser не поддерживает проверки дей-
ствительности.
894
Глава 22. XML
Пространства имен
Вложение элементов принадлежит к числу особенно удобных возможностей XML.
Оно позволяет включить один документ внутрь другого. Допустим, вы хотите
отправить документ с заказом внутри почтового сообщения. Вот как это делается:
<ma11>
<header>
<from>me@example.com</from>
<to>you@example.com</to>
<subject>PO for my trip</subject>
</header>
<body>
<purchaseorder>
<for>A1rfare</for>
<bi1l_to>Edi tori al</b111_to>
<amount>349.50</amount>
</purchaseorder>
</body>
</mai1>
Такое решение работает, но оно легко создает проблемы. Например, если бы
для обозначения отдела, оплачивающего счет, использовался элемент <to> вме-
сто <bill_t0>, в документе было бы два элемента с именем <to>. Итоговый доку-
мент будет выглядеть примерно так:
<ma11>
<header>
<to>you@examplе.com</to>
</header>
<body>
<to>Ed1tori al</to>
</body>
</ma11>
Получается, что элемент to используется в нем для двух разных целей. Анало-
гичная проблема возникает в программировании при совпадении имен глобаль-
ных переменных в двух разных модулях. Нельзя рассчитывать на то, что про-
граммист не будет использовать имена переменных из других модулей, потому
что для этого нужно знать, какие имена определяются во всех модулях.
В XML эта проблема решается так же, как в программировании: при помощи
пространств имен. Пространство имен представляет собой уникальный префикс
для всех элементов и атрибутов в словаре XML. Наличие такого префикса пре-
дотвращает конфликты с элементами других словарей. С пространствами имен
наш пример мог бы выглядеть приблизительно так:
<ma11 xml ns:emall="http://example.com/dtds/mal 1 spec/">
<ema11:from>me@example.com</ema11:from>
<ema11:to>you@example.com</emai1:to>
<ema11:subject>PO for my tr1p</ema11:subject>
<ema11:body>
<purchaseorder xml ns:po="http://example.com/dtd/purch/">
< po:for>A1rfa re</po:for>
< po:to>Ed1 tori al</po:to>
< po:amount>349.50</po:amount>
22.0. Введение
895
</purchaseorder>
</emai1:body>
</mai1>
Атрибут xml ns: префикс- 'URL" определяет пространство имен для содержимого
элемента, с которым связан данный атрибут. В нашем примере задействованы
два пространства имен: email и ро. Элемент email :to отличается от элемента po:to,
и это позволит избежать путаницы в программе разбора.
Пространства имен поддерживаются большинством парсеров XML, исполь-
зуемых в Perl, в том числе XML::Parser и XML::LibXML.
Преобразования
Одно из любимых развлечений мастеров XML — преобразование кода XML во
что-нибудь другое. Раньше для этой цели использовались программы, которые
знали конкретный словарь XML и могли преобразовать файл XML, использую-
щий этот словарь, в другой код XML или в совершенно иной формат (например,
HTML или PDF). Задача встречалась настолько часто, что программисты стали
отделять механизм преобразований от конкретной трансформации. Так появи-
лась новая спецификация XSLT (XML Stylesheet Language for Transformations).
В преобразованиях XML с применением XSLT используется таблица стилей
(stylesheet). Отдельный элемент этой таблицы фактически указывает: «Если во
входном коде XML встречается это, выдать то» (например: «При обнаружении
элемента book выдать только содержимое вложенного элемента title»).
Для выполнения преобразований в Perl лучше всего использовать модуль
XML::LibXSLT, хотя иногда используются модули XML::Sabiotron и XML::XSLT. Рабо-
та с XML::LibXSLT продемонстрирована в рецепте 22.7.
XPath
Вероятно, из всех новых словарей и средств для работы с XML самым полез-
ным является XPath. Выражения XPath можно рассматривать как аналоги регу-
лярных выражений для структуры XML — вы задаете искомые элементы, а про-
цессор XPath возвращает указатель на найденные совпадения.
Выражения XPath имеют вид
/books/book/title
Критерии поиска разделяются символами /. В XPath предусмотрен синтак-
сис проверки атрибутов, элементов и текста, а также идентификации родителей
и соседей узлов.
Модуль XML::LibXML обладает сильной поддержкой XPath, а пример его ис-
пользования продемонстрирован в рецепте 22.6. XPath также используется в ра-
боте модуля XML : :Twig (см. рецепт 22.8).
История поддержки XML в Perl
Сначала в Perl существовал только один механизм разбора XML: регулярные
выражения. Такой способ разбора порождал ошибки и нередко не справлялся
с правильно сформированными документами XML (например, с секциями CDATA).
Первым настоящим парсером XML для Perl стал модуль XML:-.Parser, разрабо-
896
Глава 22. XML
тайный Ларри Уоллом Perl-интерфейс к библиотеке С expat Джеймса Кларка
(James Clark). В большинстве других языков (прежде всего Python и РНР) пер-
вым полноценным парсером XML тоже стала интерфейсная «обертка» expat.
XML::Parser был всего лишь прототипом — механизм передачи Perl компонен-
тов документов XML был экспериментальным, и ему предстояло развиваться
в течение нескольких лет. Но поскольку XML:: Parser был единственным парсе-
ром XML для Perl, вскоре появились приложения, в которых он использовался,
и дальнейшие модификации интерфейса стали невозможны. XML::Parser имеет
специальный API, поэтому работать с ним напрямую не следует.
Работа XML::Parser основана на событиях. Вы регистрируете функции об-
ратного вызова для таких событий, как «начало элемента», «текст» и «конец
элемента». В процессе разбора XML::Parser вызывает функции обратного вызова,
которые передают программе информацию о происходящих событиях. Разбор
с применением событий достаточно часто встречается в мире XML, но XML:: Parser
использует собственные события без применения стандартного интерфейса со-
бытий SAX (Simple API for XML). Именно по этой причине мы не рекомендуем
использовать XML::Parser напрямую.
Модули XML::SAX предоставляют интерфейс SAX к XML::Parser и еще несколь-
ким парсерам XML. XML: .Parser разбирает документ, но вы пишете код работы
с XML::SAX, a XML::SAX осуществляет преобразование между событиями XML::Parser
и SAX. XML::SAX также содержит парсер, написанный на Perl, поэтому программа
для XML:: SAX будет работать в любой Perl-системе — даже в такой, которая не
компилирует модули XS. XML:: SAX поддерживает полный SAX API второго уровня
(а парсер, непосредственно выполняющий разбор, обеспечивает такие возмож-
ности, как пространства имен).
Другой распространенный способ разбора XML основан на построении дере-
ва: элемент А является потомком элемента В в дереве, если в документе XML он
является вложенным по отношению к В.
Для работы с такими структурами данных существует стандартный API: DOM
(Document Object Model). Модуль XML::LIbXML использует библиотеку 11bxml2
проекта GNOME для быстрого и эффективного построения дерева DOM. Эта
библиотека работает быстро, она поддерживает XPath и проверку действи-
тельности документа. Модуль XML::DOM пытался строить деревья DOM на базе
XML::Parser, но большинство программистов предпочитает скорость XML::LIbXML.
В рецепте 22.2 будет рассматриваться именно XML::LibXML, а не XML::DOM.
Подведем итог: для разбора с событиями используйте модуль XML::SAX с
XML::Parser или XML::LibXML, а для разбора с деревьями DOM — модуль XML::LIbXML.
Для проверки действительности также используется модуль XML::LIbXML.
Дополнительная литература
Спецификация XML сама по себе проста, но спецификации пространств имен,
схем, таблиц стилей и т. д. достаточно сложны. Существует немало хороших
книг, которые помогут вам освоить эти технологии:
1. Рэй Э., Макинтош Дж. Perl.& XML. Библиотека программиста. — СПб.: Пи-
тер, 2003.
2. Холзднер С. XML. Энциклопедия, 2-е изд. — СПб.: Питер, 2004.
22.1. Разбор XML в структуры данных
897
22.1. Разбор XML в структуры данных
Проблема
Требуется получить структуру данных (комбинацию хэшей и массивов), ко-
торая бы соответствовала структуре и содержимому файла XML. Допустим,
имеется код XML, представляющий конфигурационный файл, и вы хотите ис-
пользовать запись $xml ->{config}{server}{hostname} для обращения к содержимо-
му элемента <config><server><hostname>.</hostname>.
Решение
Воспользуйтесь модулем CPAN XML::Simple. Если код XML хранится в файле,
передайте имя файла при вызове XML1 п:
use XML:: Simple:
$ref = XMLin($FILENAME. ForceArray => 1);
Если код XML хранится в строковой переменной, передайте ее XML1 п:
use XML::Simple:
$ref = XML1n($STRING, ForceArray => 1):
Комментарий
Ниже приведена структура данных, которая строится модулем XML::Simple для
кода из примера 22.1:
{
'book' => {
•Г => {
'authors* => [
{
'author* => [
{
*f1rstname* => [ 'Larry* ].
'lastname* => [ 'Wall* ]
}.
{
'firstname' => [ 'Tom' ].
'lastname' => [ 'Christiansen' ]
}•
{
'firstname' => [ 'Jon' ].
'lastname' => [ 'Orwant' ]
}
]
}
L
'edition* => [ *3* ].
'title* => [ 'Programming Perl* ].
'isbn* => [ *0-596-00027-8’ ]
}.
898
Глава 22. XML
21 => {
'authors' -> [
{
'author' -> [
{
'firstname' => [ 'Sean' ],
'lastname' => [ 'Burke' ]
}
]
}
].
'edition' => [ '1' ].
'title' => [ 'Perl & LWP' ].
'isbn' => [ '0-596-00178-9' ]
}•
'3' => {
'authors' => [ {} ].
'edition' -> [ 'Г ].
'title' -> [ 'Anonymous Perl' ].
'isbn' => [ '0-555-00178-0' ]
}.
}
}
Главной функцией XML::Simple является преобразование элемента, содержа-
щего другие элементы, в хэш. Если внешний элемент содержит несколько одно-
именных вложенных элементов, они преобразуются в массив хэшей (если толь-
ко XML::Simple не уверен в том, что они однозначно идентифицируются своими
атрибутами, как, например, Id).
По умолчанию XML::Simple считает, что если у элемента имеется атрибут Id,
name или key, то этот атрибут является уникальным идентификатором элемента.
Для управления этим режимом используется атрибут KeyAttr функции XMLIn.
Например, присваивание KeyAttr пустого списка запрещает преобразование мас-
сива элементов в хэш по атрибуту:
$ref = XML1n($xml. ForceArray => 1. KeyAttr => []);
Чтобы еще точнее управлять процессом преобразования, передайте в этом
параметре хэш, который связывает имя элемента с атрибутом, содержащим уни-
кальный идентификатор. Например, чтобы элементы book хэшировались по атри-
буту Id (и ни по каким другим атрибутам), используйте запись
$ref = XML1n($xml. ForceArray => 1, KeyAttr => { book => "Id" }):
При установленном флаге ForceArray в структуре данных создаются все мас-
сивы, содержащие всего один элемент. Если флаг сброшен, XML::Simple сжимает
одноэлементные массивы:
•3' => {
'authors' => {}.
'edition' => 'Г.
'title' => 'Anonymous Perl'.
'Isbn' => '0-555-00178-0'
22.2. Разбор кода XML в деревья DOM
899
Хотя такой формат проще читается, программировать для него сложнее. Если
вы уверены в том, что элементы не повторяются, сбросьте флаг ForceArray. Но
если одни элементы повторяются, а другие — нет, флаг ForceArray необходим для
обеспечения логической целостности структуры данных. Наличие данных, об-
ращение к которым иногда производится напрямую, а иногда — через массив,
усложняет код.
У модуля XML::Simple имеются параметры для управления построением струк-
туры данных по коду XML. За дополнительной информацией обращайтесь к доку-
ментации по модулю. Учтите, что XML::Simple приносит реальную пользу только
при работе с сильно структурированными данными, вроде тех, которые исполь-
зуются в конфигурационных файлах. Он неудобен при работе с кодом XML,
представляющим документы, а не структуры данных, и он не позволяет исполь-
зовать такие возможности XML, как инструкции по обработке и комментарии.
Мы рекомендуем использовать модели DOM и SAX при разборе любого кода,
кроме самого простого.
См. также
Документация по модулю CPAN XML::Simple; рецепт 22.10.
22.2. Разбор кода XML в деревья DOM
Проблема
Требуется использовать модель DOM (Document Object Model) для обработки,
а возможно — и для модификации дерева разбора XML.
Решение
Воспользуйтесь модулем XML::LibXML:
use XML::LibXML:
my Sparser = XML::LibXML->new();
my Sdom = $parser->parse_string($XML):
# or
my $dom = $parser->parse_file($FILENAME):
my Sroot = Sdom->getDocumentElement:
Комментарий
В модели DOM дерево разбора XML представляется в виде набора классов. Ка-
ждому элементу ставится в соответствие узел дерева, с которым выполняются
такие операции, как поиск узлов-потомков (в данном случае это вложенные эле-
менты XML), создание нового потомка и перемещение узла в дереве. Конструк-
торы parse_string, parse_file и parse_fh (для файлового манипулятора) возвра-
щают объект DOM, который может использоваться для поиска узлов в дереве.
900
Глава 22. XML
Например, в примере 22.2 для кода XML books из примера 22.1 приведен
один из вариантов вывода названий.
Пример 22.2. dom-titledumper
# !/usr/Ыn/perl -w
# dom-titledumper -- вывод элементов title i3 файла books
# с использованием DOM
use XML::LibXML;
use Data::Dumper:
use strict:
my Sparser = XML::LibXML->new:
my $dom = $parser->parse_file("books.xml") or die:
# Получить все элементы title
my ©titles = $dom->getElementsByTagName("title"):
foreach my $t (©titles) {
# Получить текстовый узел внутри <title>
# и вывести его значение.
print $t->firstChi1d->data. "\n":
}
Метод getElementsByTagName возвращает список элементов как узлов докумен-
та с заданным именем тега. В рассмотренном примере мы получаем список эле-
ментов title, а затем перебираем каждый элемент и находим его содержимое.
Известно, что каждый элемент title содержит только один фрагмент текста, по-
этому мы предполагаем, что первый узел-потомок содержит текст, и выводим
его содержимое.
Чтобы убедиться в том, что узел действительно содержит текст, можно вос-
пользоваться следующей записью:
die "the title contained something other than text!"
if $t->firstChild->nodeType != 3:
Проверка гарантирует, что первый узел относится к типу 3 (текст). В табл. 22.1
перечислены числовые коды типов узлов LibXML, возвращаемые методом nodeType.
Таблица 22.1. Числовые коды типов узлов LibXML
Тип узла Число
Элемент 1
Атрибут 2
Текст 3
Секция CDATA 4
Ссылка на сущность 5
Сущность 6
Инструкция по обработке Комментарий 7 8
22.2. Разбор кода XML в деревья DOM
901
Тип узла Число
Документ 9
Тип документа 10
Фрагмент документа И
Запись 12
Документ HTML 13
Узел DTD 14
Объявление элемента 15
Объявление атрибута 16
Объявление сущности 17
Объявление пространства имен 18
Начало XInclude 19
Конец XInlude 20
Дерево разбора также можно модифицировать, добавляя в него новые или
перемещая/удаляя существующие узлы. В примере 22.3 в каждый элемент book
добавляется случайно сгенерированное значение price.
Пример 22.3. dom-addprice
# !/usr/Ыn/perl -w
# dom-addprice -- включение элемента price в элементы book
use XML::LibXML;
use Data::Dumper:
use strict:
my Sparser = XML::LibXML->new:
my $dom = $parser->parse_file("books.xml") or die:
my Sroot = Sdom->documentElement:
# get list of all the "book" elements
my @books = Sroot->getElementsByTagName("book"):
foreach my Sbook (@books) {
my Sprice = sprintf("\$£d.95", 19 + 5 * int rand 5): # Случайное число
my $price_text_node = Sdom->createTextNode(Sprice): # Содержимое <price>
my $price_element = Sdom->createElement("price"): # Создать <price>
Sprice_element->appendChild($price_text_node): # Занести содержимое
# в <price>
Sbook->appendChild(Sprice_element): # Поместить <price> в <book>
}
print Sdom->toString:
Ter price и его содержимое создаются методами createTextNode и createElement.
Затем метод appendChild вставляет тег в конец существующего содержимого теку-
щего тега book. Метод toString выдает документ в формате XML, что позволяет
легко создавать подобные фильтры XML с использованием DOM.
902
Глава 22. XML
Страница руководства XML::LIbXML: :DOM содержит вводную информацию о под-
держке DOM в XML::LIbXML и ссылки,на документацию по конкретным классам
DOM (например, XML::LIbXML: :Node). В ней приводятся списки методов конкрет-
ных объектов.
См. также
Документация по модулям XML: :L1bXML::DOM, XML::LibXML::Document,
XML::Li bXML::Element и XML::Li bXML::Node.
22.3. Разбор кода XML в события SAX
Проблема
Требуется организовать обработку событий SAX (Simple API for XML) для
кода XML. По сравнению с деревьями D0M событийный разбор происходит
быстрее и расходует меньше памяти.
Решение
Воспользуйтесь модулем CPAN XML::SAX:
use XML::SAX::ParserFactory;
use MyHandler;
my Shandler = MyHandler->new();
my Sparser = XML::SAX::ParserFactory->parser(Handler => Shandler):
Sparser->parse_ur1(SFILENAME):
# или
$parser->parse_string($XML):
Логика обработки событий программируется в классе обработчика (MyHandler
в данном примере):
# MyHandler.pm
package MyHandler;
use base qw(XML::SAX::Base):
sub start_element { # Имена методов определяются SAX
my (Sself, Sdata) =
# Sdata - хэш с ключами вида Name и Attributes
# ...
}
# Также могут использоваться методы end_element() и charactersO
1:
22.3. Разбор кода XML в события SAX
903
Комментарий
Процессор XML, использующий модель SAX, состоит из трех частей: парсера
XML, генерирующего события SAX; обработчика, реагирующего на события;
и заглушки (stub), которая связывает их между собой. Парсером XML может
быть XML:: Parser, XML:: LibXML или «чистая» Perl-реализация XML:: SAX:: PurePerl,
поставляемая c XML::SAX. Модуль XML: :SAX: :ParserFactory выбирает парсер и под-
ключает его к обработчику. Обработчик реализуется в виде класса, производно-
го от XML::SAX: :Base. Код заглушки приведен выше в Решении.
Модуль XML::SAX: :Base содержит заглушки для разных методов, вызываемых
парсером XML для вашего обработчика. Эти методы, перечисленные в табл. 22.2,
определены в стандартах SAX1 и SAX2 (http://www.saxproject.org). Perl-реализа-
ция использует специфические для Perl структуры данных, описанные на стра-
нице руководства XML::SAX:: Intro.
Таблица 22.2. Методы XML::SAX::Base
start-document end-document characters
start_element end_element processing-instructions
ignorable_whitespace set_docu men t-locator skipped_entity
start_prefix_mapping end_prefix_ma ppi ng comment
start_cdata end_cdata entity.reference
notation_decl u nparsed_entity_decl element_decl
attlist_decl doctype_decl xml_decl
entity_decl attribute_decl internal_entity_decl
start_dtd end_dtd externa l_entity_decl
resolve_entity start.entity end_entity
warning error fatal_error
Чаще всего используются структуры данных, представляющие элементы и ат-
рибуты. Параметр $data методов start_element и end_element содержит ссылку на
хэш, ключи которого перечислены в табл. 22.3.
Таблица 22.3. Хэш представления элемента в XML::SAX
Ключ Описание
Prefix Префикс пространства имен XML (например, email:)
Local Name Имя элемента без префикса (например, to)
Name Полное имя элемента (например, email:to)
Attributes Хэш атрибутов элемента
NamespaceURI URI пространства имен XML данного элемента
В хэше атрибутов каждый атрибут представлен отдельным ключом вида
{иШ^ространства_имен}имя_атрибута. Например, для URI текущего простран-
904
Глава 22. XML
ства имен http://example.com/dtds/ma11spec/ и атрибута msgld в хэше атрибутов
создается ключ
{http://examplе.com/dtds/та11 spec/}msgld
Значение атрибута также представляет собой хэш, ключи которого перечис-
лены в табл. 22.4.
Таблица 22.4. Хэш представления атрибута в XML::SAX
Ключ Описание
Prefix Префикс пространства имен XML (например, email:)
Local Name Имя атрибута без префикса (например, to)
Name Полное имя атрибута (например, email :to)
Value Значение атрибута
NamespaceURI URI пространства имен XML данного атрибута
В примере 22.4 показано, как получить список названий книг с использова-
нием событий SAX. Решение получается более сложным, чем при использова-
нии модели DOM, поскольку мы должны отслеживать текущую позицию в до-
кументе XML.
Пример 22.4. sax-titledumper
# TltleDumper.pm
# TltleDumper.pm -- обработчик SAX для вывода элементов title из файла books
package TltleDumper;
use base qw(XML::SAX:;Base):
my $1n_t1tle = 0;
# При входе в title увеличить $1n_t1tle
sub start_element {
my (Sself. Sdata) =
If ($data->{Name} eq ’title’) {
$1n_t1tle++;
}
)
# При выходе из title уменьшить $1n_title и вывести перевод строки
sub end_element {
my (Sself. Sdata) =
If ($data->{Name} eq ’title’) {
$1n_t1tle--:
print ”\n”:
}
}
# Внутри title вывести весь полученный текст
sub characters {
my (Sself. Sdata) =
22.4. Простые изменения в элементах и тексте
905
if ($in_title) {
print $data->{Data};
}
}
1:
В документации XML:: SAX приведено доступное введение в механизмы раз-
бора XML.
См. также
Документация по модулям CPAN XML::SAX, XML: :SAX: :Base и XML: :SAX::Intro.
22.4. Простые изменения в элементах и тексте
Проблема
Требуется отфильтровать некоторый фрагмент кода XML. Например, вы хотите
выполнить подстановку в теле документа, включить цену в каждое описание
книги в документе XML или заменить <book id="l"> на <book> <id>l</id>.
Решение
Воспользуйтесь модулем CPAN XML::SAX::Maehlnes:
#!/usr/Ыn/perl -w
use MySAXFiIterl:
use MySAXFi1ter2:
use XML::SAX::ParserFactory:
use XML::SAX:Machines qw(Pipeline):
my Smachine = Pi pel 1ne(MySAXF11terl => MySAXFilter2): # и более
$machine->parse_uri(SFILENAME):
Напишите обработчик, производный от XML::SAX: :Base, как в рецепте 22.3,
а затем при каждой обработке события SAX вызывайте соответствующий обра-
ботчик в своем суперклассе. Пример:
$self->SUPER::start_element($tag_struct):
Комментарий
Фильтр SAX принимает события SAX и генерирует новые события. Модуль
XML::SAX: :Base проверяет, используется ли ваш объект-обработчик как фильтр.
В этом случае методы XML::SAX: :Base передают события SAX следующему фильт-
ру в цепочке. Если объект-обработчик не используется как фильтр, то методы
XML::SAX: :Base только принимают события, не генерируя их. В результате орга-
низовать выдачу новых событий ненамного сложнее, чем принимать их.
906
Глава 22. XML
Модуль XML::SAX: :Machines обеспечивает сцепление фильтров. Импортируйте
функцию Pipeline, после чего используйте запись
my Smachine = Pi pel 1ne(Fi1terl => Filter2 => Filters => Filter4):
$machine->parse_uri(SFILENAME):
События SAX, сгенерированные при разборе файла XML, передаются фильтру
Fi 1 terl. Этот фильтр передает события (возможно, другие) Filter2; тот, в свою оче-
редь, передает их Filters, затем события передаются Filter4. Последний фильтр
должен обеспечить вывод или иную обработку входящих событий SAX. При пе-
редаче ссылки на тип-глоб XML::SAX: Machines записывает код XML в файловый
манипулятор, связанный с этим тип-глобом.
В примере 22.5 приведен фильтр, который преобразует атрибут id элемен-
тов book документа XML из примера 22.1 в новый элемент id. Например, <book
id="l"> преобразуется в <book><id>l</id>.
Пример 22.5. filters-rewriteids
package RewritelDs:
# RewritelDs.pm -- преобразование атрибутов "id" в элементы
use base qw(XML::SAX::Base):
my $ID_ATTRIB = "{}id": # the attribute hash entry we're interested in
sub start_element {
my (Sself. Sdata) =
if ($data->{Name} eq 'book') {
my Sid = $data->{Attributes}{$ID_ATTRIB}{Value}:
delete $data->{Attributes}{$ID_ATTRIB}:
$self->SUPER::start_element(Sdata):
# Создать новую структуру данных элемента для тега <id>
my $id_node = {};
Hid_node = Hself;
$1d_node->{Name} = 'id': # Сложнее, если используются
# пространства имен
$id_node->{Attributes} = {}:
# Построить <id>$id^/id>
$self->SUPER::start_element($id_node):
Sself->SUPER::characters({ Data => Sid });
Sself->SUPER::end_element($id_node):
} else {
$self->SUPER::start_element(Sdata):
}
}
1:
В примере 22.6 приведена заглушка, которая организует цепочку обработки
books.xml при помощи модуля XML::SAX: Machines и выводит измененный код XML.
22.5. Проверка действительности XML
907
Пример 22.6. filters-rewriteprog
# !/usr/Ыn/perl -w
# rewrite-ids -- вызов фильтра SAX для преобразования
# атрибутов id в элементы
use RewritelDs:
use XML::SAX::Machines qw(:all):
my Smachine = Pipeline(RewriteIDs => *STDOUT):
$machine->parse_uri("books.xml"):
Результат выполнения работы примера 22.6 (сокращенный для экономии места):
<book><id>l</id>
<title>Programming Perl</title>
<book><id>2</id>
<title>Perl &: LWP</title>
Чтобы сохранить XML в файле new-books.xml, воспользуйтесь модулем
XML::SAX::Writer:
#!/usr/bin/perl -w
use RewritelDs:
use XML::SAX::Machines qw(:all):
use XML::SAX::Writer:
my Swriter = XML::SAX::Writer->new(Output => "new-books.xml"):
my Smachine = Pipeline(RewriteIDs => Swriter):
$machine->parse_uri("books.xml"):
В параметре Output также можно передать ссылку на скаляр, чтобы код XML
был добавлен к скалярной величине, ссылку на массив, чтобы код XML был до-
бавлен к массиву, по одному элементу на каждое событие SAX или файловый
манипулятор, в который будет выведен код XML.
См. также
Документация по модулям XML::SAX: Machines и XML::SAX::Writer.
22.5. Проверка действительности XML
Проблема
Требуется убедиться в том, что обрабатываемый код XML соответствует схеме
или DTD.
Решение
Чтобы проверить действительность кода XML по DTD, воспользуйтесь моду-
лем XML::LibXML:
908
Глава 22. XML
use XML::LIbXML:
my Sparser = XML::L1bXML->new:
Sparser->val1dation(l):
$parser->parse_file($FILENAME):
Чтобы выполнить проверку по схеме W3C, воспользуйтесь модулем XML: :Xerces:
use XML::Xerces:
my Sparser = XML::Xerces::DOMParser->new:
Sparser->setVal1dationScheme($XML::Xerces::DOMParser::Val_Always):
my $error_handler = XML::Xerces::PerlErrorHandler->new():
Sparser->setErrorHandler($error_handler):
$parser->parse($FILENAME):
Комментарий
Библиотека 11 bxml2, заложенная в основу XML::LibXML, может проверять действи-
тельность кода в процессе разбора. Для этой цели используется метод validation
парсера. На момент написания книги модуль XML::LibXML позволял проверять
действительность кода только при разборе в стиле DOM — для разбора SAX такая
проверка не поддерживалась.
В примере 22.7 приведено определение DTD для файла books.xml из примера 22.1.
Пример 22.7. validating-booksdtd
<!ELEMENT books (book*)>
<!ELEMENT book (title.edition.authors.isbn)>
<!ELEMENT authors (author*)>
<!ELEMENT author (firstname.lastname)>
<!ELEMENT title (#PCDATA)>
<!ELEMENT edition (#PCDATA)>
<!ELEMENT firstname (#PCDATA)>
<!ELEMENT lastname (#PCDATA)>
<!ELEMENT Isbn (#PCDATA)>
<!ATTLIST book
id CDATA #REQUIRED
Чтобы модуль XML::LibXML разобрал DTD, включите в файл books.xml следую-
щую строку:
<!DOCTYPE books
SYSTEM "books.dtd">
В примере 22.8 представлена простая управляющая программа для проверки
действительности.
Пример 22.8. validating-bookchecker
#!/usr/bin/perl -w
# bookchecker - разбор и проверка действительности файла books.xml
use XML::LIbXML:
22.5. Проверка действительности XML
909
Sparser = XML::LibXML->new:
$parser->validation(l):
$parser->parse_file("books.xml"):
При проверке действительности документа программа не создает выходных
данных — XML::LIbXML успешно разбирает документ в структуру DOM, которая
автоматически уничтожается при завершении программы. Но если внести из-
менения в books. xml, XML:: Li bXML выдает сообщения об ошибках синтаксиса XML.
Например, при замене атрибута id на unique_id будет выведено следующее со-
общение:
’books.xml:0: validity error: No declaration for attribute uniquejd
of element book
<book unique_id=’T’>
books.xml:0: validity error: Element book does not carry attribute id
</book>
’ at /usr/local/per!5-8/Library/Perl/5.8.0/darwin/XML/LibXML.pm line
405.
at checker-1 line 7
XML::LibXML хорошо справляется с обнаружением неизвестных атрибутов и те-
гов. К сожалению, с нарушениями в порядке следования элементов дело обстоит
хуже. Если вернуть books.xml в исходное состояние, а затем поменять местами
элементы title и edition, вы получите следующее сообщение:
’books.xml:0: validity error: Element book content does not follow the
DTD
</book>
A
’ at /usr/local/per!5-8/Library/Perl/5.8.0/darwin/XML/LibXML.pm line
405.
at checker-1 line 7
На этот раз XML::LibXML сообщает, что элемент book не соответствует DTD, но
не указывает, в чем именно состоит нарушение.
На момент написания книги для проверки XML при разборе SAX приходилось
использовать XML:: Xerces или же проверять действительность по схеме W3C. Обе
эти возможности (а также проверка по RelaxNG) запланированы к реализации
в будущих версиях XML:: Li bXML, но на момент написания книги они были недоступны.
Пример построения дерева DOM при проверке DTD с использованием
XML::Xerces:
use XML: -.Xerces:
# Создать новый парсер, который всегда проверяет действительность кода:
my $р = XML::Xerces::DOMParser->new():
$р->setVa1i dati onScheme($ XML::Xerces::DOMParser::Vai_A1ways):
# Назначить обработчик для ошибки разбора
my $error_handler = XML::Xerces::PerlErrorHandler->new():
Sp->setErrorHandler($error_handler):
$p->parse($FILENAME):
910
Глава 22. XML
Чтобы провести проверку по схеме, необходимо сообщить XML: :Xerces, где на-
ходится схема и как ее использовать:
$p->setFeature("http://xml.org/sax/features/val1dation", 1);
$p->setFeature("http://apache.org/xml/features/validation/dynanric". 0):
$p->setFeature("http://apache.org/xml/features/val1dat1on/schema". SSCHEMAFILE):
При вызове setValldatlonScheme могут передаваться три возможных значения:
$XML::Xerces::DOMParser::Val_Always
$XML::Xerces::DOMParser::Val_Never
$XML::Xerces::DOMParser::Val_Auto
По умолчанию проверка действительности не производится никогда (Val_
Never). Если в режиме Val_Always у файла отсутствует DTD или схема, происхо-
дит ошибка. В режиме Val_Auto ошибка происходит только тогда, когда у файла
имеется DTD или схема, но проверка действительности дает отрицательный ре-
зультат.
Для работы XML: :Xerces необходима библиотека разбора XML Apache Xerces
C++ (доступная по адресу http://xml.apache.org/xerces-c). На момент написания
книги модуль XML::Xerces требовал архивной, старой версии библиотеки Xerces
(1.7.0), а документация по нему была явно недостаточной. Чтобы понять, как он
работает, приходилось читать документацию по библиотеке C++ и анализиро-
вать примеры из каталога samples/ поставки XML::Xerces.
См. также
Документация по модулю CPAN XML: :L1bXML; http://xml .apache.org/xerces-c; http://
xml.apache.org/xerces-p/.
22.6. Поиск элементов и текста
в документе XML
Проблема
Требуется найти некоторую часть кода XML, например, атрибут href тега, в содер-
жимом которого присутствует тег 1 mg со словом "monkey".
Решение
Воспользуйтесь модулем XML::LIbXML и сконструируйте выражение XPath для
поиска нужных узлов:
use XML::LIbXML:
my Sparser = XML::L1bXML->new;
$doc = $parser->parse_f11e($FILENAME):
my @nodes = $doc->findnodes($XPATH_EXPRESSION):
22.6. Поиск элементов и текста в документе XML
911
Комментарий
Пример 22.9 выводит все элементы title из кода XML, приведенного в при-
мере 22.1.
Пример 22.9. xpath-1
# !/usr/bin/perl -w
use XML::LibXML:
my Sparser = XML::LibXML->new:
Sdoc = $parser->parse_file(,,books.xmr’):
# Найти элементы title
my @nodes = $doc->findnodes(’7books/book/title"):
# Вывести текст элементов title
foreach my Snode (@nodes) {
print $node->firstChild->data, "\n":
}
Метод findnodes отличается от метода DOM getElementsByTagName тем, что по-
следний позволяет идентифицировать элементы только по имени. Выражение
XPath определяет последовательность действий, выполняемых механизмом XPath
при поиске интересующего вас узла. Выражение XPath из примера 22.9 означает:
«начать с верха документа, перейти к элементу books, перейти к элементу book,
затем перейти к элементу title».
Это весьма принципиальное отличие. Рассмотрим следующий документ XML:
<message>
<header><to>Tom</to><from>Nat</from></header>
<body>
<order><to>555 House St. Mundaneville</to>
<product>Fish sticks</product>
</order>
</body>
</message>
Этот фрагмент содержит два элемента to: в заголовке и в теле документа.
Если использовать вызов $doc->getElementsByTagName(”to"), мы получим оба эле-
мента to. Выражение XPath "message/header/to" ограничивает вывод элементом
to в заголовке (header).
Выражения XPath являются аналогами регулярных выражений, которые вме-
сто текста работают со структурой кода XML. Синтаксис XPath, как и синтаксис
регулярных выражений, позволяет формулировать гораздо более сложные кри-
терии, чем простейший критерий «найти узел-потомок и перейти к нему» из на-
шего примера.
Вернемся к файлу books и добавим в него еще один элемент:
<book id=,,4">
<!-- Perl Cookbook -->
<title>Perl Cookbook</title>
<ed iti on>2</edi 11on>
<authors>
912
Глава 22. XML
<author>
<firstname>Nathan</fi rstname>
< 1astname>Torki ngton</lastname>
</author>
<author>
< firstname>Tom</fi rstname>
< 1astname>Chri sti ansen</lastname>
</author>
</authors>
<1sbn>123-345-678-90</1sbn>
</book>
Поиск всех книг, написанных Томом Кристиансеном, выполняется так:
my @nodes = $doc->findnodes(’7books/book/authors/author/
f1rstname[text()=,Tom,J/.•/
1astname[text()=’Ch г1sti ansen’]/
../../. ./title/textO"):
foreach my Snode (@nodes) {
print $node->data, ”\n";
}
Мы находим автора (author) с именем (firstname) "Tom" и фамилией (lastname)
"Christiansen", затем возвращаемся к элементу "title" и получаем его текстовые
узлы-потомки. Возврат также можно сформулировать в виде «идти наружу до
обнаружения следующего элемента book»:
my Onodes = $doc->findnodes(’’/books/book/authors/author/
fi rstname[text()=’Tom’]/../
1astname[text()=’Chri sti ansen’]/
ancestor::book/ti tle/text()");
Система XPath обладает чрезвычайно мощными возможностями, и наше зна-
комство с ней нельзя назвать даже поверхностным. Ее спецификация W3C на-
ходится по адресу http://www.w3.org/TR/xpath. Опытным пользователям стоит
присмотреться к модулю XML::LibXML::XPathContext (также распространяемом
через CPAN), который позволяет писать на Perl собственные функции XPath.
См. также
Документация по модулям XML: :L1bXML и XML::LibXML::XPathContext; http://www.
w3.org/TR/xpath.
22.7. Обработка преобразований
таблиц стилей XML
Проблема
Имеется таблица стилей XML, которая должна использоваться для преобразо-
ваний кода XML. Допустим, вы хотите применить ее для построения кода HTML
на базе файла XML.
22.7. Обработка преобразований таблиц стилей XML
913
Решение
Используйте модуль XML::LibXSLT:
use XML::LIbXSLT:
my Sxslt = XML::L1bXSLT->new:
my Sstylesheet = Sxslt->parse_stylesheet_f11e($XSL_FILENAME):
my Sresults = Sstylesheet->transform_f11e($XML_FILENAME):
print $stylesheet->output_string(Sresults):
Комментарий
Модуль XML::LibXSLT построен на основе быстрой и мощной библиотеки libxslt
из проекта GNOME. Чтобы выполнить преобразование, следует построить объект
таблицы стилей по исходному коду XSL, а затем использовать его для преобра-
зования файла XML. Если потребуется (например, если код XSL генерирует-
ся динамически, а не хранится в файле), этот процесс можно разбить на этапы:
use XML::L1bXSLT:
use XML::LibXML:
my $xml_parser = XML::L1bXML->new;
my $xslt_parser = XML::L1bXSLT->new;
my Sxml = Sxml_parser->parse_f11e($XML_FILENAME):
my Sxsl = $xml_parser->parse_file($XSL_FILENAME):
my Sstylesheet = Sxslt_parser->parse_stylesheet(Sxsl):
my Sresults = $stylesheet->transform($xml):
my Soutput = Sstylesheet->output_str1ng(Sresults):
Чтобы сохранить вывод в файле, воспользуйтесь методом output—fi1е:
Sstylesheet->output_f11e($OUTPUT_FILENAME):
Аналогично производится вывод в уже открытый файловый манипулятор
методом output_fh:
$stylesheet->output_fh($FILEHANDLE):
Механизму преобразования можно передать параметры. Например, они мо-
гут использоваться для включения стандартного завершителя в конец каждой
страницы:
$stylesheet->transform($xml, footer => '"I Made This!’"):
Несколько странный вид передаваемой строки объясняется тем, что механиз-
му XSLT должны передаваться строковые данные, заключенные в ограничители.
Кавычки сообщают Perl, что передается строка, а апострофы предназначены для
механизма XSLT.
Perl позволяет даже получать данные, недоступные для XSLT (например,
выборкой из базы данных), или изменять данные XSLT во время выполнения.
Рассмотрим файл из примера 22.10, содержащий многоязычные теги названий.
914
Глава 22. XML
Пример 22.10. text.xml
<11st>
<t 111e>System</t1tle>
<T1tuloGrande>Products</T1tuloGrande>
<sublist>
<SubT111eOne>Book</SubT111 eOne>
</subl1st>
</l1st>
Мы хотим вызвать функцию Perl match_names из шаблона XSLT test.xsl, при-
веденного в примере 22.11.
Пример 22.11. test.xsl
<?xml vers1on="1.0" encod1ng="UTF-8"?>
<xsl:stylesheet
xmlns:xsl="http://www.w3.org/1999/XSL/Transform" version="l.0"
xmlns:test="urn:test,,>
<xsl template match=,7">
<xslvariable name="matched" seiect="test;match_names(’title |
titulo | titre | tltolo*. . )’’ />
<xsl:for-each select="$matched">
<xsl;copy-of select="." />
</xsl:for-each>
</xsl:tempi ate>
</xsl:stylesheet>
В аргументах match_names передается регулярное выражение и список узлов;
предполагается, что функция вернет объект списка узлов. Используйте методы
XML::LIbXML::NodeLIst для работы с параметрами и создания возвращаемого зна-
чения. Код функции match_names приведен в примере 12.12.
Пример 22.12. Функция match_names
sub match_names {
my Spattern = shift;
my Snodellst = shift;
my Smatches = XML;;LIbXML::NodeLIst->new;
foreach my Scontext (Snodel1st->get_nodel1st) {
foreach my Snode (Scontext->f1ndnodes(’//*’)) {
If (Snode->nodeName =~ /$pattern/1x) {
Smatches->push(Snode);
}
}
}
return Smatches;
}
Регистрация функции для использования в шаблонах XSLT осуществляется ме-
тодом reg1ster_funct1on. А вот как происходит обработка шаблона из примера 22.10:
use strict;
use XML;;L1bXML;
use XML;:LlbXSLT;
22.8. Обработка больших файлов
915
my $xml_parser = XML::LibXML->new:
ту $xslt_parser = XML::LibXSLT->new:
sub match_names { ... } # См. пример 22-10
$xslt_parser->reg1ster_funct1on("urn:test". "match_names". \&match_names):
my $dom = $xml_parser->parse_file('test.xml'):
my $xslt_dom = $xml_parser->parse_f11e('test.xsl'):
my $xslt = $xslt_parser->parse_stylesheet($xslt_dom):
my $result_dom = $xslt->transform($dom);
print $result_dom->toStr1ng;
Чтобы предоставить XSLT доступ к переменным Perl, используйте замыка-
ния (closures), как показано на примере объекта запроса Apache:
$xslt->reg1ster_funct1on("urn:test". "get_request".
sub { &get_request($apache_req,@_) } ):
Функция XSLT get_request (указанная во втором аргументе register_function)
вызывает процедуру Perl get_request, при этом $apache_req предшествует всем
аргументам, передаваемым функции XSLT. Вы можете воспользоваться им для
возвращения списка узлов с параметрами формы HTTP или инкапсуляции за-
просов к базам данных DBL
См. также
Документация по модулям XML: :L1 bXSLT и XML::LibXML.
22.8. Обработка больших файлов
Проблема
Требуется работать с большим файлом XML, однако вы не можете прочитать
его в память для формирования дерева DOM или другой структуры данных, по-
скольку файл слишком велик.
Решение
Воспользуйтесь моделью SAX (см. рецепт 22.3) для обработки событий вместо
построения дерева.
Другое решение — воспользуйтесь модулем XML: :Tw1g и постройте деревья
только для тех частей документов, с которыми вы собираетесь работать (опреде-
ляя их при помощи выражений XPath):
use XML::Tw1g:
my Stwlg = XML::Tw1g->new( twig_handlers => {
$XPATH_EXPRESSION => \&HANDLER,
# ...
});
$twig->parsef11e($FILENAME):
$tw1g->flush():
916
Глава 22. XML
Из обработчика можно вызывать много различных DOM-подобных функций,
но в дерево включаются только элементы, определяемые выражением XPath
(а также вложенные в них элементы).
Комментарий
Модули DOM строят дерево для всего документа независимо от того, собирае-
тесь ли вы работать со всем деревом или нет. При использовании модулей SAX
деревья вообще не строятся — если ваша задача зависит от структуры документа,
вы должны самостоятельно отслеживать эту структуру. Модуль XML: :Twig реали-
зует компромисс между этими двумя крайностями; деревья DOM строятся толь-
ко для тех частей файла, которые вас интересуют. Так как вы работаете с файлом
на уровне отдельных фрагментов, это позволяет обрабатывать очень большие
файлы по частям, помещающимся в памяти.
Например, вывод названий книг из файла books.xml (пример 22.1) может
быть выполнен так:
use XML::Twlg;
my Stwig = XML::Twig->new( tw1g_roots => { ’/books/book* => \&do_book }):
$twig->parsefile("books.xml");
$twig->purge();
sub do_book {
my($title) = $_->find_nodes(”title”):
print $title->text, ”\n”;
}
Модуль XML: '.Twig последовательно вызывает do_book для содержимого каждо-
го элемента book. Эта процедура находит узел title и выводит его текст. Вместо
того чтобы разбирать весь файл в структуру DOM, мы работаем только с от-
дельным элементом book.
За дополнительной информацией об уровне поддержки DOM и XPath обра-
щайтесь к документации по модулю XML::Twig — эта поддержка не является полной,
но постоянно расширяется. XML: :Twig разбирает XML при помощи XML: .Parser,
в результате чего состав функций, доступных для узлов, слегка отличается от
состава функций, доступных при разборе DOM средствами XML: :L1 bXSLT.
См. также
Рецепт 22.6; документация по модулю XML::Twig.
22.9. Чтение и запись файлов RSS
Проблема
Требуется создать файл RSS (Rich Site Summary) или прочитать такой файл,
созданный другим приложением.
22.9. Чтение и запись файлов RSS
917
Решение
Для чтения существующего файла RSS используйте модуль CPAN XML::RSS:
use XML::RSS:
my $rss = XML::RSS->new:
$rss->parsef1le($RSS_FILENAME):
my ©Items = ©{$rss->{1tems}}:
foreach my $ltem (©items) {
print "title: $1tem->{'title'}\n";
print "link: $1tem->{'link'}\n\n":
}
Создание файла RSS происходит следующим образом:
use XML::RSS:
my $rss = XML::RSS->new (version => SVERSION):
$rss->channel( title => $CHANNEL_TITLE,
link => $CHANNEL_LINK,
description => $CHANNEL_DESC):
$rss->add_1tem(title => $ITEM_TITLE,
link => $ITEM_LINK,
description => $ITEM_DESC,
name => $ITEM_NAME);
print $rss->as_str1ng:
Комментарий
Существуют как минимум четыре разновидности RSS: 0.9, 0.91, 1.0 и 2.0. На мо-
мент написания книги модуль XML::RSS понимал все, кроме RSS 2.0. Версии отли-
чаются по своим возможностям, поэтому состав методов и параметров зависит от
того, какую версию RSS вы используете. Например, RSS 1.0 поддерживает RDF
и использует метаданные Dublin Core (http://dublincore.org/). Информация о том,
какие функции можно вызывать в каждой версии, приводится в документации.
XML::RSS использует XML: -.Parser для разбора RSS. К сожалению, не все файлы
RSS представляют собой правильно сформированные документы XML, не го-
воря уже о простой действительности. Модуль CPAN XML::RSSL1 te предлагает
более свободный подход к разбору RSS — он использует регулярные выражения
и гораздо либеральнее относится к ошибкам XML.
Пример 22.13 использует модули XML::RSSL1 te и LWP::Simplе для приема свод-
ки RSS газеты «Guardian» и вывода элементов, описания которых содержат за-
данные ключевые слова.
Пример 22.13. rss-parser
#!/usr/Ы n/perl -w
# guardian-list -- поиск статей в "Guardian" по ключевым словам
use XML::RSSL1te:
use LWP::SImple:
продолжение &
918
Глава 22. XML
Пример 22.13 (продолжение)
use strict:
# Список ключевых слов
my ^keywords = qw(perl Internet porn Iraq bush):
# Принять RSS
my SURL = ’http://www.guardian.co.Uk/rss/l,,,00.xml':
my Scontent = get(SURL):
# Разобрать RSS
my ^result:
parseRSS(Uresult, \$content):
# Построить регулярное выражение по ключевым словам
my Sre = join ’j", ^keywords:
Sre = qr/\b(?:$re)\b/1:
# Вывести отчет о найденных совпадениях
foreach my Sitem (@{ Sresult{1 terns} }) {
my Stltle = $1tem->{t1tle}:
Stltle =~ s{\s+}{ }: Stltle =~ s{x\s+}{ }: Stltle =~ s{\s+$}{ }:
if (Stltle =~ /Sre/) {
print "$title\n\t$item->{link}\n\n":
}
}
Примерный результат выполнения примера 22.13 будет выглядеть так:
UK troops to lead Iraq peace force
http://www.guard!an.co.uk/1raq/Story/0,2763,989318,00.html ?=rss
Shia cleric challenges Bush plan for Iraq
http://www.guardi an.co.uk/1raq/Story/0,2763,989364.00.html?=rss
Объединив этот пример c XML::RSS, можно сгенерировать новую сводку RSS
на базе отфильтрованных данных. Конечно, было бы проще ограничиться XML::RSS,
но зато комбинированная версия продемонстрирует работу обоих модулей. Пол-
ный код программы приведен в примере 22.14.
Пример 22.14. rss-filter
#!/usr/bin/perl -w
# guardian-filter -- фильтрация сводки RSS "Guardian" по ключевым словам
use XML::RSSLite:
use XML::RSS:
use LWP::Simple;
use strict:
# Список ключевых слов
my ^keywords = qw(perl internet porn Iraq bush):
# Принять RSS
my SURL = 'http://www.guardian.co.Uk/rss/l,,,00.xml’:
my Scontent = get(SURL):
22.9. Чтение и запись файлов RSS
919
# Разобрать RSS
my ^result:
parseRSS(Uresult, \$content):
# Построить регулярное выражение по ключевым словам
my $re = join ", (^keywords:
$re = qr/\b(?:$re)\b/1:
# Создать новую поставку RSS
my Srss = XML: :RSS->new(version => ’0.9Г):
$rss->channel(title => $result{tltle}.
link => Sresult{11nk}.
description => Sresult{descr1pt1on}):
foreach my Sltem (@{ $result{1tems} }) {
my Stltle = $1tem->{t1tle}:
Stltle =~ s{\s+}{ }: $t1tle =~ s{x\s+}{ }: Stltle =~ s{\s+$}{ }:
If (Stltle =~ /Sre/) {
Srss->add_item(t1tle => Stltle, link => $1tem->{11nk}):
}
}
print $rss->as_string:
Пример сгенерированной сводки RSS:
<?xml vers1on="l.0" encod1ng="UTF-8"?>
<!DOCTYPE rss PUBLIC "-//Netscape Communicat1ons//DTD RSS 0.91//EN"
"http://my.netscape.com/publ1sh/formats/rss-0.91.dtd">
<rss vers1on="0.91">
<channel>
<t1tle>Guard1an Uni 1 mlted</t111e>
<11nk>http://www.guardlan.co.uk</11 nk>
<descr1pt1on>Inte!11gent news and comment throughout the day from The Guardian
newspaper</descr1pt1on>
<1tem>
<t1tle>UK troops to lead Iraq peace force</t1tle>
<11nk>http://www.guardlan.co.uk/Iraq/Story/0,2763,989318,00.html?=rss</l1nk>
</1tem>
<1tem>
<t1tle>Sh1a cleric challenges Bush plan for Iraq</t1tle>
<11 nk>http://www.guardlan.co.uk/1raq/Story/0,2763,989364.00.html?=rss</l1nk>
</1tem>
</channel>
</rss>
См. также
Документация по модулям XML::RSS и XML: :RSSL1te.
920
Глава 22. XML
22.10. Построение кода XML
Проблема
Имеется структура данных, которую нужно преобразовать в формат XML.
Решение
Воспользуйтесь функций XMLout модуля XML::Simple:
use XML::Simple qw(XMLout);
my $xml = XMLout(Shashref);
Комментарий
Функция XMLout получает структуру данных и строит ее представление в формате
XML. Например, вот как может генерироваться XML для структуры с информа-
цией о книгах:
#!/usr/Ыn/perl -w
use XML::Simple qw(XMLout):
$ds = {
book => [
{
id => 1,
title => [ "Programming Perl" ],
edition => [ 3 ],
}.
{
id =>2.
title =z> [ "Perl & LWP" ],
edition => [ 1 ],
b
{
id => 3,
title => [ "Anonymous Perl" ].
edition => [ 1 ],
b
]
b
print XMLout($ds, RootName => "books" ):
Программа генерирует следующий код XML:
<books>
<book id="l">
<edition>3</edition>
<title>Programming Perl</title>
</book>
22.10. Построение кода XML
921
<book id="2">
<edition>l</edi ti on>
<title>Perl & </title
</book>
<book id="3">
<edition>l</edition>
<title>Anonymous Perl</title>
</book>
</books>
Соблюдайте следующее правило: все данные, которые должны быть оформ-
лены в виде текста, а не значения атрибута, следует разместить в массиве. Обра-
тите внимание на то, как мы при помощи параметра RootName сообщаем XMLout,
что books является элементом верхнего уровня. Если передать undef или пус-
тую строку, будет сгенерирован фрагмент XML без элемента верхнего уровня.
По умолчанию используется значение opt.
Элемент 1 d каждого хэша преобразуется в атрибут, потому что по умолчанию
XMLout поступает подобным образом с полями id, key и name. Чтобы отменить это
преобразование, поступите так:
XMLout($ds. RootName => "books". KeyAttr => □ ):
Как и в случае с XMLin (см. рецепт 22.1), вы можете указать значения, которые
должны стать атрибутами конкретных элементов:
XMLout($ds. RootName => "books". KeyAttr => [ "car" => "license" ]):
Эта команда указывает XMLout, что атрибуты должны создаваться только для
поля license хэша саг.
XML::Simple соблюдает правило, по которому ключ хэша, начинающийся с дефи-
са (например, -name), считается закрытым и не включается в выходной код XML.
См. также
Документация по модулю XML::Simple; рецепт 22.1.
Алфавитный указатель
переменная, 218
$/, переменная, 306
переменная, 575
$|, переменная, 281
$+, переменная, 218
&&, оператор, 42
.. и ..., операторы, 234
/ (корневой каталог), 380
массив, 408
', оператор, 658
', расширение, 66
||, оператор, 41
||в, оператор, 41
~, расширение в именах файлов, 287
+<, режим открытия, 283
+>, режим открытия, 283
+», режим открытия, 283
<, 278,305
<, режим открытия, 283
<=, 171
=, 185
=~, оператор, 39
>, режим открытия, 283
», режим открытия, 283
А
accept(), 704, 708
alarm(), 695
AND, в регулярных выражениях, 254
Apache, 856, 857, 866, 868, 871, 876, 882
авторизация, 858
аутентификация, 858
журналы, 842
журналы запросов, 870
заметки, 873
обработка запросов, 858
перезагрузка, 876
Apache
кэширование, 869
ASCII, кодировка, 35
atan2(), 111
atime, поле, 381
autoflush(), 316
AUTOLOAD, механизм, 432
AutoLoader, модуль, 502
awk, 308
в
basename(), 399
Berkeley DB, библиотека, 583
bind(), 704
binmode(), 354
bless(), 533,560
В-деревья, 589
c
С, написание модулей, 517
caller(), 414
can(), 556
Carp, модуль, 507
cbreak, режим, 624
ceil(), 99
CGI, 786,791,863
CGI, программирование
методы HTTP, 789
многостраничные сценарии, 812
общие сведения, 786
CGI.pm, модуль, 786
chr(), 45
Class, 549
close(), 273
closedir(), 384
cmp(), 171
color(), 623
colored(), 623
Common Log Format, стандарт, 841
confess(), 507
Config, модуль, 684
Алфавитный указатель
923
cookie, 862
сору(), 388
cos(), 111
CPAN
общие сведения, 482
построение и установка модулей, 523
croak(), 507
CSV, формат, 594
ctime, поле, 381
Curses, модуль, 632
Cwd, модуль, 504
D
Data, 463, 591
Date, 125,439
DateCalc(), 140
Day_of_week(), 132
DBD, 583,608
DBD, модуль, 595
DBI, модуль, 595
DBIx, 594
DBM, библиотеки, 582
DBM, файлы
преобразование, 587
сортировка, 589
хранение сложных данных, 591
dclone(), 464
defined(), 33, 584
delete(), 190
Devel, 469,877
die, функция, 425
Digest, 49
dirname(), 399
DNS, поиск, 751
do(), 361
DOM, модель, 896
DTD, 893
E
each(), 202
Email, 260
eval(), 485
Exception, 426
exec(), 654, 800
execute(), 601
exists(), 187, 584
Expect, модуль, 634
Exporter, модуль, 478
F
fcntl(), 315,421
FETCH(), 574
FIFO, 678
File, 237, 287, 300, 315, 326, 347, 372, 382,
388, 392, 394, 399, 401
fileparse(), 399
FindBinQ, модуль, 496
finddepth(), 396
flock(), 314,329
floor(), 99
foreach(), 167
fork()
закрытие сокета, 725
зомби, 691
неразветвляющие серверы, 728
общие сведения, 654, 671, 800
разветвляющие серверы, 724
FreezeThaw, модуль, 591
FTP, клиенты, 754
G
GD, 644
get(), 822
GET, метод, 789
gethostbyaddr(), 719
gethostbyname(), 719
Getopt, 617
GetOpt, 525
getopt(), 618
GetOptionsQ, 619
getoptsQ, 618
GetTerminalSize(), 622
gmtimeQ, 124
H
h2ph, утилита, 514
Hash, 189
head()(LWP, 833
HEAD, метод, 787
hex(), 116
hidden(), 812
HotKey, модуль, 628
HTML, 826,830,878
HTML, формы, 788
HTTP, 821
httpd.conf, файл, 857
I
If-Modified-Since, заголовок, 839
Image, 645
inet_ntoa(), 708
Inline, 321,520
int(), 99
924
Алфавитный указатель
10, 274, 292, 295, 323, 346, 635, 670, 703, 713, 736, 741 ioctl(), 320, 421 IPC, 669,670,682 isa()(UNIVERSAL), 558 OR, в регулярных выражениях, 254 ord(), 45 output(), 209 p
к keys(), 190, 191, 203 kill, команда, 684 pack(), 45, 356 package, 477 ParseDate(), 134 PDL, модули, 113
L last(), 167 lc(), 61 lcfirst(), 61 LDAP, протокол, 768 Lingua, 119 List, 168,349 listen(), 704 local(), 427 local time(), 124 Logfile, 843 logn(), 113 LWP, 821 LWP, модули, 808 pipe(), 654 places(), 571 pod, документация, 521 pop(), 176 POP3, серверы, 762 POSIX, модуль, 99, 689 POST, метод, 789 prepare(), 601 print(), 704 printf(), 45 push(), 163, 449 р-заметки, 871, 875 R RaiseError, 599
M m//, оператор, 39 Mail, 750,757,758 main, пакет, 478 map(), 174 Mason, 878 Math, 107,110,113,487,507 MIME, 771,775 mirror(), 839 MLDBM, модуль, 467, 591 mod_perl общие сведения, 856 mtime, поле, 381 my, ключевое слово, 410 rand(), 104 read(), 356 readdir(), 392 redirect(), 805 Regexp, 94, 253 retrieve() (Storable), 466 reverse(), 51, 118, 198 rewinddir(), 392 rmdir(), 397 RSS, 916 s s///, оператор, 39 SAX, модель, 896
N Net, 750, 752, 754, 760, 763, 765, 767, 769, 773, 783 Netscape, 611 new(), 534 NOT, в регулярных выражениях, 254 nstore(), 466 Scalar, 96, 470 seek(), 339 seekdir(), 392 select(), 139, 323 SelfLoader, модуль, 501 SGML, 889 Shareable, модуль, 682 shift(), 166
О oct(), 117 open(), 273 shutdown(), 721 SIGALRM, сигнал, 655 SIGCHLD, сигнал, 655 SIGHUP, сигнал, 655
Алфавитный указатель
925
SIGINT, сигнал, 655 SIGPIPE, сигнал, 655 SIGQUIT, сигнал, 655 SIGTERM, сигнал, 655 SIGUSR1 и SIGUSR2, сигналы, 655 sin(), 111 SOAP, 780 SOCK_, константы, 703 sockaddr_in(), 713 sockaddr_un(), 717 socket(), 704 sort(), 171 Soundex, алгоритм, 82 split(), 48, 343, 352 SQL, базы данных, 837 srand(), 106 Stat, 401 stat(), 363 STDERR, 33,280 STDERR, манипулятор, 276 STDIN, манипулятор, 276 STDOUT, манипулятор, 276 Storable, модуль, 591 STOREQ, 574 String, 83, 244 struct(), 549 substrQ, 32, 37, 39 Sys, 280,720,744 sysopenQ, 283 systemQ, 658 UDP, протокол, 714 umask(), 284 uname(), 720 undef, 33 Unicode, 54 unlinkQ, 387 unpackQ, 39, 45, 48 unshiftQ, 176 untie(), 584 URI, 833 URL, 785 use constant, директива, 81 use fields, директива, 551 use strict, директива, 189 use warnings, директива, 509 UTF-8, 338 utime(), 386 w wait(), 692 waitpidQ, 692 wantarrayQ, 415 Week_Number(), 132 Win32, 644 X XML, 889, 893, 895, 896, 897, 902, 903, 908, 915,917 объявления, 891 преобразования, 912 проверка действительности, 893
T TCP, протокол, 705 telldirQ, 392 Template Toolkit, 882 Term, 72, 621, 622, 623, 624, 631 Text, 57, 71, 72, 77, 78, 82, 83, 253, 261, 373 Tie, 78, 195, 204, 335, 350, 575, 589 tie(), 574,584 Time, 136,504,768 timegmQ, 125 timelocal(), 125 Tk, пакет, 615, 639 tr///, оператор, 39 truncateQ, 339 события, 896 XMLRPC, 778 XPath, 895 XSLT, 895 A автоматическое оживление, 274 авторизация, 858 анонимные данные, 443 аргументы общие сведения, 408 передача в именованных параметрах, 417 передача по ссылке, 422 прототипы функций, 421
и uc(), 61 ucfirstQ, 61 асинхронное чтение, 324 асинхронный ввод/вывод, 322 атрибуты, 539, 564 аутентификация, 858
926
Алфавитный указатель
Б
базовый класс, 539, 560
базы данных
запросы, 803
преобразование DBM-файлов, 587
сортировка, 589
устойчивые данные, 592
хранение сложных данных, 591
библиотеки, 481
бизнес-логика, 884
бинарные деревья, 474
блокировка сигналов, 694
брандмауэры, 744
в
ввод/вывод
буферизованный, 339
небуферизованный, 340
операции, 338
уровни, 337, 355
визуальный сигнал, 626
вложенные процедуры, 433
вложенные теги HTML, 832
временные файлы, 299
встроенные документы, 34
г
глобальные величины, сохранение, 427
глубокое копирование, 465
д
данные классов, 548
данные объектов, 548
дата и время
Date, 130, 132, 140
вычисления, 126
общие сведения, 123
таймеры, 136
двоичные файлы, 356
двусторонние клиенты, 722
дейтаграммные сокеты, 703, 712
демоны, 737
деревья, 915
дескрипторы, 274, 297
деструкторы, 470, 535, 566
динамическая область действия, 429
домашний каталог, 287
ж
журнал, веб-сервера, 787
журналы запросов, 870
3
заголовки, 865
закрепление, 606
заметки, 873
замыкания, 453
и
идемпотентность, 787
именованные каналы, 678
индексные узлы, 380
инструкции по обработке, 891
исключения
обработка, 425
перехват, 432
истинность, логическая, 33
к
каскадные команды, 638
каталоги
копирование файлов, 388
модулей, 497
общие сведения, 380
переименование файлов, 397
сортировка, 391
удаление файлов, 396
классы
генерация методов с помощью
AUTOLOAD, 563
доступ к переопределенным
методам, 561
как структуры, 549
наследование, 532
общие сведения, 532
клиенты
FTP, 754
TCP, 705
UDP, 712
двусторонние, 722
комбинированные символы, 369
комментарии
в документации pod, 522
в регулярных выражениях, 223
комплексные числа, ИЗ
конструкторы, 534, 561
контурные схемы, 472
конфигурационные файлы, 360
копирование
структур данных, 464
файлов, 388
кэширование, 294
л
логарифмы, 112
локальные контексты, 36
локальный контекст, 242
Алфавитный указатель
927
М
манипуляторы
общие сведения, 273
связанные, 574
маска доступа, 284
массивы
анонимные, 443
изменение размера, 148
инициализация, 144
многомерные, 144
общие сведения, 143
объединение, 161
перебор элементов, 152
последний индекс, 148
случайные перестановки, 177
сортировка, 171
сравнение со списками, 143
умножение матриц, ИЗ
хэши массивов, 446
метасимволы, 52
методы, 532
методы класса, 534
методы объектов, 534
модули
AUTOLOADER, 502
SelfLoader, 501
загрузка, 485
написание на С, 517
общие сведения, 477
проектирование интерфейса, 478
монопольная блокировка, 314
н
накопитель, 884
натуральные логарифмы, 112
Нейгла, алгоритм, 711
неразветвляющиеся серверы, 728
неформальный поиск, 243
о
область аутентификации, 861
обработчики, 856
автоматические, 881
установка, 856
объединение массивов, 161
объекты
конструирование, 534
общие сведения, 532
октеты, 35
определенность, 33
откат, 605
ошибка, признак, 421
п
пакеты, 452
общие сведения, 477
парсер, 892
перевод строки, 337
перегрузка операторов, 568
переменные, 57
перенаправление, 864
поверхностное копирование, 465
построение модулей от CPAN, 523
потоковые сокеты, 703
потомки, 858
преобразование
ASCII-символов и кодов, 45
DBM-файлов, 587
между ASCII и HTML, 828
формат pod, 521
приведение, 533
привязка, 601
производные классы, 560
пропуски, 51
прототипы, 421
прямые ссылки, 385
р
регулярные выражения
комментарии, 223
неформальный поиск, 82
общие сведения, 118
список, 270
режимы доступа, 283
с
сглаживание списков, 164
синонимы
для элементов списков, 154
скалярное умножение, 114
скалярные переменные, 32
сокеты
TCP, 709
UDP, 712
Unix, 703
двусторонние клиенты, 722
дейтаграммные, 703
идентификация компьютеров, 718
Интернета, 703
общие сведения, 703
потоковые, 703
соединение через брандмауэр, 744
928
Алфавитный указатель
списки
инициализация, 144
общие сведения, 143
сглаживание, 164
циклические, 176
списковый контекст, 422
сравнение
ключей в хэшах, 203
ссылки
на массивы, 443
на скаляры, 442
на функции, 451
на хэши, 442
общие сведения, 441
строки
общие сведения, 32
поиск по шаблону, 218
поиск слов, 222
последовательная обработка
символов, 48
форматирование абзацев, 71
субъекты, 441
схемы, 893
т
таблицы стилей, 895
текстовые файлы, 354
тип-глобы, 291
транзакции, 605
У
уборка мусора, 532
уровни ввода/вывода, 337, 355
условная блокировка, 314
ф
файлы, 334
двоичные, 354
конфигурационные, 360
фильтры, 905
формы, 866
X
хронометраж, 877
хэши
анонимные, 443
добавление элементов, 186
инвертирование, 198
инициализация, 185
массивов, 446
общие сведения, 155
объединение, 201
сортировка, 200
удаление элементов, 190
ц
циклические списки, 176
циклические структуры данных, 565
ш
шаблоны, 882
Mason, 878
э
экранирование, 34, 73
эпоха, начало, 123
ю
Юникод, 368
Юникод, кодировка, 36
O’REILLY®
Perl. Сборник рецептов для профессионалов
| I Рег1- Сборник рецептов представляет собой обширный набор задач, решений
и практических примеров для всех программистов Perl. Первое издание
сборника, опубликованное в 1998 г., пользовалось огромным успехом.
Книга быстро прославилась не только как один из лучших учебников
по ЯЗЫКУ Рег^’но и как °ДНО из самых удачных пособий по программированиь
ЖЖЭДГ ! вообще. Фактически она положила начало новой разновидности книг по
программированию, которые не ограничиваются изложением полезных советов и приемов,
а обучают тонкостям программирования на примере реальных задач.
С момента выхода первого издания Perl обогатился дополнительными возможностями,
а также появился ряд новых технологий. Возникла необходимость во втором, расширенном
издании. В книгу добавлены две главы, а многие старые главы были дополнены.
В общей сложности появилось более 80 новых рецептов, а около 100 старых рецептов
было обновлено для использования новых модулей или средств языка.
Как и в первом издании Perl. Сборник рецептов, в книге рассматривается множество тем:
обработка данных (строки, числа, даты, массивы и хэши), файловый ввод/вывод, регулярные
выражения, модули, ссылки, объекты, структуры данных, обработка сигналов, операции
с базами данных, графические приложения, межпроцессные взаимодействия, безопасность,
интернет-программирование, CGI и LWP.
Кроме того, во втором издании вы найдете:
• описание поддержки Юникода в Perl, особенно в области обработки строк, применения
регулярных выражений и файлового ввода/вывода;
• главу, посвященную программированию mod_perl — модуля Apache, обеспечивающего
интеграцию Perl с веб-сервером Apache. Modjperl существенно ускоряет выполнение
задач, которые раньше приходилось выполнять средствами CGI;
• новые и обновленные рецепты, в которых используются модули, недавно вошедшие
в базовую поставку Perl;
• главу, посвященную обработке XML, — всеобщему стандарту представления данных,
а также обмена документами и информацией независимо от их конечной формы.
Многие считают Perl. Сборник рецептов самой полезной из когда-либо написанных
книг по языку Perl. Она учит программированию самым эффективным способом —
показывает, как задача решается специалистами, а затем объясняет, как работает
представленное решение. Эта книга рассказывает не о языке программирования Perl,
а о том, как на нем программировать.
Посетите веб-сайт издательства O'Reilly: www.oreilly.com
СЕЛИГЕР
Серия: для профессионалов
Уровень пользователя: опытный
Посетите наш веб-магазин: http://www.piter.com