Сборник рецептов

ДЛЯ ПРОФЕССИОНАЛОВ

O'R 日 LLY®

哮ППТЕР®

Том Кристиансен

Натан Торкингтон

Perl Cookbook

Second Edition

Tom Christiansen and Nathan Torkington

O'REILLY®

Beijing • Cambridge • Famham • Koln • Paris • Sebastopol • laipei • lokyo

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. Программирование CGI785

Глава 20. Автоматизация в Веб821

Глава 21. mod_perl 856

Глава 22. XML889

Алфавитный указатель922

Содержание

Предисловие18

Введение20

О чем рассказано в этой книге21

Что нового в этом издании 23

Платформы24

Условные обозначения, использованные в книге25

Благодарности для первого издания27

Благодарности для второго издания30

От издательства31

Глава 1. Строки32

.0. Введение32

Работа с подстроками38

Выбор значения по умолчанию41

Перестановка значений без использования временных переменных44

Преобразование между символами и ASCII-кодами45

Использование именованных символов Юникода47

Посимвольная обработка строк48

Обратная перестановка слов или символов51

Интерпретация комбинированных символов Юникода как одиночных символов52

Приведение строк с комбинированными символами Юникода к каноническому виду54

Интерпретация строки Юникода как последовательности октетов55

Расширение и сжатие символов табуляции57

Расширение переменных во входных данных58

Преобразование регистра60

Расстановка прописных букв в заголовках62

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

Отступы во встроенных документах67

Переформатирование абзацев71

Экранирование символов73

Удаление пропусков в обоих концах строки75

Анализ данных, разделенных запятыми77

Константы80

Сравнение слов с похожим звучанием82

Программа: fixstyle84

Программа: psgrep87

Глава 2. Числа92

.0. Введение92

Проверка строк на соответствие числам93

Округление чисел с плавающей запятой96

Сравнение вещественных чисел100

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

Работа с числами в римской записиЮЗ

Генератор случайных чиселЮ4

Получение повторяющихся серий случайных чисел 105

Повышение фактора случайностиЮб

Получение случайных чисел с неравномерным распределением107

Выполнение тригонометрических вычислений в градусах110

Тригонометрические функцииШ

Вычисление логарифмов112

Умножение матрициз

Операции с комплексными числами115

Преобразования двоичных, восьмеричных и шестнадцатеричных чисел . . . 116

Вывод запятых в числах118

Правильный вывод во множественном числе119

Программа: разложение на простые множители121

Глава 3. Время и дата123

.0. Введение123

Определение текущей даты126

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

Преобразование секунд с начала эпохи в полное время128

Операции сложения и вычитания для дат129

Вычисление разности между датами130

Определение номера недели или дня недели/месяца/года132

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

Вывод даты135

Таймеры высокого разрешения136

Короткие задержки139

Программа: hopdelta140

Глава 4. Массивы143

.0. Введение143

Определение списка в программе144

Вывод списков с запятыми146

Изменение размера массива148

Реализация разреженного массива150

Выполнение операции с каждым элементом списка152

Перебор массива по ссылке155

Выборка уникальных элементов из списка156

Поиск элементов одного массива, отсутствующих в другом массиве158

Вычисление объединения, пересечения и разности уникальных списков . . 161

Присоединение массива163

Обращение массива164

Обработка нескольких элементов массива 165

Поиск первого элемента списка, удовлетворяющего некоторому критерию 167

Поиск всех элементов массива, удовлетворяющих определенному критерию 170

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

Сортировка списка по вычисляемому полю172

Реализация циклических списков176

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

Программа: words178

Программа: permute180

Глава 5. Хэш и 184

.0. Введение184

Занесение элемента в хэш186

Проверка наличия ключа в хэше187

Создание хэша с неизменяемыми ключами или значениями189

Удаление из хэша190

Перебор хэша191

Вывод содержимого хэша194

Перебор элементов хэша в порядке вставки195

Хэши с несколькими ассоциированными значениями196

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

Сортировка хэша200

Объединение хэшей201

Поиск общих или различающихся ключей в двух хэшах203

Хэширование ссылок204

Предварительное выделение памяти для хэша205

Поиск самых распространенных значений206

Представление отношений между данными 206

Программа: dutree208

Глава 6. Поиск по шаблону213

.0. Введение213

Копирование с подстановкой 219

Идентификация алфавитных символов220

Поиск слов222

Комментирование регулярных выражений223

Поиск N-ro совпадения 227

Межстрочный поиск229

Чтение записей с разделением по шаблону232

Извлечение строк из определенного интервала233

Работа с метасимволами командных интерпретаторов236

Ускорение интерполированного поиска238

Проверка правильности шаблона240

Локальный контекст в регулярных выражениях242

Неформальный поиск243

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

Максимальный и минимальный поиск246

Поиск повторяющихся слов249

Поиск вложенных конструкций252

Логические операции AND, OR и NOT в одном шаблоне254

Проверка адресов электронной почты259

Поиск сокращений260

Программа: urlify262

Программа: tcgrep263

Копилка регулярных выражений270

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

.0. Введение273

Открытие файла281

Открытие файлов с нестандартными именами285

Тильды в именах файлов287

Имена файлов в сообщениях об ошибках288

Сохранение файловых манипуляторов в переменных289

Написание процедуры, получающей файловые манипуляторы293

Кэширование открытых манипуляторов вывода 294

Одновременный вывод по нескольким манипуляторам295

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

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

Создание временных файлов299

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

Сохранение нескольких файлов в области DATA302

Создание фильтра305

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

Непосредственная модификация файла с помощью параметра -i310

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

Блокировка файла313

Очистка буфера316

Асинхронный вво/^вывод319

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

Асинхронное чтение из нескольких манипуляторов322

Асинхронное чтение полной строки324

Программа: netlock326

Программа: lockarea329

Глава 8. Содержимое файлов334

.0. Введение334

Чтение строк с символами продолжения340

Подсчет строк (абзацев, записей) в файле341

Обработка каждого слова в файле343

Чтение файла по строкам или абзацам в обратном направлении344

Чтение из дополняемого файла346

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

Случайная перестановка строк349

Чтение строки с конкретным номером350

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

Удаление последней строки файла353

Обработка двоичных файлов 354

Ввод/вывод с произвольным доступом355

Обновление файла с произвольным доступом356

Чтение строки из двоичного файла357

Чтение записей фиксированной длины359

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

Проверка достоверности файла363

Интерпретация файла как массива365

Назначение уровней ввода/вывода 367

Чтение и запись Юникода через файловый манипулятор368

Преобразование текстовых файлов Microsoft в Юникод370

Сравнение содержимого двух файлов372

Интерпретация строки как файла374

Программа: tailwtmp374

Программа: tctee375

Программа: laston377

Программа: индексация файла378

Глава 9. Каталоги380

.0. Введение380

Получение и установка атрибутов времени385

Удаление файла387

Копирование или перемещение файла388

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

Обработка всех файлов каталога390

Получение списка файлов по шаблону392

Рекурсивная обработка всех файлов каталога393

Удаление каталога вместе с содержимым396

Переименование файлов397

Деление имени файла на компоненты399

Работа с разрешениями доступа к файлам в символьном представлении . . 400

Программа: symirror402

Программа: 1st403

Глава 10. Процедуры407

.0. Введение407

Доступ к аргументам процедуры408

Создание закрытых переменных в функциях410

Создание устойчивых закрытых переменных412

Определение имени текущей функции414

Передача массивов и хэшей по ссылке415

Определение контекста вызова416

Передача именованных параметров 417

Пропуск некоторых возвращаемых значений418

Возврат нескольких массивов или хэшей419

Возвращение признака неудачного вызова420

Прототипы функций421

Обработка исключений425

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

Переопределение функции430

Перехват вызовов неопределенных функций с помощью AUTOLOAD . . . . 432

Вложенные процедуры433

Имитация команды switch434

Сортировка почты438

Глава 11. Ссылки и записи441

.0. Введение441

Ссылки на массивы447

Создание хэшей массивов 449

Получение ссылок на хэши450

Получение ссылок на функции451

Получение ссылок на скаляры454

Создание массивов ссылок на скаляры455

Применение замыканий вместо объектов457

Создание ссылок на методы458

Конструирование записей459

Чтение и сохранение записей в текстовых файлах461

Вывод структур данных462

Копирование структуры данных464

Сохранение структур данных на диске465

Устойчивые структуры данных467

Циклические структуры данных и слабые ссылки468

Программа: Outlines472

Программа: бинарные деревья474

Глава 12. Пакеты, библиотеки и модули477

.0. Введение477

Определение интерфейса модуля482

Обработка ошибок require и use485

Отложенное использование модуля486

Ограничение доступа к переменным модуля488

Ограничение доступа к функциям модуля491

Определение пакета вызывающей стороны492

Автоматизированное выполнение завершающего кода494

Ведение собственного каталога модулей496

Подготовка модуля к распространению499

Ускорение загрузки модуля с помощью SelfLoader501

Ускорение загрузки модуля с помощью Autoloader502

Переопределение встроенных функций503

Переопределение встроенной функции во всех пакетах505

Вывод сообщений об ошибках и предупреждений по аналогии со встроенными функциями507

Настройка предупреждений509

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

Применение h2ph для преобразования заголовочных файлов С514

Применение h2xs для создания модулей с кодом С517

Написание расширений на С с использованием Inline: :С520

Документирование модуля в формате pod521

Построение и установка модуля CPAN523

Пример: шаблон модуля526

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

Глава 13. Классы, объекты и связи532

.0. Введение532

Конструирование объекта540

Уничтожение объекта542

Работа с данными экземпляра 544

Управление данными класса547

Использование класса как структуры549

Клонирование объектов553

Копирующие конструкторы554

Косвенный вызов методов555

Определение принадлежности субкласса557

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

Вызов переопределенных методов561

Генерация методов доступа с помощью AUTOLOAD563

Использование циклических структур данных565

Перегрузка операторов568

Создание «магических» переменных функцией tie573

Глава 14. Базы данных581

.0. Введение581

Создание и использование DBM-файла584

Очистка DBM-файла586

Преобразование DBM-файлов586

Объединение DBM-файлов588

Сортировка больших DBM-файлов589

Хранение сложных структур данных в DBM-файлах590

Устойчивые данные592

Сохранение результатов запроса в Excel или в CSV594

Выполнение команд SQL с помощью DBI595

Экранирование строк598

Обработка ошибок при операциях с базами данных599

Эффективное повторение запросов600

Программное построение запросов602

Определение количества записей, возвращаемых запросом604

Использование транзакций605

Постраничный просмотр данных606

Запросы к файлам CSV с использованием SQL608

Работа с SQL без сервера БД609

Программа: ggh —- поиск в глобальном журнале Netscape611

Глава 15. Интерактивность615

.0. Введение615

Лексический разбор аргументов617

Проверка интерактивного режима619

Очистка экрана621

Определение размера терминала или окна622

Изменение цвета текста622

Чтение символа с клавиатуры624

Предупреждающие сигналы625

Использование termios627

Проверка наличия входных данных629

Ввод пароля629

Редактирование входных данных630

Управление экраном632

Управление другой программой с помощью Expect 634

Создание меню с помощью Тк636

Создание диалоговых окон с помощью Тк639

Обработка событий масштабирования вТк642

Удаление окна сеанса DOS в Perl/Tk для Windows643

Построение диаграмм644

Создание миниатюр645

Включение текста в изображение646

Программа: tcapdemo 647

Программа: tkshufflepod649

Программа: graphbox651

Глава 16- Управление процессами и межпроцессные взаимодействия . . 653

.0. Введение653

Получение вывода от программы656

Запуск другой программы658

Замена текущей программы660

Получение или передача данных другой программе661

Фильтрация выходных данных663

Предварительная обработка ввода665

Чтение содержимого STDERR666

Управление потоками ввода и вывода другой программы669

Управление потоками ввода, вывода и ошибок другой программы670

Взаимодействие между родственными процессами673

Имитация файла на базе именованного канала678

Совместное использование переменных в разных процессах681

Получение списка сигналов683

Посылка сигнала684

Установка обработчика сигнала685

Временное переопределение обработчика сигнала687

Написание обработчика сигнала688

Перехват Ctrl+C690

Уничтожение процессов-зомби691

Блокировка сигналов694

Тайм-аут695

Преобразование сигналов в фатальные ошибки697

Программа: sigrand698

Глава 17. Сокеты703

.0. Введение703

Написание клиента TCP705

Написание сервера TCP707

Передача данных через TCP709

Создание клиента UDP712

Создание сервера UDP715

Использование сокетов UNIX717

Идентификация другого конца сокета718

Определение вашего имени и адреса720

Закрытие сокета после разветвления721

Написание двусторонних клиентов722

Разветвляющие серверы724

Серверы с предварительным ветвлением725

Серверы без ветвления728

Многопоточный сервер732

Написание многопоточного сервера с использованием РОЕ733

Написание многоканального сервера735

Создание сервера-демона737

Перезапуск сервера по требованию739

Управление несколькими потоками ввода740

Про「рамма: backsn肝744

Программа: fwdport744

Глава 18. Протоколы Интернета749

.0. Введение749

Простой поиск в DNS751

Клиентские операции FTP 754

Отправка почты757

Чтение и отправка новостей Usenet760

Чтение почты на серверах POP3762

Программная имитация сеанса telnet765

Проверка удаленного компьютера766

Обращение к серверу LDAP768

Отправка вложений по электронной почте771

Извлечение вложений из сообщений774

Написание сервера XML-RPC776

Написание клиента XML-RPC778

Написание сервера SOAP779

Написание клиента SOAP780

Программа: rfrm781

Программы: ехрп и vrfy783

Глава 19. Программирование CGI 785

.0. Введение785

Написание сценария CGI788

Перенаправление сообщений об ошибках791

Исправление ошибки 500 Server Error792

Написание безопасных программ CGI796

Выполнение команд без обращений к командному интерпретатору . . . . 799

Форматирование списков и таблиц средствами HTML802

Перенаправление клиентского браузера804

Отладка на уровне HTTP806

Работа с cookie808

Создание устойчивых элементов810

Создание многостраничного сценария CGI812

Сохранение формы в файле или канале814

19J3. Про「рамма: chemisehe816

Глава 20. Автоматизация в Веб 821

.0. Введение821

Обращение по URL из сценария Perl822

Автоматизация отправки формы824

Извлечение URL826

Преобразование ASCII в HTML828

Преобразование HTML в ASCII829

Удаление тегов HTML830

Поиск устаревших ссылок833

Поиск недавно обновлявшихся ссылок834

Создание шаблонов HTML835

Зеркальное копирование веб-страниц838

Создание робота839

Анализ файла журнала веб-сервера840

Обработка серверных журналов842

Работа с cookie844

Загрузка страниц, защищенных паролем845

Загрузка веб-страниц https://846

Продолжение загрузки по команде HTTPGET847

Разбор кода HTML848

Извлечение табличных данных851

Программа: htmlsub853

Программа: hrefsub854

Глава 21. mod_perl 856

.0. Введение856

Аутентификация860

Установка cookie862

Получение значений cookie863

Перенаправление браузера864

Чтение информации из заголовков865

Работа с параметрами форм866

Получение отправленных файлов867

Ускорение операций с базой данных .. . 868

Настройка ведения журналов Apache870

Прозрачное хранение данных в URL871

Взаимодействие между mod_perl и PHP873

Переход с CGI на mod_perl873

Передача информации между обработчиками875

Повторная загрузка измененных модулей876

Хронометраж 叩иложени达 mod_perl877

Построение шаблонов с использованием HTML::Mason878

Построение шаблонов с использованиемTemplate Toolkit882

Глава 22. XML 889

.0. Введение889

Разбор XML в структуры данных897

Разбор кода XML в деревья DOM 899

Разбор кода XML в события SAX902

Простые изменения в элементах и тексте905

Проверка действительности XML907

Поиск элементов и текста в документе XML910

Обработка преобразований таблиц стилей XML912

Обработка больших файлов915

Чтение и запись файлов RSS916

Построение кода XML920

Алфавитный указатель922

Предисловие

Говорят, метафорами легко увлечься. Но некоторые метафоры настолько хороши, что в таком увлечении нет ничего плохого. Вероятно, к их числу относится и метафора поваренной книги — по крайней мере, в данном случае. Меня смущает лишь одно: представленная работа настолько монументальна, что все сказанное мной будет либо повторением, либо пустыми словами.

Впрочем, прежде меня это никогда не останавливало.

Вероятно, кулинария является самым скромным из всех искусств; но я всегда считал скромность достоинством, а не недостатком. Великий художник, как и великий повар, всегда работает с конкретными выразительными средствами. И чем скромнее средства, тем скромнее должен быть художник, чтобы вывести их за рамки обыденного. И еда, и язык программирования относятся к скромным средствам; они состоят из внешне разрозненных ингредиентов. И все же в руках мастера, наделенного творческим мышлением и дисциплиной, из самых обыденных вещей — картошки, макарон и Perl — возникают произведения искусства, которые не просто справляются со своей задачей, но и делают это так, что ваше странствие по жизни становится чуть более приятным.

Кроме того, кулинария принадлежит к числу самых древних искусств. Некоторые современные художники полагают, что так называемое эфемерное искусство изобрели совсем недавно, однако кулинария всегда была эфемерным искусством. Мы пытаемся сохранить произведения искусства, продлить их существование, но даже пища, захороненная вместе с фараонами, со временем приходит в негодность. Итак, плоды нашего программирования на Perl тоже в чем-то эфемерны. Этот аспект «кухни Perl» часто порицают. Если хотите — называйте его «программированием на скорую руку», но миллиардные обороты в кафе быстрого обслуживания позволяют надеяться, что быстрая еда может быть качественной (нам хотелось бы в это верить).

Простые вещи должны быть простыми, а сложные... возможными. На один рецепт быстрых блюд приходится бесчисленное множество обычных рецептов. Одна из прелестей жизни в Калифорнии заключается в том, что для меня доступна практически любая национальная кухня. Но даже в границах одной культуры у каждой задачи всегда найдется несколько решений. Как говорят в России — «сколько поваров, столько и рецептов борща», и я этому верю. Рецепт моей мамы даже обходится без свеклы! И это вполне нормально. Борщ становится неким разделителем культур, а культурное разнообразие интересно, познавательно, полезно и увлекательно.

Итак, Том и Нат в этой книге не всегда делают все так, как бы это сделал я. Иногда они даже не могут прийти к единому решению — и это тоже сила, а не слабость. Признаюсь, из этой книги я узнал кое-что новое. Более того, наверняка и сейчас я знаю далеко не все (и надеюсь, не узнаю в ближайшее время). Мы часто говорим о культуре Perl так, словно она является чем-то единым, непоколебимым, хотя в действительности существует множество здоровых субкультур Perl, не говоря уже о всевозможных сочетаниях суб-субкультур, суперкультур и околокультур, наследующих друг от друга атрибуты и методы.

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

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

Ларри Уолл, июнь 1998 г.

Введение

Бизнесмены осторожно разглядывали докладчика, скепсис на лицах переходил в заинтересованность и наоборот.

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

«Прежде всего, — ответил он, — я знаю, как вертикально поставить яйцо без внешней опоры. А вы?» С этими словами докладчик залез в сумку и осторожно вынул свежее куриное яйцо. Он передал яйцо финансовым магнатам, которые передавали его из рук в руки, пытаясь справиться с несложной задачей. Все попытки оказались тщетными. Раздавались отчаянные возгласы: «Это невозможно! Никому не удастся поставить яйцо вертикально!»

Докладчик взял яйцо у рассерженных бизнесменов и поставил яйцо на дубовый стол, прочно удерживая его в руках. После легкого, но уверенного нажатия скорлупа слегка потрескалась. Когда докладчик убрал руку, яйцо осталось на месте — слегка продавленное, но определенно устойчивое. «Что здесь невозможного?» —спросил он.

«Но это же обычный фокус, — закричали бизнесмены. — Такое может сделать любой!»

«Ваша правда, — последовал ответ. — Но это относится ко всему. Пока вы не знаете решения, задача кажется невозможной. А решение выглядит так просто, что вы не понимаете, почему это раньше не приходило вам в голову. Так позвольте мне показать простое решение, чтобы другие могли легко пойти тем же путем. Вы мне доверяете?»

Скептически настроенные капиталисты убедились, что предприниматель действительно на что-то способен, и выделили деньги на его проект. Из маленького андалузского порта отправились в море «Нинья», «Пинта» и «Санта Мария». Их вел предприниматель с надбитым яйцом и своими идеями — Христофор Колумб.

За ним последовали многие.

Задачи программирования часто похожи на колумбово яйцо. Пока никто не покажет решения, вы сидите и смотрите, как яйцо (то бишь программа) падает снова и снова, ни на шаг не приближаясь к решению. Это особенно справедливо для таких идиоматических языков, как Perl.

Эта книга не задумывалась как полный справочник по Perl, хотя мы опишем некоторые недокументированные аспекты Perl. Любая поставка Perl содержит

свыше 1000 страниц электронной документации. Если их не окажется под рукой, обратитесь к системному администратору или к разделу документации на сайте http://www.perl.сот.

Итак, эта книга — для тех, кто хочет лучше узнать Perl. Перед вами не справочник и не учебник, хотя книга окажется полезным дополнением к ним. Она предназначена для людей, которые изучили основы языка и теперь пытаются связать ингредиенты в готовую программу. На протяжении 22 глав и свыше 400 отдельных тем, которые можно назвать «рецептами», вы найдете тысячи решений для повседневных задач, с которыми сталкиваются как новички, так и опытные программисты.

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

Главы начинаются с краткого обзора. За Введением следует основная суть главы, ее рецепты. В духе лозунга Perl — «Всегда существует несколько решений» —во многих рецептах продемонстрированы разные способы решения той же самой или аналогичной задачи. Рецепты простираются от конкретных решений в стиле «коротко, но мило» до углубленных мини-учебников. Там, где приведено несколько вариантов, мы часто объясняем преимущества и недостатки каждого подхода.

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

Каждая глава завершается одной или несколькими законченными программами. Хотя некоторые рецепты уже содержат маленькие программы, эти приложения выделяют основную тему главы; кроме того, в них, как и в любой реальной программе, используются приемы из других глав. Все эти программы полезны, некоторые из них используются ежедневно. Некоторые программы даже помогли нам в работе над книгой.

О чем рассказано в этой книге

Первая четверть книги, занимающая пять глав, посвящена базовым типам данных Perl. В главе 1 «Строки» рассматриваются такие вопросы, как работа с подстроками, расширение вызовов функций в строках и разбор данных, разделенных запятыми. Глава 2 «Числа» описывает некоторые странности представления с плавающей запятой, разделение разрядов запятыми и процесс генерации псевдослучайных чисел. Глава 3 «Дата и время» демонстрирует преобразования

между числовыми и строковыми форматами даты и применение таймеров. В главе 4 «Массивы» рассматривается все, что относится к операциям со списками и массивами, в том числе поиск уникальных элементов, эффективная сортировка и случайные перестановки элементов. Глава 5 «Хэши» завершает основы языка и представляет самый полезный тип данных — ассоциативные массивы. В ней показано, как обращаться с элементами хэша в порядке вставки, как отсортировать хэш по значению и как хранить несколько ассоциированных значений для одного ключа.

Рецепты главы 6 «Поиск по шаблону» описывают преобразование метасимволов командного интерпретатора в шаблоны, поиск букв и слов, многострочные совпадения, минимализм при поиске, а также поиск строк, которые близки к искомым, но не совпадают с ними. Хотя глава и так получилась самой длинной, она могла бы стать еще длиннее — в каждой главе вы найдете примеры использования регулярных выражений. Это часть того, что придает Perl его неповторимость.

Три следующие главы относятся к файловой системе. В главе 7 «Доступ к файлам» показано, как открыть файл, заблокировать его для параллельной работы, модифицировать его на месте и сохранить файловый манипулятор в переменной. В главе 8 «Содержимое файлов» обсуждается проблема сохранения манипуляторов в переменных, операции с временными файлами, поиска конца увеличивающегося файла, чтение конкретной строки файла, работа с альтернативными кодировками типа Юникода, и двоичный ввод/вывод с произвольным доступом. Наконец, в главе 9 «Каталоги» описаны приемы копирования, перемещения и удаления файлов, изменения атрибутов времени файла и рекурсивной обработки всех файлов каталога.

Основное внимание в главах 10-13 уделено тому, как сделать программы более гибкими и функциональными. Глава 10 «Процедуры» содержит рецепты для создания устойчивых локальных переменных, передачи параметров по ссылке, косвенного вызова функций, имитации конструкции switch и обработки исключений. Глава И «Ссылки и записи» посвящена структурам данных; продемонстрированы основные операции со ссылками на данные и функции. Также в ней показано, как создавать аналоги конструкции struct языка С, как сохранять и загружать их из устойчивого хранилища. В главе 12 «Пакеты, библиотеки и модули» рассматривается деление программы на отдельные файлы; создание переменных и функций, действующих только в границах данного модуля; замена встроенных функций, перехват обращений к отсутствующим модулям и использование утилит h2Ph и h2xs для использования кода, написанного на С и C++. Наконец, в главе 13 «Классы, объекты и связи» рассматриваются основные принципы построения объектно-ориентированных модулей для создания пользовательских типов, обладающих конструкторами, деструкторами и возможностями наследования. В других рецептах показаны примеры использования циклических структур данных, перегрузки операторов и связанных типов данных.

Две следующие главы посвящены интерфейсам: первая — интерфейсам к базам данных, вторая — пользовательским интерфейсам. В главе 14 «Базы данных» описана методика работы с файлами DBM, выборки и обновления баз данных с применением SQL и модуля DBI. В главе 15 «Интерактивность» рассматрива-

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

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

POSIX (Portable Operating System Interface) — к их числу принадлежат практически все разновидности Unix и множество других операционных систем. Большинство рецептов будет работать в любой POSIX-системе без каких-либо изменений (или с минимальными изменениями).

Perl может использоваться для системного программирования даже в системах, не соответствующих стандарту POSIX. Для этого вам понадобятся специализированные модули для этих систем, однако в этой книге они не рассматриваются. Это объясняется тем, что такие программы не переносимы, — и, честно говоря, еще и тем, что в распоряжении авторов таких систем нет. Информация о специализированных модулях приведена в документации, прилагаемой к вашей версии Perl. Например, можно начать со страницы руководства perlport (1); в разделе SEE ALSO приводятся ссылки на документацию для конкретных платформ (например, perlmacos^i) и 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：

Однако некоторые примеры должны вводиться в приглашении командной строки. Приглашение обозначается символом %:

% perl -е 'print "Hello, world.\"'

Hello, world.

Подобный стиль характерен для стандартных командных строк Unix. Правила определения строк и универсальные символы в других системах могут быть другими. Например, большинство стандартных командных интерпретаторов в MS-DOS и VMS требует, чтобы для группировки аргументов с пробелами или универсальными символами использовались кавычки вместо апострофов.

Шрифтовое выделение

В книге использованы следующие условные обозначения:

Курсив

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

Моноширинный шрифт

Имена функций и методов, а также их аргументы. В примерах обозначает непосредственно вводимый текст, а в тексте книги — элементы программного кода.

Моноширинный полужирный шрифт

Выходные данные в примерах.

ВНИМАНИЕ Предупреждение или предостережение.

Документация

Самая свежая и полная документация по Perl распространяется вместе с Perl. В печатном виде эта объемистая антология займет свыше 1000 страниц и внесет заметный вклад в глобальную вырубку лесов. К счастью, распечатывать ее не нужно, поскольку вся документация представлена в удобном электронном виде с возможностями поиска.

Говоря о «страницах руководства» в этой книге, мы имеем в виду набор электронных документов. Название чисто условное; для их чтения необязательно использовать программу man, традиционную для UNIX. Также подойдет команда perldoc, распространяемая с Perl. Страницы руководства даже могут устанавливаться в виде HTML-страниц, особенно в системах, не принадлежащих к семейству Unix. Если вам известно местонахождение электронной документации, вы сможете искать в ней информацию с помощью утилиты grep1. HTML-версия электронной документации также имеется в Веб по адресу http：/ / www.perl.com/CPAN/doc/manual.html/.

Если утилита grep отсутствует в вашей системе, воспользуйтесь программой tcgrep, приведенной в конце главы 6.

Когда мы ссылаемся на документацию, не относящуюся к Perl (например, «См. страницу руководства 班〃⑵ вашей системы»), речь идет о странице 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 Огат), Брент Халси (Brent Halsey), Брайан Баас (Bryan Buus), Джайсл Aac (Gisle Aas), Грэхем Барр (Graham Barr), Джефф Хемер (Jeff Наешег), Джеффри Фридл (Jeffrey Friedl), Линкольн Стейн (Lincoln Stein), Марк Мильке (Mark Mielke), Мартин Бреч (Martin Brech), Маттиас Неерахер (Matthias Neeracher), Майк Сток (Mike Stok), Нат Патвардхан (Nate Patwardhan), Пол Грасси (Paul Grassie), Питер

А также вставлял сноски.

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

границы строки или ограниченного определенным разделом и т. д. Некоторые из этих утилит описаны в книге.

Том

Прежде всего, благодарю Ларри и Глорию за то, что они пожертвовали частью своего отпуска в Европе для работы над книгой, а также моих друзей и семью — Брайана, Шерон, Брента, Тодда и Дрю — за то, что они терпели меня в течение двух последних лет и выдержали бесчисленные проверки ошибок.

Хочу поблагодарить Натана за то, что он выдержал свои еженедельные поездки, мою пикантную вегетарианскую кухню, а также за то, что он упрямо исследовал темы, которые я старался избегать.

Благодарю наших безвестных титанов, Денниса, Линуса, Кирка, Эрика и Рича, которые тратили время на мои глупые вопросы об операционной системе и troff. Они проделали громадную работу, без которой эта книга никогда бы не была написана.

Также благодарю моих учителей, которые доблестно отправлялись в опасные места типа Нью-Джерси и преподавали Perl. Благодарю Тима ОТейли (Tim O'Reilly) и Фрэнка Уиллисона (Frank Willison): во-первых — за то, что они поддались на уговоры и согласились опубликовать эту книгу, и во-вторых — за то, что они ставили на первое место качество, а не скорость работы. Также благодарю Линду, нашего ошеломляюще честного редактора, за то, что ей удалось совершить невероятное — соблюсти сроки издания.

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

Наконец, хочу поблагодарить Иоганна Себастьяна Баха, который был для меня бесконечным источником поэзии и вдохновения, лекарством для ума и тела. Отныне при виде этой книги я всегда буду вспоминать звуки музыки, навечно запечатленные в моей памяти.

Нат

Без любви и терпения своей семьи я ничего не достиг бы в этой жизни. Спасибо вам! От своих друзей — Жюля, Эми, Раджа, Майка, Кефа, Сая, Роберта, Эвана, Понди, Марка и Энди — я узнал много нового. Я глубоко благодарен своим коллегам в Сети, от которых я получал ценные технические советы и где познакомился со своей женой (впрочем, относительно нее никаких советов мне не давали). Также благодарю свою фирму, Front Range Internet, за интересную работу, с которой мне не хотелось бы уходить.

Том был великолепным соавтором. Без него эта книга была бы отвратительной, тупой и короткой. Напоследок хочу поблагодарить Дженин. Мы были женаты около года, когда я принял предложение насчет книги, и с тех пор практически не виделись. Никто так не порадуется окончанию этой работы, как она.

Благодарности для второго издания

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

Назову лишь нескольких из этих бескорыстных людей: Адам Маккаби Трахтенберг (Adam Maccabee Trachtenberg), Рафаэль Гарсиа-Суарес (Rafael Garcia- Suarez), Аск Бьерн Хансен (Ask Bjorn Hansen), Марк-Джейсон Доминус (Mark- Jason Dominus, Абхиджит Менон-Сен (Abhijit Menon-Sen), Яакко Хитаниеми (Jarkko Hietaniemi), Бенджамин Голдберг (Benjamin Goldberg), Аарон Страуп Коуп (Aaron Straup Соре), Тони Стабблбайн (Tony Stubblebine), Майкл Родригес (Michel Rodriguez), Ник Инг-Симмонс (Nick Ing-Simmons), Джеффри Янг (Geoffrey Young), Дуглас Уилсон (Douglas Wilson), Пол Кульченко (Paul Kul- chenko), Джеффри Фридл (Jeff 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), Джон Оруэнт (Jon Orwant), Рич Боуэн (Rich Bowen), Майк Сток (Mike Stok), Тим Бунс (Tim Bunce), Роб Браун (Rob Brown), Дэн Брайан (Dan Brian), Джисл Aac (Gisle Aas) и Эбигейл (Abigail).

Также хотим поблагодарить нашего терпеливого и настойчивого редактора Линду Май. Ей так часто приходилось добиваться от нас «окончательной правки», что это могло превратиться во вредную привычку.

Том

Я благодарен Ларри Уоллу, стараниями которого мир программирования (и не только) стал более совершенным. Спасибо Натану за документирование недокументированного и нашему редактору Линде Май за неистощимое терпение, с которым она опекает своих недисциплинированных подчиненных. Без этих троих людей книга бы не существовала.

Хочу особо поблагодарить того, кто уже не сможет прочитать эти слова: главного редактора издательства O'Reilly и моего друга Фрэнка Уилсона (Frank Wilson), покинувшего нас два года назад. Комментарии этого эрудированного человека были настоящим сокровищем и ценились авторами дороже золота.

За годы совместной работы Фрэнк постоянно вдохновлял и поощрял нас. Его обаяние и добродушие, широта интересов и блестящее остроумие — когда утонченное, когда шутливое, веселое, а чаще и то и другое — неизменно привлекали к нему окружающих, и сейчас мне его очень не хватает. Благодарю тебя, Фрэнк, где бы ты ни находился.

Нат

Генри Дэвид Торо писал: «То, что обычно называют дружбой, лишь немногим более понятия чести у бродяг». Если это правда, я хочу поблагодарить двух честных бродяг: Джона Оруэнта, руководившего моей работой в издательстве «O'Reilly & Associates», и Линду Май, которая помогла мне сохранить эту работу.

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

Напоследок хочу поблагодарить свою семью. На время работы над книгой Дженин практически превратилась в мать-одиночку. Я слышал, как Уильям печально сказал другу: «А мой папа все работает и работает — днем и ночью», а первое предложение из двух слов, произнесенное Рейли, — «Папа работает». Спасибо вам всем!

От издательства

Ваши замечания, предложения, вопросы отправляйте по адресу электронной почты comp@p1ter.com (издательство «Питер», компьютерная редакция).

Мы будем рады узнать ваше мнение!

На веб-сайте издательства http://www.p1ter.com вы найдете подробную информацию о наших книгах.

Строки

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

Книга Иова, 35:16

.0. Введение

Многие языки программирования заставляют нас мыслить на неудобном низком уровне. Вам понадобилась строка, а язык хочет, чтобы вы работали с указателями или байтами. Подобные мелочи лишь отвлекают программиста от основной задачи. Впрочем, не отчаивайтесь — Perl не относится к языкам низкого уровня, и в нем удобно работать со строками.

Perl проектировался для обработки текста. На самом деле в Perl существует такое количество текстовых операций, что их невозможно описать в одной главе. Рецепты обработки текста встречаются и в других главах. В частности, обратитесь к главе 6 «Поиск по шаблону» и главе 8 «Содержимое файлов» — в них описаны интересные приемы, не рассмотренные в этой главе.

Основной единицей для работы с данными в Perl является скаляр (scalar), то есть отдельное значение, хранящееся в отдельной (скалярной) переменной. В скалярных переменных хранятся строки, числа и ссылки. Массивы и хэши представляют собой соответственно списки или ассоциативные массивы скаляров. Ссылки используются для косвенных обращений к другим величинам; они отчасти похожи на указатели в языках низкого уровня. Числа обычно хранятся в вещественном формате с двойной точностью. Строки в Perl могут иметь произвольную длину (ограниченную только объемом виртуальной памяти вашего компьютера) и содержат произвольные данные — даже двоичные последовательности с нулевыми байтами.

Строка Perl не является массивом символов или байтов. К отдельному символу нельзя обратиться по индексу, как к элементу массива, — для этого следует воспользоваться функцией substr. Строки, как и все типы данных Perl, увеличиваются и уменьшаются в размерах по мере необходимости. Неиспользуемые данные уничтожаются системой сборки мусора Perl (обычно при выходе переменной из области видимости или после вычисления выражения, в которое входит строка). Иначе говоря, об управлении памятью можно не беспокоиться — об этом уже позаботились до вас.

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

В программах строки записываются в апострофах или в кавычках, в форме q// или qq// или «встроенных документов» (here-documents). Независимо от выбранной формы записи, строковые литералы делятся на интерполируемые и неин- терполируемые. Под интерполяцией понимается замена ссылок на переменные и специальных последовательностей символов. В большинстве случаев по умолчанию интерполяция выполняется — в частности, в шаблонах (/regex/) и при выполнении команд ($х = ' cmd').

В некоторых ситуациях отдельные символы имеют особую интерпретацию. С префиксом \ любой специальный символ становится обычным символом; другими словами, он превращается в простой литерал. Такое преобразование обычно называется экранированием (escaping).

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

$string = '\гГ；# Два символа, \ и п

Sstrlng = 'Jon \'Maddog\' Orwant'； # Внутренние апострофы-литералы

В строках, заключенных в кавычки, возможна интерполяция имен переменных (но не вызовов функций — о том, как это делается, см. рецепт 1.15). В них также поддерживаются различные служебные последовательности: "\п" (перевод строки) "\033" (символ с восьмеричным кодом 33), "\cJ" — Ctrl+J, "\х1В" (символ с шестнадцатеричным кодом 0x1В) и т. д. Полный список приведен на странице руководства perlop(l).

Sstring = "\n"：# Символ перевода строки

$string = "Jon \"Maddog\" Orwant"； # Внутренние кавычки

Если строка не содержит расширяемых служебных последовательностей или переменных, вы можете использовать любую запись по своему усмотрению. Выбирая между 'this' и "this", некоторые программисты Perl предпочитают второй вариант, чтобы строки лучше выделялись. К тому же кавычки предотвращают даже малейшую вероятность того, что читатель программы спутает простой апостроф с обратным. Для Perl это несущественно, но чтение программы упрощается.

Операторы q// и qq// позволяют использовать произвольные ограничители с интерполируемыми и неинтерполируемыми литералами; они являются аналогами строк, заключенных соответственно в апострофы и кавычки. Например, для записи неинтерполируемой строки с внутренними апострофами проще воспользоваться оператором q// вместо того, чтобы использовать экранированные символы \':

Sstring = 'Jon \'Maddog\' Orwant'； # Внутренние апострофы

$str1ng = q/Jon 'Maddog' Orwant/；# To же самое, но более наглядно

В качестве разделителей могут использоваться одинаковые символы, как / в приведенном примере, или любая из четырех комбинаций парных ограничителей (различных типов скобок):

Sstring = q[Jon 'Maddog' Orwant]； # Внутренние апострофы

Sstring = q{Jon 'Maddog' Orwant}； # Внутренние апострофы

Sstring = 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 и Latin 1 соответственно).

Малое количество битов на символ приводит к тому, что количество представляемых символов также невелико. Как известно, палитра графического файла с 8-разрядным цветом ограничивается всего 256 цветами. Аналогично, при хранении символов в виде отдельных октетов (то есть байтов, состоящих из 8 бит) документ может содержать не более 256 различных букв, знаков препинаний и знаков.

Кодировка ASCII (American Standard Code for Information Interchange) не решала всех проблем за пределами Соединенных Штатов, поскольку в нее входили лишь символы слегка усеченного американского диалекта английского языка. Из-за этого многие страны разработали собственные, несовместимые 8-разряд- ные кодировки на базе 7-разрядной кодировки ASCII. Появились конфликтные схемы назначения символам числовых кодов из одного ограниченного интервала. Это означало, что в разных системах одно число могло обозначать разные символы, а одному символу могли быть сопоставлены разные коды.

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

Объединяющие последовательности (collating sequences) определяют комбинации символов, которые должны особым образом обрабатываться при сортировке и т. д. Например, в немецком языке 0 считается символом, расположенным между «s» и «t», но сортируемым как два «s» подряд.

зове для строки функции 1 ength Perl возвращает размер строки в символах, а не в байтах. При извлечении из строки первых трех символов функцией substr длина результата может быть отлична от трех байт... а может быть равна трем байтам. Вы этого не знаете, да это и не важно. К базовому низкоуровневому представлению вообще не стоит слишком пристально приглядываться — если вам приходится думать о нем, то, скорее всего, вы рассматриваете происходящее со слишком близкого расстояния. Выбор представления не должен влиять на работу программиста — а если он все же влияет, это может означать, что реализация Perl еще не идеальна. Мы над этим работаем.

Поддержка символов с кодами, превышающими 256, означает, что аргумент функции chr уже не ограничивается значением 256, а функция ord может возвращать числа, большие этого значения. Например, по запросу chr(0x394) будет возвращена греческая буква «дельта» верхнего регистра:

$char = chr(0x394); $code = ord($char)： prlntf "char 在 Is code %d, Ш4х\п", $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 рассказано, как использовать названия символов для включения в строковые литералы конструкций \^{NAME}. Например, символ Л может задаваться в виде \N{GREEK CAPITAL LETTER DELTA}, \N{greek ：Delta} и даже просто \N{Delta}.

Чтобы работать с Юникодом в Perl, достаточно и этого, но для взаимодействия Perl с другими программами потребуется кое-что еще.

В старых однобайтовых кодировках (таких, как ASCII или ISO 8859-〃)при выводе символа с числовым кодом NN выводился один байт с числовым значе-

нием NN. Конкретный вывод зависел от доступных шрифтов, от выбранного локального контекста и ряда других факторов. Но в Юникоде уже не существует однозначного соответствия между логическими кодами символов (кодовыми пунктами) и выводимыми физическими байтами. Теперь логические коды могут представляться в любом из нескольких доступных выходных форматов.

Во внутренней работе Perl используется формат UTF-8, но для Юникода существует много других форматов выходной кодировки; Perl может работать и с этими форматами. Директива use encoding сообщает Perl, в какой кодировке написан сам сценарий и какая кодировка должна использоваться для стандартных файловых манипуляторов. Директива use open задает выходную кодировку по умолчанию для всех манипуляторов. Формат кодировки для конкретного файлового манипулятора задается при помощи специальных аргументов функций open и binmode. Ключ командной строки -С задает кодировку для всех (или только для стандартных) манипуляторов, а также для самих аргументов программы. Переменные окружения PERLIO, PERL_ENCODING и PERL_UNICODE сообщают Perl дополнительную информацию, относящуюся к этой теме.

Работа с подстроками

Проблема

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

Решение

Soffset, $count)：Soffset, $count)：$value = substr($string.$value = substr($string.Функция substr предназначена для чтения и записи отдельных частей строки:

Soffset, $count)：

Soffset, $count)：

$value = substr($string.

$value = substr($string.

$value = substr($string, Soffset);

substr($string, Soffset, substr($string. Soffset, substr($string. $offset)substr($string, Soffset, substr($string. Soffset, substr($string. $offset)$count) = Snewstring：

substr($string, Soffset, substr($string. Soffset, substr($string. $offset)

substr($string, Soffset, substr($string. Soffset, substr($string. $offset)

$count, Snewstring)： # Эквивалент предыдущей строки =$newtail:

Функция unpack ограничивается доступом только для чтения, но при извлечении нескольких подстрок работает быстрее:

Получить 5-байтовую строку, пропустить 3 байта,

затем извлечь две 8-байтовых строки, затем все остальное

(Примечание： работает только с ASCII-данными, но не с Юникодом)

($leading, $sl, $s2. $trailing)=

unpack("A5 x3 A8 A8 A*". $data):

Деление на группы из пяти байт

©fivers = unpack("A5" х (length($string)/5), Sstring)：

Деление строки на однобайтовые символы

©chars = unpackCAl" х length(Sstring), Sstring)：

Комментарий

Строки Perl входят в число базовых типов данных; они не являются массивами, содержащими элементы базовых типов. Это означает, что для работы с отдельными символами или подстроками вместо индексирования, как в других языках программирования, в Perl применяются такие функции, как unpack или substr.

Второй аргумент substr (смещение) определяет начало интересующей вас подстроки; положительные значения отсчитываются от начала строки, а отрицательные —с конца. Если смещение равно 0, подстрока начинается с начала. Третий аргумент определяет длину подстроки.

Sstring = "This is what you have"；

+012345678901234567890 Прямое индексирование (слева направо)

109876543210987654321- Обратное индексирование (слева направо)

0 соответствует 10, 20 и т. д.

veh .e и u VTis# # # # #veh .e и u VTis# # # # #$first = substr($string, 0, 1);

ve

h .e и u V

Tis

# # # # #

ve

h .e и u V

Tis

# # # # #

$start = substr($string, 5. 2):

$rest = substr($str1ng, 13):

$last = substr($string, -1)： $end = substr($string, -4)；

$piece = substr($string, -8, 3); # "you"

Однако функция substr позволяет не только просматривать части строки, но и изменять их. Дело в том, что substr относится к экзотической категории левосторонних функций, то есть таких, которым при вызове можно присвоить значение. К тому же семейству относятся функции vec, pos и keys (а при некоторой фантазии функции local, my и our также можно рассматривать как левосторонние).

$string = "This is what you have"； print $string；

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///, m// или tr///, можно заставить их работать только с определенной частью строки:

Проверка подстрок по шаблону

if (substr($string, -10) =~ /pattern/) {

print "Pattern matches 1n last 10 characters\n"：

}

# Подставить "at" вместо "is" в первых пяти символах строки substr($string. 0, 5) =~ s/is/at/g：

Более того, подстроки даже можно поменять местами, используя с каждой стороны присваивания несколько вызовов substr:

Поменять местами первый и последний символы строки $а = "make a hat"：

(substr($a,O,l). substr($a,-D) = (substr($a,-1), substr($a,O,D): print $a； take a ham

Хотя функция unpack не является левосторонней, она работает значительно быстрее substr, особенно при одновременном извлечении нескольких величин. Структура извлекаемой записи определяется специальной форматной строкой, в которой символ "х" нижнего регистра с числом пропускает заданное количество байт в прямом направлении, а символ "X" верхнего регистра — в обратном направлении. Символ "@" перемещается к заданному смещению в байтах внутри записи. Если вы работаете со строковыми данными Юникода, будьте осторожны при использовании этих трех спецификаторов: они работают только на уровне байтов, а выполнять байтовые операции в многобайтовых кодировках в лучшем случае рискованно.

Извлечение подстроки функцией unpack $а = "То be or not to be"；

$b = unpack("хб A6", $a); # Пропустить 6 символов, прочитать 6 символов print $b;

or not

($b, $c) = unpack("x6 A2 X5 A2", $a); # Вперед 6, прочитать 2:

назад 5, прочитать 2 print "$b\n$c\n"；

or be

Иногда строка «режется» на части в определенных позициях. Предположим, вам захотелось установить позиции разделения перед символами 8, 14, 20, 26 и 30 — в каждом из перечисленных столбцов начинается новое поле. В принципе форматная строка unpack вычисляется просто — "А7 Аб Аб А4 А*", но программист на Perl по природе ленив и не желает попусту напрягаться. Пусть за него работает Perl. Воспользуйтесь приведенной ниже функцией cut2fmt:

sub cut2fmt {

my(©positions) = @_:

my Stemplate =''；

my Slastpos = 1:

foreach $place(positions) {

Stemplate .= "A" . (Splace - Slastpos)."":

$lastpos = $place：

}

Stemplate .= "A*"：

return Stemplate：

}

$fmt = cut2fmt(8. 14, 20. 26, 30): print "$fmt\n"：

A7 Аб Аб Аб A4 A*

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

В настоящем рецепте предполагается, что все символы представляются в 7- или 8-разрядной кодировке, иначе байтовые операции unpack не будут работать так, как предполагается.

См. также

Описание функций unpack и substr в perlfunc(i); процедура cut2fmt из рецепта 1.24. Применение unpack для двоичных данных продемонстрировано в рецепте 8.24.

Выбор значения по умолчанию

Проблема

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

Решение

Воспользуйтесь оператором 11 или 11 =, работающим как со строками, так и с числами:

Использовать $Ь. если значение $Ь истинно, и $с в противном случае $а = $b 11 $с:

Присвоить $х значение $у. но лишь в том случае, # если $х не является истиной

$х I|= $у；

Если переменная может принимать значения О, "О" и "", воспользуйтесь функцией defined:

Использовать $Ь, если значение $Ь определено, и $с в противном случае $а = def1ned($b) ? $b : $с：

"Новый" оператор "определено-или" из будущей версии Perl use 5.9;

$а = $b // $с:

Комментарий

Главное отличие между этими двумя решениями (defined и | |) состоит, прежде всего, в том, что именно проверяется — определенность или истинность. В мире Perl три определенных значения являются ложными: О, "О" и "". Если ваша

переменная содержит одну из этих величин, но вы не хотите изменять ее, 11 не подойдет — приходится выполнять неуклюжие проверки с defl ned. Часто бывает удобно организовать программу так, чтобы принималась в расчет истинность или ложность переменных, а не их определенность.

В отличие от других языков, где возвращаемые значения ограничиваются О и 1, в Perl оператор 11 обладает более интересным свойством: он возвращает первый (левый) операнд, если тот имеет истинное значение; в противном случае возвращается второй операнд. Оператор && ведет себя аналогично (для второго выражения), но этот факт используется реже. Для этих операторов несущественно, что представляют собой их операнды — строки, числа или ссылки; подойдет любое скалярное значение. Они просто возвращают первый операнд, из-за которого все выражение становится истинным или ложным. Возможно, это расходится с возвращаемым значением в смысле булевой алгебры, но такими операторами удобнее пользоваться.

Это позволяет установить значение по умолчанию для переменной, функции или более длинного выражения в том случае, если первый операнд не подходит. Ниже приведен пример использования 11, в котором $foo присваивается либо $bar, либо, если значение $bar ложно, — строка "DEFAULT VALUE":

$foo = $bar 11 "DEFAULT VALUE"

В другом примере переменной $dir присваивается либо первый аргумент командной строки программы, либо "/tmp", если аргумент не указан:

$d什=shift(QARGV) || "/tmp"

То же самое можно сделать и без изменения ©ARGV:

$d什=$ARGV[0] И "/tmp"

Если 0 является допустимым значением $ARGV[0], использовать 11 нельзя, потому что вполне нормальное значение будет интерпретировано как ложное. Приходится обращаться к тернарному оператору выбора:

$chr = def1ned($ARGV[0]) ? shift(@ARGV) ： "/tmp";

To же можно записать и иначе, со слегка измененной семантикой:

$dir = @ARGV ? $ARGV[0] : "/tmp"

Мы проверяем количество элементов в ©ARGV. В условии оператора выбора (?:) QARGV интерпретируется в скалярном контексте. Значение будет ложным лишь при нулевом количестве элементов, в этом случае будет использоваться "/tmp". В остальных ситуациях (то есть при заданных аргументах) переменной будет присвоен первый аргумент командной строки.

Следующая строка увеличивает значение %count, при этом в качестве ключа используется значение $shell, а если оно ложно — строка "/bln/sh":

$count{ Sshell II "/bin/sh" }++：

В одном условии можно объединить несколько альтернативных вариантов, как показывает следующий пример. Результат выражения определяется первым операндом, имеющим истинное значение.

# Определить имя пользователя в системе Unix $user = $ENV{USER}

И $ENV{LOGNAME}

11 getlogim)

11 (getwuid($<))[0]

11 "Unknown uid number $<"：

Оператор && работает аналогично; он возвращает свой первый операнд, если этот операнд ложен. В противном случае возвращается второй операнд. Поскольку ложные значения представляют интерес существенно реже, чем истинные, это свойство используется не так часто. Некоторые возможные применения продемонстрированы в рецептах 13.12 и 14.19.

Оператор присваивания 11= выглядит странно, но работает точно так же, как и остальные операторы присваивания. Практически для всех бинарных операторов Perl $VAR 0Р= VALUE означает $VAR = $VAR OP VALUE; например, $a += $b — то же, что и $a = $a + $b. Следовательно, оператор 11= может использоваться для присваивания переменной, значение которой интерпретируется как ложное. Поскольку 11 выполняет простую логическую проверку (истина или ложь), у него не бывает проблем с неопределенными значениями, даже при включенном выводе предупреждений. В следующем примере 11= присваивает переменной $start1ng_po1nt строку "Greenwich", если значение переменной не было задано ранее. Предполагается, что $starting_point не принимает значений 0 или "О", а если принимает — то такие значения должны быть заменены.

$starting_point ||= "Greenwich"

В операторах присваивания 11 нельзя заменять оператором or, поскольку or имеет слишком низкий приоритет. Выражение $а = $b or $с эквивалентно ($а = $b) or $с. В этом случае переменной $Ь всегда присваивается $а, а это совсем не то, чего вы добивались.

Не пытайтесь распространить это любопытное применение 11 и 11= со скалярных величин на массивы и хэши. У вас ничего не выйдет, потому что левый операнд интерпретируется в скалярном контексте. Вместо этого приходится делать что-нибудь подобное:

@d = @b unless @а；# Копировать, если массив пуст

@а = @Ь ? @Ь : @с：# Присвоить @Ь. если он не пуст, иначе @с

Ожидается, что когда-нибудь в Perl будут поддерживаться новые операторы //, //= и err. Возможно, это уже произойдет к тому моменту, когда вы будете читать эту книгу. Новые операторы будут работать аналогично оператору 11, но вместо истинности они будут проверять определенность переменных, поэтому следующие пары станут эквивалентными:

$а = def1ned($b) ? $b : $с；

$а = $Ь // $с：

$х = defined($x) ? $х ： $у； $х //= $у；

defined(read(FH, $buf, $count) or die "read failed： $!": read(FH, $buf, $count)err die "read failed: $!"：

Эти три оператора уже включены в Perl версии 5.9. Как и все версии с нечетными номерами, версия 5.9 является экспериментальной, поэтому использовать ее в среде реальной эксплуатации не рекомендуется. Видимо, операторы останутся в стабильной версии 5.10 и наверняка будут поддерживаться в версии 6, дата выхода которой пока остается неопределенной.

См. также

Описание оператора 11 вperlopQ); описание функций defined и exists вperlfunc(\).

Перестановка значений без использования временных переменных

Проблема

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

Решение

Воспользуйтесь присваиванием по списку:

($VAR1, $VAR2) = ($VAR2, $VAR1):

Комментарий

В большинстве языков программирования перестановка значений двух переменных требует промежуточного присваивания:

$temp = $а：

$3= $ь;

$b = $temp：

В Perl дело обстоит иначе. Язык следит за обеими сторонами присваивания и гарантирует, что ни одно значение не будет случайно стерто. Это позволяет избавиться от временных переменных:

$а = "alpha"；

$b = "omega"；

($а, $Ь) = ($Ь. $а)；# Первый становится последним - и наоборот

Подобным способом можно поменять местами сразу несколько переменных:

($alpha, $beta. $production) = qw(January March August)；

beta перемещается в alpha.

production - в beta, # alpha - в production ($alpha, $beta. Sproduction) = ($beta, Sproductlon, $alpha)；

Значения переменных $alpha, $beta и $product1on после завершения этого фрагмента будут равны соответственно "March", "August" и "January".

См. также

Раздел «List value constructors» perlop(\).

Преобразование между символами и ASCII-кодами

Проблема

Требуется вывести код, соответствующий некоторому символу в кодировке ASCII, или наоборот — символ по ASCII-коду.

Решение

Воспользуйтесь функцией ord для преобразования символа в числовой код или функцией chr — для преобразования числового кода в символ: $num = ord($char);

$char = chr($num)；

Формат %c в функциях prlntf и sprlntf также преобразует число в символ:

$char = spEntf("%c", $num); # Медленнее, чем chr($num)

prlntf("Number Md 1s character 省c\rT, $num, $num)：

Number 101 is character e

Шаблон С*, используемый в функциях pack и unpack, позволяет быстро преобразовать несколько 8-разрядных символов; для символов Юникода следует использовать шаблон U*:

kbytes = unpackCC*", $string)；

©string = packCC*", ©bytes)；

$un1str = pack("U4".0x24b6.0x24b7,0x24b8.0x24b9):

Qunichars = unpackC'U*". $unistr);

Комментарий

В отличие от низкоуровневых, нетипизованных языков вроде ассемблера, Perl не считает эквивалентными символы и числа; эквивалентными считаются строки и числа. Это означает, что вы не можете произвольно присвоить вместо символа его числовое представление или наоборот. Для преобразования между символами и их числовыми значениями в Perl существуют функции chr и ord, взятые из Pascal: $value = ordC'e"):# Теперь 101

Scharacter = chr(lOl):# Теперь "e"

Символ в действительности представляется строкой единичной длины, поэтому его можно просто вывести функцией print или с помощью формата %s функций prlntf и sprlntf. Формат %с заставляет prlntf или sprlntf преобразовать

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

printf("Number 省d is character %c\r\", 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 ~

$word = packCC*". asci i_character_numbers):

$word = packCC*", 115, 97, 109, 112, 108. 101): # To же самое print "$word\n"

sample

А вот как превратить HAL в IBM:

$hal = "HAL":

©byte = unpackCC*", $hal);

foreach $va】 (@byte) {

$val++：# Увеличивает каждый ASCII-код на 1

}

$ibm = packCC*", ©byte)；

print "$ibm\n"；# Выводит "IBM"

Для однобайтовых символьных данных (таких, как старая добрая кодировка ASCII или любые наборы семейства ISO 8859) функция ord возвращает числа от О до 255. Этот диапазон соответствует типу данных unsigned char языка С.

Однако Perl этим не ограничивается: в нем появилась интегрированная поддержка универсальной кодировки Юникода. Если при вызове chr, sprintf ”％с” или pack "U*" передаются значения, превышающие 255, то полученный результат будет представлять собой строку Юникода.

Ниже приведен аналог предыдущего фрагмента в Юникоде:

@unicode_points = unpackCU*", "fac\x{0327}ade")： print "@unicode_po1nts\n"：

102 97 99 807 97 100 101

Sword = packCU*", @unicode_po1nts):

print "$word\n"；

facade

Если требуется лишь вывести коды символов, возможно, вам даже не придется использовать unpack. У функций Perl prlntf и sprintf существует модификатор V, который работает следующим образом:

prlntf "%vd\n", "fac\x{0327}ade":

102.97.99.807.97.100.101

prlntf "Ш\п", "fac\x{0327}ade":

66.61.63.327.61.64.65

Функции выводят числовые коды всех символов строки (в терминологии Юникода — «кодовые пункты»), разделенные точками.

См. также

Описание функций chr, ord, printf, sprintf, pack и unpack в perlfunc(l).

Использование именованных символов Юникода

Проблема

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

Решение

Включите в начало файла директиву use charnames, а затем свободно включайте в строковые литералы служебные последовательности "\N{...}".

Комментарий

Директива use charnames позволяет использовать символические имена для символов Юникода. Имена представляют собой константы времени компиляции, для обращения к которым используются служебные последовательности вида \N{...}. Для директивы use charnames поддерживается ряд поддиректив. Поддиректива :full открывает доступ ко всему интервалу имен символов, но вам придется записывать их полностью и точно в таком виде, как они хранятся в базе данных символов Юникода (в частности, имена должны записываться в верхнем регистре). Поддиректива : short позволяет использовать удобные сокращения. Импортируемое имя без префикса «:» воспринимается как имя алфавита, что дает возможность использовать для указанного алфавита сокращенные имена символов с учетом регистра.

use charnames '：fulГ ： print "\N{GREEK CAPITAL LETTER DELTA} 1s called delta.\n";

is called delta.

use charnames ':short';

print "\N{greek:Delta} is an upper-case delta.\n"：

is an upper-case delta.

use charnames qw(cyr1111c greek);

print "\N{Sigma} and \N{s1gma} are Greek sigmas.\n"；

print "\N{Be} and \N{be} are Cyrillic bes.\n"；

2 and о are greek sigmas.

Б and 6 are Cyrillic bes.

Функции charnames： ：viacode и charnames： ：vianame выполняют преобразования между числовыми кодовыми пунктами и длинными именами. В документации Юникода символ с кодовым пунктом ХХХХ обозначается как U+XXXX, поэтому мы также воспользуемся этим обозначением при выводе данных в следующем примере:

use charnames qw(:full)： for $code (0xC4, 0x394) {

printf "Character U+%04X Ms) Is named %s\n".

$code. chr($code), charnames：：viacode($code)： }

Character U+OOC4 (A) is named LATIN CAPITAL LETTER A WITH DIAERESIS

Character U+0394 (△) is named GREEK CAPITAL LETTER DELTA

use charnames qw(：full):

$name = "MUSIC SHARP SIGN"；

$code = charnames::vi aname($name):

pdntf 唄s is character U+%04X (%s)\n".

$name, $code, chr($code);

MUSIC SHARP SIGN is character U+266F ( # )

Имя копии базы данных символов Юникода в Perl определяется так:

% perl -MConfig -Ie 'print "$Config{privl1b}/unicore/NamesL1st.txt"'

/usr/local/1 i b/perl5/5.8.1/unicore/NamesList.txt

Из этого файла можно узнать доступные имена символов.

См. также

Charnamesf^Y база данных символов Юникода по адресу http://www.unicode.org.

Посимвольная обработка строк

Проблема

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

Решение

Воспользуйтесь функцией split с пустым шаблоном, чтобы разбить строку на отдельные символы, или функцией unpack, если вам нужны лишь коды символов:

©array = sp!1t(//, $string); # Список содержит отдельные символы

@array = unpackCU*", $string)： # Список содержит кодовые пункты (числа)

Также можно последовательно выделять очередной символ в цикле:

while (/(.)/g) {# Символ . не совпадает с символом перевода строки

# Переменная $1 содержит символ. ord($l) - числовой код символа.

Комментарий

Как говорилось выше, базовой единицей текста в Perl является строка, а не символ. Необходимость посимвольной обработки строк возникает достаточно редко. Обычно такие задачи легче решаются с помощью высокоуровневых операций Perl (например, поиск по шаблону). Пример приведен в рецепте 7.14, где для поиска аргументов командной строки используются подстановки.

Если вызвать split с шаблоном, который совпадает с пустой строкой, функция вернет список отдельных символов строки. При намеренном использовании эта особенность оказывается удобной, однако с ней можно столкнуться и случайно. Например, /X*/ совпадает с любыми строками, включая пустую строку. Не исключено, что вам встретятся и другие ненамеренные совпадения.

Следующий пример выводит символы строки "an apple a day", отсортированные по возрастанию:

%seen =()；

Sstring = "an apple a day":

foreach $char (split //, Sstrlng) {

$seen{$char}++；

}

print "unique chars are: ", sort(keys ^seen), "\n"；

unique chars are: adelnpy

Решения с функциями split и unpack предоставляют массив символов, с которым можно выполнять дальнейшие операции. Если массив не нужен, воспользуйтесь поиском по шаблону в цикле while с флагом /д, который извлекает по одному символу из строки:

%seen = О：

$str1ng = "an apple a day": while ($string =~ /(. )/g) { $seen{$l}++：

}

print "unique chars are： ", sort(keys %seen). "\n"：

unique chars are: adelnpy

Как правило, посимвольная обработка строк не является оптимальным решением. Иногда вместо использования Index/substr или spllt/unpack проще воспользоваться шаблоном. В следующем примере 32-разрядная контрольная сумма вычисляется вручную, но лучше поручить работу функции unpack — она сделает то же самое намного эффективнее.

Следующий пример вычисляет контрольную сумму символов Sstrlng в цикле foreach. Приведенный алгоритм не оптимален; просто мы используем традиционную и относительно легко вычисляемую сумму. Если вам потребуются более совершенные средства вычисления контрольной суммы, воспользуйтесь стандартным модулем Digest： ：MD5.

$sum = 0;

foreach $byteval (unpackCC*", $string)) {

$sum += $byteval ；

}

print "sum 1s $sum\n"：

Для строки "an apple a day" выводится сумма 1248

Следующий вариант делает то же самое, но намного быстрее:

$sum = unpack("^32C*", $str1ng)；

Это позволяет эмулировать программу вычисления контрольной суммы SysV:

#!/usr/b1n/perl

sum - вычисление 16-разрядно而 контрольной суммы всех входных файлов $checksum = О；

while (<>) { $checksum += unpack('716C*", $_) }

$checksum 宵=(2 **16)-1；-

print "$checksum\n"：

Фактически это выглядит так:

% perl sum /etc/termcap

1510

Если у вас установлена GNU-версия sum, то для получения идентичного ответа для того же файла ее следует вызвать с параметром -sysv:

胃 sum -sysv /etc/termcap

1510 851 /etc/termc叩

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

Пример 1.1. slowcat

#!/usr/bin/perl

slowcat -замедленный вывод

использование： slowcat [-DELAY] [files..

где DELAY - задержка

$DELAY = ($ARGV[O] =~ /人-([.\d]+)/) ? (shift. $1) : 1:

$| = 1:

while (<>) {

for (spl1t(//)) {

print;

select(undef.undef.undef, 0.005 * $DELAY)：

}

См. также

Описание функций split и unpack в perlfitnc(l); применение select для организации задержки объясняется в рецепте 3.10.

Обратная перестановка слов или символов

Проблема

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

Решение

Для перестановки байтов воспользуйтесь функцией reverse в скалярном контексте:

$revchars = reverse($string)：

Для перестановки слов воспользуйтесь reverse в списковом контексте с функциями split и join:

$revwords = join(" ". reverse splitC ", Sstring)；

Комментарий

У функции reverse существует два варианта применения. В скалярном контексте функция объединяет аргументы и возвращает полученную строку в обратном порядке. В списковом контексте функция возвращает свои аргументы в обратном порядке. Если функция reverse применяется для перестановки символов в неочевидной ситуации, воспользуйтесь функцией scalar для форсированного применения скалярного контекста.

$gn1rts = reverse($string);# Перестановка символов Sstring

$sdrow = reverse(@words)；# Перестановка элементов ©words

Sconfused = reverse(@words); # Перестановка букв в join("". ©words)

Рассмотрим пример обратной перестановки слов в строке. Вызов функции split с шаблоном " " является особым случаем: он заставляет split использовать в качестве разделителя смежные пропуски (whitespace) и отбрасывать начальные пустые поля (по аналогии с awk). Обычно split отбрасывает только конечные пустые поля.

# Обратная перестановка слов

Sstring = 'Yoda said, "can you see this?"':

Qdllwords = splitC ", Sstring):

Qrevwords = join(" ". reverse @dl1 words)；

print $revwords. "\n"：

this?" see you "can said, Yoda

Временный массив ©dllwords можно убрать и сделать все в одной строке:

$revwords = jo1n(" ". reverse splitC ". Sstring)；

Смежные пропуски в $string превращаются в один пробел в $revwords. Чтобы сохранить существующие пропуски, поступите так:

$revwords = join("", reverse split (/(\s+)/. Sstring))；

С помощью функции reverse можно проверить, является ли слово палиндромом (то есть читается ли одинаково в обоих направлениях):

Sword = "reviver"：

$1s_pal1ndrome = ($word eq reverse($word))；

Программа для поиска длинных палиндромов в файле /usr/d1ct/words записывается в одну строку:

% perl -nle 'print if $_ eq reverse && length >5' /usr/dict/words deedeed

degged deified denned hall ah kakkak murdrum redder repaper retter reviver rotator sooloos tebbet terret tut-tut

См. также

Описание функций split, reverse и scalar в perlfunc(iy, рецепт 1.8.

Интерпретация комбинированных символов Юникода как одиночных символов

Проблема

Строка Юникода содержит комбинированные символы. Требуется интерпретировать каждую из комбинированных последовательностей как один логический символ.

Решение

Обработайте строку, используя регулярное выражение с метасимволом \Х:

# facade# Неудача# Совпадение# facade# Неудача# Совпадение# # ## # #7 букв в @chars То же самое6 "букв" в @chars7 букв в @chars То же самое6 "букв" в @chars$string = "fac\x{0327}ade"；

# facade

# Неудача

# Совпадение

# facade

# Неудача

# Совпадение

# # #

# # #

7 букв в @chars То же самое

6 "букв" в @chars

7 букв в @chars То же самое

6 "букв" в @chars

Sstring =~ "fa.ade"：

Sstring =~ "fa\Xade"；

@chars = split(//, Sstring)； @chars = Sstring =~ /(.)/g； @chars = Sstring =~ /(\X)/g；

Комментарий

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

Например, слово «facade» можно записать так, чтобы между двумя буквами «а» находился один символ "\х{Е7}" из кодировки Latin 1 (ISO 8859-1). Возможно, в кодировке UTF-8, используемой во внутренней работе Perl, эти два символа представляются двухбайтовой последовательностью, но эти два байта все равно интерпретируются как отдельный символ.

Однако существует и другой способ записи. Символ U+00E7 может быть представлен двумя кодовыми пунктами: обычной буквой «с», за которой следует "\х{0327}". Кодовый пункт U+0327 соответствует комбинационному символу нулевой ширины, который означает, что под предыдущим базовым символом должен находиться седиль.

Иногда бывает нужно, чтобы Perl интерпретировал каждый комбинированный символ как один логический символ. Но поскольку комбинированный символ представлен несколькими кодовыми пунктами, символьные операции Perl (включая функции substr и length, а также метасимволы регулярных выражений /./и /[人 abc]/) интерпретируют комбинационные символы нулевой ширины как самостоятельные символы.

В регулярном выражении метасимвол \Х совпадает с последовательностью, определяющей комбинированный символ Юникода. Он в точности эквивалентен конструкции (?:\РМ\рМ*), или в расширенной записи:

(?х：# Начало несохраняющей группы

\РМ# Один символ без свойства М (знак)

(например, буква)；

\рМ# один символ со свойством М (знак)

(например, акцент),

*# который может повторяться любое количество раз

)

Без метасимвола \Х присутствие этих комбинаций в строке основательно запутывает даже простейшие операции. Рассмотрим пример с обратной перестановкой символов слова из предыдущего рецепта. В комбинированной записи слова «аппёе» и «nino» представляются в Perl в виде "аппе\х{301}е" и "п1п\х{303}о".

for Sword ("anne\x{301}e", "n1n\x{303}o") {

printf ”％s simple reversed to ^s\n", $word, scalar reverse $word；

printf "%s better reversed to %s\n", $word, jo1n("", reverse $word =~ /\X/g)；

}

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

аппёе simple reversed to eenna аппёе better reversed to eenna nino simple reversed to onin nino better reversed to onin

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

См. также

Perlre(l) и perluniintro(iy, рецепт 1.9.

Приведение строк с комбинированными символами Юникода к каноническому виду

Проблема

Две строки одинаково выглядят при выводе, но при проверке равенства они считаются различными, а иногда даже имеют разную длину. Как добиться того, чтобы Perl считал эти строки одинаковыми?

Решение

Если хотя бы некоторые из сравниваемых строк содержат комбинированные символы Юникода, то при сравнении следует использовать результаты обработки этих строк функцией NFDO модуля Unicode：:Normalize:

use Unicode：：NormalIze；

$sl = "fa\x{E7}ade"；

$s2 = "fac\x{0327}ade":

if (NFD($sl) eq NFD($s2)) { print "Yup!\n" }

Комментарий

Одни и те же символы в некоторых случаях могут определяться разными способами. Иногда это происходит при использовании старых кодировок — например, букв с диакритическими знаками из кодировки Latin 1. Такие буквы задаются либо непосредственно в виде отдельного символа (например, U+00E7, строчная латинская буква «с» с седилем), либо косвенно, как сочетание базового символа (U+0063, строчная латинская буква «с») с комбинационным символом (U+0327, седиль).

Возможен и другой вариант: если за базовым символом следуют два и более знака, которые могут следовать в разном порядке. Допустим, вы хотите использовать символ «с» с седилем и коронкой, чтобы на печати выводился символ с. Такой символ может определяться несколькими способами:

Sstrlng = V231.780;

Строчная латинская буква С с седилем

Комбинационная коронка

$string = v99.807.780:

Строчная латинская буква С

Комбинационная коронка

Комбинационный седиль

$str1ng = v99.780.807;

Строчная латинская буква С

Комбинационный седиль

Комбинационная коронка

Функции нормализации приводят эти варианты к единому порядку. Существует несколько таких функций, в том числе функция NFDO для выполнения канонической декомпозиции и функция NFC() для выполнения канонической декомпозиции с последующей канонической композицией. Какой бы из трех вариантов не был избран для определения символа 9, NFD всегда возвращает v99.807.780, a NFC 一 V321.780.

Иногда бывает удобнее использовать функции NFKDO и NFKCO, аналогичные предыдущим функциям, но в отличие от них выполняющие совместимую декомпозицию, после которой в случае NFKCO следует каноническая композиция. Например, \x{FB00} определяет лигатуру ff. Формы NFD и NFC возвращают одну и ту же строку "\x{F800}", но формы NFKD и NFKC возвращают строку из двух символов "\х{66}\х{66}"・

См. также

Раздел «Универсальная кодировка символов» в начале этой главы; документация Юникода; модуль Unicode： formalize; рецепт 8.20.

Интерпретация строки Юникода как последовательности октетов

Проблема

Требуется интерпретировать строку Юникода в Perl как последовательность октетов (например, для вычисления ее длины или в контексте ввода/вывода).

Решение

Директива use bytes заставляет все операции Perl в своей лексической области видимости интерпретировать строку как группу октетов. Используйте ее при вызове символьных функций Perl:

$ff = "\x{F800}":Schars = length($ff);{use bytes：$octets = length($ff)； }$chars = length($ff)；$ff = "\x{F800}":Schars = length($ff);{use bytes：$octets = length($ff)； }$chars = length($ff)；Лигатура ff

$ff = "\x{F800}":

Schars = length($ff);

{

use bytes：

$octets = length($ff)； }

$chars = length($ff)；

$ff = "\x{F800}":

Schars = length($ff);

{

use bytes：

$octets = length($ff)； }

$chars = length($ff)；

Длина равна одному символу

Принудительное использование байтовой семантики

Длина равна двум октетам

Возврат к символьной семантике

Существует и другое решение: модуль Encode позволяет преобразовать строку Юникода в строку октетов и наоборот. Используйте его в том случае, если код с символьной семантикой не находится в лексической области видимости:

use Encode qw(encode_utf8)；

sub somefunc：sub somefunc：# Определяется в другом месте

sub somefunc：

sub somefunc：

$ff = "\x{F800}";$ff_oct = encode_utf8($ff)；$ff = "\x{F800}";$ff_oct = encode_utf8($ff)；# Лигатура ff# Преобразование в октеты# Лигатура ff# Преобразование в октеты

$ff = "\x{F800}";

$ff_oct = encode_utf8($ff)；

$ff = "\x{F800}";

$ff_oct = encode_utf8($ff)；

# Лигатура ff

# Преобразование в октеты

# Лигатура ff

# Преобразование в октеты

$chars = somefunc(Sff)：$octets = somefunc($ff_oct);$chars = somefunc(Sff)：$octets = somefunc($ff_oct);Функция работает с символьной строкой

$chars = somefunc(Sff)：

$octets = somefunc($ff_oct);

$chars = somefunc(Sff)：

$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 являются действительными октетными строками.

См. также

Документация по директиве use bytes; документация по стандартному модулю

Encode.

Расширение и сжатие символов табуляции

Проблема

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

Решение

Примените подстановку весьма странного вида:

while (Sstring =~ s/\t+/' ' х (length($&) * 8 - length($') % 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($、)當 8)/e： print:

}

Чтобы обойтись без $', можно воспользоваться более сложным решением, в котором части совпадения сохраняются в именованных переменных. Следующий цикл заменяет один символ табуляции четырьмя пробелами вместо восьми:

while s/A(.*?)(\t+)/$l . ' ' х (length($2) * 4 - length($l) % 4)/e:

Другой прием основан на прямом использовании смещений из массивов @+ и @-. В следующем примере символ табуляции тоже расширяется до четырех пробелов:

1 while s/\t+/' ' х (($+[0] - $-[0]) * 4 - $-[0] % 4)/е：

Вы смотрите на все эти циклы 1 while и не можете понять, почему их нельзя было записать в виде простой конструкции s///g? Потому что нам приходится каждый раз заново пересчитывать длину от начала строки, а не от последнего совпадения.

Конструкция 1 while УСЛОВИЕ эквивалентна while (УСЛОВИЕ) {}, но более компактна. Она появилась в те дни, когда первая конструкция работала в Perl несравнимо быстрее второй. Хотя сейчас второй вариант почти не уступает по скорости, удобный первый вариант вошел в привычку.

Стандартный модуль Text: :Tabs содержит функции преобразований в обоих направлениях и экспортирует переменную $tabstop, которая определяет число пробелов на символ табуляции. Кроме того, применение модуля не приводит к снижению быстродействия, потому что вместо $& п $' используются переменные $1 и $2: use Text:：Tabs； Stabstop = 4； while (<>) { print expand($_) }

Модуль Text: :Tabs также может применяться для «свертки» табуляции. В следующем примере используется стандартное значение Stabstop, равное 8:

use Text：:Tabs； while (<>) { print unexpand($_) }

См. также

Страница руководства модуля Text: :Tabs; описание оператора s/// в perlre{ 1) и perlop^i).

Расширение переменных во входных данных

Проблема

Программа читает строку, внутри которой присутствует ссылка на переменную: You owe $debt to me.

Требуется заменить имя переменной $debt в строке ее текущим значением.

Решение

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

$text =~ s/\$(\w+)/${$l}/g；

Но если среди переменных могут встречаться лексические (ту) переменные, следует использовать /ее:

$text =~ s/(\$\w+)/$l/gee；

Комментарий

Первый способ фактически сводится к следующему: мы ищем нечто похожее на имя переменной, а затем интерполируем ее значение посредством символического разыменования (dereferencing). Если $1 содержит строку somevar, то ${$1} будет равно содержимому $somevdr. Такой вариант не будет работать при действующей директиве use strict 'refs', потому что она запрещает символическое разыменование.

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

our Grows $cols)；

no strict 1 refs'：# для привепенно「о ниже ${$l}/g

my $text：

($rows, $cols) = (24, 80):

$text = q(I am $ rows high and $cols long)： # Как строка в апострофах!

$text =~ s/\$(\w+)/${$l}/g；

print $text:

I am 24 high and 80 long

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

$text = "I am 17 years old"： $text =~ s/(\d+)/2 * $l/eg：

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

2 * 17

Но если попытаться выполнить следующий фрагмент:

$text = 'I am $AGE years old'： # Обратите внимание на апострофы!

$text =~ s/(\$\w+)/$l/eg：# НЕВЕРНО

при условии, что $text содержит имя переменной SAGE, Perl послушно заменит $1 на $AGE и вычислит следующее выражение:

'SAGE'

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

$text =~ s/(\$\w+)/$l/eeg：# Находит переменные ту()

Да, количество модификаторов /е может быть любым. Только первый модификатор компилируется вместе с программой и проверяется на правильность синтаксиса. В результате он работает аналогично конструкции eval {BLOCK}, хотя и не перехватывает исключений. Возможно, лучше провести аналогию с do {BLOCK}.

Остальные модификаторы /е ведут себя иначе и больше напоминают конструкцию eval "STRING". Они не компилируются до выполнения программы. Маленькое преимущество этой схемы заключается в том, что вам не придется вставлять в блок директиву no strict 'refs'. Есть и другое, огромное преимущество: этот механизм позволяет находить лексические переменные, созданные с помощью ту — символические ссылки на это не способны.

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

# Расширить переменные в $text. Если переменная не определена, # вставить сообщение об ошибке.

$text =~ s{

\$

(\w+)

# Найти знак доллара

# Найти "слово" и сохранить его в $1

no strict 'refs1:

# Для $$1

if (defined ${$1}) {

${$1}:

# Расширять только глобальные переменные

} else {

"[NO VARIABLE: \$$1]":

# Сообщение об ошибке

} }egx；

В незапамятные времена выражение $$1 в строках обозначало ${$}1, то есть переменную $$, за которой следует 1. Такая интерпретация принималась для удобства расширения переменной $$ как идентификатора процесса (PID) при формировании имен временных файлов. Сейчас $$1 всегда обозначает ${$1}, то есть разыменование содержимого переменной $1. В приведенной программе уточненная запись используется только для наглядности, поскольку программа и так работает правильно.

См. также

Описание оператора s/// в perlre(i) м perlop⑴;описание функции eval в perlfunc(i).

Похожее использование подстановок встречается в рецепте 20.9.

Преобразование регистра

Проблема

Строку с символами верхнего регистра необходимо преобразовать в нижний регистр или наоборот.

Решение

Воспользуйтесь функциями 1с и ис или модификаторами \L и \U:

$big = uc($little)： Slittie = lc($big); $big = "\U$little"： Slittie = "\L$big":$big = uc($little)： Slittie = lc($big); $big = "\U$little"： Slittie = "\L$big":# # # ## # # #"bo peep" -> "ВО PEEP" "JOHN" -> "John" "bo peep" -> "BO PEEP" "JOHN" -> "John""bo peep" -> "ВО PEEP" "JOHN" -> "John" "bo peep" -> "BO PEEP" "JOHN" -> "John"

$big = uc($little)： Slittie = lc($big); $big = "\U$little"： Slittie = "\L$big":

$big = uc($little)： Slittie = lc($big); $big = "\U$little"： Slittie = "\L$big":

# # # #

# # # #

"bo peep" -> "ВО PEEP" "JOHN" -> "John" "bo peep" -> "BO PEEP" "JOHN" -> "John"

"bo peep" -> "ВО PEEP" "JOHN" -> "John" "bo peep" -> "BO PEEP" "JOHN" -> "John"

Для замены отдельного символа используйте функции lefirst и ucfirst или модификаторы \1 и \и：

ИЛИИЛИ$big = "\u$little"；

ИЛИ

ИЛИ

SHttle = "\l$b1g":

Комментарий

Функции и модификаторы выглядят по-разному, но делают одно и то же. Допускается изменение регистра как первого символа, так и целой строки. Вы даже можете совместить оба решения и преобразовать первый символ к верхнему регистру (а точнее, сделать его заглавным — см. Комментарий), а все остальные символы — к нижнему регистру.

Sbeast = "dromedary"；

# Изменить регистр разных символов $beast

$capit

=ucfirst($beast);

# Dromedary

$(:叩计

="\u\L$beast";

# (то же)

Scapal1

=uc($beast)：

# DROMEDARY

$capal1

="\U$beast":

# (то же)

Scaprest

=lcfirst(uc($beast))：

# dROMEDARY

$caprest

="\l\U$beast":

# (то же)

Как правило, модификаторы обеспечивают единый стиль применения регистра в строке:

Сделать первый символ каждого слова заглавным.

а остальные символы привести к нижнему регистру

$text = "tHIS is a loNG UNE":

$text =~ s/(w+)/\u\L$l/g;

print $text；

This Is A Long Line

Ими также можно пользоваться для сравнения строк без учета регистра:

if (uc($a) eq uc($b)) {

print "a and b are the same\n"： }

Программа randcap из примера 1.2 случайным образом преобразует в верхний регистр примерно 20 процентов вводимых символов. Пользуясь ею, вы сможете свободно общаться с 14-летними кРУтЫми ХаЦкЕРамИ:

Пример 1.2. randcap

#!/usr/bin/perl -р

продолжение 挨продолжение 挨randcap： фильтр, который случайным образом # преобразует к верхнему регистру 20% символов # Начиная с версии 5.4, вызов srand() необязателен.

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

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

Пример 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 01F2 01F3Кодовый пункт 01F1 01F2 01F3ЗаписьDZDz dzЗаписьDZDz dzНазвание

Кодовый пункт 01F1 01F2 01F3

Кодовый пункт 01F1 01F2 01F3

Запись

DZ

Dz dz

Запись

DZ

Dz dz

LATIN CAPITAL LETTER DZ

LATIN CAPITAL LETTER D WITH SMALL LETTER Z

LATIN SMALL LETTER DZ

Преобразования регистра конструкциями типа tr[d-z][A-Z] или чем-нибудь в этом роде выглядят соблазнительно, однако поступать так не рекомендуется. Такое решение ошибочно, поскольку из него выпадают все символы с умляутами, седилями и прочими диакритическими элементами, встречающимися во многих языках (в том числе и в английском). Впрочем, задача правильного отображения регистра в символьных данных с диакритическими знаками вообще гораздо сложнее, чем кажется на первый взгляд. Простого решения не существует, но если все данные хранятся в Юникоде, все не так плохо, потому что регистровые функции Perl безупречно работают с Юникодом. За дополнительной информацией обращайтесь к разделу «Универсальная кодировка символов» во введении настоящей главы.

См. также

Описание функций uc, 1с, ucfirst и Icflrst в perlfunc(l\, описание модификаторов \L, \U, \1 и \и в разделе «Quote and Quote-like Operators» perlop(l).

Расстановка прописных букв в заголовках

Проблема

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

Решение

Воспользуйтесь разновидностью функции tc():

INIT {

our ^nocap：

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']*)/$nocap{$l} ? 1с($1) : ucfirst(lc($l))/ge:

s/x(\pL[\pL']*) /\u\L$l/x； # Последнее слово всегда

начинается с заглавной буквы

s/ (\pL[\pL']*)$/\u\L$l/x: # Последнее слово всегда

начинается с заглавной буквы

Часть в круглых скобках интерпретируется как полное название s/\( (\pL[\pL']*) /(\u\L$l/x;

s/(\pL[\pL']*) \) /\u\L$l)/x;

Первое слово после двоеточия или точки с запятой

начинается с заглавной буквы

s/ ( [::] \s+ ) (\pL[\pL']* ) /$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",

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

prlntf $mask, "ALL CAPITALS", uc($datum)；

prlntf $mask, "no capitals", lc($datum)：

prlntf $mask, "simple titlecase", tc_lame($datum)： prlntf $mask, "better titlecase", tcf$ddtum)；

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

@а11—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».

Еще одно обстоятельство, которое также следует учитывать, — возможное применение \и и ucfirst без принудительного перевода строки в нижний регистр. В этом случае слова, уже записанные прописными буквами (например, акронимы), не изменят своего написания. Вероятно, сокращения «FBI» и «LBJ» не должны преобразовываться в «Fbi» и «Lbj».

См. также

Описание функций uc, 1с, ucfirst и lefirst вperlfunc^l)} описание модификаторов \L, \U, \1 и \и в разделе «Quote and Quote-like Operators» perlop(l).

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

Проблема

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

Решение

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

$answer = $varl . func(). $v“2; # Только для скалярных величин

Также можно воспользоваться несколько неочевидными расширениями @{[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"；

Если интерполяция абсолютно неизбежна, придется воспользоваться вторым вариантом, изобилующим знаками препинания. Только символы @, $ и \ имеют

особое значение в кавычках и в обратных апострофах. Как и в случаях с т// и s///, синоним qx() не подчиняется правилам расширения для кавычек, если в качестве ограничителя использованы апострофы! В выражении $home = qx'echo home i 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 send_mail(«"EOTEXT". $target)；

To： $naughty

From： Your Bank

Cc： @{ get_manager_l1 st($naughty) }

Date: @{[ do { my $now = 'date': chomp $now； $now} ]} (today)

Dear $naughty.

Today, you bounced check number @{[ 500 + int rand(lOO) ]} 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";

В другом примере для хэша %money вызывается указанная вами функция:

use Interpolation money => \&currency_commify；

print "That will be $money{ 4 * $payment }. right now.\n":

Результат будет выглядеть примерно так:

That will be $3,232.421.04, right now.

См. также

perlref(l); модуль Interpolation из CPAN.

Отступы во встроенных документах

Проблема

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

Решение

Воспользуйтесь оператором s/// для отсечения начальных пропусков:

Все сразу

($var = « HERE_TARGET) =~ s/x\s+//gm； далее следует ваш текст

HERE_TARGET

Или за два этапа

$var = « HERE_TARGET: далее следует ваш текст

HEREJARGET

$var =~ s/x\s+//gm；

Комментарий

Подстановка получается весьма прямолинейной: она удаляет начальные пропуски из текста встроенного документа. Модификатор /ш разрешает совпадение метасимвола 人 в начале каждой логической строки документа, а модификатор /д заставляет механизм поиска повторять подстановку с максимальной частотой (то есть для каждой строки встроенного документа).

($definition = «'FINIS') =~s/x\s+//gm：

The five variations of camelids are the familiar camel, his frieds the llama and the alpaca, and the

rather less well-known guanaco

and vicuna.

FINIS

Учтите: во всех шаблонах этого рецепта используется метасимвол \s, обозначающий один символ-пропуск, который также может обозначать символ перевода строки. В результате из встроенного документа будут удалены все пустые строки. Если вы не хотите этого, замените в шаблонах \s на [x\S\n].

В подстановке используется то обстоятельство, что результат присваивания может использоваться в левой части =〜.Появляется возможность сделать все в одной строке, но она работает лишь при присваивании переменной. При непосредственном использовании встроенный документ интерпретируется как неизменяемый объект, и вы не сможете модифицировать его. Более того, содержимое встроенного документа нельзя изменить без предварительного сохранения его в переменной.

Впрочем, для беспокойства нет причин. Существует простой обходной путь, особенно удобный при частом выполнении этой операции. Достаточно написать небольшую процедуру:

sub fix {

my $string = shift;

$string =~ s/x\s+//gm；

return $string；

}

print fix(«"END");

Наш документ

END

# Если функция была объявлена заранее, скобки можно опустить： print fix «"END";

Наш документ

END

Как и во всех встроенных документах, маркер конца документа (END в нашем примере) должен быть выровнен по левому полю. Если вы хотите снабдить отступом и его, в документ придется добавить соответствующее количество пропусков:

($quote = « FINIS') =~s/人\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, но не для читателей.

Мы подходим к следующему усовершенствованию — специальным префиксам для строк, которые должны снабжаться отступами. Например, в следующем примере каждая строка начинается с @@@ и нужного отступа:

if ($REMEMBER_THE_MAIN) {

$perl_main_C = dequote«' MAIN_INTERPRETER_LOOP';

@G@ int

@@@ runops() {

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

($white, $leader_ = (/ (\s+)/,''):

}~

s/x\s*?$leader(?:$white)?//gm； return $_;

}~

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

if (m{\s * (?：(L\w\s] +)(\s* ) .* \n(?: \s * \1 \2 ? .* \n)+$}Xif (m{\s * (?：(L\w\s] +)(\s* ) .* \n(?: \s * \1 \2 ? .* \n)+$}X############начало строки

if (m{

\s * (?：

(

L\w\s] +

)

(\s* ) .* \n

(?: \s * \1 \2 ? .* \n

)+

$

}X

if (m{

\s * (?：

(

L\w\s] +

)

(\s* ) .* \n

(?: \s * \1 \2 ? .* \n

)+

$

}X

######

######

0 и более символов-пропусков

начало первой несохраняющей 「руппн

начать сохранение $1

один байт - не пробел и не символ слова

1 или более

закончить сохранение $1

занести 0 и более пропусков в буфер $2 искать до конца первой строки

конец первой 「руппировки

начало второй несохраняющей 「руппм

0 и более символов-пропусков

строка, предназначенная для $1

то. что будет в $2, но дополнительно

искать до конца строки

повторить идею с 「руппами 1 и более раз

($white, Sleader) } else {($white, $leader) }s{人\s *$leader(?: $white)?}{}xgm;($white, Sleader) } else {($white, $leader) }s{人\s *$leader(?: $white)?}{}xgm;=($2, quotemeta($D)；=(/人(\s+)/.一)；=($2, quotemeta($D)；=(/人(\s+)/.一)；##############начало каждой строки (из-за /т)любое количество начальных пропусков с минимальным совпадениемсохраненный префиксначать несохраняющую 「руппуто же количествоесли после префикса следует конец строкиначало каждой строки (из-за /т)любое количество начальных пропусков с минимальным совпадениемсохраненный префиксначать несохраняющую 「руппуто же количествоесли после префикса следует конец строкидо конца строки

($white, Sleader) } else {

($white, $leader) }

s{人

\s *

$leader

(?: $white

)?

}{}xgm;

($white, Sleader) } else {

($white, $leader) }

s{人

\s *

$leader

(?: $white

)?

}{}xgm;

=($2, quotemeta($D)；

=(/人(\s+)/.一)；

=($2, quotemeta($D)；

=(/人(\s+)/.一)；

#######

#######

начало каждой строки (из-за /т)

любое количество начальных пропусков с минимальным совпадением

сохраненный префикс

начать несохраняющую 「руппу

то же количество

если после префикса следует конец строки

начало каждой строки (из-за /т)

любое количество начальных пропусков с минимальным совпадением

сохраненный префикс

начать несохраняющую 「руппу

то же количество

если после префикса следует конец строки

Ну что, разве не стало понятнее? Пожалуй, нет. Нет смысла уснащать программу банальными комментариями, которые просто дублируют код. Возможно, перед вами один из таких случаев.

См. также

Раздел «Scalar Value Constructors» perldata⑴;описание оператора s/// в perlre(l) и perlop(l).

Переформатирование абзацев

Проблема

Длина текста не позволяет разместить его в одной строке. Требуется разделить его на несколько строк без переноса слов. Например, сценарий проверки стиля читает текстовый файл по одному абзацу и заменяет неудачные обороты более точными. Замена оборота «применяет функциональные возможности» словом «использует» приводит к изменению количества символов в строках, поэтому перед выводом абзаца его придется переформатировать.

Решение

Воспользуйтесь стандартным модулем Text: :Wrap для расстановки разрывов строк в нужных местах:

use Text：：Wrap；

^output = wrap($leadtab, $nexttab, @para)；

Можно воспользоваться более интеллектуальным модулем Text: :Autoformdt из CPAN:

use Text::Autoformat:

$formatted = autoformat $rawtext:

Комментарий

В модуле Text: :Wrap присутствует функция wrap (см. пример 1.3), которая получает список строк и переформатирует их в абзац с длиной строки не более $Text: :Wrap： ：columns символов. Мы присваиваем переменной $columns значение 20; это гарантирует, что ни одна строка не будет длиннее 20 символов. Перед списком строк функции wrap передаются два аргумента; один определяет отступ первой строки абзаца, а второй — отступы всех последующих строк.

Пример 1.3. wmpdemo

#!/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(" ". " ". Oinput). "\n":

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

01234567890123456789

Folding and

splicing is the work of an editor, not a mere collection of silicon and mobi1e electrons!

В результате мы получаем один абзац, в котором каждая строка, кроме последней, завершается символом перевода строки:

# Объединение нескольких строк с переносом текста use Text::Wrap： undef $/；

print wrap(, sp!1t(/\s*\n\s*/, <>);

Если в вашей системе установлен модуль Term：:ReadKey из CPAN, вы можете воспользоваться им для определения размеров окна, чтобы длина строк соответствовала текущему размеру экрана. Если этого модуля нет, размер экрана иногда можно взять из $ENV{COLUMNS} или определить по выходным данным команды stty.

Следующая программа переформатирует и слишком короткие, и слишком длинные строки абзаца по аналогии с программой fmt. Для этого разделителем входных записей $/ назначается пустая строка (благодаря чему <> читает целые абзацы), а разделителем выходных записей $\ — два перевода строки. Затем абзац преобразуется в одну длинную строку с заменой всех символов перевода строки (вместе с окружающими пропусками) одиночными пробелами. Наконец, мы вызываем функцию wrap с пустыми отступами первой и всех последующих строк:

use Text：:Wrapqw(&wrap $columns)；

use Term：：ReadKeyqw(GetTerm1nalS1ze);

(Scolumns) = GetTerm1nalS1ze():

($/, $\) = (''."\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>s1gns 1n front of everything

：> CN> * There are too many OR operators： having |, || and 'or'

:> CN>operators 1s confusing

:> CN> * VB rools, yeah!!!!!!!!!

:> 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, mlcrocephalic :> script-Infant.

:Sheesh, what's with this group - ask a question, get toasted! And how :*dare* you accuse me of lanuphilia!

к следующему виду:

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, :> mlcrocephalic script-Infant.

:Sheesh, what's with this group - ask a question, get toasted!

:And how *dare* you accuse me of lanuphilla!

Эффектно, не правда ли?

В следующей мини-программе этот модуль используется для переформатирования каждого абзаца во входном потоке:

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 и хотите заменить символы % последовательностями %%.

Решение

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

Обратная косая черта

$var =~ s/([CWZ./sn)/W$l/g:

Удвоение

$var =~ s/([CWZ.7Sn)/$l$l/g:

Комментарий

В приведенных выше решениях $var — модифицируемая переменная, a CHARLIST — список преобразуемых символов, который может включать комбинации типа \t или \п. Если преобразуется всего один символ, можно обойтись без скобок:

Sstring =~ s/%/統/д；

Преобразования, выполняемые в следующем примере, позволяют подготовить строку для передачи командному интерпретатору. На практике преобразование символов ' и " еще не сделает произвольную строку полностью безопасной для командного интерпретатора. Правильно собрать весь список символов так сложно, а риск так велик, что для запуска программ лучше воспользоваться списковыми формами system и ехес (см. рецепт 16.2) — в этом случае вы вообще избегаете взаимодействия с интерпретатором.

$string = q(Mom said. "Don*t do that."):

Sstrlng =~ s/(['"])/\\$l/g：

Две обратные косые черты в секции заменителя были использованы потому, что эта секция интерпретируется по правилам для строк в кавычках. Следовательно, чтобы получить одну обратную косую черту, приходится писать две. Приведем аналогичный пример для VMS DCL, где дублируются все апострофы и кавычки:

$str1ng = q(Mom said, "Don't do that.");

Sstrlng =~ s/(['"])/$l$l/g；

С командными интерпретаторами Microsoft дело обстоит еще сложнее. В Windows COMMAND. СОМ работает с кавычками, но не с апострофами; не имеет представления о применении обратных апострофов для запуска команд, а для превращения кавычек в литерал используется обратная косая черта. Впрочем, почти во всех бесплатных и коммерческих Unix-подобных командных интерпретаторах для Windows этот недостаток исправлен.

В регулярных выражениях поддерживаются символьные классы, поэтому также можно определить интервал с помощью -, а затем инвертировать его метасимволом 人.Следующая команда экранирует все символы, не входящие в интервал от А до Z:

$string =~ s/([AA-Z])/\\$l/g:

Для преобразования всех неалфавитных символов следует воспользоваться метасимволами \Q и \Е или функцией quotemeta. Например, следующие команды эквивалентны:

$string = "this \Qis a test!\E":

$string = "this is\\ a\\ test!";

Sstring = "this " . quotemeta("is a test!"):

См. также

Описание оператора s/// в perlre( 1) и perlop(\\, описание функции quotemeta рассматривается в perlfunc(l). В рецепте 19.1 рассматривается экранирование служебных символов в HTML, а в рецепте 19.5 говорится о том, как избежать экранирования при передаче строк командному интерпретатору.

Удаление пропусков в обоих концах строки

Проблема

В полученную строку могут входить начальные или конечные пропуски. Требуется удалить их.

Решение

Воспользуйтесь парой подстановок:

$string =~ s/^\s+//:

Sstring =~ s/\s+$//;

Или напишите специальную функцию, которая возвращает нужное значение:

$string = trim($string)：

@many = tr1m(@many)：

sub trim {

my ©out = @_；

for (©out) j

s/a\s+//；// Удаление пропусков слева

s/\s+$//；// Удаление пропусков справа

}

return ©out == 1

? $out[0]// Возвращается одна строка

:@out[0]；// Возвращается много строк

Комментарий

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

новые версии переданных строк, из которых удалены начальные и конечные пробелы. Функция работает как с отдельными строками, так и со списками.

Для удаления последнего символа из строки воспользуйтесь функцией chop. Будьте внимательны и не перепутайте ее с похожей функцией chomp, которая удаляет последнюю часть строки в том и только в том случае, если она содержится в переменной $/ (по умолчанию — "\п")« Чаще всего она применяется для удаления завершающего символа перевода строки из введенного текста:

# Вывести полученный текст заключенным в >< while(<STDIN>) { chomp；

print ">$_<\n":

}~

Функцию можно усовершенствовать несколькими способами.

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

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

s/\s+/ /д;# Свертка внутренних пропусков

Строка вида " but\t\tnot here\n" превращается в "but not here". Три последовательных подстановки s/、s+//； s/\s+$//;

s/\s+/ /д;

эффективнее заменить командой

$_ = join(‘ ’，spine ')):

Если функция вызывается вообще без аргументов, можно последовать примеру chop и chomp и по умолчанию использовать $_. После всех перечисленных усовершенствований мы получаем следующую функцию:

1. Отсечение начальных и конечных пропусков

2. Свертка внутренних пропусков в одиночные пробелы

3. При отсутствии аргументов входные данные берутся из $_

4. При возвращении в скалярном контексте

список объединяется в скаляр с промежуточными пробелами, sub trim {

my ©out = @_ ? @_ : $_;

$_ = join(' ', splitC ')) for ©out;

return wantarray ? @out : "©out";

См. также

Описание оператора s/// в perlre(l) nperlop(i)\ описание функций chop и chomp в perlfunc(l). Начальные пропуски удаляются в функции getnum из рецепта 2.1.

Анализ данных, разделенных запятыми

Проблема

Имеется файл данных, поля которого разделены запятыми. Требуется прочитать данные из файла. Однако в полях могут присутствовать свои запятые (находящиеся внутри строк или экранированные). Во многих электронных таблицах и СУБД списки полей, разделенных запятыми, поддерживаются в качестве стандартного формата для импорта/экспорта данных.

Решение

Если содержимое файла данных соответствует стандартным правилам экранирования Unix (то есть внутренние кавычки в полях экранируются обратной косой чертой: "like \"this\"", воспользуйтесь стандартным модулем Text::ParseWords и простой программой:

use Text::ParseWords； sub parse_csvO {

return quotewordsC," => 0, $_[0]);

}"

Если кавычки в полях экранируются удваиванием ("like ""this""”), можно воспользоваться стандартной процедурой из книги Джеффри Фридла «Регулярные выражения: Библиотека программиста, 2 издание» (издательство «Питер», 2003 г.):

sub parse_csvl {

my $text = shift: # Запись co значениями, разделенными запятыми

my ©fields =()； while ($text =~ m{ # Произвольная последовательность символов, кроме запятых и кавычек： (+ )

.. .или...

... поле в кавычках (внутри поля разрешаются удвоенные кавычки)

"# Открывающая кавычка поля (не сохраняем)

(# Теперь поле содержит либо

(?:[人”]# символы, отличные от кавычек, либо

# смежные кавычки

)* # Повторяется сколько угодно раз )

"# Закрывающая кавычка поля (не сохраняем)

}дх)

{

if (defined $1) {

$f1eld = $1;

} else {

($field = $2) =~ s/""/'7g:

}

push ©fields, $field:

}

return ©fields；

}

Также можно воспользоваться модулем 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 ($1 = 0； $1 < ©data； $1++) {

printf "Row 为d (Line 为d) is %s\n". $1, $1+1. "@{$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), gettytab(5\ printcap(5) и termcap®). Функции quotewords этого модуля передаются два аргумента и строка разделенных данных. Первый аргумент определяет символ-разделитель (в нашем случае запятая, но часто используется двоеточие), а второй — логический

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

В таких файлах данных кавычки внутри полей экранируются обратной косой чертой: "like \"this\". Кавычки, апострофы и обратная косая черта — единственные символы, для которых этот префикс имеет специальное значение. Все остальные экземпляры \ остаются в итоговой строке. Для работы с такими данными достаточно функции quotewords стандартного модуля Text::ParseWords.

Однако это решение не подходит для файлов данных из устаревших систем, в которых внутренние кавычки экранируются удваиванием: "like ""this…. В таких случаях приходится прибегать к другим решениям. Первое из них основано на регулярном выражении, приведенном во втором издании книги Джеффри Фридла «Регулярные выражения: Библиотека программиста». Его преимуществом следует считать то, что решение работает в любой системе без установки дополнительных модулей, не входящих в стандартную поставку. Фактически оно вообще не требует никаких модулей. Тем не менее, несмотря на обилие комментариев это решение вызывает легкий шок у неподготовленного читателя.

Объектно-ориентированный модуль CPAN Text： ：CSV, задействованный в следующем решении, скрывает сложности разбора в более удобных «обертках». Модуль Tie： :CSV из CPAN предлагает еще более элегантное решение: вы работаете с объектом, похожим на двумерный массив. Первый индекс представляет строки файла, а второй — его столбцы.

Рассмотрим примеры практического использования наших функций parse_csv. Здесь q() — всего лишь хитроумный заменитель кавычек, чтобы нам не приходилось расставлять повсюду символы \.

$line = q(XYZZY,"","O'Reilly, Inc"."Wall. Larry"."a \"glug\" bit,".5."Error. Core Dumped"): ©fields = parse_csvO($Hne)；

for ($1 = 0:$1 < ©fields； $i++) {

print "$1 : $f1eldsL$1]\n"； }

0 : XYZZY

:

: O'Reilly, Inc

: Wall, Larry

: a "glug" bit, 5 : 5

: Error, Core Dumped

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

О : XYZZY

: "O'Reilly, Inc"

: "Wall, Larry"

： "a \"glug\" bit," 5 : 5

： "Error, Core Dumped"

Другая разновидность файлов данных обрабатывается точно так же, но вместо parse_csvO используется parse_csvl. Обратите внимание на удвоение кавычек вместо экранирования префиксом:

$line = q(Ten Thousand.10000. 2710 .."10,000".

"It's ""10 Grand"", baby",ЮК):

©fields = parse_csvl($line):

for ($1 = 0； $1 < ©fields； $i++) {

print "$i : $fieldsL$i]\n"：

}

0 : Ten Thousand

1 : 10000

2 : 2710

:

: 10,000

： It's "10 Grand", baby

: ЮК

См. также

Описание синтаксиса регулярных выражений в perlre(l); документация по стандартному модулю Text::ParseWords; раздел «Разбор данных, разделенных запятыми» главы 5 книги «Регулярные выражения: Библиотека программиста, 2 издание».

Константы

Проблема

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

Решение

Если величина не обязана быть скалярной переменной, которая может интерполироваться, можно обойтись директивой use constant:

use constant AVOGADRO => 6.02252e23;

printf "You need %g of those for guac\n". AVOGADRO:

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

MV0GADR0 = \6.02252e23;

print "You need SAVOGADRO of those for guac\n";

Но самый надежный способ основан на использовании маленького класса tie с выдачей исключения в методе STORE:

package Tie：：Constvar； use Carp；

sub TIESCALAR {

my ($class, $1n1tval) = @_;

my $var = $1n1tval;

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 AVOGADRO0 { 6.02252е23 }

Чтобы область видимости константы ограничивалась текущим блоком, можно создать временную процедуру, для чего анонимная процедура присваивается тип-глобу с нужным именем:

use subs qw(AVOGADRO):

local *AVOGADRO = sub О { 6.0225e23 };

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

Если вместо ссылки на процедуру присвоить тип-глобу ссылку на констат- ный скаляр, то вы сможете использовать переменную с соответствующим именем. На этом основан второй прием, приведенный в Решении. У него есть свои недостатки: тип-глобы доступны только для пакетных переменных, но не для лексических, созданных с ключевым словом ту. Под действием рекомендуемой директивы use strict с необъявленными пакетными переменными возникнут проблемы, но переменную можно объявить при помощи our:

our SAVOGADRO;

local *AVOGADRO = \6.02252e23;

Третье решение — с созданием маленького класса tie — может показаться самым запутанным, но оно обеспечивает наибольшую гибкость. Кроме того, при желании константу можно объявить как лексическую переменную:

tie my SAVOGARO. Tie::Constvar, 6.02252e23;

После этого можно спокойно использовать конструкции вида

print "You need $AVOGADRO of those for guac\n"：

Любые попытки модификации константы будут отвергнуты:

$AVOGADRO = б.625бе-34：# Ничего не выйдет

См. также

Рецепты 1.15 и 5.3; некоторые идеи также можно почерпнуть из модуля CPAN Tie::Scalar：:RestrictUpddtes.

1-22. Сравнение слов с похожим звучанием

Проблема

Имеются две английских фамилии. Требуется узнать, звучат ли они похожим образом (независимо от написания). Это позволит выполнять «неформальный поиск» в телефонной книге, в результатах которого наряду со Smith будут присутствовать и другие похожие имена, например, Smythe, Smite и Smote.

Решение

Воспользуйтесь стандартным модулем Text： ：Soundex:

use Text:：Soundex：

$CODE = soundex($STRING):

©CODES = soundex(亂1ST);

Также можно воспользоваться модулем CPAN Text： ：Metaphone:

use Text：：Metaphone：

$phoned_words = Metaphone('Schwern')；

Комментарий

Алгоритм Soundex хэширует слова (особенно английские фамилии) в небольшом пространстве с использованием простой модели, имитирующей произношение по правилам английского языка. Грубо говоря, каждое слово сокращается до четырехсимвольной строки. Первый символ является буквой верхнего регистра, а прочие — цифры. Сравнивая значения для двух строк, можно определить, звучат ли они похожим образом.

Следующая программа предлагает ввести имя и ищет в файле паролей имена с похожим звучанием. Аналогичный подход может использоваться для баз данных имен, поэтому при желании можно индексировать базу данных по ключам Soundex. Конечно, такой индекс не будет уникальным.

use Text：：Soundex：

use User：：pwent：

print "Lookup user: ”； chomp($user = <STDIN>)； exit unless defined $user； $name_code = soundex(Suser)；

while($uent = getpwentO) {

($firstndme, Slastname) = $uent->gecos =~ /(\w+)「，]*\b(\w+)/；

II II )II II )Sflrstname. Slastname；Sflrstname. Slastname；If ($name_code eq soundex($uent->name) $name_code eq soundex($lastname) $name_code eq soundex($firstname)

II II )

II II )

Sflrstname. Slastname；

Sflrstname. Slastname；

printf "Zs： Zs %s\n". $uent->name.

Модуль Text::Metaphone из архива CPAN решает ту же задачу другим, более разумным способом. Функция soundex возвращает код из буквы и трех цифр для начала входной строки, а функция Metaphone возвращает код в виде последовательности букв переменной длины. Пример:

soundex metaphone

Christiansen Kris JensonKyrie El el son Curious LiaisonChristiansen Kris JensonKyrie El el son Curious LiaisonC623KRSXNSNK625KRSJNSNK642KRLSNC624KRSLSNC623KRSXNSNK625KRSJNSNK642KRLSNC624KRSLSN

Christiansen Kris Jenson

Kyrie El el son Curious Liaison

Christiansen Kris Jenson

Kyrie El el son Curious Liaison

C623KRSXNSN

K625KRSJNSN

K642KRLSN

C624KRSLSN

C623KRSXNSN

K625KRSJNSN

K642KRLSN

C624KRSLSN

Чтобы в полной мере реализовать возможности Metaphone, следует также воспользоваться модулем String：:Approx из CPAN, более подробно описанным в рецепте 6.13. Этот модуль позволяет найти успешное совпадение даже при наличии отдельных ошибок в строках. Количество изменений, необходимых для перехода от одной строки к другой, называется расстоянием между этими строками. Следующая команда проверяет совпадение строк, разделенных расстоянием 2 и менее:

if (amatchCstringl", [2], "string2") { }

Также присутствует функция adist, которая возвращает расстояние между строками. Например, расстояние между «Kris Jenson» и «Christiansen» равно 6, тогда как расстояние между их кодами Metaphone равно всего 1. Расстояние между компонентами другой пары в исходном варианте равно 8, а при сравнении кодов Metaphone оно снова уменьшается до 1:

use Text::Metaphone qw(Metaphone):

use String：:Approx qw(amatch):

if (amatch(Metaphone($sl). [IL Metaphone($sl)) {

print "Close enough!\n"： }

Этот фрагмент найдет успешные совпадения для обеих пар из рассмотренного примера.

См. также

Документация по стандартным модулям Text: ：Soundex и User： ：pwent; модули С PAN Text： ： Metaphone и String：: Approx; страница руководства pass 坦 d(5) вашей системы; том 3, глава 6 «Искусства программирования».

1-23- Программа: fixstyle

Представьте себе таблицу с парами устаревших и новых слов:

Старые слова

Новые слова

bonnet

hood

rubber

eraser

lorry

truck

trousers

pants

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

При вызове без файловых аргументов программа выполняет функции простого фильтра. Если в командной строке передаются имена файлов, то программа записывает в них изменения, а прежние версии сохраняются в файлах с расширениями *.orig (см. рецепт 7.16). При наличии параметра командной строки -V сообщения обо всех изменениях записываются в STDERR.

Таблица пар «исходное слово/заменитель» хранится в основной программе, начиная с маркера —END— (см. рецепт 7.12). Пары преобразуются в подстановки (с экранированием символов) и накапливается в переменной $code так же, как это делается в программе popgrep2 из рецепта 6.10.

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

Пример 1.4. fixstyle

#!/usr/bin/perl -w

fixstyle - замена строк секции <DATA> парными строками

использование： $0 [-v] [файлы...] use strict;

my $verbose = (@ARGV && $ARGV[0] eq '-v' && shift);

if (@ARGV) {

$T = ".orig"：# Сохранить старые файлы

} else {

warn "$0： Reading from stdin\n" if -t STDIN：

}

my $code = "while (<>) {\n"：

Читать данные и строить код для eval

while (<DATA>) {

chomp;

my ($in, $out) = split /\s*=>\s*/;

next unless $1n && $out;

$code .= "s{\\Q$in\\E}{$out}g":

$code .= "&& printf STDERR qq($in => $out at \$ARGV line \$.\\n) if $verbose；

$code .= "An"：

}

$code .= "print:\n}\n"； eval "{ $code } 1" || die；

_END_

analysed

=>

analyzed

built-in

=>

builtin

chastized

=>

chastised

commandline

=>

command-11 ne

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 $in && $out:

$change{$in} = $out:

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

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

if (@ARGV) {

$Т = ".orig";

} else {

warn "$0： Reading from stdin\n" if -t STDIN;

}

while (<>) {

my $1 =0;

s/y\s+)〃 && print $1；# Выдать начальный пропуск

for (split /(\s+)/, $_, -1) {# Сохранить конечные пропуски

print( ($i++ & 1)~? $_ ： ($change{$J || $_));

}

_ _END_ _

analysed

=>

analyzed

built-in

=>

builtin

chastized

=>

chastised

commandline

=>

command-11 ne

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

В конце каждой строки появляется лишний пробел. Если это нежелательно, воспользуйтесь методикой рецепта 16.5 и создайте выходной фильтр. Вставьте следующий фрагмент перед циклом while, сжимающим пропуски:

my $pid = open(STDOUT. "|=");

die "cannot fork： $!" unless defined $pid； unless ($pid) {

while (<STDIN>) { s/ $//: print:

} exit;

}

1-24. Программа: psgrep

Многие программы (в том числе ps, netstdt, Is -1, find -Is и tcpdump) часто выдают большие объемы данных. Файлы журналов тоже быстро увеличиваются в размерах, что затрудняет их просмотр. Такие данные можно обработать программой-фильтром типа grep и отобрать из них лишь часть строк, однако регулярные выражения плохо согласуются со сложной логикой — достаточно взглянуть на ухищрения, на которые приходится пускаться в рецепте 6.18.

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

Программа psgrep умеет делать все это — и бесконечно большее, потому что в ней критерии отбора не являются регулярными выражениями; они состоят из полноценного кода Perl. Каждый критерий последовательно применяется к каждой строке вывода. В результате выводятся лишь те данные, которые удовлетворяют всем аргументам. Ниже приведены примеры критериев поиска и соответствующие им командные строки:

О Строки со словами, заканчивающимися на sh:

% psgrep ' /sh\b/'

О Процессы с именами команд, заканчивающимися на sh:

% psgrep 'command =~ /sh$/'

О Процессы с идентификатором пользователя, меньшим 10:

% psgrep 'uid < 10'

О Интерпретаторы с активными консолями:

% psgrep 'command =~ 7人-/' 'tty ne "?"'

О Процессы, запущенные на псевдоконсолях:

% psgrep 'tty =~ /A[p-t]'

О Отсоединенные непривилегированные процессы:

% psgrep 'uid && tty eq "?"'

О Большие непривилегированные процессы:

% psgrep 'size > 10 * 2**10' 'uid != О'

Ниже показаны данные, полученные при последнем вызове psgrep на нашем компьютере. Как и следовало ожидать, в них попал только netscape и его вспомогательный процесс:

FLAGS

UID

PID

PPID PRI

NI

SIZE

RSS WCHANSTA TTY

TIME COMMAND

0

101

9751

1 0

0

14932

9652 do_select S pl

0:25 netscape

100000

101

9752

97510

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 ^fields;# Для хранения данных

die « Thanatos unless @ARGV；

usage: $0 criterion ...

Each criterion is a Perl expression involving： ©fieldnames

All criteria must be met for a line to be printed.

Thanatos

Создать синонимы для uid, size, UID, SIZE и т.д.

Пустые скобки необходимы для создания прототипа без аргументов for my $name (©fieldnames) {

no strict 'refs'；

*name = *{lc $name} = sub () { $fields{$name} }：

}

my $code = "sub 1s_desicable { " . join(" and ", @ARGV) . " }"：

unless (eval $code.l) {

die "Error in code： $@\n\t$code\n"；

}

open (PS, "ps wwaxl I")11 die "cannot fork: $!"：

print scalar <PS>;# Строка-заголовок

while (<PS> {

@fi elds {(^fieldnames} = trim(unpack($fmt, $_))；

print If is_desirable()：# Строки, удовлетворяющие критериям

}'

close(PS)11 die "ps failed!"；

# Преобразовать позиции разреза в формат распаковки

sub cut2fmt {

my(©positions) = @_:

my $template ='':

my $lastpos = 1:

foreach $place(positions) {

$template .= "A" . ($place - $lastpos)."

$lastpos = $place：

}

$template .= "A*"；

return $template：

}

sub trim {

my (^strings = @_;

for ((^strings)彳

s/rs+//;

s/\s+$//;

}

return wantarray ? ©strings : $strings[0]；

}

# Следующий шаблон использовался для определения позиций разреза.

# Далее следует пример входных данных

#123456789012345678901234567890123456789012345678901234567890123456789012345

#

1

2

3

45

6

7

# Позиции：

#8

1420

26 30

344147

59

63 6772

1

111

_ _END_ "flags"

~UID

PID PPID

PRI NI

SIZE RSS WCHAN

STA

TTY TIME COMMAND

100

0

10

0 0

760 432 do_select

S

?0:02 init

140

0

1871

0 0

784 452 do_select

s

?0:02 syslogd

100100

101

4281

0 0

1436944 do]exit

s

1 0:00 /bin/login

100140

99

30217402

0 0

1552 1008 posixlock

s

?0:00 httpd

0

101

593428

0 0

1780 1260 copy_thread

s

1 0:00 -tcsh

100000

101

30639 9562

170

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

1412928 setup_frame T

p3 0:00 ssh -C www

100100

0

26560 26554

0 0

1076572 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). Присваивание @fields{@fieldndmes} заносит сразу несколько величин в хэш ^fields. Срезы хэшей рассматриваются в рецептах 4.8 и 5.11.

Входные данные программы-примера, расположенные под —END—, описаны в рецепте 7.12. На стадии разработки для тестирования использовались «консервированные» данные, полученные через файловый манипулятор DATA. Когда программа заработала, мы перевели ее на получение данных из присоединенной команды ps, однако исходные данные были оставлены для будущего переноса на

другие платформы и сопровождения. Конвейерный запуск других программ рассматривается в главе 16 «Управление процессами и межпроцессные взаимодействия» более подробно в рецептах 16.10 и 16.13.

Настоящая сила и выразительность psgrep обусловлена тем, что в Perl строковые аргументы могут представлять собой не просто строки, а программный код Perl. Похожий прием использован в рецепте 9.9, за исключением того, что в psgrep аргументы пользователя «упакованы» в процедуру 1 s_desicable. При этом строки компилируются в код Perl всего один раз — еще перед запуском той программы, чей вывод мы обрабатываем. Например, при запросе UID ниже 10 будет сгенерирована следующая строка:

eval "sub 1s_desirable { uid < 10 } " . 1:

Загадочное .1 в конце присутствует для того, чтобы при компиляции пользовательского кода команда eval возвращала истинное значение. В этом случае нам даже не придется проверять $@ на предмет ошибок компиляции, как это делается в рецепте 10.12.

Использование произвольного кода Perl в фильтрах для отбора записей — невероятно мощная возможность, но она не является абсолютно оригинальной. Perl многим обязан языку программирования awk, который часто применялся для подобной фильтрации. Один из недостатков awk заключался в том, что он не мог легко интерпретировать входные данные в виде полей фиксированной длины (вместо полей, разделенных особыми символами). Другой недостаток — отсутствие мнемонических имен полей; в awk использовались имена $1, $2 и т. д. К тому же Perl может делать многое из того, на что не способен awk.

Пользовательские критерии даже не обязаны быть простыми выражениями. Например, следующий вызов инициализирует переменную $1d номером пользователя nobody и затем использует ее в выражении:

% psgrep 'no strict "vans"：

BEGIN { $1d = getpwnam("nobody") } uid == $1d '

Но как использовать слова u1d, command и size, даже не снабжая их символом $ для представления соответствующих полей входных записей? Мы напрямую манипулируем с таблицей символических имен, присваивая замыкания (closures) неявным тип-глобам (typeglobs), которые создают функции с соответствующими именами. Имена функций создаются с использованием записи, как в верхнем, так и в нижнем регистре, что позволяет использовать как "UID < 10", так и "u1d > 10". Замыкания описаны в рецепте 11.4, а их присвоение тип-глобам для создания синонимов функций — в рецепте 10.14.

Однако в psgrep встречается нюанс, отсутствующий в этих рецептах, — речь идет о пустых скобках в замыкании. Благодаря скобкам функция может использоваться в выражениях везде, где допускается отдельная величина (например, строка или числовая константа). В результате создается пустой прототип, а функция обращения к полю (например, uid) вызывается без аргументов, по аналогии со встроенной функцией time. Если не создать для функций прототипы с пустыми списками аргументов, выражения "uid < 10" или "s1ze/2 > rss" приведут в заме-

шательство лексический анализатор — он увидит в них незаконченный глоб (wildcard glob) или шаблон поиска соответственно. Прототипы рассматриваются в рецепте 10.11.

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

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

sub id(){ $_->{ID}}

sub titleO{ $_->{TITLE} }

sub executive { title =~/(?：v1ce-)?president/i }

# Критерии отбора указываются при вызове grep

©slowburners = grep { Id < 10 && 'executive } ©employees；

По причинам, связанным с безопасностью и быстродействием, такой подход редко встречается в реальных механизмах, описанных в главе 14 «Базы данных». В частности, он не поддерживается в SQL, но, имея в своем распоряжении Perl и некоторую долю изобретательности, нетрудно создать свой собственный вариант.

2

Числа

«Каждый, кто занимается математическими методами получения случайных чисел, несомненно, впадает в грех».

Джон фон Нейман (1951)

.0. Введение

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

Perl старается по возможности облегчить вам жизнь, и его средства для работы с числами не являются исключением из этого правила. Если скалярное значение интерпретируется в программе как число, то Perl преобразует его в числовую форму. Читаете ли вы числовые данные из файла, извлекаете отдельные цифры из строки или иным образом получаете числа из бесчисленных текстовых источников внешнего мира — вам не приходится преодолевать препятствия в виде неудобных ограничений других языков на пути преобразования ASCII- строк в числа.

Если строка используется в числовом контексте (например, в математическом выражении), то Perl старается интерпретировать ее как число, однако у него нет возможности сообщить о том, что строка не имеет действительного числового представления. Встречая нечисловой символ, Perl прекращает интерпретацию строки, при этом нечисловые строки считаются равными нулю — поэтому "А7" преобразуется в 0, а "7А" — в 7 (хотя флаг -w предупредит вас о некорректных преобразованиях). Иногда (например, при проверке вводимых данных) требуется узнать, соответствует ли строка числу. Мы покажем, как это делается, в рецепте 2.1.

В рецепте 2.16 объясняется, как получить число из строк с шестнадцатеричными, восьмеричными или двоичными представлениями чисел — например, "Oxff", "0377" и "OblOllO". Perl автоматически преобразует литералы в программном коде (поэтому команда $а = 3 + Oxff присвоит $а значение 258), но это не относится к данным, прочитанным программой. Вы не можете прочитать "ff" или даже "Oxff" в $b и затем написать $а = 3 + $Ь, чтобы присвоить $а значение 258.

А если трудностей с целыми числами окажется недостаточно, числа с плавающей запятой преподнесут целый букет новых проблем. Во внутреннем представ-

лении дробные числа хранятся в двоичном формате с плавающей запятой. Они представляют вещественные числа лишь приближенно, с ограниченной точностью. Для представления бесконечного множества вещественных чисел используется конечное пространство, обычно состоящее из 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 "%.6^W. О.Г

0.100000000000000005551115123125782792118158340454101562500000

В рецептах 2.2 и 2.3 показано, как работать с вещественными представлениями чисел на вашем компьютере как с обычными числами.

Рецепт 2.4 описывает три способа выполнения некоторой операции с каждым элементом последовательного множества целых чисел. Преобразование чисел в римскую запись и обратно продемонстрировано в рецепте 2.5.

Случайным числам посвящено сразу несколько рецептов. Функция Perl rand возвращает число с плавающей запятой от 0 до 1 или от 0 до своего аргумента. Мы покажем, как получить случайное число в конкретном интервале, как сделать их «еще более случайными» и как заставить rand генерировать новый набор случайных чисел при каждом запуске программы.

Глава завершается рецептами, относящимися к тригонометрии, логарифмам, умножению матриц, комплексным числам. Заодно вы найдете ответ на часто встречающийся вопрос: «Как включить в выводимое число запятую?»

.L Проверка строк на соответствие числам

Проблема

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

Решение

Проверьте строку по регулярному выражению, которое совпадает со всеми интересующими вас разновидностями чисел:

if (Sstring =~ /PATTERN/) {

является числом

} else {

не является числом

Или воспользуйтесь готовыми шаблонами из модуля CPAN Regexp:: Common:

if ($string =~ m{x$RE{num}{real}$}) {

является вещественным числом

} else {

не является вещественным числом

}

Комментарий

Все зависит от того, что именно понимать под числом. Даже простые на первый взгляд понятия, например, целое, заставят вас поломать голову над тем, какие строки следует отнести к этой категории. Например, что делать с начальным + для положительных чисел? Разрешить, сделать обязательным или запретить? А числа с плавающей запятой представляются таким огромным количеством способов, что у вас в голове перегреется процессор.

Сначала решите, какие символы допустимы, а какие — нет. Затем сконструируйте для отобранных символов регулярное выражение. Ниже приведены некоторые стандартные конструкции для самых распространенных ситуаций (что-то вроде полуфабрикатов для нашей поваренной книги).

# Содержит нецифровые символы

warn "has nondlglts"If 八D/；

# Не является натуральным числом

warn # Не

"not a natural number" является целым числом

unless

L\d+$/;

# Отвергает -3

warn

"not an Integer"

unless

L-?\d+$/;

# Отвергает +3

warn .# Не

"not an Integer" является десятичным числом

unless

/T+-]?\d+$/;

warn

"not a decimal number"

unless

/，？\d+\.?\d*$/；

# Отвергает .2

warn # Не

"not a decimal number"unless

является вещественным числом С

/J?(?：\d+(?:\.\d*)?|\.\d+)$/;

warn "not a C float"

unless /人([+-]?)(?=\d|\.\d)\d*(\.\d*)?([Ее]([+-]?\d+))?$/：

В этих шаблонах не обрабатываются особые случаи Infinity и NaN в записи IEEE. Если вы не боитесь, что члены комитета IEEE придут к вашему компьютеру и начнут бить вас по голове копиями соответствующих стандартов, вероятно, об этих странных «числах» можно забыть.

Для строк с начальными или конечными пробелами эти шаблоны не подходят. Либо вставьте в них соответствующую логику, либо вызовите функцию trim из рецепта 1.19.

Модуль Regexp：:Common из архива CPAN содержит множество готовых решений для проверки того, содержит ли строка текстовое представление числа. Помимо того что вам не придется тратить время на самостоятельное составление этих шаблонов, их использование сделает программу более удобочитаемой. По умолчанию этот модуль экспортирует хэш с именем ZRE, индексируемый по типу регулярного выражения. Будьте внимательны и используйте якорные метасимволы там, где это необходимо, иначе поиск по шаблону будет производиться во всей строке. Пример:

use Regexp：：Common；

$string = "Gandalf departed from the Havens in 3021 TA."；

print "Is an 1nteger\n"if Sstring =〜/人 $RE{num}{int} $ /x:

print "Contains the integer $l\n" if $string =~ /( $RE{num}{1nt} ) /x；

Ниже приводятся другие примеры шаблонов, которые могут использоваться

модулем для проверки чисел:

$RE{num}{1nt}{-sep=>',

?'}

# Совпадает

с

1234567 и 1,234,567

$RE{num}{1nt}{-sep=>'.

'}{-group=>4}

# Совпадает

с

1.2345.6789

$RE{num}{1nt}{-base =>

8}

# Совпадает

с

014. но не с 99

$RE{num}{1nt}{-sep=>',

'}{-group=3}

# Совпадает

с

1,234,594

$RE{num}{1nt}{-sep=>'.

?'}{-group=3}

# Совпадает

с

1,234 и 1234

$RE{num}{real}

# Совпадает

с

123.456 и -0.123456

$RE{num}{roman}

# Совпадает

с

XV11 и MCMXCVIII

$RE{num}{square}

# Совпадает

с

9, а также 256 и 12321

Некоторые из этих шаблонов (в частности, square) отсутствовали в ранних версиях модуля. Общее описание модуля приведено на странице руководства Regexp：:Common, а более подробная документация по числовым шаблонам содержится на странице руководства Regexp： ：Common： ：number.

Некоторые способы идентификации чисел обходятся без регулярных выражений. Вместо этого они используют функции системных библиотек или Perl. Конечно, возможности таких функций ограничиваются определением «числа», принятым в системной библиотеке или в Perl.

В POSIX-системах Perl поддерживает функцию POSIX： ：strtod. Ее семантика чрезвычайно громоздка, поэтому ниже приводится функция getnum для упрощения работы с ней. Эта функция получает строку и возвращает либо найденное число, либо undef для строк, не соответствующих вещественным числам С. Интерфейсная функция 1s_numer1c упрощает вызов getnum в ситуациях, когда вы просто хотите спросить: «Это вещественное число?»

sub getnum {

# Удаление начальных пропусков# Удаление конечных пропусков=strtod($str)：($unparsed != 0) || $!) {# Удаление начальных пропусков# Удаление конечных пропусков=strtod($str)：($unparsed != 0) || $!) {use POSIX qw(strtod): my $str = shift： $str =~ s/x\s+//: $str =~ s/\s+$//； $! = 0;

# Удаление начальных пропусков

# Удаление конечных пропусков

=strtod($str)：

($unparsed != 0) || $!) {

# Удаление начальных пропусков

# Удаление конечных пропусков

=strtod($str)：

($unparsed != 0) || $!) {

my($num. $unparsed) if (($str eq ") || return；

} else {

return $num：

sub 1s_numeric { defined scalar &getnum }

Модуль Scalar::Util, ставший стандартным в недавней версии Perl 5.8.1, экспортирует функцию looks_like_number, которая использует одноименную внутреннюю функцию компилятора Perl (см. perlapi(l)). Функция возвращает true для любого десятичного числа, приемлемого с точки зрения Perl, например, О, 0.8, 14.98 или 6.02е23, но не для чисел ОхЫОЮ, 077, 0x392 или чисел, содержащих внутренние символы подчеркивания. Следовательно, если вы захотите разрешить ввод чисел в других системах счисления, вам придется самостоятельно проверить их синтаксис и декодировать их, как показано в примере 2.1.

Пример 2.1. Декодирование чисел

#!/usr/bin/perl -w

use Scalar： ：Util qw(looksJ1ke_number)：

print "$0: hit 人D (your eof character) to exit\n"；

for (：:) {

my ($on, $n)：# Исходная строка и ее числовое представление

print "Pick a number, any number:"：

$on = $n = <STDIN>：

last if !defined $n；

chomp($on,$n)；

$n =~ s/_//g：# Разрешить 186_282.398_280_685

$n = oct?$n) if $n =~ /F/; # Разрешить OxFF, 037, OblOlO

if (looksj1ke_number($n)) {

print? "Decimal double of $on is %g\n". 2*$n；

} else {

print "That doesn't look like a number to Perl An"；

}

}

print "\nBye.\n"：

См. также

Описание синтаксиса регулярных выражений в perlre(l)', страница руководства sMod(3); страница руководства perlapi(l); документация по модулю CPAN Regexp： ：Common, включая страницу руководства Regexp：:Common： ：number; документация по стандартным модулям POSIX и Scalar: :UtiL

2・2. Округление чисел с плавающей запятой

Проблема

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

Решение

Чтобы просто вывести число, воспользуйтесь функцией Perl sprintf или prlntf:

# Округление до двух разрядов

$ rounded = sprlntfd.Zf"", $unrounded);

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

Комментарий

Работа с вещественными числами практически неизбежно сопровождается округлением (видимым или незаметным для программиста). Применение специальных стандартов (а именно IEEE 754, стандарта двоичной вещественной математики) в сочетании с разумным механизмом стандартного округления в Perl часто позволяет устранить или по крайней мере скрыть ошибки округления.

Более того, автоматическое округление при выводе в Perl обычно работает так хорошо, что его результаты очень редко оказываются неожиданными для пользователя. Числа почти всегда лучше хранить в неокругленном виде до момента вывода, и если вас не устраивает стандартное округление Perl — воспользуйтесь функцией prlntf или sprintf с явно заданным форматом округления. Форматы %f, %е и %д позволяют задать количество десятичных разрядов, до которого должен округляться аргумент. Следующий пример демонстрирует работу всех трех форматов; в каждом случае запрашивается поле с шириной 12 позиций, но не более 4 цифр в дробной части:

for $п ( 0.0000001. 10.1. 10.00001. 100000.1 ) {

printf "П2.4е 犯2.4f П2.4д\п", $п, $п. $п:

}

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

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

$b = 0.725;# 725/1000. или 29/40

printf "$_ 1s Г30д\п", $_ for $а, $b;

выводит следующий результат:

0.625 1s 0.625 0.725 is 0.724999999999999977795539507497

Число, хранящееся в переменной $а, может быть точно представлено в двоичной системе, а число в переменной $Ь не имеет точного представления. Когда

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

$b = 0.725;# 725/1000, или 29/40

printf 'Is is %.2f or Г30д\п", ($_) 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:

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

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

Существуют три функции, предназначенные для округления чисел с плавающей запятой до целых: int, cell и floor. Встроенная функция Perl Int возвращает целую часть передаваемого ей вещественного числа (это называется «округлением по направлению к нулю» или «отсечением дробной части», поскольку функция игнорирует дробную часть: положительные числа округляются вниз, а отрицательные — вверх). Функции модуля POSIX floor и cell тоже игнорируют дробную часть, но они всегда осуществляют округление до ближайшего меньшего или большего числа соответственно независимо от знака.

use POSIX qw(floor ceil);

pEntf "%8s %8s %8s %8s %8s\rT,

qw(number even zero down up):

for $n (-6 .. +6) {

$n += 0.5;

pEntf "%8g %8.0f %8s %8s ^8s\n".

$n. $n, 1nt($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.56 б 013

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

См. также

Функции sprintf и int в perlfunc(l); описания floor и cell в документации по стандартному модулю POSIX; пример использования sprintf из рецепта 2.3.

2.3. Сравнение вещественных чисел

Проблема

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

Решение

Воспользуйтесь функцией sprintf и отформатируйте числа до определенного десятичного разряда, после чего сравните полученные строки:

equal(NUM1. NUM2. PRECISION)； возвращает true, если NUM1 и NUM2

совпадают на PRECISION десятичных разрядов.

sub equal {

my ($А. $В, $dp) = @_;

return spr1ntf('T${dp}g". $А) eq sprlntfCl.${dp}g", $B);

}

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

Комментарий

Процедура equal понадобилась из-за того, что в компьютерах многие числа с плавающей запятой являются приближенными представлениями реальных чисел (об этом говорилось во Введении). Стандартные функции вывода Perl выводят числа с округлением до 15 десятичных разрядов, но при числовых сравнениях округление не применяется. Следовательно, некоторые числа при выводе могут выглядеть одинаково (после округления), но не совпадать при сравнении (без округления).

Проблема особенно заметна в циклах, где ошибки округления незаметно накапливаются. Допустим, вы обнуляете переменную и десять раз увеличиваете ее на 0,1; логично предположить, что результат будет равен 1. На самом деле это не так, поскольку в двоичной системе число 0,1 не имеет точного представления. Например, фрагмент

for ($num = $i = 0; $1 < 10; $1++) { $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. Однако во внутреннем представлении

переменная $num отлична от 1, но если ограничить проверку несколькими десятичными разрядами, например, пятью:

!equal($num, 1. 5)

сравнение даст желаемый результат.

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

$wage = 536;# $5.3б/час

$week = 40 * $wage； # $214.40

printfC'One week's wage is： \$%.2f\rT, $week/100):

One week's wage is: $214.40

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

См. также

Описание функции sprintf в perlfunc(l); описание переменной $OFMT на странице руководства perlvar(i); документация по стандартному модулю Math::BigFloat. Функция sprintf используется в рецепте 2.2. Также обращайтесь к разделу 4.2.2 тома 2 «Искусства программирования».

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

Проблема

Требуется выполнить некоторую операцию со всеми целыми между X и Y. Подобная задача может возникнуть при работе с непрерывной частью массива или в любой ситуации, когда необходимо обработать все числа из заданного интервала.

Решение

Воспользуйтесь циклом for или .. в сочетании с циклом foreach:

foreach ($Х .. $Y) {

$_ принимает все целые значения от X до Y включительно

foreach $i ($Х .. $Y) {

$1 принимает все целые значения от X до Y включительно }

for ($1 = $Х： $1 <= $Y: $i++) {

$1 принимает все целые значения от X до Y включительно }

for ($i = $Х; $1 <= $Y; $i+=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"：

Infancy is： 0 1 2

Toddling is: 3 4

Childhood is: 5 6 7 8 9 10 11 12

См. также

Описание операторов for и foreach в perlsyn(i).

2.5. Работа с числами в римской записи

Проблема

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

Решение

Воспользуйтесь модулем Roman из архива CPAN:

use Roman:

$roman = roman($arabic):# Преобразование

в римскую запись

$arabic = arabic($roman) if 1sroman($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 f1fteen is xv

Converted back, xv is 15

В следующем примере выводится текущий год:

use Time: JocaRime:

use Roman:

printf "The year is now ^s\n", Roman(1900 + locaRime->year)；

The year is now MMIII

Если в вашем распоряжении имеются шрифты Юникода, вы можете убедиться, что кодовые пункты в интервале от U+2160 до U+2183 представляют римские числа, в том числе и отсутствующие в обычной кодировке ASCII:

use charnames ": fulT ；

print "2003 Is \N{ROMAN NUMERAL ONE THOUSAND}" x 2.

"\N{ROMAN NUMERAL THREE}\n";

2003 is MMIII

Поддержка этих символов пока отсутствует в модуле Roman.

use Math print $d print $d print $d print $duse Math print $d print $d print $d print $d# # # ## # # #Хотите — верьте, хотите — нет, но в CPAN существует даже модуль, позволяющий выполнять вычисления в римской записи:

use Math print $d print $d print $d print $d

use Math print $d print $d print $d print $d

# # # #

# # # #

I

MM I

MCMXCVIII

XCVIII

См. также

Документация по модулям CPAN Roman и Math： ：Roman; рецепт 6.23.

2.6. Генератор случайных чисел

Проблема

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

Решение

Воспользуйтесь функцией Perl rand:

$random = 1nt( rand( $Y-$X+1 ) ) + $X：

Комментарий

Следующий фрагмент генерирует и выводит случайное число в интервале от 25 до 75 включительно:

$rdndom = int( rand(5D) + 25: print "$random\n"；

Функция rand возвращает дробное число от 0 (включительно) до заданного аргумента (не включается). Мы вызываем ее с аргументом 51, чтобы случайное число было больше либо равно 0, но никогда не было бы равно 51 и выше. Затем от сгенерированного числа берется целая часть, что дает число от 0 до 50 вклю-

чительно (функция 1nt превращает 50,9999... в 50). К полученному числу прибавляется 25, что дает в результате число от 25 до 75 включительно.

Одно из распространенных применений этой методики — выбор случайного элемента массива:

$elt = SarrayL rand @array ]；

Эта запись эквивалентна следующей:

$elt = SarrayL int( rand(O+@array))]：

В соответствии с прототипом функция rand вызывается с одним аргументом, поэтому аргумент неявно интерпретируется в скалярном контексте, что для именованного массива означает количество элементов. Функция возвращает вещественное число, меньшее аргумента, но большее либо равное нулю. При использовании в качестве индекса массива вещественное число автоматически усекается до целой части. В результате мы получаем элемент массива, случайно выбранный с равномерным распределением, и присваиваем его $e〕t.

Так же легко сгенерировать случайный пароль из заданной последовательности символов:

©chars = ( "А" .. "Z". "а" .. "z". О .. 9, qw(當！ @ $ % 人 & *))；

$password = join("". @chdrs[ map { rand ©chars } ( 18 )]);

Мы генерируем восемь случайных индексов @chdrs с помощью функции тар, извлекаем соответствующие символы в виде среза и объединяем их в случайный пароль. Впрочем, такие случайные числа являются недостаточно случайными, потому что надежность пароля зависит от стартового значения (seed) генератора случайных чисел, который (в старых версиях Perl) инициализировался на основании времени запуска программы. В рецепте 2.7 показано, как «раскрутить» генератор случайных чисел и сделать генерируемые числа более случайными.

См. также

Описание функций Int, rand и join в perlfunc(l). Случайные числа исследуются в рецептах 2.7, 2.8 и 2.9, а используются в рецепте 1.13.

2-7. Получение повторяющихся серий случайных чисел

Проблема

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

Решение

Воспользуйтесь функцией Perl srand:

srand EXPR； # Вызов с константой генерирует повторяющиеся серии

Комментарий

Генерация случайных чисел — непростое дело. Лучшее, на что способен компьютер без специального оборудования — генерация псевдослучайных чисел, равномерно распределенных в области своих значений. Псевдослучайные числа генерируются по математическим формулам, а это означает, что при одинаковом стартовом значении генератора две программы сгенерируют одни и те же псевдослучайные числа.

Функция srand задает новое стартовое значение для генератора псевдослучайных чисел. Если она вызывается с аргументом, то указанное число будет использовано в качестве стартового. При отсутствии аргумента srand использует величину, значение которой трудно предсказать заранее.

Если вызвать rand без предварительного вызова srand, Perl автоматически вызывает srand с «хорошим» стартовым значением. Таким образом, при каждом запуске программы вы будете получать разные серии случайных чисел. Старые версии Perl не вызывали srand, поэтому программы всегда генерировали одну и ту же последовательность чисел. Однако в некоторых ситуациях разные серии не нужны; наоборот, при каждом запуске должен выдаваться один и тот же набор. Если вы предпочитаете именно такое поведение, вызовите srand с конкретным аргументом:

srand( 42 )； # Выбор любого фиксированного стартового значения

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

См. также

Описание функции srand в perlfunc(i). Примеры ее применения приведены в рецептах 2.6 и 2.8.

Повышение фактора случайности

Проблема

Требуется генерировать случайные числа, которые были бы «более случайными», чем выдаваемые генератором Perl. Иногда возникают проблемы, связанные с ограниченным выбором стартовых значений в библиотеках С. В некоторых

приложениях последовательность псевдослучайных чисел начинает повторяться слишком рано.

Решение

Воспользуйтесь другими генераторами случайных чисел, например, теми, которые присутствуют в модулях CPAN Math::Random и Math： ：TrulyRandom:

use Math：：TrulyRandom:

$random = truly_random_value();

use Math_Random：

$random = random_un1form()；

Комментарий

Процесс сборки Perl выбирает лучшую библиотечную функцию С для построения случайных чисел из 收九d(3), random⑶ и drand48(3) (впрочем, на стадии компоновки это можно изменить). Стандартные библиотечные функции работают достаточно хорошо, но некоторые древние реализации функции rand возвращают только 16-разрядные случайные числа или используют слабые алгоритмы, не обеспечивающие достаточной степени случайности.

Модуль Math: :TrulyRandom генерирует случайные числа, используя погрешности системного таймера. Процесс занимает некоторое время, поэтому им не стоит пользоваться для генерации большого количества случайных чисел.

Модуль Math： ：Random генерирует случайные числа с помощью библиотеки randlib. Кроме того, он содержит многочисленные вспомогательные функции для получения случайных чисел с заданными распределениями, включая биномиальное, пуассоновское и экспоненциальное.

См. также

Описание функций srand и rand в perlfunc(l); рецепты 2.6 и 2.7; документация по модулям CPAN Math： ：Random и Math： ：TrulyRandom.

Получение случайных чисел с неравномерным распределением

Проблема

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

или иного баннера. А может быть, вы имитируете нормальное распределение (закон распределения Гаусса).

Решение

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

sub gaussian_rand {

my ($ul, $u2); # Случайные числа с однородным распределением

my $w;# Отклонение, затем весовой коэффициент

my ($gl, $g2)； # Числа с гауссовским распределением

do {

$ul = 2 * randO - 1:

$u2 = 2 * randO - 1:

$w = $ul*$ul + $u2*u2;

} while ($w >= 1 11 $w == 0);

$w = sqrt( (-2 * log($w)) / $w)；

$g2 = $ul * $w；

$gl = $u2 * $w；

# Возвратить оба числа или только одно return wantarray ? ($gl. $g2) : $gl；

}

Если у вас есть список весовых коэффициентов и значений, которые должны выбираться случайным образом, выполните два последовательных шага. Сначала преобразуйте весовые коэффициенты в вероятностное распределение с помощью приведенной ниже функции we1ght_to_d1st, а затем воспользуйтесь функцией weighted_rand для случайного выбора чисел.

weight_to_dist： получает хэш весовых коэффициентов

и возвращает хэш вероятностей sub weight_to_dist { my ^weights = @_;

my Zdlst= (7：

my $totdl = 0;

my ($key, $we1ght)； local $_:

foreach (values ^weights) { $totdl += $_； }"

while ( ($key, $weight) = each ^weights ) { $d1st{$key} = $weight/$totdl；

}

return Zdlst;

weighted_rand： получает хэш вероятностей

и возвращает случайный элемент хэша

sub weighted_rand {

my ^dlst = @_： my ($key, $weight);

while (1) {# Чтобы избежать погрешностей вычислений

# с плавающей запятой.

my $rdnd = rand；

while ( ($кеу, $we1ght) = each %dist ) {

return $key if ($rdnd -= $we1ght) <0;

Комментарий

Функция gauss1an_rand реализует полярный метод Бокса—Мюллера для преобразования двух независимых случайных чисел с равномерным распределением, лежащих в интервале от 0 до 1 (такие числа возвращаются функцией rd nd), в два числа с математическим ожиданием 0 и стандартным отклонением 1 (то есть распределенных по закону Гаусса). Чтобы сгенерировать числа с другим математическим ожиданием и стандартным отклонением, умножьте выходные данные gauss1an_rand на нужное стандартное отклонение и прибавьте математическое ожидание:

# gaussian_rand - см. выше $mean = 25;

$sdev = 2:

$sdlary - gaussian_rand() * $sdev + $mean：

prlntfCYou have been hired at \$%.2f\"', $sdlary)；

Модуль Math::Random содержит готовые реализации для нормального и других распределений:

use Math：：Random qw(random_normal):

$sdlary = random_normal(1, $mean, $sdev);

Функция we1ghted_rand получает случайное число из интервала от 0 до 1. Затем она использует вероятности, сгенерированные weight_to_dist, и определяет, какому элементу соответствует это случайное число. Из-за погрешностей представления с плавающей запятой накопленные ошибки могут привести к тому, что возвращаемый элемент не будет найден. Поэтому код размещается в цикле while, который в случае неудачи выбирает новое случайное число и делает очередную попытку.

Кроме того, модуль С PAN Math:: Random содержит функции, генерирующие случайные числа для многих распределений.

См. также

Описание функции rand в perlfunc(l); рецепт 2.6; документация по модулю CPAN Math： ：Random.

Выполнение тригонометрических вычислений в градусах

Проблема

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

$radians = deg2rad($degrees)： $degrees = rad2deg($radians)；

Комментарий

Если вам приходится выполнять большое количество тригонометрических вычислений, подумайте об использовании стандартных модулей Math： ：Trig или POSIX. В них присутствуют многие дополнительные тригонометрические функции, которых нет в стандартном Perl. Другое решение основано на использовании приведенных выше функций rdd2deg и deg2rdd. В Perl нет встроенной константы 兀, однако при необходимости ее можно вычислить настолько точно, насколько позволит ваше оборудование для вычислений с плавающей запятой. В приведенном выше решении 兀 является константой, определяемой командой use constant. Чтобы не запоминать, что число 兀 равно 3,14159265358979, мы используем вызов встроенной функции, результат которого вычисляется на стадии компиляции. Этот прием не только избавляет от необходимости запоминать длинную цепочку цифр, но и гарантирует максимальную точность, обеспечиваемую данной платформой.

Синус угла, заданного в градусах, вычисляется следующим образом:

# Функции deg2rad и rad2deg приведены выше или взяты из Math：：Trig sub degree_sine {

my $degrees = shift;

ту $rddidns = deg2rad($degrees)；

ту $result= sin($radians):

return $result；

}

См. также

Описание функций sin, cos и atan2 в perlfunc(l); документация по стандартным модулям POSIX и Math: :Trig.

Тригонометрические функции

Проблема

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

Решение

В Perl определены лишь стандартные тригонометрические функции sin, cos и atan2. С их помощью можно вычислить тангенс (tan) и другие тригонометрические функции (конечно, для этого необходимо хорошо разбираться в тригонометрических тонкостях): sub tan {

my $thetd = shift:

return sin($theta)/cos($theta)：

}

В модуле POSIX представлен расширенный набор тригонометрических функций: use POSIX：

$у = acos(3.7);

Стандартный модуль Math： ：Trig содержит полный набор тригонометрических функций, а также позволяет выполнять операции с комплексными аргументами (или дающие комплексный результат):

use Math：：Trig：

$у = acos(3.7):

Комментарий

Если значение $theta равно 兀/2, 3兀/2 и т. д., в функции tan возникает исключительная ситуация деления на нуль, поскольку для этих углов косинус равен

нулю. Аналогичные ошибки могут происходить и во многих функциях модуля Math: ：Trig. Чтобы перехватить их, воспользуйтесь конструкцией eval:

eval {

$у = tan($pi/2)；

} or return undef:

См. также

Описание функций sin, cos и atan2 в perlfunc(l); документация по стандартному модулю Math: ：Trig. Тригонометрия в контексте комплексных чисел рассматривается в рецепте 2.14, а применение eval для перехвата исключений — в рецепте 10.12.

Вычисление логарифмов

Проблема

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

Решение

Для натуральных логарифмов (по основанию е) существует встроенная функция log:

$log_e = log(VALUE):

Чтобы вычислить логарифм по основанию 10, воспользуйтесь функцией loglO модуля POSIX:

use POSIX qw(loglO);

$log_10 = loglO(VALUE);

Для других оснований следует использовать соотношение:

logn(x) = loge(x)/loge(n)

где х — число, логарифм которого вычисляется, п — нужное основание, а е — основание натуральных логарифмов.

sub log_base {

my 7$base, $value) = ©一； return log($value)/log?$base);

}

Комментарий

Функция log_base позволяет вычислять логарифмы по любому основанию. Если основание заранее известно, намного эффективнее вычислить его натуральный логарифм заранее и сохранить для последующего использования вместо того, чтобы каждый раз пересчитывать его заново.

# 0叩еделение 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) = ^lf\n", logn(1024. 2)： # Обратите внимание

# на порядок аргументов!

Iog2(1024) = 10.000000

хотя комплексные числа в вычислениях не используются. Функция не очень эффективна, однако в будущем планируется переписать модуль Math::Complex на С для ускорения его работы.

См. также

Описание функции log в perlfunc(i); документация по стандартным модулям POSIX и Math::Complex.

Умножение матриц

Проблема

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

Решение

Воспользуйтесь модулями 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"；

my $result = 口；

my ($1. $j, $k)：

for $1 (range($mlrows)) {

for $j (range($m2cols)) {

for $k (range($mlcols)) {

$result->[$i][$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 scdldr(@$dry_ref)；

sub matdim {

my $matrix = $_[0]:

my $rows = vecTen($matrlx)；

my $cols = veclen($matr1x->[0])； return ($rows, $cols);

Комментарий

Если у вас установлена библиотека PDL, вы можете воспользоваться ее молниеносными числовыми операциями. Они требуют значительно меньше памяти и ресурсов процессора, чем стандартные операции с массивами Perl. При использовании объектов PDL многие числовые операторы (например, + и *) перегружаются и работают с конкретными типами операндов (например, оператор * выполняет так называемое скалярное умножение). Для умножения матриц используется перегруженный оператор х.

use PDL：

$а = pdl [

[3. 2. 3

[5, 9, 8 ].

]；

$b = pdl [

[4, 7

[9, 3

[8. 1 ],

$c = $a x $b; # Перегруженный оператор x

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

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

$х =[

[3. 2, 3 ].

[5. 9. 8

];

$У =[

[4. 7 ].

[9, 3 ],

[8, 1 ],

]；

$z = mmult($x, $у)；

См. также

Документация по модулю CPAN PDL.

Операции с комплексными числами

Проблема

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

Решение

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

$с = $а * $Ь - моделирование операции

$c_real = ( $a_real * $b_real ) - ($а_1magi nary * $b_imagi nary )：

$c_1magi nary = ( $a_real * $b_imagi nary ) - ($b_real * $a_imagi nary )；

либо воспользуйтесь модулем Math： ：Complex (из стандартной поставки Perl):

Умножение комплексных чисел с помощью Math：：Comp]ex use Math：:Complex：

$c = $a * $b;

Комментарий

Ручное умножение комплексных чисел 3+5i и 2-2i выполняется следующим образом:

$a_real = 3: Jajmaginary = 5；# 3 + 5i;

$b_real = 2： $b_imagi nary = -2；# 2 - 21 ：

$c_real = ($a_real * $b_real ) - ( $a_1magi nary * $b_imagi nary )；

$с_1 magi nary = ($a_real * $b_i magi nary ) - ( $b_real * Sajmaginary ):

print "c = ${c_reaT}+${c_imaginary}i\rT；

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 или экспортированной константы г:

use Math：：Complex：

$с = cplx(3.5) * cplx(2.-2)；# Лучше воспринимается

$d = 3 + 4*1 ；#3 + 41

printf "sqrt($d) = ^s\n", sqrt($d):

sqrt(3+4i) = 2+1

Модуль Math::Complex используется во внутренних операциях модуля Math: :Trig, поскольку некоторые функции могут выходить за пределы вещественной оси в комплексную плоскость, например, арксинус 2.

См. также

Документация по стандартному модулю Math: ：Complex.

Преобразования двоичных, восьмеричных и шестнадцатеричных чисел

Проблема

Требуется преобразовать строку с двоичным, восьмеричным или шестнадцатеричным представлением (например, "ОЬЮПО", "0x55" или "0755") в правильное число.

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

Решение

Если вы работаете с шестнадцатеричными строковыми представлениями вида "2е" или "0х2е", воспользуйтесь функцией Perl hex:

$number = hex($hexadecimal);# Шестнадцатеричное число

Для шестнадцатеричных строк вида "0х2е", восьмеричных строк вида "057 и двоичных строк вида "0Ы01110" можно воспользоваться функцией Perl oct:

$number = oct($hexadecimal);Snumber = oct($octal)； $number = oct($binary)；$number = oct($hexadecimal);Snumber = oct($octal)； $number = oct($binary)；# "0x2e" преобразуется в 47# "057" преобразуется в 47# "ОЬОПЮ" преобразуется в 47# "0x2e" преобразуется в 47# "057" преобразуется в 47# "ОЬОПЮ" преобразуется в 47

$number = oct($hexadecimal);

Snumber = oct($octal)； $number = oct($binary)；

$number = oct($hexadecimal);

Snumber = oct($octal)； $number = oct($binary)；

# "0x2e" преобразуется в 47

# "057" преобразуется в 47

# "ОЬОПЮ" преобразуется в 47

# "0x2e" преобразуется в 47

# "057" преобразуется в 47

# "ОЬОПЮ" преобразуется в 47

Комментарий

Функция oct преобразует восьмеричные числа как с начальными нулями, так и без них (например, "0350" и "350"). Вопреки своему названию, она не ограничивается восьмеричной системой счисления и преобразует шестнадцатеричные числа с префиксом "Ох" (например, "0x350"), а также двоичные числа с префиксом "0Ь" ("0Ы01010"). Функция hex преобразует только шестнадцатеричные числа с префиксом "Ох" или без него, например, "0x255", "ЗА", "ff" или "deadbeef" (допускаются символы верхнего и нижнего регистра).

Следующий пример получает число в десятичном, двоичном, восьмеричном или шестнадцатеричном представлении и выводит его во всех четырех системах счисления. Если введенное число начинается с 0, число преобразуется из двоичной, восьмеричной и шестнадцатеричной системы функцией oct. Затем функция printf при выводе преобразует число во все четыре системы счисления:

print "Gimme a number in decimal, octal, or hex："：

$num = <STDIN>;

chomp $num；

exit unless defined $num：

$num = oct($num) 1s $num =~ /人0/; # Находит 077 OblO 0x20 printf "^d %#x 宵#o %#b\n", ($гшм) x 4；

Символ # между знаком % и кодом формата заставляет printf выводить данные с указанием системы счисления, в которой отображается целое число. Например, если ввести число 255, программа выдаст следующий результат:

255 Oxff 0377 Obllllllll

Без знака # результат будет менее очевидным:

255 ff 377 11111111

Следующий фрагмент преобразует режимы доступа к файлам Unix. Режим всегда задается в восьмеричном виде, поэтому вместо hex используется функция oct:

print "Enter file permission in octal:"： $perm1ssions = <STDIN>：

die "Exiting ..An" unless defined Spermlsslons：

chomp $perm1ssions；

Spermlsslons = oct($perm1ssions)；# Режим доступа всегда задается

# в восьмеричной системе

print "The decimal value is $perm1ssions\n"；

См. также

Раздел «Scalar Value Constructors» в perldata(l); описание функций oct и hex в perlfunc(l).

Вывод запятых в числах

Проблема

При выводе числа требуется вывести запятые после соответствующих разрядов.

Длинные числа так воспринимаются намного лучше, особенно в отчетах.

Решение

Обратите строку, чтобы перебирать символы в обратном порядке, это позволит избежать подстановок в дробной части числа. Затем воспользуйтесь регулярным выражением, найдите позиции для запятых и вставьте их с помощью подстановки. Наконец, восстановите исходный порядок символов в строке, sub commlfy {

my $text = reverse $_[0]；

$text =~ s/(\d\d\d)(?=\d)(?!\d*\.)/$l./g： return scalar reverse $text；

Комментарий

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

Функцию нетрудно модифицировать так, чтобы вместо запятых разряды разделялись точками, как принято в некоторых странах.

Пример использования функции comml fy:

# Достоверный счетчик обращений ：-)

use Math：：TrulyRandom；

$hits = truly_random_value();# Отрицательное значение!

Soutput = "Your web page received Shits accesses last month.\n"： print commlfy(Soutput):

Your web page received -1,740,525,205 accesses last month.

См. также

perllocale(l); описание функции reverse в perlfunc(i); раздел «Разделение разрядов числа запятыми» в главе 2 книги «Регулярные выражения: Библиотека программиста», 2 издание (издательство «Питер», 2003 г.).

Правильный вывод во множественном числе

Проблема

Требуется вывести фразу типа: "It took $time hours" («Это заняло $time часов»). Однако фраза "It took 1 hours" («Это заняло 1 часов») не соответствует правилам грамматики. Необходимо исправить ситуацию1.

Решение

Воспользуйтесь printf и тернарным оператором X?Y:Z, чтобы изменить глагол или существительное:

printf "It took 宵d hour^s\n". $time, $time == 1 ? "" : "s":

printf ”％d hour^s %s enough.\n", $time.

$time == 1 ? ""： "s".

$time == 1 ? "is" ： "are":

Кроме того, можно воспользоваться модулем С PAN Lingua: :EN： ： Inflect, упоминаемым в Комментарии.

Комментарий

Невразумительные сообщения наподобие "1 fi〕e(s) updated" встречаются только из-за того, что автору программы лень проверить, равен ли счетчик 1.

Если образование множественного числа не сводится к простому добавлению суффикса -s, измените функцию printf соответствующим образом:

printf "It took 宵d centur^s". $time, $time == 1 ? "y" ： "les":

В простых ситуациях такой вариант подходит, однако вам быстро надоест писать его снова и снова. Возникает желание написать для него специальную функцию: sub noun_plural {

locaT $_ = shift:

# Порядок проверок крайне важен!

s/ss$/sses/11

s/([psc]h)$/${l}es/11

s/z$/zes/11

s/ff/$/ffs/11

s/f$/ves/11

s/ey$/eys/||

s/y$/ies/11

s/ix$/ices/||

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

s/([sx])$/$les/11

s/$/s/11

die "can't get here"：

return $_：

*verb_singular = \&noun_plural： # Синоним функции

Однако co временем будут находиться новые исключения, и функция будет становиться все сложнее и сложнее. Если у вас возникнет потребность в подобных морфологических изменениях, воспользуйтесь универсальным решением, которое предлагает модуль CPAN L1ngua：EN::Inflect.

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

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

См. также

Описание тернарного оператора выбора в ре"ор⑴;документация по модулю CPAN Lingua::EN::Inflect.

Программа: разложение на простые множители

Следующая программа получает один или несколько целых аргументов и раскладывает их на простые множители. В ней используется традиционное числовое представление Perl, кроме тех ситуаций, когда представление с плавающей запятой может привести к потере точности. В противном случае (или при запуске с ключом -Ь) используется стандартная библиотека Math： ：B1gInt, что позволяет работать с большими числами. Однако библиотека загружается лишь при необходимости, поэтому вместо use используются ключевые слова require и import — это позволяет выполнить динамическую загрузку библиотеки во время выполнения вместо статической загрузки на стадии компиляции. Наша программа не является эффективным инструментом для подбора больших простых чисел, используемых в криптографии.

Запустите программу со списком чисел, и она выведет простые множители для каждого числа:

$ factors 8 9 96 2178

82**3

93**2

962**53

21782 3**211**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;

our ($opt_b $opt_d)：our ($opt_b $opt_d)：use integer:

our ($opt_b $opt_d)：

our ($opt_b $opt_d)：

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

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

use Getopt：：Std：

QARGV && getopts('bd') or die "usage： $0 [-b] number ..."； load_biglib() if $opt_b;

ARG: foreach my $orig ( @ARGV ) { my ($n. $root,奸actors, $factor);

$n = $opt_b ? Math::B1gInt->new($or1g) : $orig：

1f ($n + 0 ne $n) { # Для этого не используйте -w

printf STDERR "bignum： Ms would become %s\n", $n, $n+0 if $opt_d: load_biglib()；

$n = Math：：B1gInt->new($orig): }

printf "%-10s ", $n;

$sqi равно квадрату $i. Используется тот факт,

что ($i + 1) ** 2 == $i ** 2 + 2 * $i + 1.

for (my ($i, $sqi) = (2, 4): $sqi <= $n; $sqi += 2 * $i ++ + 1) { while ($n % $1 == 0) {

$n /= $i:

print STDERR "<$i>" if $opt_d;

$factors {$1} ++;

} }

if ($n != 1 && $n != $orig) { $factors{$n}++ }

if (! %factors) { print "PRIME\n"； next ARG;

}

for $factor ( sort { $a <=> $b } keys ^factors ) { print "$factor";

if ($factors{$factor} > 1) {

print "**$factors{$factor}"； }

print ""：

}

print "\n"：

# Имитирует use, но на стадии выполнения sub load_biglib {

require Math：：BigInt：

Math： ：BigInt->1mport(); immaterial?

Время и дата

«Не следует требовать, чтобы время в секундах с начала эпохи точно соответствовало количеству секунд между указанным временем и началом эпохи».

Стандарт IEEE 1003.1b-1993 (POSIX) раздел В.2.2.2

3.0. Введение

Время и дата — очень важные величины, и с ними необходимо уметь работать. «Сколько пользователей регистрировалось за последний месяц?», «Сколько секунд я должен проспать, чтобы проснуться к полудню?» и «Не истек ли срок действия пароля данного пользователя?» — вопросы кажутся тривиальными, однако ответ на них потребует на удивление нетривиальных операций.

В Perl моменты времени представлены в виде интервалов, измеряемых в секундах, прошедших с некоторого момента, называемого началом эпохи. В Unix и многих других системах начало эпохи соответствует 00 часов 00 минут 1 января 1970 года в формате UTC1.

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

Однако люди не привыкли измерять время в секундах с начала эпохи. Мы предпочитаем работать с конкретным годом, месяцем, днем, часом, минутой и секундой. Более того, название месяца может быть как полным, так и сокращенным; число может указываться как перед месяцем, так и после него. Использование разных форматов затрудняет вычисления, поэтому введенная пользователем или прочитанная из списка строка даты/времени обычно преобразуется в количество секунд с начала эпохи, с ней производятся необходимые операции, после чего секунды снова преобразуются для вывода.

Для удобства вычислений количество секунд с начала эпохи всегда измеряется в абсолютном значении, без учета часовых поясов или летнего времени. В любых

Сейчас рекомендуется использовать сокращение UTC (Universal Corrected Time) вместо прежнего сокращения GMT (Greenwich Mean Time).

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

Функция Perl time возвращает количество секунд, прошедших с начала эпохи... более или менее точно. В соответствии со стандартом POSIX функция time не должна возвращать секунды, которые накапливаются из-за замедления вращения Земли, обусловленного воздействием приливов (за дополнительной информацией обращайтесь к разделу 3 sci.astro FAQ, расположенному по адресу http: //sd astro. astronomy. net/sci. astro. 3. FAQ). Для преобразования секунд, прошедших с начала эпохи, для конкретных дней, месяцев, лет, часов, минут и секунд используются функции locdltime и gmtime. В списковом контексте эти функции возвращают список, состоящий из девяти элементов (табл. 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 с учетом возможных корректировок; трудно сказать, когда по требованию какого-нибудь комитета по стандартизации в нашу жизнь может войти лишняя секунда.

В дальнейшем совокупность «день/месяц/год/час/минута/секунда» будет обозначаться выражением «полное время» — хотя бы потому, что писать каждый раз «отдельные значения дня, месяца, года, часа, минут и секунд» довольно утомительно. Сокращение не связано с конкретным порядком возвращаемых значений.

Perl не возвращает данные о годе в виде числа из двух цифр. Он возвращает разность между текущим годом и 1900, которая до 1999 года представляет собой число из двух цифр. У Perl нет своей «проблемы 2000 года», если только вы не изобретете ее сами (впрочем, у вашего компьютера и Perl может возникнуть проблема 2038 года, если к тому времени еще будет использоваться

32-разрядная адресация). Для получения полного значения года прибавьте к его представлению 1900. Не пользуйтесь конструкцией "20$уеаг", иначе вскоре ваши программы начнут выдавать «год 20103». Мы не можем точно зафиксировать интервал года, потому что все зависит от размера целого числа, используемого вашей системой для представления секунд с начала эпохи. Малые числа дают небольшой интервал; большие (64-разрядные) числа означают огромные интервалы.

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

Fri Apr 11 09:27:08 1997

Объекты стандартного модуля Time: :tm позволяют обращаться к компонентам даты/времени по именам. Стандартные модули Time::localtime и Time::gmtime переопределяют функции localtime и gmtime, возвращающие списки, и заменяют их версиями, возвращающими объекты Time： :tm. Сравните два следующих фрагмента:

Массив

print "Today 1s day ", (localtime)[7]. " of the current year.'n"；

Today is day 117 of the current year.

Объекты Time::tm use Time：：local time； $tm = localtime;

print "Today 1s day ", $tm->yday, " of the current year An"；

Today is day 117 of the current year.

Чтобы преобразовать список в количество секунд с начала эпохи, воспользуйтесь стандартным модулем Time: :Local. В нем имеются функции timelocal и tlmegm, которые получают список из девяти элементов и возвращают целое число. Элементы списка и интервалы допустимых значений совпадают с теми, которые возвращаются функциями localtime и gettime.

Количество секунд с начала эпохи ограничивается размером целого числа. 32-разрядное целое со знаком позволяет представить время (в формате UTC) от 20:45:52 13 декабря 1901 года до 03:14:07 19 января 2038 года включительно. Предполагается, что к 2038 году в компьютерах будут использоваться целые числа большей разрядности. Во всяком случае, будем надеяться на это. Чтобы работать с временем за пределами этого интервала, вам придется воспользоваться другим представлением или выполнять операции с отдельными компонентами года, месяца и числа.

Модули Date::Calc и Date: :Мап1р из архива CPAN работают с этими отдельными компонентами, но учтите — они не всегда вычитают из года 1900, как это делает localtime, а нумерация месяцев и недель в них не всегда начинается с 0. Как всегда, на страницах руководства можно найти достоверные сведения о том, какая информация передается модулю, а какая — возвращается им. Только представьте, как будет неприятно, если рассчитанные вами финансовые показатели уйдут на 1900 лет в прошлое!

Определение текущей даты

Проблема

Требуется определить год, месяц и число для текущей даты.

Решение

Воспользуйтесь функцией localtime. Без аргументов она возвращает текущую дату и время. Вы можете вызвать local time и извлечь необходимую информацию из полученного списка:

($DAY, $MONTH. $YEAR) = (localtime)[3,4.5]:

Модуль Time: :localtime переопределяет localtime так, чтобы функция возвращала объект Time: :tm:

use Time：：localtime：

$tm = localtime:

($DAY, $MONTH, $YEAR) = ($tm->mday, $tm->mon, $tm->year):

Комментарий

Вывод текущей даты в формате ГГГГ-ММ-ДД с использованием стандартной функции localtime выполняется следующим образом:

($day, Smonth, $year) = (local time)[3.4,5]:

printfCThe current date is %04d %02d %02d\n", $year+1900, $month+l, $day): The current date is 2003 03 06

Нужные поля из списка, возвращаемого localtime, извлекаются с помощью среза. Запись могла выглядеть иначе:

($day. $month, $year) = (localtime)[3..5]:

А вот как текущая дата выводится в формате ГГГГ-ММ-ДД (рекомендованном стандартом ISO 8601) с использованием Time: :localtime:

use Time::localtime； $tm = localtime;

printfCThe current date 1s %04d-%02d-%02\n", $tm->year+1900. ($tm->mon)+l, $tm->mday);

The current date is 2003-03-06

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

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

printfCThe current date 1s %04d-%02d-%02d\n".

sub {($_[5]+1900. $」4]+l. $J3])}->(localt1me)):

Кроме того, в модуле POSIX имеется функция strftlme, упоминаемая в рецепте 3.8:

use POSIX qw(strftime):

print strftime "%Y-^ni-%d\n", localtime:

Функция gmtlme работает аналогично localtlme, но возвращает время в формате UTC вместо времени в местном часовом поясе.

См. также

Описание функций localtime и gmtlme в perlfunc(l); документация по стандартному модулю Time：:localtime.

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

Проблема

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

Решение

Воспользуйтесь функцией timelocdl или timegm стандартного модуля Time::Local. Выбор зависит от того, задается ли дата/время для UTC или для текущего часового пояса:

use Time::Local:

$TIME = timelocal($sec, $min, $hours. $mday, $mon, $year):

$TIME = t1megm($sec, $min. $hours, $mday, $mon. $year);

Комментарий

Встроенная функция localtime преобразует количество секунд с начала эпохи в компоненты полного времени; процедура timelocal из стандартного модуля Time: :Local преобразует компоненты полного времени в секунды. Следующий пример показывает, как определяется количество секунд с начала эпохи для текущей даты. Значения дня, месяца и года получаются при помощи функции localtime:

$hours, $minutes и $seconds задают время для текущей даты

и текущего часового пояса use Time：：Local;

$time = timelocal($seconds, $minutes, $hours, (localtime)[3.4.5]):

Если функции timelocal передаются месяц и год, они должны принадлежать тем же интервалам, что и значения, возвращаемые localtime. А именно нумерация месяцев начинается с 0, а из года вычитается 1900.

Функция timelocal предполагает, что компоненты полного времени соответствуют текущему часовому поясу. Модуль Time： ：Local также экспортирует процедуру timegm, для которой компоненты полного времени задаются для часового пояса UTC. К сожалению, удобных средств для работы с другими часовыми поясами, кроме текущего или UTC, не существует. Лучшее, что можно сделать, —преобразовать время к Гринвичскому и вычесть или прибавить смещение часового пояса в секундах.

В следующем фрагменте продемонстрировано как применение timegm, так и настройка интервалов года и месяца:

$day - день месяца (1-31)

$month - месяц (1-12)

$уеаг - год, состоящий из четырех цифр (например, 1999)

$hours. $minutes и $seconds - компоненты времени UTC (GMT) use Time::Local:

$time = timegni($seconds, $minutes, $hours, $day, $month-l, $year-1900):

Как было показано во Введении, количество секунд с начала эпохи не может выходить за пределы интервала от 20:45:52 13 декабря 1901 года до 03:14:07 19 января 2038 года включительно. Не преобразуйте такие даты — либо воспользуйтесь модулем Date:: из архива CPAN, либо выполняйте вычисления вручную.

См. также

Документация по стандартному модулю Time：:Local. Обратное преобразование рассматривается в рецепте 3.3.

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

Проблема

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

Решение

Воспользуйтесь функцией local time или gmtime в зависимости от того, хотите ли вы получить дату/время для текущего часового пояса или для часового пояса UTC.

($seconds, $minutes, $hours, $day_of_month, $year,

$wday, $yday, $1sdst) = Iocalt1me($t1nie)；

Стандартные модули Time： :timelocal и Time::gmtime переопределяют функции localtime и gmtime так, чтобы к компонентам можно было обращаться по именам:

use Time：：localt1me； # или Time::gmtime

$tm = localtime($TIME):# или gmt1me($TIME)

$seconds = $tm->sec：

#

Комментарий

Функции localtime и gettlme возвращают несколько странную информацию о годе и месяце; из года вычитается 1900, а нумерация месяцев начинается с 0 (январь). Не забудьте внести поправку в полученные величины, как это делается в следующем примере:

($seconds, $minutes, $hours. $day_of_month, $month, $year, $wday, $yday, $isdst) = localt1me($tinie);

printfCDateline: %02d:%02d:%02d-%04d/%02d/%02d\n",

$hours, $minutes, $seconds, $year+1900, $month+l, $day_of_month):

Модуль Time： :localtime позволяет избавиться от временных переменных:

use Time： ：localtinie： $tm = localtime($tinie): printfCDateline:犯2d：02d:%02d-%04d/%02d/%02d\n",

$tm->hour. $tm->min, $tm->sec, $tm->year+1900, $tm->mon+l. $tm->mday)：

См. также

Описание функции localtime в perlfunc(l); документация по стандартным модулям Time::localtime и Time: ：gmt1me. Обратное преобразование рассматривается в рецепте 3.2.

Операции сложения и вычитания для дат

Проблема

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

Решение

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

$when = $now + $difference： $then = $now - $difference；

Если у вас имеются отдельные компоненты полного времени, воспользуйтесь модулем CPAN Date: :Са1с. Если вычисления выполняются только с целыми днями, примените функцию Add_DeRa_Days (смещение $offset может представлять собой как положительное, так и отрицательное целое количество дней):

use Date：：Calc qw(Add_Delta_Days)：

($y2. $m2. $d2) = Add Delta Ddys($y, $m. $d, $offset):

Если в вычислениях используются часы, минуты и секунды (то есть не только дата, но и время), воспользуйтесь функцией Add_Delta_DHMS:

use Date：:DateCalc qw(Add_Delta_DHMS):

($year2. $month2, $day2. $h2, $m2, $s2)=

Add_Delta_DHMS( $year, $month, $day, $hour, $minute, $seconds, $days_offset, $hour_offset, $minute_offset. $seconds_offset ):

Комментарий

Вычисления с секундами от начала эпохи выполняются проще всего (если не считать усилий на преобразования даты/времени в секунды и обратно). В следующем фрагменте показано, как прибавить смещение (в данном примере — 55 дней, 2 часа, 17 минут и 5 секунд) к заданной базовой дате и времени:

$birthtime = 96176750:# 18 января 1973 「ода. 03:45:50

$interval = 5 +# 5 секунд

17 * 60 +# 17 минут

2 * 60 * 60 +# 2 часа

55 * 60 * 60 * 24:# и 55 дней

$then = $birthtime + $interval;

print "Then 1s ", scalar(localtime($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 「on£ 93 45.50

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： :DateCalc:

use Date：:DateCalc 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： :Calc.

Вычисление разности между датами

Проблема

Требуется определить количество дней между двумя датами или моментами времени.

Решение

Если даты представлены в виде секунд с начала эпохи и принадлежат интервалу от 20:45:52 13 декабря 1901 года до 03:14:07 19 января 2038 года включительно, достаточно вычесть одну дату из другой и преобразовать полученные секунды в дни:

Sseconds = $recent = $earl1er：

Если вы работаете с отдельными компонентами полного времени или беспокоитесь об ограничениях интервалов для секунд с начала эпохи, воспользуйтесь модулем CPAN Date: :Calc. Он позволяет вычислять разность дат:

use Date::Calc qw(Delta_Days):

$days = Delta_Days( $yearl, $monthl. $dayL $year2, $month2, $day2);

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

use Date：:Calc qw(Delta_DHMS):

($days, $hours, $minutes. $seconds)=

Deltd_DHMS( $yearl, $monthl, $dayl, $hourl, Sminutel, Ssecondsl, # Ранний

# момент

$year2. $month2. $day2. $hour2. $minute2, $seconds2. # Поздний

# момент

Комментарий

Одна из проблем, связанных с секундами с начала эпохи, — преобразование больших целых чисел в форму, понятную для человека. Следующий пример демонстрирует один из способов преобразования секунд с начала эпохи в привычные недели, дни, часы, минуты и секунды:

$bree = 361535725;# 04:35:25 16 июня 1981 года

$nat = 96201950;# 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：

$difference = (Sdifference - $seconds) / 60:

$minutes= Sdifference % 60；

Sdifference = ($difference - $minutes) / 60：

$hours= Sdifference $ 24；

Sdifference = (Sdifference - $hours) / 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： :Calc упрощают подобные вычисления. Функция Delta_ Days возвращает количество дней между двумя датами. Даты передаются ей в виде списка «год/месяц/день» в хронологическом порядке, то есть начиная с более ранней.

use Date:：Calc qw(Delta_Days);

@bree = (1981, 6. 16); "# 16 июня 1981

@nat = (1973, 1. 18);# 18 января 1973

Sdifference = Deltd_Days(@nat, @bree);

print "There were $difference days between Nat and Bree\n"；

There were 3071 days between Nat and Bree

Функция Deltd_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[1]:$diff[2]：$diff[3] after Nat\n"；

Bree came 3071 days, 0:49:35 after Nat

См. также

Документация по стандартному модулю CPAN Date： :Calc.

Определение номера недели или дня недели/месяца/года

Проблема

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

Решение

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

($MONTHDAY, SWEEKDAY, $YEARDAY) = (localtime $DATE) [3,6,7];

$WEEKNUM = 1nt($YEARDAY /7)+1:

Отдельные компоненты полного времени можно преобразовать в число секунд с начала эпохи (см. рецепт 3.2) и воспользоваться приведенным выше решением. Возможен и другой вариант — применение функций Day_of_Week, Week_Number и Day_of_Year модуля Date： :Са1с из архива CPAN:

use Date：:Calc qw(Day_of_Week Week_Number Ddy_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)；

Комментарий

Функции 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 Ddy_of_Week_To_Text);

$year = 1981;

$month = 6:# (Июнь)

$day = 16:

$wday = Day_of_Week($year, Smonth, $day):

print "$month/$day/$year was a ", Day_of_Week_to_Text($wday), "\n";

См. выше

$wnum = Week_Number($year, $month, $day);

print "in the $wnum week.Xn";

6/16/1981 was a Tuesday in the 25 week.

В некоторых странах существуют специальные стандарты, касающиеся первой недели года. Например, в Норвегии первая неделя должна содержать не менее 4 дней (и начинаться с понедельника). Если 1 января выпадает на неделю из 3 и менее дней, она считается 52 или 53 неделей предыдущего года. В Америке первая рабочая неделя обычно начинается с первого понедельника года. Возможно, при таких правилах вам придется написать собственный алгоритм или, по крайней мере, изучить форматы %G,乳，％W и %U функции UnixDate модуля Date： :Man1p.

См. также

Описание функции localtime в perlfunc(l); документация по стандартному модулю CPAN Date： :Calc.

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

Проблема

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

Решение

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

дня, месяца и года. Затем преобразуйте их в секунды с начала эпохи с помощью функций timelocal и timegm стандартного модуля Time： :Local.

use Time：:Local;

$date хранится в формате "2003-02-13" (ГГГГ-ММ-ДД).

($УУУУ， $mm, $dd) = ($date =~ /(\d+)-(\d+)-(\d+)/);

Вычислить секунды с начала эпохи для полночи указанного дня # в текущем часовом поясе

$epoch_seconds = timelocal(0. 0, 0, $dd, $mm-l, $уууу):

Более гибкое решение — применение функции ParseDate из модуля CPAN Date： :Manip и последующее извлечение отдельных компонентов с помощью UnixDate.

use Date：：Manip qw(ParseDate UnixDate);

$date = ParseDate($STRING):

if (!$date) {

Неверная дата

} else {

©VALUES = 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. "^Y", "%m", '7d"): print "Date was $month/$day/$year\n"：

См. также

Документация по модулю С PAN Date: :Manip; пример использования приведен в рецепте 3.11.

Вывод даты

Проблема

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

Решение

Вызовите функцию localtime или gmtlme в скалярном контексте — в этом случае функция получает количество секунд с начала эпохи и возвращает строку вида Tue July 22 05:15:20 2003:

$STRING = localtime($EPOCH_SECONDS):

Кроме того, функция strftime из стандартного модуля POSIX обладает дополнительными возможностями настройки формата вывода и работает с отдельными компонентами полного времени:

use POSIX qw(strftime);

SSTRING = strftime($FORMAT, SSECONDS, SMINUTES. $HOUR.

$DAY_OF_MONTH, $MONTH, $YEAR, $WEEKDAY, $YEARDAY, $DST)：

В модуле CPAN Date： :Manip есть функция UnlxDate — нечто вроде специализированного варианта sprlntf, предназначенного для работы с датами. Ей передается дата в формате Date： :Мап1р. Преимущество Date： :Мап1р перед POSIX: :strft1me состоит в том, что от системы не требуется совместимость со стандартом POSIX.

use Date::Manip qw(UnixDate):

$STRING = UnixDate($DATE, SFORMAT):

Комментарий

Простейшее решение — функция localtime — относится к встроенным средствам 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

Разумеется, дата и время для localtime должны исчисляться в секундах с начала эпохи. Функция POSIX: ：strftime получает набор компонентов полного времени и строку в формате printf и возвращает также строку. Поля в строке задаются при помощи директив %. Полный список директив приведен в документации по strftime для вашей системы. Функция strftime ожидает, что отдельные компоненты даты/времени принадлежат тем же интервалам, что и значения, возвращаемые localtime:

use POSIX qw(strftime):

use Time：：Local:

$time = timelocal(50, 45, 3, 18, 0, 73):

print "strftime gives: ", strftimeC^A 汕二 localtime($time)), "\n"； strftime gives: Thursday 01/18/73

При использовании POSIX： ：strftime все значения выводятся в соответствии с национальными стандартами. Так, во Франции ваша программа вместо "Sunday" выведет "Dimanche". Однако учтите: интерфейс Perl к функции POSIX strftime всегда преобразует дату в предположении, что она относится к текущему часовому поясу.

Если функция strftime модуля POSIX недоступна, у вас всегда остается надежный модуль Date: :Manip, описанный в рецепте 3.6.

use Date::Manip qw(ParseDate UnixDate);

$date = ParseDate("18 Jan 1973, 3:45:50");

$datestr = UnixDate($date, "%a %b %e 汕：％M：%S %z %Y")； # скалярный контекст

print "Date：：Manip gives： $datestr\n"：

Date::Manip gives: Thu Jan 18 03:45:50 GMT 1973

См. также

Описания функций gmtime и localtime в perlfunc(l); perllocale(iy, страница руководства strftime^} вашей системы; документация по модулю POSIX и модулю CPAN Date： ：Manip.

Таймеры высокого разрешения

Проблема

Функция time возвращает время с точностью до секунды. Требуется измерить время с более высокой точностью.

Решение

Средства работы с таймерами высокого разрешения для большинства систем инкапсулируются в модуле Time：: HI Res, включенном в число стандартных модулей, начиная с Perl версии 5.8:

use Time：：H1Res qw(gettimeofday);

$t0 = gettlmeofday；

# Ваши операции

$tl = gettimeofday；

$elapsed = $tl - $t0；

$elapsed - вещественное значение, представляющее число секунд

между $tl и $t2

Комментарий

В следующем фрагменте модуль Time： ： Hi Res используется для измерения промежутка между выдачей сообщения и нажатием клавиши RETURN:

use Time::Hi Res qw(gettimeofday);

print "Press return when ready："：

$before = gettimeofday；

$line = <STDIN>：

$elapsed. = gettimeofday() - $before；

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

Если ваша система не поддерживает этот модуль, можно попытаться решить задачу вручную при помощи syscall. Сравните Time： ： Hi Res с эквивалентным кодом syscall (пример приводится в основном для того, чтобы продемонстрировать использование малопонятной и архаичной функции Perl syscall):

require 'sys/syscall.ph':

Инициализировать структуры, возвращаемые gettimeofday

$TIMEVAL_T = "LL":

$done = $start = pack($TIMEVAL_T, (0,0));

Вывод приглашения

print "Press return when ready："：

Прочитать время в $start

syscall(&SYS_gettimeofday, $start, 0)) != -1

11 die "gettimeofday: $!"；

Прочитать перевод строки $line = <>：

Прочитать время в $done

syscall(&SYS_gettimeofday, $done, 0) != -1

11 die "gettimeofday: $!":

Распаковать структуру

©start = unpack($TIMEVAL_T, $start); ©done = unpack($TIMEVAL_T. $done);

Исправить микросекунды

for ($done[l]. $start[l]) { $_ /= l_000_000 }

Вычислить разность

$delta_time = sprintf "%.4f", ($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/syscall .h в sys/syscall .ph. В частности, в нем определена функция &SYS_gettimeofday, возвращающая номер системного вызова для gettimeofday.

Следующий пример показывает, как использовать Time:: HI Res для проведения хронометража (если вы почему-либо не хотите использовать стандартный модуль Benchmark):

use Time::H1Res qw(gettimeofday);

Вычисление среднего времени сортировки $size = 2000;

$number_of_times = 100: $total_t"ime = 0;

for ($1 = 0; $1 < number_of_times： $i++) {

my (@array, $j, $begin, $time);

Заполнение массива

@array =():

for ($j=0: $j < $size: $j++) { push(@array. rand) }

Выполнение сортировки

$begin = gettimeofday；

©array = sort { $a <=> $b } ©array；

$time = gettimeofday-Sbegin； $total_time += $time； }~

printf "On average, sorting %d random numbers takes %5.f seconds\n", $size, ($total_time/$number_of_times):

On average, sorting 500 random numbers takes 0.01033 seconds

См. также

Документация по модулям Time：: Hi Res и BenchMark; описание функции syscall в perlfunc⑴;шап-страница syscall⑵.

Короткие задержки

Проблема

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

Решение

Воспользуйтесь функцией select(), если она поддерживается вашей системой: select(undef, undef, undef, $time_to_sleep)； где $time_to_sleep — длительность паузы.

Некоторые системы не поддерживают select с четырьмя аргументами. В модуле Time：: Hi Res присутствует функция sleep, KOTopoii передается продолжительность паузы в вещественном формате:

use Time：:H1Res qw(sleep)； sleep($time_to_sleep)；

Комментарий

Следующий пример демонстрирует применение функции select; он представляет собой упрощенную версию программы из рецепта 1.6. Можете рассматривать его как эмулятор 300-бодного терминала: while (<>) { select(undef, undef, undef, 0.25)； print;

}

С помощью Time： :H1Res это делается так:

use Time::H1Res qw(sleep); while (<>) { sleep(0.25);

print：

См. также

Документация по модулям CPAN Time：: HI Res и BenchMark; описание функций sleep и select в perlfunc⑴.Функция select используется для организации короткой задержки в программе slowest из рецепта 1.6.

Программа: hopdelta

Вы никогда не задавались вопросом, почему какое-нибудь важное письмо так долго добиралось до вас? Обычная почта не позволит узнать, как долго ваше письмо пылилось на полках всех промежуточных почтовых отделений. Однако в электронной почте такая возможность имеется. В заголовке сообщения присутствует строка Received: с информацией о том, когда сообщение было получено каждым промежуточным транспортным агентом.

Время в заголовках воспринимается плохо. Заголовки приходится читать в обратном направлении, снизу вверх. Время записывается в разных форматах по прихоти каждого транспортного агента. Но хуже всего то, что каждое время регистрируется в своем часовом поясе. Взглянув на строки "Тие, 26 Мау 1998 23:57:38 -0400" и "Wed, 27 Мау 1998 05:04:03 +0100", вы вряд ли сразу поймете, что эти два момента разделяют всего 6 минут 25 секунд.

На помощь приходят функции ParseDate и DateCalc модуля Date： :Manip из архива CPAN:

use Date：:Manip qw(ParseDate DateCalc);

$dl = ParseDateCSun, 09 Mar 2003 23:57:38 -0400"); $d2 = ParseDateC'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+/ /д：# Объединить строки продолжения

Вычислить, когда и где начался маршрут сообщения

my($start_from) = /人From.*\@([人\s>]*)/m；

my($stdrt_ddte) = /人Date：\s+(.*)/m: my $then = getdate($start_date)：

printf '7-20.20s %-20.20s %s\n", 'Start', $start_from, fmtdate(Sthen);

my $prevfrom = $stdrt_from:

Обрабатывать строки заголовка снизу вверх for (reverse split(/\n/)) {

my ($delta, $now, $from. $by. $when)；

next unless /人Received：/;

s/\bon (.*?) (id.*)/： $l/s；# Кажется, заголовок qmail

unless (($when) = /；\s+(.*)$/) {

warn "bad received Une： $_"： next；

}

($from) = /from\s+(\S+)/:

($from) = /\((,*?)\)/ unless $from： # Иногда встречается

$from =~ s/\)$//：# Кто-то пожадничал

($by)= /by\s+(\S+\.\S+)/；# Отправитель для данного участка

Операции, приводящие строку к анализируемому формату for ($when) {

s/ (for|via) .*$//:

s/([+-]\d\d\d\d) \(\S+\)/$l/；

s/ld \S+:\s*//:

}

next unless $now = getdate(Swhen)；# Перевести в секунды

# с начала эпохи

$delta = $now - $then；

printf "%-20.20s %-20.20s %s ", $from. $by. fmtdate($now):

$prevfrom = $by: puttime($delta):

$then = $now；

exit；

Преобразовать произвольные строки времени в секунды с начала эпохи sub getdate {

my $string = shift:

Sstrlng =~ s八s+\(.*\)\s*$〃；# Убрать нестандартные

# терминаторы

my $date = ParseDate($string)：

my $epoch_secs = UnixDate($date.'7s"):

return $epoch_secs；

}~

Преобразовать секунды с начала эпохи в строку опрепепенносо формата sub fmtdate {

my Sepoch = shift:

my($sec,$mi n.$hour,$mday.$mon,$year) = localtime($epoch)：

продолжение 夕продолжение 夕return sprintf ”Z02d:Z02d:Z02d Z04d/Z02d/Z02d”.

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

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

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

$hour. $min, $sec,

$year + 1900, $mon + 1, $mday.

Преобразовать секунды в удобочитаемый формат sub puttime {

my($seconds) = shift； my($days, $hours, $minutes)；

$days = pull_count($seconds, 24 * 60 * 60); $hours = pull_count($seconds, 60 * 60)；

$minutes = pull_count($seconds, 60)：

put_field('s'. $seconds)；

put_field('m', Sminutes): put_field('h', Shours)； put_field('d', $days)；

print "\n"；

Применение： $count = pull_count(seconds, amount)

Удалить из seconds заданную величину, изменить версию вызывающей # стороны и вернуть число удалений.

sub pull_count {

my($answer) = int($_[0] / $_[!])：

$_[0] -= Sanswer * $_[!]：

return Sanswer：

Применение： put_field(char. number)

Вывести числовое поле в десятичном формате с 3 разрядами и суффиксом char

Выводить лишь для секунд (char == 's') sub put_field {

my ，$char, $number) = @_；

printf " %3d%s", $number, $char if Snumber || $char eq 's':

=end

Sender Start wall.org

RecipientTime

wall.org09:17:121998/05/23

mail.brainstorm.net 09:20:56 1998/05/23

Delta

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++. Аналогично, рор(@а) — допустимо, а рор(1,2,3) — нет.

Главное — помнить, что списки и массивы в Perl представляют собой упорядоченные совокупности скалярных величин. Операторы и функции, работающие со списками и массивами, обеспечивают более быстрый или удобный доступ к элементам по сравнению с ручным извлечением. Поскольку размер массива изменяется не так уж часто, термины «массив» и «список» обычно можно считать синонимами.

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

Определение списка в программе

Проблема

Требуется включить в программу список, например, при инициализации массива.

Решение

Перечислите элементы, разделяя их запятыми:

@а = ("quick", "brown", "fox")；

При большом количестве однословных элементов воспользуйтесь оператором qw():

@а = qw(Meddle not in the affairs of wizards.):

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

©lines = («"END_OF_HERE_DOC" =~ m/"\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 «Пакеты, библиотеки и модули»), либо просто читаются из файла данных:

@Ыдаггау = О:

open(FH, "<", "myinfo") or die "Couldn't open myinfo: $!\n"： while (<FH>) {

chomp；

push(@b1garray, $_)；

}_

close(FH):

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

©banner = ('Costs', 'only', '$4.95');

©banner = qw(Costs only $4.95):

©banner = splitC ' Costs only $4.95');

Оператор qw() подходит лишь для списков, в которых каждый элемент является отдельным словом, ограниченным пробелами. Будьте внимательны, а то во флотилии Колумба вместо трех кораблей появится четыре:

Sships = qw(Nina Pinta Santa Maria):# НЕВЕРНО!!!

$ships = ('Nina', 'Pinta*, 'Santa Maria'): # Правильно

В третьем решении используется встроенный документ — текст, состоящий из нескольких логических строк. Во встроенном документе производится глобальный поиск по шаблону. Шаблон /人\s*(.+)/ игнорирует все пропуски в начале

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

©ships = ( « "END_OF_FLOTILLA" =~ /人\s*(.+)/gm):

Nina" ~

Pinta

Santa Maria

END_OF_FLOTILLA

См. также

Раздел «List Value Constructors» perldata(l); раздел «Quote and Quote-Like Operators» perlop⑴;оператор s/// описан в perlop(i).

Вывод списков с запятыми

Проблема

Требуется вывести список с неизвестным количеством элементов. Элементы должны разделяться запятыми (если их больше двух), а перед последним элементом выводится слово «and».

Решение

Следующая функция возвращает строку, отформатированную требуемым образом:

sub comni1fy_series {

(@_ == 0) ?'':

(@_ == 1) ? $_[0]:

延==2) ? join(" and ", @_):

join(", @_[0 .. ($#_-!], "and $_[-!]")：

}

Комментарий

При выводе содержимое массива порой выглядит довольно странно:

©array = ("red", "yellow", "green")；

print "I have ", ©array, " marbles.\n"：

print "I have ©array marbles\n"：

I have redyel1owgreen marbles.

I have red yel 1 ow green marbles.

На самом деле вам нужна строка "I have red, yellow, and green marbles". Приведенная выше функция генерирует строку именно в таком формате. Между

двумя последними элементами списка вставляется "and". Если в списке больше двух элементов, все они разделяются запятыми.

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

Пример 4.1. commify_series

#!/usr/bin/perl -w

# commify_series - демонстрирует вставку запятых при выводе списка

# ©lists - массив ссылок на анонимные массивы (массив массивов). ©lists =(

['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 (@lists) {

print "The list is： " . comniify_series(@$aref) . "An"；

}一

# Демонстрация для одного списка

©list = qw(one two three)；

print "The last list is： " . commify_series(@list) . "An"；

sub commify_series {

my $sepchar = grep(/,/ => @_) ?"："：；

(@_ = = 0) ? "~：

(@_ = = 1) ? $_[0]:

(@_ = = 2) ? join(" and ", @_):

join("$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, heippy 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.

Как видите, мы отвергаем порочную практику исключения последней запятой из списка, так как это нередко приводит к появлению двусмысленностей.

См. также

Описание синтаксиса вложенных списков в рецепте 11.1; описание функции grep в perlfunc(l)\ описание тернарного оператора выбора в perlop(l). Синтаксис вложенных списков рассматривается в рецепте 11.1.

Изменение размера массива

Проблема

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

Решение

Присвойте значение $#ARRAY:

# Увеличить или уменьшить ©ARRAY

$#ARRAY = $NEW_LAST_ELEMENT_INDEX_NUMBER

Присваивание элементу, находящемуся за концом массива, автоматически увеличивает массив:

$ARRAYL$NEW_LAST_ELEMENT_INDEX_NUMBER] = $VALUE:

Комментарий

$#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), " elementsAn":

print "The index of the last element is $#people.\n"；

print "Element #3 is '$people[3]'.\rT；

©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" безвозвратно утерян. Вместо присваивания $#peoplе можно было указать:

$peopleL10_000]=undef:

хотя это не совсем одно и то же. Например, если в массиве из трех элементов ©colors = qw(red blue green)：

присвоить undef последнему элементу

undef $colors[2]； # Элемент green удаляется

у вас остается массив из трех элементов, просто его последний элемент не определен. Однако при удалении элемента из массива при помощи функции или ручным изменением $#colors:

$ldst_color = ScolorsL $#colors--];

размер массива уменьшается на один элемент.

Массивы Perl не являются разреженными. Другими словами, если у вас имеется 10 000-й элемент, то должны присутствовать и остальные 9999 элементов. Они могут быть неопределенными, но все равно будут занимать память. Из-за этого $array[time()] или любая другая конструкция, где в качестве индекса используется очень большое целое число, является неудачным решением. Лучше воспользуйтесь хэшем.

См. также

Описание $#ARRAY в perldata(l).

Реализация разреженного массива

Проблема

На хранение массива, в котором элементы разделяются большими свободными блоками, расходуется слишком много памяти. Как избавиться от лишних затрат?

Решение

Воспользуйтесь хэшем вместо массива.

Комментарий

Если присвоить значение миллионному элементу массива, то 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 $foo[3] ?

prlntf "bar element 3 is* defined\n".

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 def1ned

bar element 3 does exist

Впрочем, и в этом случае память будет расходоваться неэффективно. Дело в том, что реализация массивов в Perl резервирует непрерывный блок памяти для всех элементов до последней занятой позиции:

$real_array[ 1_000_000 ] = 1：# Расходует более 4 Мбайт

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

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

$fake_array{ 1_000_000 } = 1;# Расходует 28 байт

Достоинства такого решения очевидны, как насчет недостатков? Поскольку ключи хэша не упорядочены, сортировка числовых ключей по порядку их хранения в настоящем массиве потребует дополнительной работы. Например, перебор элементов в порядке индексов может осуществляться так:

foreach $element ( @real_array ) {

Выполнить операцию с $element

}

Перебор индексов по возрастанию производится так:

foreach $1dx ( 0 .. $#real_array ) {

Выполнить операцию с $real_array[$1dx]

}_

При представлении массива в виде хэша перебор элементов в порядке индексов выполняется сложнее:

foreach Selement ( @fake_array{ sort {$a <=> $b} keys ^fake_array } ) {

Выполнить операцию c Selement

}

Перебор индексов по возрастанию:

foreach $1dx ( sort {$а <=> $b} keys ^fake_array ) {

Выполнить операцию c $fake_array{$idx}

}_

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

Первый случай — увеличение массива многократным присоединением новых элементов. Используемая в Perl схема выделения памяти при увеличении массива такова, что затраты памяти могут оказаться в четыре раза больше необходимых. Если максимальный размер массива известен заранее, затраты на перераспределение памяти можно предотвратить. Для этого следует либо присваивать значения элементов, начиная со старших индексов:

for ($i = 10_000; $1 >= 0: $1--) { $real_array[$i] = 1 }

либо зарезервировать память под весь массив при помощи специальной конструкции $#:

$#real_array = 10_000;

Второй частный случай встречается тогда, когда каждый элемент массива содержит всего один бит данных. Например, при работе с пронумерованными статьями Usenet в элементе массива может храниться информация о том, была

ли прочитана соответствующая статья. В таких ситуациях вместо массива используется битовый вектор:

my $have_read ='':

for ($1 = 10_000； $1 >= 0： $1--) { vec($have_read, $1. 1) = 1 }

В этом примере состояние флага проверяется следующим образом:

1f (vec($hdve_redd, $drtno. D) { .... }

См. также

Описание функции vec в perlfunc(l).

Выполнение операции с каждым элементом списка

Проблема

Требуется повторить некоторую операцию для каждого элемента списка.

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

Решение

Воспользуйтесь циклом foreach:

foreach $1tem (LIST) {

# Выполнить некоторые действия с $1tem

}

Комментарий

Предположим, в массиве @bad_users собран список пользователей, превысивших свои дисковые квоты. В следующем фрагменте для каждого нарушителя вызывается процедура complalnO:

foreach $user (@bdd_users) {

compla1n($user):

}

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

foreach $var (sort keys 狂NV) {

print "$var=$ENV{$var}\n";

В этом примере функции sort и keys строят отсортированный список имен переменных окружения. Конечно, многократно используемые списки следует сохранять в массивах. Но для одноразовых задач удобнее работать со списком напрямую.

Возможности этой конструкции расширяются не только за счет построения списка в foreach, но и за счет дополнительных операций в блоке кода. Одно из распространенных применений foreach — сбор информации о каждом элементе списка и принятие некоторого решения на основании полученных данных. Вернемся к примеру с квотами: foreach $user (@dll_users) {

$disk_spdce = get_usage($user):# Определить объем используемого

дискового пространства

if ($disk_space > $MAX_QUOTA) {# Если он больше допустимого...

compla1n($user):# ... предупредить о нарушении.

}

}

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

Переменная, которой последовательно присваиваются все элементы списка, называется переменной цикла, или итератором. Если итератор не указан, используется глобальная переменная $_. Она используется по умолчанию во многих строковых, списковых и файловых функциях Perl. В коротких программных блоках пропуск $_ упрощает чтение программы (хотя в длинных блоках излишек неявных допущений делает программу менее понятной). Например: foreach ('who') {

1f (/tchrlst/) { print；

}

Или в сочетании с циклом while:

while (<FH>) {chomp：foreach (split) {$_ = reverse；print:}while (<FH>) {chomp：foreach (split) {$_ = reverse；print:}Присвоить $_ очередную прочитанную строку

while (<FH>) {chomp：

foreach (split) {

$_ = reverse；

print:

}

while (<FH>) {chomp：

foreach (split) {

$_ = reverse；

print:

}

Удалить из $_ конечный символ \п,

если он присутствует

Разделить $_ по пропускам и получить @_

Последовательно присвоить $_

каждый из полученных фрагментов

Переставить символы $_

в противоположном порядке

Вывести значение $_

Многочисленные применения $_ заставляют понервничать. Особенно беспокоит то, что значение $ изменяется как в foreach, так и в while. Возникает

вопрос — не будет ли полная строка, прочитанная в $_ в <FH>, навсегда потеряна после выполнения foreach?

К счастью, эти опасения необоснованны — по крайней мере, в данном случае. Perl не уничтожает старое значение $_, поскольку переменная-итератор ($_) существует в течение всего выполнения цикла. При входе во внутренний цикл старое значение автоматически сохраняется, а при выходе — восстанавливается.

Однако причины для беспокойства все же есть. Если цикл while будет внутренним, a foreach — внешним, ваши страхи в полной мере оправдаются. В отличие от foreach, конструкция while <FH> разрушает глобальное значение $_ без предварительного сохранения! Следовательно, в начале любой процедуры (или блока), где $_ используется в подобной конструкции, всегда должно присутствовать объявление local $_.

Если в области действия (scope) присутствует лексическая переменная (объявленная с ту), то временная переменная будет иметь лексическую область действия, ограниченную данным циклом. В противном случае она будет считаться глобальной переменной с динамической областью действия. Во избежание странных побочных эффектов лучше использовать более наглядную и четкую запись: foreach my $item (@array) { print "i = $item\n"：

}

Цикл foreach обладает еще одним свойством: в цикле переменная-итератор является не копией, а скорее синонимом (alias) текущего элемента. Иными словами, изменение итератора приводит к изменению каждого элемента списка.

Qdiray = (1.2.3): foreach $item (@array) {

}

print "@array\n"： 0 1 2

# Умножить каждый элемент @d и @b на семь 财=(.5, 3): @b = (0, 1): foreach $item (@d, @b) {

$item *= 7； } print "@a @b\n"： 3.5 21 0 7

Однако изменять константы нельзя, поэтому следующий фрагмент недопустим: foredch $n (1, 2, 3) {

$п 2： }

Механизм синонимов означает, что модификация списков в цикле foreach оказывается более понятной и быстрой, чем в эквивалентном коде с циклом for и указанием конкретных индексов. Это не ошибка; такая возможность была намеренно предусмотрена разработчиками языка. Не зная о ней, можно случайно изменить содержимое списка. Теперь вам это известно.

Например, для удаления начальных и конечных пропусков из элементов хэша используется особенность функции values: элементы возвращаемого списка в действительности являются значениями хэша, а их модификация приводит к изменению исходного хэша. Непосредственное применение s/// к элементам списка, возвращаемого функцией values, без копирования в переменную, приведет к модификации самого хэша.

Убрать пропуски из скалярной величины, массива и всех значений хзша foreach ($scalar, @array. values ^hash) { s/'\s+//: s八s+$//;

}

По причинам, связанным с эквивалентными конструкциями командного интерпретатора Борна для UNIX, ключевые слова for и foreach взаимозаменяемы: for $item (@array) { # То же, что и foreach $item (@array)

Сделать что-то

}

for (@array) { # То же. что и foreach $_ (@array)

Сделать что-то

}

Подобный стиль часто показывает, что автор занимается написанием или сопровождением сценариев интерпретатора и связан с системным администрированием UNIX. Жизнь таких людей и без того сложна, поэтому не стоит судить их слишком строго. Вспомните главный принцип Perl: «У каждой задачи всегда существует несколько решений».

См. также

Разделы «For Loops», «Foreach Loops» и «Loop Control» perlsyn{Y)\ раздел «Temporary Values via local()» perlsub(1). Оператор local () рассматривается в рецепте 10.13, a my О — в рецепте 10.2.

4.6. Перебор массива по ссылке

Проблема

Имеется ссылка на массив. Вы хотите использовать цикл для обращения к каждому элементу массива.

Решение

Для перебора разыменованного (dereferenced) массива используется цикл foreach или for:

Перебор элементов массива $ARRAYREF

foreach $item(@$ARRAYREF) {

Сделать что-то с $item

for ($1 = 0: $1 <= $#$ARRAYREF; $1++) {

Сделать что-то с $ARARAYREF->[$l]

}

Комментарий

Приведенное решение предполагает, что у вас имеется скалярная переменная, содержащая ссылку на массив. Это позволяет делать следующее:

©fruits = ( "Apple", "Blackberry")：

$fru1t_ref = '©fruits；

foreach $fru1t (@$fru1t_ref) {

print "$fruit tastes good In a pie.\n"；

}

Apple tastes good in a pie.

Blackberry tastes good in a pie.

Цикл foreach можно переписать в виде цикла for следующего вида:

for ($1=0; $i <= $#$fruit_ref: $i++) {

print "$fruit_ref->[$i] tastes good In a pie.\n"：

Однако ссылка на массив нередко является результатом более сложного выражения. Для превращения такого результата в массив применяется конструкция @{ EXPR }:

$namel1st{felines} = \@rogue_cats:

foreach $cdt ( @{ $namelist{felines} } ) { print "$cdt purrs hypnotically.An";

}

print "--More--\nYou are control led.\n"；

Как и прежде, цикл foreach можно заменить эквивалентным циклом for:

for ($1=0： $1 <= $#{ $namelist{felines} }； $1++) { print "$namelist{fel1nes}[$i] purrs hypnotically.\n"；

}

См. также

perlref(l) и perllol(\)\ рецепт 11.1; рецепт 4.5.

4-7. Выборка уникальных элементов из списка

Проблема

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

Решение

Хэш используется для сохранения встречавшихся ранее элементов, а функция keys — для их извлечения. Принятая в Perl концепция истинности позволит уменьшить объем программы и ускорить ее работу.

О Прямолинейно:

%seen =();

@un1q =()；

foreach $1tem (©list) { unless ($seen{$item}) # Если мы попали сюда, значит. элемент не встречался ранее $seen{$1tem} = 1； push(Gun1q, $1tem)：

}

}

О Быстро:

%seen =()：

foreach $1tem (©list) { push(@uniq, $1tem) unless $seen{$item}++:

}

О Аналогично, но с пользовательской функцией:

%seen =()：

foreach $1tem (©list) { some_func($1tem) unless $seen{$1tem}++： }~

О Быстро, но по-другому:

%seen =()：

foreach $1tem (©list) { $seen{$1tem}++；

}

Quniq = keys ^seen：

О Быстро и совсем по-другому:

%seen =()；

©unique = grep { ! $seen{$」++ } ©list;

Комментарий

Суть сводится к простому вопросу — встречался ли данный элемент раньше? Хэши идеально подходят для подобного поиска. В первом варианте («Прямолинейно») массив уникальных значений строится по мере обработки исходного списка, а для регистрации встречавшихся значений используется хэш.

Второй вариант («Быстро») представляет собой самый естественный способ решения подобных задач в Perl. Каждый раз, когда встречается новое значение, в хэш с помощью оператора ++ добавляется новый элемент. Побочный эффект состоит в том, что в хэш попадают все повторяющиеся экземпляры. В данном случае хэш работает как множество.

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

В следующем варианте («Быстро, но по-другому») уникальные ключи извлекаются из хэша %seen лишь после того, как он будет полностью построен. Иногда это удобно, но исходный порядок элементов утрачивается.

В последнем варианте («Быстро и совсем по-другому») построение хэша % seen объединяется с извлечением уникальных элементов. При этом сохраняется исходный порядок элементов.

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

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

Построить список 3dpe「истрированннх пользователей с удалением дубликатов ^ucnt = О:

for ('who') {

s/\s.*\n//；# Стереть от первого пробела до конца строки -

остается имя пользователя

$ucnt{$_}++； # Зафиксировать присутствие данного пользователя

}~

# Извлечь и вывести уникальные ключи

©users = sort keys ^ucnt;

print "users logged 1n： @users\n"：

См. также

Раздел «Foreach Loops» perlsyn(i); описание функции keys в perlfunc(l). Аналогичное применение хэшей продемонстрировано в рецептах 4.8 и 4.9.

Поиск элементов одного массива^ отсутствующих в другом массиве

Проблема

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

Решение

Мы ищем элементы @А, которых нет в @В. Постройте хэш из ключей @В — он будет использоваться в качестве таблицы просмотра. Затем проверьте каждый элемент @А и посмотрите, присутствует ли он в @В.

О Простейшая реализация:

Предполагается. что @А и @В уже 3d「руженм

^seen = О；# Хзш для проверки принадлежности элемента В

©donly = О:# Результат

Построить таблицу просмотра

foreach $item (@В) { $seen{$item} = 1 }

Найти элементы @А, отсутствующие в @В

foreach $item (@А) {

unless ($seen{$item}) {

# Отсутствует в ^seen, поэтому добавить в ©donly push(@donly, $1tem)；

}

}

О Идиоматическая версия:

my %seen；# Таблица просмотра

my ©donly；# Результат

Построить таблицу просмотра

@seen{@B}=()：

foreach $item (@А) {

push(@donly, $item) unless exists $seen{$item}；

}

О Версия без цикла:

my @А =…：

my @В =…；

my %seen；

©seen {@A} = 0;

delete ©seen {@B};

my ©donly = keys ^seen：

Комментарий

Практически любая проблема, при которой требуется определить принадлежность скалярной величины к списку или массиву, решается в Perl с помощью хэшей. Сначала мы обрабатываем @В и регистрируем в хэше %seen все элементы @В, присваивая соответствующему элементу хэша значение 1. Затем мы последовательно перебираем все элементы @А и проверяем, присутствует ли данный элемент в хэше %seen (то есть в @В).

В приведенном фрагменте ответ будет содержать дубликаты из массива @А. Проблема легко решается, для этого достаточно включать элементы @А в %seen по мере обработки:

foredch $1tem (@А) {

push (Qdonly. $item) unless $seen{$item}：

$seen{$item} = 1:# Пометить как уже встречавшийся

Эти решения в основном отличаются по способу построения хэша. В первом варианте перебирается содержимое @В. Во втором для инициализации хэша используется срез. Работу со срезами хэшей проще всего продемонстрировать на примере. Фрагмент $hash{"keyl"} = 1: $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 $pathl： $!"：

@seen{ <OLD> }=()：

open(NEW, $path2)|| die "can't open $path2： $!"：

while (<NEW>) {

print If exists $seen{$_}：

}'

Программа выводит те строки второго файла, которые уже встречались в первом файле. Чтобы вывести строки второго файла, отсутствуюище в первом, замените if на unless.

Допустим, у нас имеются два файла. Первый содержит строки:

red yel1ow green blue

Второй файл содержит строки:

green

orange

purple black yellow

C 1 f результат выглядит так:

green

yel1ow

Результат c unless:

orange

purple black

Проверку даже можно выполнить из командной строки. При наличии программы типа cat(l) это делается легко:

% perl -е '@s{'cdt OLD'}=(); exists $s{$_} && print for 'cat NEW'1

% perl -e '@s{'cat OLD'}=(): exists $sj$」|| print for 'cat NEW''

На самом деле эти команды эмулируют следующие вызовы программы Unix fgrep(l):

% fgrep -Ff OLD NEW

% fgrep -vFf OLD NEW

См. также

Описание срезов хэшей в perldata(l). Аналогичное применение хэшей продемонстрировано в рецептах 4.7 и 4.9.

Вычисление объединения^ пересечения и разности уникальных списков

Проблема

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

Решение

В приведенных ниже решениях списки инициализируются следующим образом:

@d = (1. 3, 5. 6. 7, 8):

@Ь = (2, 3. 5, 7, 9):

©union = bisect = @diff =():

bunion = bisect = О;

%count = О:

О Простое решение для объединения и пересечения:

foreach $е(@а) { $union{$e} = 1 }

foreach $е (@b) {

If ( $union{$e} ) { $isect{$e} = 1 }

$un1on {$e} = 1;

}

©union = keys bunion；

@isect = keys bisect:

О Идиоматическое решение:

foreach $e (@a, @b) { $union{$e}++ && $isect{$e}++ }

bunion = keys Zunions；

bisect = keys bisect：

О Объединение, пересечение и симметричная разность:

foreach $е (@а, @b) { $count{$e}++ }

foreach $е (keys Zcount) {

push(©union, $e):

if ($count{$e} == 2) {

push @isect. $e：

} else {

push @diff, $e;

}

}

О Косвенное решение:

@isect = @diff = ©union =()：

foreach $e (@a. @b) { $count{$e}++ }

©union = keys Zcount;

foreach $e (keys %count) {

push @{ $count{$e} == 2 ? \@isect : \@d1ff }, $e;

}

Комментарий

В первом решении происходит непосредственное вычисление объединения и не- ресечения двух списков, ни один из которых не содержит дубликатов. Для записи элементов, принадлежащих к объединению и пересечению, используются два разных хэша. Сначала мы заносим каждый элемент первого массива в хэш объединения и ассоциируем с ним истинное значение. Затем при последовательной обработке элементов второго массива мы проверяем, присутствует ли элемент в объединении. Если присутствует, он также включается и в хэш пересечения.

В любом случае элемент заносится в хэш объединения. После завершения перебора мы извлекаем ключи обоих хэшей, а ассоциированные с ними значения не нужны.

Второе решение («идиоматическое»), в сущности, делает то же самое, однако для него потребуется хорошее знание операторов Perl (а также awk, С, C++ и Java) ++ и &&. Если ++ находится после переменной, то в программе используется ее старое значение до приращения. Когда элемент встречается впервые, он еще отсутствует в объединении, поэтому первая часть && будет ложной, а вторая часть попросту игнорируется. Когда тот же элемент встретится во второй раз, он уже присутствует в объединении, поэтому мы заносим его и в пересечение.

В третьем решении информация о том, сколько раз встретился тот или иной элемент, хранится всего в одном кэше. Записав элементы обоих массивов в хэш, мы последовательно перебираем его ключи. Каждый ключ автоматически попадает в объединение. Ключи, с которыми ассоциировано значение 2, присутствуют в обоих массивах и потому заносятся в массив пересечения. Ключи с ассоциированным значением 1 встречаются лишь в одном из двух массивов и зано・ сятся в массив разности. В отличие от исходного решения, порядок элементов в выходных массивах не совпадает с порядком элементов входных массивов.

В последнем решении, как и в предыдущем, используется всего один хэш с количеством экземпляров каждого элемента. Однако на этот раз мы динамически выбираем один из двух возможных массивов, размещая в блоке разыменования массива @{. •.} выражение, результат вычисления которого дает ссылку на нужный массив.

Мы вычисляем не простую, а симметричную разность. Эти термины происходят из теории множеств. Симметричная разность представляет собой набор всех элементов, являющихся членами либо @А, либо @В, но не обоих сразу. Простая разность — набор всех элементов @А, отсутствующих в @В (см. рецепт 4.8).

См. также

Аналогичное применение хэшей продемонстрировано в рецептах 4.7 и 4.8.

Присоединение массива

Проблема

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

Решение

Воспользуйтесь функцией push:

# push

push(@ARRAYl. ©ARRAY2):

Комментарий

Функция push оптимизирована для присоединения списка в конец массива. Два массива также можно объединить посредством сглаживания (flattening) списков Perl, однако в этом случае выполняется намного больше операций копирования, чем при использовании push:

©ARRAY1 = (QARRAY1, ©ARRAY2);

Ниже показан пример практического использования push:

©members = ("Time", "Flies"):

©initiates = ("An", "Arrow")： push(©members, ©initiates)；

#@members содержит элементы ("Time". "Flies", "An". "Arrow")

Если содержимое одного массива требуется вставить в середину другого, воспользуйтесь функцией splice:

splice(©members. 2. О, "Like", ©initiates):

print "OmembersXn"：

splice(©members, 0, 1, "Fruit")；

splice(©members, -2, 2, "A". "Banana")： print "OmembersXn":

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

Time Flies Like An Arrow

Fruit Flies Like A Banana

См. также

Описание функций splice и push в perlfunc(l); раздел «List Value Constructors» perldata(l).

Обращение массива

Проблема

Требуется обратить массив (то есть переставить элементы в противоположном порядке).

Решение

Воспользуйтесь функцией reverse:

Обращение ©ARRAY дает ©REVERSED ©REVERSED = reverse @ARRAY:

Также можно воспользоваться циклом foreach:

foreach $element (reverse ©ARRAY) { # Сделать что-то c Selement

}

или циклом for, начиная с индекса последнего элемента и продвигаясь к началу:

for ($1 = $#ARRAY; $1 >= 0: $1--) {

# Сделать что-то с $ARRAY[$1]

}

Комментарий

В списковом контексте функция reverse переставляет элементы списка-аргумента в обратном порядке. Вы можете сохранить копию обращенного списка в массиве или просто воспользоваться циклом foreach для перебора элементов в обратном порядке, если этого достаточно. Цикл for просто перебирает элементы в обратном порядке с явным заданием индексов. Если обращенная копия списка не нужна, цикл for экономит память и время для очень больших массивов.

Если функция reverse используется для обращения только что отсортированного списка, логичнее будет сразу отсортировать список в нужном порядке. Например:

Два шага： сортировка, затем обращение ^ascending = sort { $а cmp $b } @users； ©descending = reverse ©ascending；

Один шаг： сортировка с обратным сравнением

©descending = sort { $b cmp $a } @users:

См. также

Описание функции reverse в perlfunc(iy, пример использования reverse в рецепте 1.7.

Обработка нескольких элементов массива

Проблема

Требуется удалить сразу несколько элементов в начале или в конце массива.

Решение

Воспользуйтесь функцией splice:

Удалить $N элементов с начала ©ARRAY (shift $N)

©FRONT = splice(©ARRAY, 0, $N);

Удалить $N элементов с конца массива (pop $N)

©END = spl1ce(@ARRAY, -$N)：

Комментарий

Функция splice позволяет добавлять и/или удалять элементы в произвольной позиции массива, не только с концов. Все остальные операции, изменяющие длину массива, также могут быть записаны в виде эквивалентных вызовов splice:

Операция

Эквивалентный вызов splice

push(@a, $х, $у)

splice(@a, @а, 0, $х, $у)

рор(@а)

spliec(@a, -1)

shift(@a)

splice(@a, 0, 1)

unshift(@az $х, $у)

splice(@a, 0, 0, $х, $у)

$а[$х] = $у

splice(@a, $х, 1, $у)

(@az @а =())

splice(@a)

Однако в отличие от функций pop и unshift, которые всегда удаляют и возвращают по одному элементу (и только с концов), splice позволяет задать количество элементов. Так получаются конструкции вроде тех, что приведены в начале Решения.

Часто бывает удобно оформить эти операции в виде функций:

sub shift2 (\@) {

return splice(@{$_[0]}, 0, 2)；

}"

sub рор2 (\@) {

return splice(@{$_[0]}, 0. -2):

}-

Использование функций делает код более наглядным:

^friends = qw(Peter Paul Mary Jim Tim)； ($this, $that) = shift2(@friends);

$this содержит Peter, $that - Paul, # a ©friends - Mary. Jim и Tim

©beverages = qw(Dew Jolt Cola Sprite Fresca):

©pair = pop2(@beverages);

$pair[0] содержит $sprite, $pair[l] - Fresca.

a ©beverages - (Dew. Jolt. Cola)

Функция splice возвращает элементы, удаленные из массива, поэтому shift2 не заменяет первые два элемента ©ARRAY ничем (то есть удаляет их) и возвращает два удаленных элемента. Функция рор2 удаляет и возвращает два последних элемента.

В качестве аргументов этим функциям передается ссылка на массив — это сделано для того, чтобы они лучше имитировали встроенные функции shift и pop. При вызове ссылка не передается явно, с использованием символа \. Вместо этого компилятор, встречая прототип со ссылкой на массив, организует передачу

массива по ссылке. Преимущества такого подхода — эффективность, наглядность и проверка параметров на стадии компиляции. Недостаток — передаваемый объ> ект должен выглядеть как настоящий массив с префиксом 储 а не как скалярная величина, содержащая ссылку на массив. В противном случае придется добавлять префикс вручную, что сделает функцию менее наглядной:

$11ne[5] = \@11st;

©got = рор2( @{ $11ne[5] });

Перед вами еще один пример, когда вместо простого списка должен использоваться массив. Прототип \@ требует, чтобы объект, занимающий данную позицию в списке аргументов, был массивом. $line[5] представляет собой не массив, а ссылку на него. Вот почему нам понадобился «лишний» знак @.

См. также

Описание функции splice в perlfunc(i); раздел «Prototypes» perlsub(1). Функция splice используется в рецепте 4.10.

Поиск первого элемента списка, удовлетворяющего некоторому критерию

Проблема

Требуется найти первый элемент списка, удовлетворяющего некоторому критерию (или индекс этого элемента). Возможна и другая формулировка — определить, проходит ли проверку хотя бы один элемент. Критерий может быть как простым («Присутствует ли элемент в списке?»)1, так и сложным («Имеется список работников, отсортированный в порядке убывания оклада. У кого из менеджеров самый высокий оклад?»). В простых случаях дело обычно ограничив вается значением элемента, но если сам массив может изменяться, вероятно, следует определять индекс первого подходящего элемента.

Решение

Перебирайте элементы в цикле foreach и вызовите last, как только критерий будет выполнен:

my($match, $found. $1tem)： foreach $1tem((aarray) { if (КРИТЕРИЙ) {

$match = $1tem:# Необходимо сохранить

$found = 1: last;

}

Но тогда почему бы не воспользоваться хэшем?

1f($found) {

# Сделать что-то с $match

} else {

# Неудачный поиск

}

Чтобы определить индекс, перебирайте все индексы массива и вызовите last, как только критерий выполнится:

my($i, $match_1dx):

for ($i = 0; $1 < ©array； $i++) {

if (КРИТЕРИЙ) {

$match_1dx = $i；# Сохранить индекс

last:

}

}

If(defined $match_idx) {

# Найден элемент $array[$match_1dx]

} else {

# Неудачный поиск

}

Модуль List: :Ut11, включенный в стандартную поставку Perl, начиная с версии 5.8, и доступный через CPAN для предыдущих версий, предоставляет еще более простое решение:

use List::Util qw(flrst):

$match = first { КРИТЕРИЙ } ©list

Комментарий

Стандартных механизмов для решения этой задачи не существует, поэтому мы напишем собственный код для перебора и проверки каждого элемента. В нем используются циклы foreach и for, а вызов last прекращает проверку при выполнении условия. Но перед тем как прерывать поиск с помощью last, следует сохранить найденный индекс.

Одно из распространенных решений основано на использовании функции grep. Но grep проверяет все элементы и находит все совпадения; если вас интересует только первое совпадение, этот вариант неэффективен. И все же grep в некоторых ситуациях работает быстрее. Дело в том, что вызов grep уменьшает объем исходного кода, а следовательно порождает меньше внутренних операций Perl, которые на практике оказывают сильное влияние на время выполнения программы.

Если объем данных больше некоторой пороговой величины, цикл с ранним завершением цикла все равно работает быстрее — если раннее завершение возможно. Согласно эмпирическим данным, цикл for работает быстрее в том случае, если он прерван до того, как будут обработаны две трети списка.

Если нас интересует значение первого найденного элемента, присвойте его переменной $match. Мы не можем просто проверять $item в конце цикла, так как

foreach автоматически локализует переменную-итератор и потому не позволяет узнать ее последнее значение после завершения цикла (см. рецепт 4.5).

Рассмотрим пример. Предположим, в массиве @dll_emps находится список объектов с информацией о работниках, отсортированный в порядке убывания оклада. Мы хотим найти инженера с максимальным окладом; это будет первый инженер в массиве. Требуется только вывести имя инженера, поэтому нас интересует не индекс, а значение элемента.

foreach $emplоуее (@a11_emps) {

if ( $employee->category() eq 'engineer' ) {

$top_engr = Semployee； last：

}

}

print "Highest paid engineer is： ", $top_engr->name(), "\n"；

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

for ($1 = О; $1 < @ARRAY; $1++) {

last if КРИТЕРИЙ：

}

If ($1 < @ARRAY) {

# Критерий выполняется для элемента с индексом $1

} else {

# Неудачный поиск

}

Функция first из List: :Util инкапсулирует логику всего цикла в простом и удобном виде. Можно рассматривать ее как упрощенную форму встроенной функции grep, которая прекращает работу сразу же после успешно найденного совпадения. Во время работы функции каждый элемент списка последовательно заносится в локализованную переменную $_. Пример:

$first_odd = first { $_ ^ 2 = = 1 } ©ARRAY:

Или для предыдущего примера с инженером:

$top_engr = first { $_->category( ) eq 'engineer' } @all_emps；

См. также

Разделы «For Loops», «Foreach Loops» и «Loop Control» perlsyn^l); описание функции grep в perlfunc(l).

Поиск всех элементов массиваЛ удовлетворяющих определенному критерию

Проблема

Требуется найти все элементы списка, удовлетворяющие определенному критерию.

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

Решение

Воспользуйтесь функцией grep. Функция применяет критерий ко всем элементам списка и возвращает лишь те, для которых он выполняется:

©matching = grep { КРИТЕРИЙ ($_) } @11 st;

Комментарий

То же самое можно было сделать в цикле foreach:

©matching = О； foreach (©list) { push(@matching, $_) if КРИТЕРИЙ ($_): }__

Функция Perl grep позволяет записать всю эту возню с циклами более компактно. В действительности функция grep сильно отличается от одноименной команды Unix — она не имеет параметров для нумерации строк или инвертирования критерия и не ограничивается проверками по регулярным выражениям. Например, чтобы отфильтровать из массива очень большие числа или определить, с какими ключами хэша ассоциированы очень большие значения, применяется следующая запись:

@bigs = grep { $_ > 1_000_000 } @nums：

©pigs = grep { $users($_} > le7 } keys fusers：

В следующем примере в (^matching заносятся строки, полученные от команды who и начинающиеся с "gnat ":

©matching = grep { /人gnat / } 'who'；

Или другой пример:

©engineers = grep { $_->position() eq 'Engineer' } ©employees；

Из массива ©employees извлекаются только те объекты, для которых метод positionO возвращает строку Engineer.

Функция grep позволяет выполнять и более сложные проверки:

@secondary_assi stance = grep { $_->1ncome >= 26_000 && $[->income < 30^000 } ©applicants;

Однако в таких ситуациях вариант с циклом выглядит более понятно.

См. также

Разделы «For Loops», «Foreach Loops» и «Loop Control» perlsyn(l); описание функции grep в perlfitnc(l); страница руководства who(l) вашей системы (если есть); рецепт 4.13.

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

Проблема

Требуется отсортировать список чисел, однако функция Perl sort (по умолчанию) выполняет алфавитную сортировку в ASCII-порядке.

Решение

Воспользуйтесь функцией Perl sort с оператором числового сравнения <=>: ©sorted = sort { $а <=> $b } ©unsorted;

Комментарий

При вызове функции sort можно передавать необязательный программный блок, с помощью которого принятый по умолчанию алфавитный порядок сравнения заменяется вашим собственным. Функция сравнения вызывается каждый раз, когда sort сравнивает две величины. Сравниваемые значения загружаются в специальные пакетные переменные $а и $Ь, которые автоматически локализуются.

Функция сравнения должна возвращать отрицательное число, если значение $а должно находиться в выходных данных перед $Ь; 0, если они совпадают или порядок несущественен; и положительное число, если значение $а должно находиться после $Ь. В Perl существует два оператора с таким поведением: оператор <=> сортирует числа по возрастанию в числовом порядке, а стр сортирует строки по возрастанию в алфавитном порядке. По умолчанию sort использует сравнения в стиле стр.

Следующий фрагмент сортирует список идентификаторов процессов (PID) в массиве Qpids, предлагает пользователю выбрать один PID и посылает сигнал TERM, за которым следует сигнал KILL. В необязательном программном блоке $а сравнивается с $Ь оператором <=>, что обеспечивает числовую сортировку.

#@pids - несортированный массив идентификаторов процессов

foreach my $pid (sort { $a <=> $b } @pids) {

print "$pid\n"；

}

print "Select a process ID to kill :\n"；

chomp ($pid = <>)；

die "Exiting ... \n" unless $pid && $pid =~ /人\d+$/;

kill ('TERM',$pid):

sleep 2:

kill ('KILL',$pid):

При использовании условия $а<=>$Ь или $а стр $Ь список сортируется в порядке возрастания. Чтобы сортировка выполнялась в порядке убывания, достаточно поменять местами $а и $Ь в функции сравнения:

©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_Pdck, а функция revnum будет использовать версии из своего пакета. Это еще один аргумент в пользу прямого определения функций сортировки при вызове:

@all = sort { $b <=> $а } 4, 19, 8, 3;

За дополнительной информацией о пакетах обращайтесь к главе 10 «Процедуры».

См. также

Описание операторов стр и <=> в perlop(l); описание функций kill, sort и sleep в perlfunc(i\t рецепт 4.16.

Сортировка списка по вычисляемому полю

Проблема

Требуется отсортировать список, руководствуясь более сложным критерием, нежели простыми строковыми или числовыми сравнениями.

Такая проблема часто встречается при работе с объектами («отсортировать по заработной плате») или сложными структурами данных («отсортировать по

третьему элементу массива, на который указывает данная ссылка»). Кроме того, она относится к сортировке по нескольким ключам, например, когда список сортируется по дню рождения, а затем по имени (когда у нескольких людей совпадают дни рождения).

Решение

Воспользуйтесь вызовом sort с нестандартной функцией сравнения:

©ordered = sort { compare О } @unordered；

Для ускорения работы значение поля можно вычислить заранее:

©precomputed = map { [compute(),$_] } @unordered;

@ordered_precomputed = sort { $a->[0] <=> $b->[0] } ©precomputed；

bordered = map { $_->[l] } @ordered_precomputed；

Наконец, эти три шага можно объединить:

©ordered = map { $_->[1] }

sort { $а->[0] <=> $b->[0] } map { [compute(),$」} @unordered；

Комментарий

О том, как пользоваться функциями сравнения, рассказано в рецепте 4.15. Помимо использования встроенных операторов наподобие <=>, можно конструировать более сложные условия:

©ordered = sort { $a->name cmp $b->name } ©employees;

Функция sort часто используется подобным образом в циклах foreach:

foreach $employee (sort {$a->name cmp $b->name } ©employees) { print $employee->name, " earns \$". $employee->salary, "\n"；

}

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

@sorted_employees = sort { $a->name cmp $b->name } ©employees；

foreach $employee (@sorted_employees) {

print $employee->name, "earns \$", $employee->salary, "\n"：

}

# Загрузить 汕onus

foreach $employee (@sorted_employees) {

if ($bonus{ $employee->ssn } ) { print $employee->name. "got a bonus!\n"；

}

}

В функцию можно включить несколько условий и разделить их операторами 11. Оператор | | возвращает первое истинное (ненулевое) значение. Следовательно, сортировку можно выполнять по одному критерию, а при равенстве

элементов (когда возвращаемое значение равно 0) сортировать по другому критерию. Получается «сортировка внутри сортировки»:

©sorted = sort {$a->name cmp $b->name

II

$b->age <=> $a->age} ©employees：

Первый критерий сравнивает имена двух работников. Если они не совпадают, 11 прекращает вычисления и возвращает результат стр (сортировка в порядке возрастания имен). Но если имена совпадают, 11 продолжает проверку и возвращает результат <=> (сортировка в порядке убывания возраста). Полученный список будет отсортирован по именам и по возрасту в группах с одинаковыми именами.

Рассмотрим реальный пример сортировки. Мы собираем информацию обо всех пользователях в виде объектов User： ：pwent, после чего сортируем их по именам и выводим отсортированный список:

use User：：pwent qw(getpwent):

@users = О;

# Выбрать всех пользователей

while (defined($user = getpwent)) { push(@users, $user)；

}

@users = sort { $a->name cmp $b->name } @users；

foreach $user (@users) {

print $user->name, ”\n”；

}

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

©sorted = sort { substr($a,l,l) cmp substr($b,l,l) } ©names；

А ниже список сортируется по длине строки:

©sorted = sort { length $а <=> length $b } ©strings：

Функция сравнения вызывается sort каждый раз, когда требуется сравнить два элемента. Число сравнений заметно увеличивается с увеличением количества сортируемых элементов. Сортировка 10 элементов требует (в среднем) 46 сравнений, однако при сортировке 1000 элементов выполняется 14 000 сравнений. Медленные операции (например, split или вызов функции) при каждом сравнении тормозят работу программы.

К счастью, проблема решается однократным выполнением операции для каждого элемента перед сортировкой. Воспользуйтесь тар для сохранения результатов операции в массиве, элементы которого являются анонимными массивами с исходным и вычисленным полем. Этот «массив массивов» сортируется по предварительно вычисленному полю, после чего тар используется для получения отсортированных исходных данных. Концепция map/sort/map применяется часто и с пользой, поэтому ее стоит рассмотреть более подробно.

Применим ее к примеру с сортировкой по длине строки:

@temp = map { [ length $_, $_ ] } ©strings;

@temp = sort { $a->[0] <=> $b->[0] } @temp：

©sorted = map {$_->[l]} @temp；

В первой строке map создает временный массив строк с их длинами. Вторая строка сортирует временный массив, сравнивая их предварительно вычисленные длины. Третья строка превращает временный массив строк/длин в отсортированный массив строк. Таким образом длина каждой строки вычисляется всего один раз.

Поскольку входные данные каждой строки представляют собой выходные данные предыдущей строки (массив ©temp, созданный в строке 1, передается sort в строке 2, а результат сортировки передается тар в строке 3), их можно объединить в одну команду и отказаться от временного массива:

©sorted = map { $_->[1] }

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+)/ в списковом контексте.

Из этого фрагмента можно убрать временные массивы. Программа принимает следующий вид:

@sorted_fields = шар { $_->[1] }

sort { $а->[0] <=> $Ь->[0] } map { [ /(\d+)/, $_ ] } ©fields；

В последнем примере выполняется компактная сортировка данных, разделенных запятыми (они взяты из файла Unix passwd). Сначала выполняется числовая сортировка файла по четвертому полю (идентификатору группы), затем — числовая сортировка по третьему полю (идентификатору пользователя) и алфавитная сортировка по первому полю (имени пользователя).

print map {

$_->L0] }

# Целая строка

sort {

$b->[l]

# Идентификатор группы

II

$d・>[2] <=>

$b->[2]

# Идентификатор пользователя

II

$a->[3] cmp

$b->[3]

# Имя пользователя

}

map {

[$_, (split /:/)[3,2,0]

]}

'cat /etc/passwd':

См. также

Описание функции sort в perlfunc(i); описание операторов стр и <=> в perlop(l); рецепт 4.15.

Реализация циклических списков

Проблема

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

Решение

Воспользуйтесь функциями unshift и pop (или push и shift) для обычного массива.

unsh1ft(@circular, pop(@circular)); # Последний становится первым push (©circular, shift(@circular))： # И наоборот

Комментарий

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

Вместо этого мы просто перемещаем последний элемент на первую позицию и наоборот.

sub grab_and_rotate (\@ ) {

my $Tlstref = shift:

my $element = $11stref->L0]: push(@listref, shift @$listref)； 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.

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

Проблема

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

Решение

Воспользуйтесь функцией shuffle стандартного модуля List: :Ut1L Функция возвращает элементы входного списка, переставленные в случайном порядке:

use List:：Ut11 qw(shuffle):

@array = shuffle(@array):

Комментарий

HE ДЕЛАЙТЕ TAK!Выбрать случайный элементПереставитьHE ДЕЛАЙТЕ TAK!Выбрать случайный элементПереставитьСлучайные перестановки на удивление коварны. Написать плохую программу перестановки очень просто:

HE ДЕЛАЙТЕ TAK!

Выбрать случайный элемент

Переставить

HE ДЕЛАЙТЕ TAK!

Выбрать случайный элемент

Переставить

sub naive_shuffle {

for (my $i = 0; $i < @_; $1++) { my $j = int rand @_；

($」$U, $」$j]) =-($」$〃 $」$U);

}

}

Такой алгоритм является смещенным — одни перестановки имеют большую вероятность, чем другие. Это нетрудно доказать: предположим, мы получили список из 3 элементов. Мы генерируем 3 случайных числа, каждое из которых может принимать 3 возможных значения — итого 27 возможных комбинаций. Однако для списка из трех элементов существует всего 6 перестановок. Поскольку 27 не делится на 6, некоторые перестановки появляются с большей вероятностью, чем другие.

Функция shuffle модуля List::Util решает эту проблему и генерирует перестановки с более равномерным распределением.

Простая выборка одного случайного элемента из массива производится так: $value = $array[ int(rand(@array))]：

См. также

Описание функции rand в perlfunc(l). Дополнительная информация о случайных числах приведена в рецептах 2.6, 2.7 и 2.8. В рецепте 4.20 показан другой способ построения случайных перестановок.

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

vi

chown

echo

In

more

rm

SU

В примере 4.2 показано, как это делается.

Пример 4.2. words

#!/usr/bin/perl -w

words - вывод данных по столбцам

use strict；

my ($1tem, $cols, $rows, $maxlen)； my ($xpixel, $ypixel, $mask, @data)；

getwinsizeO:

Получить все строки входных данных

и запомнить максимальную длину строки

$maxlen = 1：

while (<>) {

my $mylen;

s八s+$//;

$maxlen = $mylen if (($mylen = length) > $maxlen)：

push(@data. $_)：

$maxlen += 1；# Дополнительный пробел

Определить границы экрана

$cols = 1nt($cols / $maxlen) || 1：

$rows = 1nt(($#data+$cols) / $cols)：

Задать маску для ускорения вычислений

$mask = sprintf("跋-%ds ", $maxlen-l)：

Подпрограмма для обнаружения последнего элемента строки

sub EOL { ($1tem+l) % $cols == 0 }

Обработать каждый элемент, выбирая нужный фрагмент

на основании позиции

for ($1tem = 0: $1tem < $rows * $cols； $item++) {

my $target = ($1tem % $cols) * $rows + 1nt($1tem/$cols)：

my $piece = sprintf($mask, $target < @data ? $data[$target]："")； $piece =~ s/\s+$// if EOL(): # Последний элемент не выравнивать print $piece；

print "Xn" If EOLO；

Завершить при необходимости print "\n" if EOLO；

He переносится -- только для Linux sub getwlnsize {

my $winsize = "\0" x 8;

my $TIOCGWINSZ = 0x40087468:

If (loctl(STDOUT. $TIOCGWINSZ. $winsize)) {

($rows, $cols, $xpixel. $ypixel) = unpack('S4', $winsize):

} else {

$cols = 80;

}

}

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

Программа words представляет собой фильтр, который генерирует выходные данные по столбцам. Она читает все входные данные и запоминает максимальную длину строки. После того как все данные будут прочитаны, ширина экрана делится на длину самой большой входной записи — результат равен ожидаемому количеству столбцов.

Затем программа входит в цикл, который выполняется для каждой входной записи. Однако порядок вывода неочевиден. Предположим, имеется список из девяти элементов:

Неправильно Правильно

1 23147

4 56258

7 89369

Программа words производит все необходимые вычисления, чтобы элементы (1,4,7) выводились в одной строке, (2,5,8) — в другой и (3,6,9) — в последней строке.

Текущие размеры окна определяются вызовом ioctl. Этот вариант прекрасно работает — в той системе, для которой он был написан. В любой другой он не подойдет. Если в вашей системе он работает — считайте, вам повезло. В рецепте 12.17 показано, как определить размер окна в вашей системе с помощью файла ioctl .pch или программы на С. Решение из рецепта 15.4 более универсально, однако вам придется установить модуль с CPAN.

См. также

Рецепт 15.4.

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

2

6

24

120

6

720

7

5040

8

40320

9

362880

10

3628800

11

39916800

12

479001600

13

6227020800

14

87178291200

15

1307674368000

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

use Math：：B1gInt;

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 (@1terns) j

print "@perms\n"；

} else {

my(@newiterns,@newpe rms,$ i);

foreach $i (0 .. $#iterns) {

@newiterns = @iterns：

©newperms = @perms;

unshift(@newperms, splice(@newiterns, $1, D);

permute(\@newitems]. \@newperms])；

}}}

}

}

}

Решение из примера 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_perniute： перестановка всех введенных слов use strict:

sub factorial($)；# Опережающее объявление прототипа

while (<>) {

my ©data = split：

my $num_permutations = factorial(scalar ©data);

for (my $1=0; $1 < $num_permutations： $i++) {

my ^permutation = @data[n2perm($i, $#data)];

print "©permutation\n"；

Вспомогательная функция： факториал с запоминанием BEGIN {

my ©fact = (1):

sub factorial($) {

my $n = shift；

return $fact[$n] if defined $fact[$n]；

$fact[$n] = $n * factorial($n - 1)；

n2pat($N. $len) : построить $Nd шаблон перестановки длины $1еп sub n2pat {

my $i = 1;

my $N = shift:

my $len = shift;

my ©pat;

while ($i <= $len + 1) {# На самом деле просто while ($N) {...

push ©pat. $N % $1：

$N = 1nt($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{\\, описания замыканий (closures) в perlsub(l) и perlref(l); рецепт 2.6; рецепт 10.3.

Хэш и

«Выполнять линейный просмотр в ассоциативном массиве — все равно, что пытаться забить кого-нибудь до смерти заряженным ,,Узи“》.

Ларри Уолл

5.0. Введение

Как люди, так и части компьютерных программ взаимодействуют между собой самым причудливым образом. Отдельные скалярные переменные похожи на отшельников, ведущих замкнутое существование в рамках собственной личности. Массив напоминает партию, где множество индивидуумов объединяется под именем харизматического предводителя. Где-то между ними расположилась удобная ниша, в которой обитают совокупности связей «один-к-одному» — хэши (в старой документации по Perl хэши часто назывались ассоциативными массивами, но термин получается слишком длинным). Аналогичные структуры данных существуют и в других языках, где они обозначаются другими терминами — хэш-таблицы, таблицы, словари, отображения и даже a-списки, в зависимости от языка.

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

Однако у хэшей есть свои преимущества. В Perl хэш является встроенным типом данных. Благодаря применению хэшей многие сложные алгоритмы сводятся к простой выборке значений. Кроме того, хэши предоставляют быстрые и удобные средства для построения индексов и таблиц просмотра.

Префикс % относится лишь к ссылкам на хэш в целом (например, %boss). Значение, ассоциированное с заданным ключом, представляет собой скалярную величину, поэтому для него используется символ $ (по аналогии с тем, как для ссылок на отдельный элемент массива используется префикс $). Следовательно, отношение «начальник Ната» должно записываться в виде $boss{"Nat"}. Ему можно присвоить значение "Tim":

$boss{"Nat"} = "Tim"；

Имена хэшей часто выбираются по названию отношения, которое в нем хранится. Возможно, знак $ в предыдущем примере вас удивит, поскольку мы вроде

бы работаем с хэшем, а не со скаляром. Но в данном случае речь идет о задании отдельного скалярного значения в хэше, поэтому мы используем признак скалярной величины $. Скалярные величины обозначаются префиксом $, массивы — префиксом @, а для хэшей используется префикс %.

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

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

gge = ( "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}. Приведенная выше инициализация 奸ood_color записывается в следующем виде:

%food_color =(

Apple => "red".

Banana => "yellow", Lemon => "yellow". Carrot => "orange" ):

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

См. также

Страница руководства perldata(l).

Занесение элемента в хэш

Проблема

Требуется добавить в хэш новый элемент.

Решение

Присвойте нужное значение в формате:

ШШ[гШЧ} = ОЗНАЧЕНИЕ:

Комментарий

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

# Хэш Kood_color определяется во Введении

$food_color^Raspberry} = "pink"：

print "Known foods:\n"；

foreach $food (keys 肝ood_color) {

print "$food\n"：

}

Known foods：

Banana

Apple

Raspberry

Carrot

Lemon

Если требуется не заменять существующее значение, а как-то связать с существующим ключом несколько значений, обращайтесь к рецептам 5.8 и 11.2.

См. также

Раздел «List Value Constructors» perldata(i); рецепт 5.2.

Проверка наличия ключа в хэше

Проблема

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

Решение

Воспользуйтесь функцией exists:

# Содержит ли ИЭШ ключ $КЛЮЧ?

if (exists($X3W{$OT4})) {

Ключ существует

} else {

Ключ не существует

Комментарий

В следующем фрагменте функция exists проверяет, присутствует ли ключ в хэше 奸ood_color:

# Хэш Uood_color определяется во Введении foreach $name ("Banana". "Martini") { if (exists $food_color{$name}) {

print "$name Is a foodAn"；

} else {

print "$name Is a drink.\n"；

} }

Banana is a food.

Martini is a drink.

Функция exi sts проверяет только наличие ключа в хэше. Она не сообщает об ассоциированном значении, определено ли оно, истинно или ложно. На первый взгляд кажется, что отличия несущественны, но в действительности проблемы такого рода плодятся быстро, как кролики. Возьмем следующий фрагмент:

%dge = О：

$age{"Toddler"} = 3：

$age{"Unborn"} = 0;

$age{"Phantasm"} = undef：

foreach Sthlng ("Toddler", "Unborn", "Phantasm", "Relic"} {

print "Sthlng："；

print "Exists " if exists $age{$thing}；

print "Defined "if defined $age{thing}：

print "True " If $age{$thing}；

print "\n"：

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{"Rel1c"} не проходит ни одной из проверок. Значение для "Relic" не заносилось в хэш, поэтому проверка на существование завершается неудачей. Из-за отсутствия ассоциированного значения попытка обратиться к $age{"Relic"} дает undef. Как мы знаем из примера с "Phantasm", undef не проходит проверки определенности и истинности.

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

^паше =()； while (<>) {

chomp：

next if $name{$_}:# НЕВЕРНО !

$name{$_} = -s $_：

}""

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

next if exists $name{$_}；

См. также

Описание функций exists и defined в perlfunc(l). Концепция истинности рассматривается в разделе «Scalar Values» perldata(l).

Создание хэша с неизменяемыми ключами или значениями

Проблема

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

Решение

Воспользуйтесь соответствующими функциями стандартного модуля Hash: :lltil:

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

Функция lock_keys не ограничивает доступ к значениям, ассоциированным с заблокированными ключами. Чтобы значения в хэше были доступны только для чтения, следует воспользоваться функцией lock_vdlue. Хэш также может содержать заблокированные ключи, но это не обязательно, если все, что вам требуется, —запретить модификацию одного или нескольких значений,

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

См. также

Документация модуля Hash: :Ut1l.

Удаление из хэша

Проблема

Требуется удалить элемент из хэша, чтобы он не опознавался функциями keys, values или each. Например, если в хэше имена работников ассоциируются с окладами, то после увольнения работника необходимо удалить его строку из хэша.

Решение

Воспользуйтесь функцией delete:

Удалить $КЛЮЧ и ассоциированное значение из хэша %ХЭШ delete($«{$OT4})：

Комментарий

Многие ошибочно пытаются удалять элементы из хэша с помощью 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 "InltiallyAn"； print_foods()；

print "\nWith Banana undef\n"；

undef $food_color{"Banana"}:

print-foods,):

print "\nW1th Banana deleted\n":

delete $food_color{"Banana"}:

print_foods(y；

Initially:

Keys： Banana Apple Carrot Lemon

Values： yel1ow red orange yel1ow

With Banana undef

Keys： Banana Apple Carrot Lemon

Values： (undef) red orange yel1ow

With Banana deleted

Keys： Apple Carrot Lemon

Values： red orange yel1ow

Как видите, после присваивания $food_color{"Banana"} = undef ключ "Banana" остается в хэше. Элемент не удаляется; просто мы присвоили ему undef. Тем не менее функция delete действительно удалила данные из хэша — ключ "Banana" исчезает из списка, возвращаемого функцией keys.

Функция delete также может вызываться для среза хэша, это приводит к удалению всех указанных ключей:

delete @food_color{"Banana", "Apple", "Cabbage"}:

См. также

Описание функций delete и keys в рег1/ипс(1). Применение keys продемонстрировано в рецепте 5.5.

Перебор хэша

Проблема

Требуется выполнить некоторые действия с каждым элементом (то есть парой «ключ/значение») хэша.

Решение

Воспользуйтесь функцией each в цикле while:

while(($key, $value) = each(^HASH)) {

Сделать что-то с $key и $value

}

Если хэш не очень велик, можно вызвать keys в цикле foreach:

foreach $key (keys 相ASH) {

$value = $HASH{$key}:

Сделать что-то c $key и $value

Комментарий

Следующий простой пример перебирает элементы хэша %food_color из Введения:

Хзш %food_color определяется во Введении

while(($food, $color) = edch(%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}An".

При каждом вызове each для одного и того же хэша функция возвращает «следующую» пару «ключ/значение». Слово «следующую» взято в кавычки, потому что пары возвращаются в порядке, соответствующем внутренней структуре хэша, и этот порядок почти никогда не совпадает с числовым или алфавитным. За последним элементом each возвращает пустой список О; результат интерпретируется как ложный, и цикл while завершается.

В примере с foreach использована функция keys, которая строит список всех ключей из хэша еще перед началом выполнения цикла. Преимущество each заключается в том, что пары «ключ/значение» извлекаются по одной. Если хэш содержит много ключей, отказ от предварительного построения полного списка существенно экономит память и время. Однако функция each не позволяет управлять порядком обработки пар.

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

foreach $food (sort keys %food_color) {

print "$food Is $food_color{$food}An"；

}~

Apple is red.

Banana is yellow.

Carrot is orange.

Lemon is yellow.

Подобное применение foreach встречается довольно часто. Функция keys строит список ключей в хэше, после чего foreach перебирает их. Если хэш состо-

ит из большого числа элементов, возникает опасность, что возвращаемый keys список займет много памяти. Таким образом, приходится выбирать между затратами памяти и возможностью обработки элементов в определенном порядке. Сортировка подробнее рассматривается в рецепте 5.10.

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

while ( ($k,$v) = each 奸ood_color) {

print "Processing $k\n"；

keys ^food_color:# Возврат к началу ^food_color

} 一一

Модификация хэша во время его перебора в each или foreach, как правило, сопряжена с опасностью. При добавлении или удалении ключей из хэша функция each ведет себя по-разному для связанных и несвязанных хэшей. Цикл foreach перебирает заранее построенный список ключей, поэтому после начала цикла он ничего не знает о добавленных или удаленных ключах. Ключи, добавленные внутри цикла, не включаются автоматически в список перебираемых ключей, а удаленные внутри цикла ключи не удаляются из этого списка.

Программа countfrom из примера 5.1 читает файл почтового ящика и выводит количество сообщений от каждого отправителя. Отправитель определяется по строке From: (в этом отношении сценарий не очень интеллектуален, однако нас сейчас интересуют операции с хэшами, а не обработка почтовых файлов). Передайте имя почтового ящика в командной строке или используйте "-" для перенаправления (когда Perl открывает файл с именем "-" для чтения с менее чем тремя аргументами, используется текущий стандартный ввод).

Пример 5.1. countfrom

#!/usr/bin/perl

countfrom - подсчет сообщений от каждого отправителя

$filename = $ARGV[O] || "-":# означает стандартный ввод

open(FILE, "< $filename")or die "Can't open $filename : $!":

while(<FILE>) {

if (/人From： (.*)/) { $from{$l}++ }

}

foreach $person (sort keys 奸rom) { print "$person： $from{$person}\n"：

}

См. также

Описание функций each и keys в perlfunc(i)\ описание циклов for и foreach в рецепте 4.6.

5-6- Вывод содержимого хэша

Проблема

Требуется вывести содержимое хэша, однако конструкции print "%hdsh" и print %hdsh не работают. Первая является обычным литералом, а вторая просто выводит подряд все ключи и значения.

Решение

Одно из возможных решений — перебрать все пары «ключ/значение» в хэше (см. рецепт 5.5) и вывести их:

while ( ($k,$v) = each Zhash) {

print "$k => $v\n":

}

Также можно построить список строк с помощью тар:

print тар { "$_ => $hash{$_}\n" } keys Zhash；

Или воспользуйтесь приемом из рецепта 1.15 и интерполируйте хэш как список: print "@{[ Zhash ]}\п"；

Или сохраните хэш во временном массиве и выведите его:

my @temp = Zhash； print "@temp"；

}

Комментарий

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

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

foreach $k (sort keys Zhash) { print "$k => $hash{$k}\n"；

}

Функция map не уступает перебору по богатству возможностей. Сортировка ключей по-прежнему позволяет работать с элементами в произвольном порядке. Выходные данные можно как угодно форматировать. На этот раз создается список строк (например, "КЛЮЧ=>ЗНАЧЕНИЕ\г]'\ как в приведенном выше примере), передаваемый print.

Два последних приема представляют собой фокусы из области интерполяции. Интерпретация хэша как списка не позволяет предсказать или управлять поряд-

ком вывода пар «ключ/значение». Более того, данные в этом случае выводятся в виде списка ключей и значений, элементы которого разделяются текущим содержимым переменной $". В отличие от других приемов, вам не удастся вывести каждую пару на новой строке или отделить ключи от значений символом =>.

Другое решение основано на выводе хэша в списковом контексте после временной локализации переменной $, и ее инициализации пробелом:

{

local $.=""； print ^hash； }

Этот вариант напоминает решение с копированием в массив и его последующей интерполяцией, но при нем содержимое хэша не дублируется вдвое чаще необходимого (сначала для массива, потом для строки).

Модуль Dumpvalue, описанный в рецепте 11.11, помогает получить красиво оформленные выходные данные, а также делает многое другое. Пример:

use Dumpvdlue;

$dumper = Dumpvalue->new；

$dumper->dumpValue(\^food_color)；

'Apple' => 'red'

'Banana' => 'yel1ow'

'Carrot' => 'orange'

'Lemon' => 'yellow'

См. также

Описание переменных $" и $, в perlvar(l); описание функций foreach, map, keys, sort и each вperlfunc^i). Интерполяция в строках рассматривается в рецепте 1.15, а методика перебора хэша — в рецепте 5.5.

57 Перебор элементов хэша

в порядке вставки

Проблема

Функции keys и each извлекают элементы хэша в довольно странном порядке. Вы хотите получить элементы в том порядке, в котором они заносились в хэш.

Решение

Воспользуйтесь модулем Tie： ： IxHash.

use Tie：:IxHash；

tie ИЭШ. "Tie：:IxHash"：

Операции с хзшем ^ХЭШ

©keys = keys ^ХЭШ;# Массив ©keys отсортирован в порядке вставки

Комментарий

Модуль Tie：: IxHash заставляет функции keys, each и values возвращать элементы в порядке занесения в хэш. Это часто избавляет от необходимости заранее обрабатывать ключи хэша какой-нибудь сложной сортировкой или поддерживать отдельный массив, содержащий ключи в порядке их вставки.

Tie：: IxHash также представляет объектно-ориентированный интерфейс к функциям splice, push, pop, shift, unshift, keys, values и delete, а также многим другим.

Следующий пример демонстрирует использование функций keys и each:

Инициализация use Tie::IxHash：

tie %food_color, "Tie::IxHas";

$food_col or{Banana} = "Yellow"：

$food_color{Apple} = "Green"：

$food_col or{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.

Хэши с несколькими ассоциированными значениями

Проблема

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

Решение

Сохраните в $hash{$key} ссылку на массив, затем сохраните значения в массиве.

Комментарий

В хэше могут храниться только скалярные величины. Однако ссылки являются скалярными величинами. Таким образом, проблема решается сохранением в $hash{$key} ссылки на массив со значениями, ассоциированными с ключом $кеу. Обычные операции с хэшами — вставка, удаление, перебор и проверка существования —переписываются для операций с массивами (push, splice и foreach).

Следующий фрагмент демонстрирует простую вставку в хэш. Он обрабатывает выходные данные команды who(l) на компьютере с Unix и выводит краткий список пользователей с терминалами, на которых они зарегистрированы:

%ttys = О；

open(WHO, "who|")or die "can't open who： $!":

while (<WHO>) {

($user. $tty) = split;

push( @{$ttys{$user}}, $tty )：

}

foreach $user (sort keys 紀tys) { print "$user： @{$ttys{$user}}\n"：

}

Вся суть этого фрагмента заключена в строке push, где содержится версия $ttys{$user} = $tty для многозначного хэша. Изначально ассоциированное значение не определено, поэтому Perl автоматически создает новый анонимный массив и сохраняет ссылку на него в значении, чтобы вызов push завершился успешно.

Все имена терминалов интерполируются конструкцией @{$ttys{user}} в строке print. Если бы, например, нам потребовалось вывести владельца каждого терминала, мы бы организовали перебор анонимного массива:

foreach $user (sort keys 統tys) {

print "$user： ", scalar( @{$ttys{$user}} ). "ttysAn"；

foreach $tty (sort @{$ttys{$user}}) {

©stat = stat('7dev/$tty");

$user = ©stat ? ( getpwuid($stat[4]) )[0] ： "(not available)";

print "\t$tty (owned by $user)\n"：

}

}

Функция exists может иметь две интерпретации: «Существует ли в хэше хотя бы одно значение для данного ключа?» и «Существует ли данное значение для данного ключа?». Чтобы реализовать вторую интерпретацию, придется просмотреть массив в поисках нужной величины. Первая трактовка exi sts косвенно связана с функцией delete: если мы можем гарантировать, что ни один анонимный массив никогда не остается пустым, можно воспользоваться встроенной функцией exists. Чтобы убедиться, что анонимные массивы не остаются пустыми, их следует проверять после удаления элемента:

sub multihash_delete {

my {$hash, $key, $vdlue) = @_;

my $1 ；

return unless ref( $hash->{$key}):

for ($1 = 0: $1 < @{ $hash->{$key} }: $i++) {

If ($hdsh->{$key}->[$i] eq $value) {

splice( @{$hash->{$key}}. $1, 1);

last；

}

}

delete $hash->{$key} unless @{$hash->{$key}};

}

Альтернативная реализация многозначных хэшей приведена в главе 13 «Классы, объекты и связи», где они реализуются как связанные обычные хэши.

См. также

Описание функций splice, delete, push, foreach и exists вperlfunc(i); рецепт 11.1.

Связи рассматриваются в рецепте 13.15.

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

Проблема

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

Решение

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

ZX3W связывает ключи со значениями

%ОБРАТНЫЙ = reverse 默3勿；

Комментарий

В этом решении используется списковая эквивалентность хэшей, о которой упоминалось во Введении. В списковом контексте reverse интерпретирует %ХЭШ как список и меняет местами составляющие его элементы. Одно из важнейших свойств списковой интерпретации хэша заключается в том, что элементы списка представляют собой пары «ключ/значение». После инвертирования такого списка первым элементом становится значение, а вторым — ключ. Если интерпретировать такой список как хэш, то его значения будут являться ключами исходного хэша, и наоборот.

Рассмотрим пример:

^surname = ( "Mickey" => "Mantle", "Babe" => "Ruth")；

%first_name = reverse ^surname：

print $f1rst_name{"Mantie", "\n"：

Mickey

Если интерпретировать %sunwe как список, мы получим следующее: ("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 - поиск продуктов по названию или цвету

"Apple" "Banana "Lemon" "Carrot"Apple" "Banana "Lemon" "Carrot"red"."red".$g1ven = shift QARGV or die "usage： foodfind food_or_color\n"： ^color =(

"Apple" "Banana "Lemon" "Carrot

"Apple" "Banana "Lemon" "Carrot

"red".

"red".

%food = reverse Zcolor：If (exists $color{$given}) {%food = reverse Zcolor：If (exists $color{$given}) {"yellow", "yellow", "orange"

%food = reverse Zcolor：

If (exists $color{$given}) {

%food = reverse Zcolor：

If (exists $color{$given}) {

print "$given Is a food with color $color{$given}An"；

If (exists $food{$g1ven}) {

print "$food{$given} Is a food with color $g1ven.\n"；

Если два ключа исходного хэша имеют одинаковые значения ("Lemon" и "Banana" в предыдущем примере), то инвертированный хэш будет содержать лишь один из них (какой именно — зависит от порядка хэширования, поэтому какие-либо предсказания невозможны). Дело в том, что хэши в Perl по определению имеют уникальные ключи.

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

Хзш %food_color определяется во Введении while (($food,$color) = each(%food_color)) { push(@{foods_with_color{$colory}, $food);

}" 一

print "@{$foods_with_color{yellow}} were yellow foods.n"；

Banana Lemon were yellow foods.

Кроме того, это позволит модифицировать программу foodfind так, чтобы она работала с цветами, соответствующими сразу нескольким продуктам. Например, при вызове foodfind yellow будут выводиться и Banana, и Lemon.

Если какие-либо значения исходного хэша были не простыми строками и числами, а ссылками, при инвертировании возникает проблема — ссылки не могут использоваться в качестве ключей, если только вы не воспользуетесь модулем Tie： :RefHash (см. рецепт 5.12).

См. также

Описание функций reverse в perlfunc⑴;рецепт 13.15.

Сортировка хэша

Проблема

Требуется работать с элементами хэша в определенном порядке.

Решение

Воспользуйтесь функцией keys для построения списка ключей, а затем отсортируйте их в нужном порядке:

Zhash - сортируемый хзш

©keys = sort { criterionO } (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)An"：

}"

Другой фрагмент сортирует ключи по ассоциированным значениям:

foreach $food (sort { $food_color{$a} cmp $food_color{$b} }) keys %food_color) {

print "$food Is $food_color{$food}An"；

Наконец, сортировка выполняется по длине ассоциированных значений:

©foods = sort {

1 ength($food_color{$a}) <=> 1ength($food_color{$b})

} keys 奸ood_color;

foreach $food (@foods5 {

print "$food Is $food_color{$food}.\n"：

}_

См. также

Описание функций sort и keys в perlfunc(l)} рецепт 5.7. Сортировка списков рассматривается в рецепте 4.16.

Объединение хэшей

Проблема

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

Решение

Интерпретируйте хэши как списки и объедините их так, как это делается со списками:

Emerged = (%А, %В)；

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

Emerged = О；

while ( ($k,$v) = each(^A) ) {

$merged{$k} = $v;

}

while ( ($k,$v) = each(%B) ) { $merged{$k} = $v：

}

Комментарий

В первом варианте, как и в предыдущем рецепте инвертирования хэшей, используется списковая эквивалентность, о которой говорилось во Введении. Конструкция (%А, %В) интерпретируется как список пар «ключ/значение». Когда список присваивается объединенному хэшу Emerged, Perl преобразует список пар снова в хэш.

Рассмотрим, как эта методика реализуется на практике:

Хзш %food_color определяется во Введении

%drink_color = ( Galliano => "yellow",

"Mal Tai" => "blue")；

%1ngested_colors = (%drink_color. %food_color)：

Ключи обоих входных хэшей встречаются в выходном не более одного раза. Если в хэшах найдутся совпадающие ключи, в итоговый хэш включается тот ключ, который встретился последним.

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

С применением each первый фрагмент записывается следующим образом:

# Хэш %food_color определяется во Введении

^drink_color = ( Galliano => "yellow",

"Mai Tai" => "blue"):

^substance_color =()；

while (($k： $v) = each Xfood_color) {

$substance_co1or{$k} = $v：

}~

while (($k, $v) = each %drink_color) { $substance_color{$k} = $v；

}~

В этом решении дублируются циклы while с присваиванием. Следующий обходной путь позволяет избавиться от дублирования:

foreach $substanceref (\^food_color, \^drink_color ) {

while (($k. $v) = each Xsubstanceref) { $substance_color{$k} = $v；

}~

}

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

foreach $substanceref (\^food_color, \^drink_color ) {

while (($k, $v) = each ^substanceref) { if (exists $substance_color{$k}) { print "Warning： $k seen twice. Using the first definition.\n"； next;

}

$substance_color{$k} = $v；

}~

}

В частном случае присоединения одного хэша к другому можно воспользоваться срезом для получения более элегантной записи:

©all_colors{keys %new_colors} = values %new_colors；

Данное решение требует памяти в объеме, достаточном для хранения списков всех ключей и значений %new_colors. Как и в первом варианте, расходы памяти при очень большом размере списков могут сделать этот способ неприемлемым.

См. также

Рецепт 4.10 (разновидностью которого является этот рецепт); описание функции each в perlfunc(i).

Поиск общих или различающихся ключей в двух хэшах

Проблема

Требуется найти в хэше ключи, присутствующие в другом хэше или, наоборот, не входящие в другой хэш.

Решение

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

О Поиск общих ключей:

my ©common =():

foreach (keys Xhashl) {

push(©common, $_) if exists $hash2{$_}；

}--

# ©common содержит общие ключи

О Поиск ключей, отсутствующих в другом хэше:

my 0thi s_not_that = О：

foreach 7keys Xhashl) { push(@this_not_that, $_) unless exists $hash2{$_}：

Комментарий

При поиске общих или различающихся ключей хэшей можно воспользоваться рецептами для поиска общих или различающихся элементов в массивах ключей хэшей. За подробностями обращайтесь к рецепту 4.8.

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

Хэш %food_color определяется во Введении

Xcitrus_color - хэш. связывающий названия цитрусовых с их цветом

^citrus_color = (Lemon => "yellow",

Orange => "orange", Lime => "green")；

Построить список продуктов, не входящих в хзш цитрусовых @non-citrus =();

foreach (keys Xfood_color) {

push (@non_citrus. $_) unless exists $citrus_color{$_};

См. также

Описание функции each в perlfunc(i). Срезы хэшей рассматриваются в perldata(i).

5-13- Хэширование ссылок

Проблема

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

Решение

Воспользуйтесь модулем Tie： :RefHash:

use Tie:：RefHash；

tie ^hash, "Tie:：RefHash"；

Теперь в качестве ключей хэша %hash можно использовать ссылки

Комментарий

Ключи хэшей автоматически преобразуются в строки — то есть интерпретируются так, словно они заключены в кавычки. Для чисел и строк при этом ничего не теряется. Однако со ссылками дело обстоит иначе.

После преобразования в строку ссылка принимает следующий вид:

Class：:Somewhere=HASH(0x72048)

ARRAY(0x72048)

Преобразованную ссылку невозможно вернуть к прежнему виду, поскольку она перестала быть ссылкой и превратилась в обычную строку. Следовательно, при использовании ссылок в качестве ключей хэша они теряют свои «волшебные свойства».

Для решения этой проблемы обычно создается специальный хэш, ключами которого являются ссылки, преобразованные в строки, а значениями — настоящие ссылки. Именно это и происходит в модуле Tie：:RefHdsh. Мы воспользуемся объектами ввода/вывода для работы с файловыми манипуляторами и покажем, что даже такие странные ссылки могут использоваться для индексации хэша, связанного с Tie: :RefHash.

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

use Tie：:RefHash；

use 10::File;

tie ^name, "Tie：:RefHash"：

foreach $filename ("/etc/termcap","/vmunix", "/bin/cat") {

$fh = 10::File->("< $f11 ename") or next:

$name{$fh} = $f11 ename；

}

print "open files： ", join(", values ^name", "\n"： foreach $file (keys 初ame) {

seek($file, 0, 2):# Позиционирование в конец файла

р门ntf("%s is %d bytes longAn", $name{$file}, tell ($file));

Однако вместо применения объекта в качестве ключа хэша почти всегда лучше использовать какой-нибудь уникальный атрибут объекта (например, имя или идентификатор).

См. также

Документация по стандартному модулю Т1е：:RefHdsh; раздел «Warning» perlref(l),

5-14. Предварительное выделение памяти для хэша

Проблема

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

Решение

Присвойте количество пар «ключ/значение» конструкции keys(^hash):

Выделить в хэше %hash память для $num элементов. keys(Xhash) = $num；

Комментарий

Эта возможность может положительно повлиять на быстродействие вашей программы (хотя это и не гарантировано). В хэшах Perl и так применяются общие ключи, поэтому при наличии хэша с ключом "Apple" Perl уже не выделяет память под другую копию "Apple" при включении этого ключа в другой хэш.

В %users резервируется место для 512 элементов. keys(^users) = 512;

Внутренние структуры данных Perl требуют, чтобы количество ключей было равно степени 2. Если написать:

keys(%users) = 1000;

Perl выделит для хэша 1024 «гнезда». Количество ключей не всегда равно количеству гнезд. Совпадение обеспечивает оптимальное быстродействие, однако конкретное соответствие между ключами и гнездами зависит от ключей и внутреннего алгоритма хэширования Perl.

См. также

Описание функции keys в perlfunc(i); рецепт 4.3.

5-15. Поиск самых распространенных значений

Проблема

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

Решение

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

%count =();

foreach $element (©array) { $count{$element}++;

}

Комментарий

Каждый раз, когда возникает задача подсчета различных объектов, вероятно, стоит воспользоваться хэшем. В приведенном выше цикле foreach для каждого экземпляра $el ement значение $count{$element} увеличивается на 1.

См. также

Рецепты 4.7 и 4.8.

5-16- Представление отношений между данными

Проблема

Требуется представить отношения между данными, например, отношения «пре- док/потомок^ в генеалогическом дереве или ^родительский/пороэ/сденный процесса в таблице процессов. Задача тесно связана с представлением таблиц в реляционных базах данных (отношения между записями) и графов в компьютерных технологиях (отношения между узлами графа).

Решение

Воспользуйтесь хэшем.

Комментарий

Следующий хэш представляет часть генеалогического дерева из Библии:

^father =(

：'Cain'

=>

'Adam'.

'Abel'

=>

'Adam'.

'Seth'

=>

'Adam',

'Enoch'

=>

'Cain',

1 lead'

=>

'Enoch',

'Mehujael1

=>

'Irad',

'Methusael1

=>

'Mehujael1,

'Lamech'

=>

'Methusael'

'JabaT

=>

'Lamech'.

'Jubal1

=>

1Lamech1,

'Tubalcain'

=>

'Lamech',

'Enos'

=>

'Seth')：

Например, мы можем легко построить генеалогическое дерево любого персонажа: while (<>) { chomp： do {

print "$_ "：# Вывести текущее имя

$_ = $father{$_}： # Присвоить $_ отца $_

} while defined; # Пока отцы находятся print "\п"：

}

Просматривая хэш Zfdther, можно отвечать на вопросы типа: «Кто родил Сета?» При инвертировании хэша отношение заменяется противоположным. Это позволяет использовать рецепт 5.9 для ответов на вопросы типа: «Кого родил Ламех?» while ( ($k, $v) = each ^father ) { push( @{ $children{$v} }, $k )：

$"=','；# Выходные данные разделяются запятыми

while (<>) {

chomp：

if ($children{$_}) {

©children = @{$children{$_}}：

} else {

©children = "nobody":

}

print "$_ begat (^children.\n"：

}_

Хэши также могут представлять такие отношения, как директива #1 nclude языка С — А включает В, если А содержит #1nclude В. Следующий фрагмент строит хэш (он не проверяет наличие файлов в /usr/1nclude, как следовало бы, но этого можно добиться ценой минимальных изменений):

foreach $file (©files) {

local *FH:

unless (open (F. "< $file")) {

warn "Couldn't read file： $!: skipping.\n"；

next；

while (<FH>) {

next unless L\s*#\s*inc1ude\s*<(「>]+)>/;

push(@{$includes{$l}}, $file):

}

close FH：

}

Другой фрагмент проверяет, какие файлы не включают других файлов:

@1nclude_free = О； # Список файлов, не включающих других файлов

@uniq{map { @$_ } values ^includes} = undef:

foreach $file 《sort keys %uniq) {

push( @include_free , $file ) unless $includes{$file}；

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

См. также

Рецепт 4.7; описание более сложных структур данных в рецептах 11.9-11.14.

5.17. Программа: dutree

Программа dutree (см. пример 5.3) преобразует выходные данные du:

% du cookbook

19pcb/fix

20pcb/rev/maybe/yes

10pcb/rev/maybe/not

705pcb/rev/maybe

54pcb/rev/web

1371pcb/rev

3pcb/pending/mine

1016pcb/pending

2412pcb

в отсортированную иерархическую структуру с расставленными отступами:

2412 pcb2412 pcb1371 rev1371 rev

2412 pcb

2412 pcb

1371 rev

1371 rev

705 maybe705 maybe1013 .3 mine1013 .3 mine

705 maybe

705 maybe

1013 .

3 mine

1013 .

3 mine

675 .

20 yes

10 not

I612 .

I 54 web 1016 pending

19 fix

6 .

Аргументы передаются программе dutree через du. Это позволяет вызвать dutree любым из приведенных ниже способов, а может быть, и иначе — если ваша версия du поддерживает другие параметры.

% dutree

% dutree /usr

% dutree -a

% dutree -a /bin

Хэш ^D1rs1ze сопоставляет имена с размерами файлов. Например, значение $D1rs1ze{"pcb"} в нашем примере равно 2412. Этот хэш используется как для вывода, так и для сортировки подкаталогов каждого каталога по размерам.

Хэш %Kids представляет больший интерес. Для любого пути Spath значение $Kids{path} содержит (ссылку на) массив с именами подкаталогов данного каталога. Так, элемент с ключом "pcb" содержит ссылку на анонимный массив со строками "fix", "rev" и "pending". Элемент "rev" содержит строки "maybe" и "web". В свою очередь, элемент "maybe" содержит "yes" и "по", которые не имеют собственных элементов, поскольку являются «листами» (конечными узлами) дерева.

Функции output передается начало дерева — последняя строка, прочитанная из выходных данных du. Сначала функция выводит этот каталог и его размер, затем сортирует его подкаталоги (если они имеются) так, чтобы подкаталоги наибольшего размера оказались наверху. Наконец, output вызывает саму себя, рекурсивно перебирая все подкаталоги. Дополнительные аргументы используются при форматировании.

Программа получается рекурсивной, поскольку рекурсивна сама файловая система. Однако ее структуры данных не рекурсивны — по крайней мере, не в том смысле, в котором рекурсивны циклические связанные списки. Каждое ассоциированное значение представляет собой массив ключей для дальнейшей обработки. Рекурсия проявляется в обработке, а не в способе хранения.

Пример 5.3. dutree

#!/usr/bin/perl -w

dutree - печать сортированного иерархического представления

выходных данных du use strict: my %Dirsize;

my %Kids;

get dots (my $topdir = inputO)： output(Stopdir);

Запустить du, прочитать входные данные, сохранить размеры и подкаталоги

Вернуть последний прочитанный каталог (файл?) sub Input {

my($size, $name. $parent);

@ARGV = ("du @ARGV |")；# Подготовить аргументы

while (<>)

($size, $name) = split；

$D1rsize{$name} = $size;

(Sparent = $name) =~ s#/L/]+$##:# Имя каталога

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

push @{ $Kids{$parent} }, $name unless eof； }

return $name；

Рассчитать, сколько места занимают файлы каждого каталога, # не находящиеся в подкаталогах. Добавить новый фиктивный # подкаталог с именем ".", содержащий полученную величину, sub getdots {

my $root = $_[0];

my($size, $cursize):

$size = $cursize = $Dirsize{$root};

if ($Kids{$root}) {

for my $kid (@j $Kids{$root} }) { $cursize -= $D1rsize{$k1d}: getdots($kid);

}

}

if ($size != $cursize) { my $dot = "$root/."; $Dirsize{$dot} = $cursize: push @{ $K1ds{$root} }, $dot;

} }

Рекурсивно вывести все данные, # передавая при рекурсивных вызовах # выравнивающие пробелы и ширину числа sub output {

my($root, $prefix, $width) = (shift, shift || 1', shift || 0);

my $path：

($path = $root) =~ s#.*/##;# Базовое имя

my $size = $Dirsize{$root};

my $line = sprintf("X${width}d Xs", $size, $path)； print $prefix, $line. "\n"；

for ($prefix .= $11пе) {# Дополнительный вывод

s/\d /| /;

s/ГЦ/ /g；

}

if ($Kids{$root}) {# Узел имеет подузлы

my ©Kids = 6{ $K1ds{$root} }:

©Kids = sort { $D1rsize{$b} <=> $Dirs1ze{$a} } @Kids； $D1rsize{$Kids[0]} =~ /(\d+)/: my $width = length $1；

for my $kid (©Kids) { output($kid, $prefix, $width) } }

}

До того как в Perl появилась прямая поддержка хэшей массивов, эмуляция подобных конструкций высшего порядка требовала титанических усилий. Некоторые программисты использовали многократные вызовы split и join, но это работало чрезвычайно медленно.

В примере 5.4 приведена версия программы dutree из тех далеких дней. Поскольку у нас не было прямых ссылок на массивы, приходилось самостоятельно залезать в символьную таблицу Perl. Программа на ходу создавала переменные с жутковатыми именами. Удастся ли вам определить, какой хэш используется этой программой?

Массив @{"pcb"} содержит ссылку на анонимный массив, содержащий "pcb/fix", "pcb/rev" и "pcb/pend1ng". Массив @{"pcb/rev"} содержит "pcb/rev/maybe" и "pcb/ rev/web". Массив @{"pcb/rev/mdybe"} содержит "pcb/rev/yes" и "pcb/rev/not".

Когда вы присваиваете *k1d что-нибудь типа "pcb/flx", строка в правой части преобразуется в тип-глоб. ©kid становится синонимом для @{"pcb/fix"}, но это отнюдь не все. &kid становится синонимом для &{"pcb/fix"} и т. д.

Если эта тема покажется неинтересной, подумайте, как locdl использует динамическую область действия глобальных переменных, чтобы избежать передачи дополнительных аргументов. Заодно посмотрите, что происходит с переменной $width в процедуре output.

Пример 5.4. dutree-org

#!/usr/bin/perl

dutree_orig： старая версия, которая появилась

до выхода perl5 (начало 90-х)

©lines = 'du QARGV';

chop(@lines);

&1nput($top = pop @lines)；

&output($top)； exit;

sub input {

local($root, *kid, $him) = @_[0,0]；

while (©lines && &childof($root, $l1nes[$#lines])) {

&1nput($h1m = pop(@lines));

push(@kid, $him)；

if (@kid) {

local ($mysize) = Groot =~ /人(\d+)/);

for (@kid) { $mysize -= (/人(\d+)/)[0]; } push(@kid, "Smysize .") if $size != $mysize； }

@kid = &sizesort(*kid)；

sub output {

local($root, *kid, $prefix) = @_[0,0,l]；

local ($size, Spath) = splitC $root):

$path =~ s!.*/!!;

$11 ne = spr1ntf('l${width}d %s", $size. Spath)； print $prefix, $line, "\n":

$prefix .= $line：

$prefix =~ s/\d /I /；

$prefix =~ s/[人|]/ /g:

local($width) = $kid[0] =~ /(\d+)/ && length("$l")； for (@kid) { &output($_, Sprefix)； }；

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

sub sizesort {

local(*11st. ©Index) = shift：

sub bynum { $index[$b] <=> $1ndex[$a]； } for (©list) { push(@1ndex, /(\d+)/)； } ©list[sort bynum 0..$#11 st];

sub chlldof {

local(©pair) = @_：

for (©pair) { s/人\d+\s+//g； s/$/\//； } 1ndex($pa1r[l], $pa1r[0]) >= 0;

}

Итак, какой же хэш используется старой программой dutree? Правильный ответ — %mdin：:, то есть символьная таблица Perl. Не стоит и говорить, что эта программа не будет работать с use strict. Мы рады сообщить, что новая версия работает втрое быстрее старой. Дело в том, что старая версия постоянно ищет переменные в символьной таблице, а новая обходится без этого. Кроме того, нам удалось избежать медленных вызовов split для занимаемого места и имени каталога. Однако мы приводим и старую версию, поскольку она весьма поучительна.

6

Поиск по шаблону

«Искусство — это шаблон, наполняемый разумом».

Сэр Герберт Рид, «Значение Искусства»

6.0. Введение

В большинстве современных языков программирования существуют примитивные средства поиска по шаблону (обычно вынесенные в дополнительные библиотеки), но шаблоны Perl интегрируются на уровне самого языка. Они обладают возможностями, которыми не могут похвастаться другие языки; возможностями, которые позволяют взглянуть на данные с принципиально новой точки зрения. Подобно тому как шахматист воспринимает расположение фигур на доске как некий образ, адепты Perl рассматривают данные с позиций шаблонов. Шаблоны записываются на языке регулярных выражений1, обладающем чрезвычайно высокой смысловой насыщенностью, и позволяют работать с мощными алгоритмами, обычно доступными лишь экспертам в области компьютерных технологий.

«Если поиск по шаблону — такая потрясающая и мощная штука, — спросите вы, — то почему же эта глава не содержит сотни рецептов по применению регулярных выражений?». Да, регулярные выражения обеспечивают естественное решение многих проблем, связанных с числами, строками, датами, веб-документами, почтовыми адресами и буквально всем, что встречается в этой книге. В других главах поиск по шаблону применяется свыше 100 раз. А в этой главе в основном представлены те рецепты, в которых шаблоны являются частью вопроса, а не ответа.

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

match( ^строка, ^шаблон)：

subst( $строка, ^шаблон, ^замена)；

Строго говоря, шаблоны Perl по своим возможностям значительно опережают обычные регулярные выражения в классическом понимании этого термина.

Однако поиск и подстановка — настолько распространенные задачи, что они заслуживают собственного синтаксиса:

$meadow =~ m/sheep/: # Истинно, если $meadow содержит "sheep"

$meadow !~ m/sheep/; # Истинно, если $meadow не содержит "sheep"

$meadow =~ s/old/new： # Заменить в $meadow "old" на "new"

Поиск по шаблону даже в упрощенном виде не похож на обычные строковые сравнения. Он больше похож на поиск строк с применением универсальных символов-мутантов, к тому же накачанных допингом. Без специального «якоря» позиция, в которой ищется совпадение, свободно перемещается по всей строке. Допустим, если вы захотите найти слово ovine или ovlnes и воспользуетесь выражением $meddow =~ /ovine/, то в каждой из следующих строк произойдет ложное совпадение:

Fine bovines demand fine toreadors.

Muskoxen are a polar ovibovine species.

Grooviness went out of fashion decades ago.

Иногда нужная строка находится прямо у вас перед глазами, а совпадения все равно не происходит:

Ovines are found typically In ovlaries.

Проблема в том, что вы мыслите категориями человеческого языка, а механизм поиска по шаблону — нет. Когда этот механизм получает шаблон /ovine/ и другую строку, в которой происходит поиск, он ищет в строке символ "о", за которым сразу же следует "v", затем "1", "п" и "е". Все, что находится до этой последовательности символов или после нее, не имеет значения. Вдобавок поиск производится с точным соблюдением регистра символов, поэтому в последнем примере не была найдена подстрока "Ovlnes", начинающаяся с прописной буквы.

Итак, выясняется, что шаблон находит совпадения там, где они не нужны, и не узнает то, что действительно нужно. Придется усовершенствовать его. Например, для поиска последовательности ovine или ovlnes шаблон должен выглядеть примерно так:

if ($meadow =~ /\bovines?\b/1) { print "Here be sheep!" }

Шаблон начинается co метасимвола \b, который совпадает только с границей слова1, s? обозначает необязательный символ s — он позволяет находить как ovine, так и ovines. Модификатор /1 в конце шаблона означает, что поиск осуществляется без учета регистра.

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

Освоить синтаксис поиска по шаблону не так уж сложно. Конечно, служебных символов много, но существование каждого из них объясняется вескими

Конечно, речь идет о «слове» в понимании Perl.

причинами. Регулярное выражение — это не просто беспорядочная груда знаков... это тщательно продуманная груда знаков! Если вы что-нибудь забыли, всегда можно заглянуть в документацию. Сводка по синтаксису регулярных выражений имеется в книге «Регулярные выражения: Библиотека программиста, 2 издание» (издательство «Питер», 2003), а также на страницах руководства perlre( 1) и perlop(l\ входящих в любую поставку Perl.

Три затруднения

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

Принцип максимализма: если стандартный квантификатор (например, *) может совпасть в нескольких вариантах, он всегда совпадает со строкой наибольшей длины. Объяснения приведены в рецепте 6.15.

Принцип торопливости: механизм поиска старается обнаружить совпадение как можно скорее, иногда даже раньше, чем вы ожидаете. Рассмотрим конструкцию "Fred" =~ /х*/. Если попросить вас объяснить ее смысл, вы, вероятно, скажете: «Содержит ли строка "Fred" символы х?». Вероятно, результат поиска окажется неожиданным — компьютер убежден, что символы присутствуют. Дело в том, что /х*/ означает не просто «символы х», а «любое количество символов х». Или более формально — ноль и более символов. В данном случае нетерпеливый механизм поиска удовлетворяется нулем.

Приведем более содержательный пример:

$string = "good food":

$string =~ s/o*/e/:

Как вы думаете, какое из следующих значений примет $string после подстановки?

goof food geod food geed food geed feed ged food ged fed egood food

Правильный ответ — последний, поскольку первая точка, в которой встречается ноль и более экземпляров "о", находится прямо в начале строки. Удивлены? С регулярными выражениями это бывает довольно часто.

А теперь попробуйте угадать, как будет выглядеть результат при добавлении модификатора /д, который делает подстановку глобальной? Строка содержат много мест, в которых встречается ноль и более экземпляров "о" — точнее, восемь. Итак, правильный ответ — "egeede efeede".

Приведем другой пример, в котором максимализм уступает место торопливости:

% echo longest | perl -ne 'print "$&\n" 1f /long|longer|longest/' long

Это объясняется тем, что при поиске в Perl используются так называемые традиционные недетерминированные конечные автоматы (в отличие от недетерминированных конечных автоматов POSIX). Подобные механизмы поиска гарантируют возврат не самого длинного итогового совпадения, а лишь самого длинного совпадения начиная с левого края. Можно считать, что максимализм Perl проявляется лишь слева направо, а не в глобальном контексте.

Механизм НК А работает медленнее, однако формулировка шаблона с учетом конкретных особенностей реализации НКА позволяет добиться существенного выигрыша по быстродействию. Этой теме посвящена значительная часть книги Джеффри Фридла «Регулярные выражения: Библиотека программиста».

Последняя и самая интересная из трех особенностей — возврат. Чтобы шаблон совпал, должно совпасть все регулярное выражение, а не лишь его отдельная часть. Следовательно, если начало шаблона с квантификатором совпадает, а одна из последующих частей шаблона — нет, механизм поиска возвращается к началу и пытается найти для него другое совпадение — отсюда и термин «возврат». Фактически это означает, что механизм поиска должен систематически перебирать разные возможности до тех пор, пока не найдет полное совпадение. В некоторых реализациях поиска возврат используется для поиска других совпадающих компонентов, которые могли бы увеличить длину найденного совпадения. Механизм поиска Perl этого не делает; найденное частичное совпадение используется немедленно — если позднее другая часть шаблона сделает полное совпадение невозможным, происходит возврат и поиск другого частичного совпадения (см. рецепт 6.16).

Модификаторы

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

Таблица 6.1 Модификаторы поиска по шаблону

Модификатор

Описание

/1

/X /д

Игнорировать регистр (с учетом национальных алфавитов)

Игнорировать большинство пропусков в шаблонах и разрешить комментарии

Глобальный модификатор — поиск/замена выполняются во всех позициях, где это возможно

/дс /S

/т

Не сбрасывать позицию при неудачном поиске

Разрешить совпадение символа «.» с символом новой строки

Разрешить совпадение 人 и $ соответственно в начале и конце логических (то есть внутренних) строк

/0

/е

Однократная компиляция шаблонов

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

/ее

Правая часть s/// представляет собой строку с программным кодом, которая выполняется дважды; окончательный результат используется как замена

На практике чаще всего используются модификаторы /1 и /д. Шаблон /гат/1 совпадает со строками "ram", "RAM", "Ram" и т. д. При наличии этого модификатора обратные ссылки проверяются без учета регистра (пример приведен в рецепте 6.16). Под действием директивы use locale в сравнениях будет учитываться состояние текущих локальных настроек.

Модификатор /д используется с s/// для замены всех неперекрывающихся совпадений, а не только первого. Кроме того, /д используется с т// в циклах поиска (но не замены!) всех совпадений:

while (m/(\d+)/g) {

print "Found number $l\n"：

}

При использовании с m// в списковом контексте /д извлекает все совпадения в массив:

©numbers = m/(\d+)/g;

В этом случае будут найдены только неперекрывающиеся совпадения. Для поиска перекрывающихся совпадений придется идти на хитрость — организовать опережающую проверку нулевой ширины с помощью конструкции (?=...). Раз ширина равна нулю, механизм поиска вообще не смещается вперед, при этом данные все равно сохраняются при помощи сохраняющих круглых скобок. Однако Perl обнаруживает, что при наличии модификатора /д текущая позиция осталась в прежнем состоянии, и перемещает ее на один символ вперед.

Продемонстрируем различия на примере:

$d1g1ts = "123456789":

@nonlap = $d1gits =~/(\d\d\d)/g：

@yeslap = $digits =~/(?=(\d\d\d))/g:

print "Non-overlapping： @nonlap\n"；

print "0^门叩р1叩： @yeslap\n":

Non-overlapping： 123 456 789

Overlapping:123 234 345 456 567 678 789

Модификаторы /s и /m используются для поиска последовательностей, содержащих внутренний перевод строки. С модификатором /s точка совпадает с "\п"— в обычных условиях этого не происходит. Кроме того, при поиске игнорируется значение устаревшей переменной $*. Модификатор /т приводит к тому, что 人 и $ совпадают в позициях после и до "\п" соответственно. Он полезен в режиме поглощения файлов, о котором говорится во Введении к главе 8 «Содержимое файлов» и рецепте 6.6.

С модификатором /е правая часть выполняется как программный код, а полученное значение используется в качестве заменяющей строки. Например, подстановка s/(\d+)/spr1ntf( "Ш" ,$D/ge преобразует все числа в шестнадцатеричную систему счисления — скажем, 2581 превращается в 0хЬ23.

В разных странах существуют разные понятия об алфавите, поэтому стандарт POSIX предоставляет в распоряжение систем (а следовательно, и программ) стандартные средства для представления алфавитов, упорядочения наборов символов и т. д. Директива Perl use locale предоставляет доступ к некоторым из них; дополнительную информацию можно найти на странице руководства perllocale.

При действующей директиве use locale в символьный класс \w попадают символы с диакритическими знаками и прочая экзотика. Служебные символы изменения регистра \u, \U, \1 и \L (а также соответствующие функции uc, ucfirst и т. д.) также учитывают use locale, поэтому \u превратит о в 2, если этого потребует локальный контекст. Впрочем, это относится только к 8-разрядным кодировкам —таким, как греческая кодировка ISO 8859-7. При работе с этими символами в Юникоде преобразование выполняется автоматически независимо от текущего выбора локального контекста.

Специальные переменные

В результате некоторых операций поиска по шаблону Perl устанавливает значения специальных переменных. Так, переменные $1, $2, $3 и т. д. до бесконечности (Perl не останавливается на $9) устанавливаются в том случае, если шаблон содержит обратные ссылки (то есть часть шаблона заключена в сохраняющие круглые скобки). Каждая открывающая круглая скобка, встречающаяся в шаблоне при его просмотре слева направо, начинает заполнение новой переменной. Переменная $+ содержит значение последней обратной ссылки для последнего успешного поиска. С ее помощью можно определить, какой из альтернативных вариантов поиска вошел в совпадение (например, при обнаруженном совпадении для /(х,*у) I (у .*z)/ в переменной $+ будет находиться содержимое $1 или $2 — в зависимости от того, какая из этих переменных была заполнена). Переменная $& содержит полный текст совпадения при последнем успешном поиске. В переменных $' и $' хранятся строки, соответственно предшествующие и следующие за совпадением при успешном поиске:

$string = "And little lambs eat ivy";

$string =~ /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] — смещение конца всего совпадения. (Говоря о «смещении конца», мы имеем в виду смещение первого символа, следующего за совпадением, что позволяет определять длину совпадения простым вычитанием начального смещения из конечного.)

При обнаружении совпадения в переменной $string следующие конструкции эквивалентны:

Variable

Equivalent

$'

substr($string, 0.$-[0])

$&

substr($string, $-[0], $+[0] - $-[0])

$'

substr($string, $+[0])

$1

substr($string, $-[1]. $+[l] - $-[l])

$2

substr($string. $-[2], $+[2] - $-[2])

$3

substr($string, $-[3], $+[3] - $-[3])

И так далее и тому подобное.

Чтобы узнать о регулярных выражениях больше, чем вы могли бы себе представить, обратитесь к книге Джеффри Фридла «Регулярные выражения: Библиотека программиста» (издательство «Питер», 2003 г.). Книга посвящена практическому применению регулярных выражений. В ней рассматриваются не только общие принципы работы регулярных выражений и специфика их реализации в Perl, но и проводится их сравнение с аналогичными средствами других языков программирования.

Копирование с подстановкой

Проблема

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

Решение

Замените фрагменты вида:

$dst = $src；

$dst =~ s/this/that/；

следующей командой:

($dst.= $src) =~ s/this/that/；

Комментарий

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

Например:

# Выделить базовое имя

(Sprogname = $0)=~ s!人.*/!!;

# Начинать Все Слова С Прописной Буквы ($capword = $word) =~ s/(\w+)/\u\L$l/g；

# /usr/man/man3/foo.1 заменяется на /usr/man/man/cat3/foo.1 ($catpage = $manpage) =~ s/man(?=\d)/cat/:

Подобная методика работает даже с массивами:

©bindirs = qw( /usr/bln /bin /usr/local/bln )：

for (@11bd1rs = ©blndirs) { s/Ып/ИЬ/ }

print "@Hbd1rs\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(l).

Идентификация алфавитных символов

Проблема

Требуется узнать, состоит ли строка только из алфавитных символов.

Решение

Наиболее очевидное решение не подходит для общего случая:

if ($var =~ /"[A-Za-z]+$/) {

# Только алфавитные символы

}

Дело в том, что такой вариант не учитывает локальный контекст пользователя. Если наряду с обычными должны идентифицироваться символы с диакритическими знаками, лучше всего воспользоваться свойствами Юникода:

if ($var =~ /^\p{Alphabet1c}+$/) {# Или просто /人\pL+$/

print "var 1s purely alphabetic\n"： }

В старых версиях Perl, не поддерживающих Юникод, остается использовать либо инвертированные символьные классы:

1f ($var =~ /TCW\d」+$/) {

print "var 1s purely alphabet1c\n"；

либо символьные классы POSIX (если они поддерживаются):

If ($var =~ /人[[:alpha：]]+$/) {

print "var Is purely alphabetic\n"： }

Но чтобы эти решения работали с символами, не входящими в кодировку ASCII, необходимо использовать директиву use locale, а система должна поддерживать локальные контексты POSIX.

Комментарий

Если не считать свойств Юникода и символьных классов POSIX, в Perl нет средств для выражения понятия «алфавитный символ», поэтому нам придется немного схитрить. Метасимвол \w совпадает с одним алфавитным или цифровым символом, а также символом подчеркивания. Следовательно, \W не является одним из этих символов. Инвертированный символьный класс [人\W\d_] определяет байт, который не является алфавитным символом, цифрой или подчеркиванием. После инвертирования остаются одни алфавитные символы, которые нас и интересуют.

В программе это выглядит так:

use locale：

use POSIX 'locale_h'

# Строка локального контекста на вашем компьютере может выглядеть иначе

unless (setlocale(LC_ALL, "fr_CA.IS08859-1")) {

die "couldn't set locale to French Canad1an\n"： }

while (<DATA>) { chomp:

1f (/Trw\d」+$/) }

print "$_： alphabetic\n"：

} else [

print "$_： line noise\n"：

}"

}

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,

print, punct, space, upper, word и xdigit. Имена символьных классов действительны только в спецификациях символьных классов, заключенных в квадратные скобки:

$phone =~ /\b[:digit:]{3}[[:space：][:punct:]]?[:digit:]{4}\b/:# ОШИБКА

Sphone =~ /\Ь[[：digit：]]{3}[[：space：][：punct：]]?[[：digit：]]{4}\Ь/： # ВЕРНО

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

Sphone =~ /\Ь\р{Number}{3}[\p{Space}\p{Punctuation]?\p{Number}{4}\Ь/;

Sphone =~ /\b\pN{3}L\pS\pP]?\pN{4}\b/;# Сокращенная форма

Один произвольный символ со свойством Юникода prop описывается конструкцией \^{ргор]. Символ, не обладающий свойством prop, описывается конструкцией \?{ргор} или [А\р{夕旷叩}]. При поиске алфавитных символов используется свойство Alphabetic, которое может сокращаться до Letter или даже до простого L. Также следует упомянуть и такие важные свойства, как UppercaseLetter, LowercaseLetter и TltlecaseLetter, сокращаемые до Lu, L1 и Lt соответственно.

См. также

Описание работы с локальным контекстом в perllocale(l); страница руководства locale(3) вашей системы; рецепт 6.12; главы 3 и 7 книги «Регулярные выражения: Библиотека программиста, 2 издание» (издательство «Питер», 2003 г.).

Поиск слов

Проблема

Требуется выделить из строки отдельные слова.

Решение

Хорошенько подумайте, что должно считаться словом и как одно слово отделяется от остальных. Затем напишите регулярное выражение, в котором будут воплощены ваши решения. Примеры:

/\8+/# Максимальная серия байтов, не являющихся пропусками

/[A-Za-z'-]+/ # Максимальная серия букв. апострофов и дефисов

Комментарий

Концепция «слова» зависит от приложения, языка и входного потока, поэтому в Perl не существует встроенного определения слов. Слова приходится собирать вручную из символьных классов и квантификаторов, как это сделано выше. Во втором примере мы пытаемся сделать так, чтобы "shepherd's" и "sheep-sheering" воспринимались как отдельные слова.

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

"spank'd" и "counter-clockwise", он выдернет "rd" из строки "23rd Psalom". Чтобы повысить точность идентификации слов в строке, можно указать то, что окружает слово. Как правило, при этом указываются метасимволы границ1, а не пропусков:

/\b([A-Za-z]+\b/# Обычно наилучший вариант

/\s([A-Za-z]+)\s/# Не работает в конце строки или без знаков препинания

В Perl существует метасимвол \w, который совпадает с одним символом, разрешенным в идентификаторах Perl. Однако идентификаторы Perl редко отвечают нашим представлениям о словах — обычно имеется в виду последовательность алфавитно-цифровых символов и подчеркиваний, но не двоеточий с апострофами. Поскольку метасимвол \Ь определяется через \w, он может преподнести сюрпризы при определении границ английских слов (и тем более — слов монгольского языка).

И все же метасимволы \Ь и \В могут пригодиться. Например, шаблон /\Bis\B/ совпадает со строкой "is" только внутри слова, но не на его границах. Скажем, в "thistle" совпадение будет найдено, а в "vis-a-vis" — нет.

См. также

Интерпретация \b, \w и \s в perlre(l); шаблоны для работы со словами из рецепта 6.23.

Комментирование регулярных выражений

Проблема

Требуется сделать ваше сложное регулярное выражение более понятным и упростить его изменение в будущем.

Решение

В вашем распоряжении четыре способа: альтернативные ограничители для сокращения числа символов \, внешние комментарии, внутренние комментарии с модификатором /х и последовательное построение шаблонов в именованных переменных.

Комментарий

Во фрагменте из примера 6.1 использованы первые два способа. Начальный комментарий описывает, для чего предназначено регулярное выражение. Для относи-

Хотя метасимвол \Ь выше был назван «границей слова», в действительности он определяется как позиция между двумя символами, по одну сторону которой располагается \w, а по другую — \W (в любом порядке). — Примеч. перев.

тельно простых шаблонов ничего больше не потребуется, но в сложных шаблонах (наподобие приведенного) желательно привести дополнительные комментарии.

Пример 6.1. resname

#!/usr/bin/perl -р

# resname - заменить все имена в

стиле "foo.bar.com" во входном потоке (или аналогичными)стиле "foo.bar.com" во входном потоке (или аналогичными)use s{use s{Socket:Socket:(?：(?! [-J [\w-] +(?：(?! [-J [\w-] +)+ [A-Za-z] [\w-] +)+ [A-Za-z] [\w-] +}{}{Загрузить inet/ddr一Сохранить имя хоста в $1Скобки только для группировкиНи подчеркивание, ни 口帥исКомпонент имени хостаи точка доменаПовторяется несколько разСледующий символ должен быть буквойЗавершающая часть доменаКонец записи $1Заменить следующим:Загрузить inet/ddr一Сохранить имя хоста в $1Скобки только для группировкиНи подчеркивание, ни 口帥исКомпонент имени хостаи точка доменаПовторяется несколько разСледующий символ должен быть буквойЗавершающая часть доменаКонец записи $1Заменить следующим:"$1"$1# Исходная часть(($dddr = gethostbyndme($D) #? "[" . inet_ntoa($addr) . "]" #:"[???]'' -#)# Исходная часть(($dddr = gethostbyndme($D) #? "[" . inet_ntoa($addr) . "]" #:"[???]'' -#)плюсЕслиплюсЕслипробелимеется адресотформатироватьпробелимеется адресотформатироватьиначе пометить как сомнительныйиначе пометить как сомнительный# на "foo.bar.com [204.148.40.9]

стиле "foo.bar.com" во входном потоке (или аналогичными)

стиле "foo.bar.com" во входном потоке (или аналогичными)

use s{

use s{

Socket:

Socket:

(?：

(?! [-J [\w-] +

(?：

(?! [-J [\w-] +

)+ [A-Za-z] [\w-] +

)+ [A-Za-z] [\w-] +

}{

}{

Загрузить inet/ddr

一

Сохранить имя хоста в $1

Скобки только для группировки

Ни подчеркивание, ни 口帥ис

Компонент имени хоста

и точка домена

Повторяется несколько раз

Следующий символ должен быть буквой

Завершающая часть домена

Конец записи $1

Заменить следующим:

Загрузить inet/ddr

一

Сохранить имя хоста в $1

Скобки только для группировки

Ни подчеркивание, ни 口帥ис

Компонент имени хоста

и точка домена

Повторяется несколько раз

Следующий символ должен быть буквой

Завершающая часть домена

Конец записи $1

Заменить следующим:

"$1

"$1

# Исходная часть

(($dddr = gethostbyndme($D) #

? "[" . inet_ntoa($addr) . "]" #

:"[???]'' -#

)

# Исходная часть

(($dddr = gethostbyndme($D) #

? "[" . inet_ntoa($addr) . "]" #

:"[???]'' -#

)

плюс

Если

плюс

Если

пробел

имеется адрес

отформатировать

пробел

имеется адрес

отформатировать

иначе пометить как сомнительный

иначе пометить как сомнительный

}дех；}дех；# /д - # /е - # /х -# /д - # /е - # /х -глобальная замена выполнение

}дех；

}дех；

# /д - # /е - # /х -

# /д - # /е - # /х -

улучшенное форматирование

Из эстетических соображений в этом примере использованы альтернативные ограничители. Когда шаблон поиска или замены растягивается на несколько строк, наличие парных скобок делает его более понятным. Другая частая причина для использования альтернативных ограничителей — присутствие в шаблоне символов / (например, s/\/\//\/. .\//g). Альтернативные ограничители упрощают чтение такого шаблона (например, s!//!/. ./!д или s{//}{/. ./}д).

При наличии модификатора /х Perl игнорирует большинство пропусков в шаблоне (в символьных классах они учитываются) и интерпретирует символы # вместе со следующим за ним текстом как комментарий. Такая возможность весьма полезна, однако у вас могут возникнуть проблемы, если пропуски или символы # являются частью шаблона. В таких случаях снабдите символы префиксом \, как это сделано в следующем примере:

s/#Заменить

\##знак фунта

(\w+)#имя переменной

\##еще один знак фунта

/${$1}/хд；# значением глобальной переменной

Помните: комментарий должен пояснять программу, а не пересказывать ее. Комментарии типа "$1++ # Увеличить $i на 1" станут причиной плохих оценок на курсах программирования и подорвут вашу репутацию среди коллег.

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

$optional_sign='[-+]?';

$mandatory_digits='\d+'；

$decimal_point=' \.?1 ；

$optionaT_d1gits='\d*'；

Snumber = $optional_sign

.$mandatory_digits

.$decimal_point

.$optionaT_d1g1ts；

В дальнейшем переменная Snumber используется при построении шаблонов:

if (/(Snumber)/) {# Поиск одного вхождения

Sfound = $1:

©dllnums = /$number/g： # Поиск всех вхождений

unless (/A$number$/) { # Что-нибудь еще?

print "need a number, just a number\n"； }

# Проверка строки т{人\s *Snumber(?：\s +Snumber)*\s * $}x# Проверка строки т{人\s *Snumber(?：\s +Snumber)*\s * $}xиз чисел, разделенных пропускамииз чисел, разделенных пропускамиВсе эти способы даже можно объединять:

# Проверка строки т{

人\s *

Snumber

(?：

\s +

Snumber

)*

\s * $

}x

# Проверка строки т{

人\s *

Snumber

(?：

\s +

Snumber

)*

\s * $

}x

из чисел, разделенных пропусками

из чисел, разделенных пропусками

Необязательные начальные пропуски

По крайней мере одно число

Начало несохраняющей группы

Необходимые разделители

Следующее число

Повторяется несколько раз

Необязательные завершающие пропуски

Конечно, такая запись гораздо нагляднее, чем

/A\s*[-+]?\d+\.?\d*(?：\s+[-+]?\d+\.?\d*)*\s*/

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

Однако с несохраняющими круглыми скобками (то есть /(?:...)/ вместо /(...)/) таких проблем не возникает. Они не только возможны, но и необходимы, если вы хотите применить квантификатор ко всей переменной. Пример:

Snumber = "(?:"

$optional_sign

$mandatory_digits

$decimal_point

. $optiona7_d1gits

Если теперь использовать запись /$number+/, квантификатор + будет относиться ко всей группе. Без группировки он оказался бы в итоговом выражении сразу же после завершающего квантификатора *, что недопустимо.

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

$hex_digit = ' (?i ：[0-%-z])'；

$hdr_line = '(?m：[人：]*：.*)'；

Конструкция qr// автоматически использует несохраняющие круглые скобки, что обеспечивает активизацию всех заданных модификаторов и подавление тех модификаторов, которые не были заданы для группы:

$hex_digit = qr/[0-9a-z]/1；

$hdr_line = qr/人厂：]*: .*/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/[-+]?/：

$manddtory_digits=qr八d+/；

$decimal_point=qr/\.?/；

$optional_digits=qr/\d*/;

Snumber = qr{

$optional_sign

$manddtory_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 издание».

Поиск N-ro совпадения

Проблема

Требуется найти не первое, a N-e совпадение шаблона в строке. Допустим, вы хотите узнать, какое слово предшествует третьему экземпляру слова fish:

One fish two fish red fish blue fish

Решение

Воспользуйтесь модификатором /g и считайте совпадения в цикле while:

$WANT = 3;

Scount = 0:

while (/(\w+)\s+fish\b/gi) {

1f (++$count == $WANT) {

print "The third fish Is a $1 one.\n"；

# Предупрежпение： не выходите из этого цикла с помощью last

}

}

The third fish is a red one.

Или воспользуйтесь счетчиком и шаблоном следующего вида:

/(?:\w+\s+fish\s+){2}(\w+)\s+fish/i;

Комментарий

Как объяснялось во Введении к этой главе, при наличии модификатора /д в скалярном контексте поиск выполняется многократно. Эта методика часто используется для подсчета совпадений в строке:

Простой вариант с циклом while

Scount = 0:

while($str1ng =~ /РАТ/g) {

$count++:# Или что-нибудь другое

То же с завершающим циклом while Scount = 0;

$count++ while $string =~ /PAT/g；

С циклом for

for (Scount = 0; $string =~ /РАТ/g: $count++) { }

Аналогично, но с подсчетом перекрывающихся совпадений

$count++ while $string =~ /(?=PAT)/g；

Чтобы найти У-й экземпляр, проще всего завести отдельный счетчик. Когда он достигнет N, сделайте то, что считаете нужным. Аналогичная методика может применяться и для поиска каждого N-ro совпадения — в этом случае проверяется кратность счетчика N посредством вычисления остатка при делении. Например, проверка (++$count % 3) == 0 находит каждое третье совпадение.

Если вам не хочется брать на себя дополнительные хлопоты, всегда можно извлечь все совпадения и затем выбрать из них то, что вас интересует.

$pond = 'One fish two fish red fish blue fish'：

С применением временного массива

©colors = ($pond =~ /(w+)\s+fish\b/gi)： # Найти все совпадения

Scolor = $colors[2]：# Выбрать одно.

# интересующее нас

Без временного массива

Scolor = ( $pond =~ /(\w+)\s+fish\b/gi )[2]： # Выбрать третий элемент

print "The third fish is the pond is Scolor.\n"； The third fish in the pond is red.

В другом примере находятся все нечетные совпадения:

Scount = 0;

$_ = 'One fish two fish red fish blue fish':

©evens = grep {$count++ % 2 == 1} /(\w+)\s+fish\b/gi: print "Even numbered fish are 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".

Другой способ — глобальный поиск в списковом контексте для получения всех совпадений и последующее извлечение нужного элемента этого списка:

$pond = 'One fish two fish red fish blue fish swim here.'：

Scolor = ( $pond =~ /\b(\w+)\s+fish\b/gi )[-1];

print "Last fish is Scolor.\n"；

Last fish is blue.

帆А(?!*А)$}х帆А(?!*А)$}хЕсли потребуется найти последнее совпадение без применения /д, то же самое можно сделать с негативной опережающей проверкой (?!...). Если вас интересует последний экземпляр произвольного шаблона Р, вы ищете Р, сопровождаемый любым количеством «не-Р», до конца строки. Обобщенная конструкция имеет вид Р(?! .*Р)*$, однако для удобства чтения ее можно разделить:

帆

А

(?!

*

А

)

$

}х

帆

А

(?!

*

А

)

$

}х

Найти некоторый шаблон А

При этом не должно находиться

что-то другое

и А

До конца строки

В результате поиск последнего экземпляра "fish" принимает следующий вид:

$pond = 'One fish two fish red fish blue fish'： if ($pond =~ m{

\b ( \w+) \s+ fish \b (?! .* \b fish \b ) }six )

{

print "Last fish is $l/\n"；

} else {

print "Failed!\n"：

}

Last fish is blue.

Такой подход имеет свои преимущества — он ограничивается одним шаблоном и потому подходит для ситуаций, аналогичных описанной в рецепте 6.18. Впрочем, имеются и недостатки. Он однозначно труднее записывается и воспринимается —впрочем, если общий принцип понятен, все выглядит не так плохо. К тому же это решение медленнее работает — для протестированного набора данных быстродействие снижается примерно в два раза.

См. также

Поведение конструкции m//g в скалярном контексте описано в разделе «Regexp Quote-like Operators» perlop(i). Негативные опережающие проверки нулевой ширины продемонстрированы в разделе «Regular Expressions» perlre(l).

6.6. Межстрочный поиск

Проблема

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

Решение

Воспользуйтесь модификатором /т, /s или обоими сразу. Модификатор /s разрешает совпадение метасимвола . с переводом строки (обычно этого не происходит). Если последовательность символов распространяется на несколько логических строк, шаблон /foo.*bar/s совпадет с "foo" и "bar", находящимися в двух разных строках. Это не относится к точкам в символьных классах (например, [#%.]), которые всегда представляют собой обычные точки.

Модификатор /т разрешает совпадение 人 и $ непосредственно после и перед внутренними переводами строк. Например, совпадение для шаблона /^=head[l-7]/m возможно не только в начале записи, но и в начале любой внутренней логической строки.

Комментарий

При разборе документов, в которых переводы строк несущественны, часто используется «силовое» решение — файл читается по абзацам (а иногда даже целиком), после чего происходит последовательное извлечение лексем. Для успешного межстрочного поиска необходимо, чтобы символ . совпадал с переводом строки — обычно этого не происходит. Если в буфер читается сразу несколько строк, вероятно, вы предпочтете, чтобы символы 人 и $ могли совпадать с началом и концом внутренних логических строк, а не только всего текста.

Необходимо хорошо понимать, чем /т отличается от /s: первый метасимвол заставляет 人 и $ совпадать на внутренних переводах строк, а второй заставляет . совпадать с переводом строки. Эти модификаторы можно использовать вместе, они не являются взаимоисключающими.

Фильтр из примера 6.2 удаляет теги HTML из всех файлов, переданных в ©ARGV, и отправляет результат в STDOUT. Сначала мы отменяем разделение записей, чтобы при каждой операции чтения читалось содержимое всего файла. (Если ©ARGV содержит несколько аргументов, файлов также будет несколько; в этом случае при каждом чтении загружается содержимое всего файла.) Затем мы удаляем все открывающие и закрывающие угловые скобки и все, что находится между ними. Мы не можем просто воспользоваться .* по двум причинам: во-первых, этот шаблон не учитывает закрывающих угловых скобок, а во-вторых, он не поддерживает межстрочных совпадений. Проблема решается применением .*? в сочетании с модификатором /s — по крайней мере, в данном случае.

Пример 6.2. killtags

#!/usr/bin/perl

# ki1Itags - очень плохое удаление тегов HTML

undef $/：# При каждом чтении загружается весь файл

while (<>) {# Читать по одному файлу

s/<.*?>//gs：# Удаление тегов (очень скверное)

print;# Вывод в STDOUT

}

Шаблон s/v[人〉]*>//д работает намного быстрее, но такой подход наивен: он приведет к неправильной обработке тегов в комментариях HTML или угловых скобок в кавычках (<IMG SRC="here.gif" ALT="«Ooh la la!»">). В рецепте 20.6 показано, как решаются подобные проблемы.

Программа из примера 6.3 получает простой текстовый документ и ищет в начале абзацев строки вида "Chapter 20: Better Living Through Chemisery". Такие строки оформляются заголовками HTML первого уровня. Поскольку шаблон получился довольно сложным, мы воспользовались модификатором /х, который разрешает внутренние пропуски и комментарии.

Пример 6.3. headerfy

#!/usr/bin/perl

while ( <> ) {s{\АChapter \s+ \d+ \s*while ( <> ) {s{\АChapter \s+ \d+ \s*# headerfy： оформление заголовков глав в HTML $/=，';

while ( <> ) {s{

\А

Chapter \s+ \d+ \s*

while ( <> ) {s{

\А

Chapter \s+ \d+ \s*

Получить абзац

Начало записи

Сохранить в $1

Текстовая строка

Обязательный пропуск

Десятичное число

Необязательный пропуск

Двоеточие

Все. кроме перевода строки, до конца строки

}{<H1>$1</Hl>}gx: print:

Если комментарии лишь затрудняют понимание, ниже тот же пример переписан в виде короткой командной строки:

% perl -ООре 's{\A(Chapter\s+\d+\s*:.*)}{<H1>$1</Hl>}gx' datafile

Возникает интересная проблема: в одном шаблоне требуется указывать как начало записи, так и конец строки. Начало записи можно было бы определить с помощью 人,но символ $ должен определять не только конец записи, но и конец строки. Мы добавляем модификатор /т, отчего изменяется смысл как 人,так и $. Вместо того чтобы использовать 人 для определения начала записи, мы используем \А. Кстати говоря, метасимвол \Z (хотя в нашем примере он не используется) совпадает с концом записи даже при наличии модификатора /т. Совпадение с настоящим концом без возможного перевода строки обеспечивается метасимволом \z.

Следующий пример демонстрирует совместное применение /s и /т. На этот раз мы хотим, чтобы символ 人 совпадал с началом любой строки абзаца, а точка — с переводом строки. Стандартная переменная $. содержит число записей последнего файла, прочитанного конструкцией readllne(FH) или <FH>. Стандартная переменная $ARGV содержит имя файла, автоматически открываемого при обработке <ARGV>.

$/ = ''；# Режим чтения абзацев

while (<ARGV>) {

while (/^START(.*?)^END/sm) { # /s - совпадение . с переводом строки

/т - совпадение 人 с началом внутренних строк print "chunk $. in $ARGV has <<$l»\n":

Если вы уже привыкли работать с модификатором /т, то 人 и $ можно заменить на \А и \Z. Но что делать, если вы предпочитаете /s и хотите сохранить исходный смысл метасимвола «точка»? Воспользуйтесь конструкцией [人\п].

Наконец, хотя $ и \Z могут совпадать в позиции, предшествующей концу строки, если последним символом является перевод строки, \z всегда совпадает только в фактическом конце строки. При помощи опережающей проверки можно определить для двух других метасимволов эквиваленты с использованием \z: $ без /т(?=\n)?\z

$ с /т(?=\n)|\z

\Z (всегда) (?=\n)?\z

См. также

Описание переменной $/ в perloar(l); описание модификаторов /s и /т в perlre(l); раздел «Якорные метасимволы и другие проверки с нулевой длиной совпадения» главы 3 книги «Регулярные выражения: Библиотека программиста, 2 издание». Мы вернемся к специальной переменной $/ в главе 8.

6-7- Чтение записей с разделением по шаблону

Проблема

Требуется прочитать записи, разделение которых описывается некоторым шаблоном. Perl не позволяет присвоить регулярное выражение переменной-разделителю входных записей.

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

Решение

Прочитайте весь файл и воспользуйтесь функцией split:

undef $/；

©chunks = s^ И(/шаблон/,<ФАЙЛОВЫЙ_МАНИПУЛЯТОР>);

Комментарий

В Perl разделитель записей должен быть фиксированной строкой, а не шаблоном. Чтобы обойти это ограничение, отмените разделитель входных записей, чтобы следующая операция чтения прочитала весь файл. Иногда это называется режимом поглощающего ввода (slurp mode), потому что весь файл поглощается как одна большая строка. Затем разделите эту большую строку функцией split, используя шаблон разделения записей в качестве первого аргумента.

Рассмотрим пример. Допустим, входной поток представляет собой текстовый файл, содержащий строки " .Se", " .Ch" и " .Ss" — служебные коды для макросов troff. Эти строки представляют собой разделители. Мы хотим найти текст, расположенный между ними.

# .Ch. ,Se и .Ss отделяют фрагменты данных STDIN

{

local $/ = undef：

©chunks = split(/x\.(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(l) и в главе 8; описание функции split в perlfunc(l).

Извлечение строк из определенного интервала

Проблема

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

Часто встречающиеся примеры — чтение первых 10 строк файла (строки с 1 по 10) или основного текста почтового сообщения (все, что следует после пустой строки).

Решение

Используйте оператор .. или ... для шаблонов или номеров строк.

Оператор .. проверяет правый операнд в той же итерации, в которой левый операнд переводит оператор в истинное состояние.

while (<>) {

if (/НАЧАЛЬНЫЙ ШАБЛОН/ .. /КОНЕЧНЫЙ ШАБЛОН/) {

Строка находится между начальным

и конечным шаблоном включительно.

}

}

while (<>) {

if ($НОМЕР_НАЧАЛЬНОЙ_СТРОКИ $НОМЕР_КОНЕЧНОЙ_СТРОКИ) {

Строка находится между начальной

и конечной включительно.

}

}

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

while (<>) {

if (/НАЧАЛЬНЫЙ ШАБЛОН/ /КОНЕЧНЫЙ ШАБЛОН/) {

Строка находится между начальным

и конечным шаблоном, расположенными в разных строках.

}

}

while (<>) {

if ($НОМЕР_НАЧАЛЬНОЙ_СТРОКИ ... $НОМЕР_КОНЕЧНОЙ_СТРОКИ) {

Оператор находится между начальной

и конечной строками включительно.

Комментарий

Из бесчисленных операторов Perl интервальные операторы .. и ..., вероятно, вызывают больше всего недоразумений. Они создавались для упрощения выборки интервалов строк, чтобы программисту не приходилось сохранять информацию о состоянии. В скалярном контексте (например, в условиях операторов 1 f и while) эти операторы возвращают значение true или false, отчасти зависящее от предыдущего состояния. Выражение левый_операнд .. правый_операнд возвращает false до тех пор, пока левый_операнд не станет истинным. Когда это условие выполняется, левый_операнд перестает вычисляться, а оператор возвращает true до тех пор, пока не станет истинным правый операнд. После этого цикл начинается заново. Другими словами, истинность первого операнда «активизирует» конструкцию, а истинность второго операнда «выключает» ее.

Условия могут быть абсолютно произвольными. Границы интервала могут быть заданы проверочными функциями mytestfunc(l) .. mytestfunc(2), хотя на

практике это происходит редко. Как правило, операндами интервальных операторов являются либо номера строк (первый пример), шаблоны (второй пример) или их комбинация.

Командная строка для вывода строк с 15 по 17 включительно (см. ниже) perl -ne 'print if 15 .. 17' datafile

Вывод всех фрагментов <ХМР> .. </ХМР> из документа HTML while (<>) {

print 1f m#<XMP>#i .. m#</XMP>#1： }

To же, но в виде команды интерпретатора

% perl -ne 'print if m#<XMP>#1 .. m#</XMP>#1' document.html

Если хотя бы один из операндов задан в виде числовой константы, интервальные операторы осуществляют неявное сравнение с переменной $. ($NR или $INPUT_LINE_NUMBER при действующей директиве use English). Поосторожнее с неявными числовыми сравнениями! В программе необходимо указывать числовые константы, а не переменные. Это означает, что в условии можно написать 3 .. 5, но не $п .. $т, даже если значения $п и $т равны 3 и 5 соответственно. В таких случаях приходится непосредственно проверять переменную $..

Команда не работает

perl -ne 'BEGIN { $top=3; $bottom=5 } print If Stop .. $bottom' /etc/passwd # Работает

perl -ne 'BEGIN {$top=3; $bottom=5 }

print 1f $. == Stop .. $. == $bottom' /etc/passwd

Тоже работает

perl -ne 'print if 3 .. 5' /etc/passwd

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

print if /begin/ .. /end/: print if /begin/ ... /end/:

Для строки "You may not end here you begin" оба интервальных оператора возвращают true. Однако оператор .. не будет выводить дальнейшие строки. Дело в том, что после выполнения первого условия он проверяет второе условие в той же строке; вторая проверка сообщает о найденном конце интервала. Тем не менее оператор ... продолжит поиск до следующей строки, в которой найдется /end/ — он никогда не проверяет оба операнда в одной строке.

Разнотипные условия можно смешивать:

while (<>) {

$in_header =1 .. /皴/:

$in_body = /人$/ .. eof():

} -

Переменная $1n_header становится истинной, начиная с первой входной строки и заканчивая пустой строкой, отделяющей заголовок от основного текста — например, в почтовых сообщениях, новостях Usenet и даже в заголовках HTTP

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

Рассмотрим пример. Следующий фрагмент читает файлы с почтовыми сообщениями и выводит адреса, найденные в заголовках. Каждый адрес выводится один раз. Заголовок начинается строкой "From：" и завершается первой пустой строкой. Если текущая строка не входит в такой интервал, мы переходим к следующей строке. Хотя такое определение заголовка и не соответствует RFC-822, оно легко реализуется.

Zseen = О；

while (<>) {

next unless /人From:?\s/i .. /人$/;

while (/(['<>(),:\s]+\@[x<>().:\s]+)/g) { print "$l\n" unless $seen{$l}++;

}

}

См. также

Описание операторов .. и ... в разделе «Range Operator» perlop⑴;описание переменной $NR в perlvar(l).

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

Проблема

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

Решение

Следующая процедура преобразует метасимволы командного интерпретатора в эквивалентные регулярные выражения; все остальные символы заключаются в кавычки, чтобы они интерпретировались как литералы.

sub glob2pat {

my Sglobstr = shift;

my Zpatm叩=(

? => 1 \

=>.

1 =>

)；

Sglobstr =~ s{(.)} { $patmap{$l} || "\Q$1" }ge； return '人’.Sglobstr . '$';

Комментарий

Шаблоны Perl отличаются от применяемых в командных интерпретаторах конструкций с метасимволами. Конструкция *. * интерпретатора не является допустимым регулярным выражением. Она соответствует шаблону /人.*\. .*$/, который совершенно не хочется вводить с клавиатуры.

Функция, приведенная в Решении, выполняет все преобразования за вас. При этом используются стандартные правила встроенной функции glob. В табл. 6.2 приводятся эквивалентные шаблоны командного интерпретатора и Perl.

Таблица 6.2. Метасимволы командного интерпретатора и Perl

Командный интерпретатор

Perl

list.? project.* *old type*.[ch] *■*

*

Alist\..$

Л projects. *$

A.*old*

Atype.*\.[ch]$ л.*\..*$ л.*$

Функция возвращает строку, а не объект регулярного выражения, поскольку это привело бы к жесткой фиксации всех заданных (и не заданных) модификаторов типа /1, а это решение лучше отложить на будущее.

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

Многие интерпретаторы не ограничиваются простыми обобщениями в одном каталоге. Например, конструкция */* означает «все файлы во всех подкаталогах текущего каталога». Кроме того, многие интерпретаторы не выводят имена файлов, начинающиеся с точки, если точка не была явно включена в шаблон поиска. Функция glob2pdt такими возможностями не обладает — если они нужны, воспользуйтесь модулем CPAN File： :KGlob.

См. также

Страницы руководства различных командных интерпретаторов, например, cs/г⑴, ksh(l), s/z(l), ksh(l) и bash(l); описание функции glob в perlfunc(l); документация по модулю CPAN Glob: :DosGlob; раздел «I/O Operators» perlop(l); рецепт 9.6.

Ускорение интерполированного поиска

Проблема

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

Решение

Если имеется всего один шаблон, который не изменяется в течение всей работы программы, сохраните его в строке и воспользуйтесь шаблоном /$pattern/o:

while ($11ne = <>) {

if ($11ne =~ /$pattern/o) {

Сделать что-то

}

}

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

@pats = map { qr/$_/ } (^strings：

while ($11ne = <>) {

for $pat (@pats) {

if ($11ne =~ /$pat/) {

Сделать что-то

Комментарий

Во время компиляции программы Perl преобразует шаблоны во внутреннее представление. На стадии компиляции преобразуются шаблоны, не содержащие переменных, однако преобразование шаблонов с переменными происходит во время выполнения. В результате интерполяция переменных в шаблонах (например, /$pattern/) замедляет работу программы. Это особенно заметно при частых изменениях $pattern.

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

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

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

В примере 6.4 показана медленная, но очень простая методика многострочного поиска для нескольких шаблонов. Массив Qpopstdtes содержит стандартные сокращенные названия некоторых американских штатов, в которых безалкогольные газированные напитки обозначаются словом «рор». Задача — вывести все строки входного потока, в которых хотя бы одно из этих сокращений присутствует в виде отдельного слова. Модификатор /о в этом случае не подходит, поскольку переменная, содержащая шаблон, постоянно изменяется.

Пример 6.4. popgrepl

# popgrepl - поиск строк с названиями штатов # версия 1： медленная, но понятная Opopstates = qw(CO ON MI WI MN): LINE: while (defined($lIne = <>)) {

for $state (Opopstates) {

if ($11ne =~ /\b$state\b/) { #Медленно 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)；

@poppats = map { qr/\b$_\b/ } Opopstates:

LINE： while (defined($11 ne = <>)) {

for Spat (Qpoppats) {

if ($11ne =~ /$pat/) {# Работает быстро

print; next LINE;

}

При выводе массива Qpoppdts вы увидите строки следующего вида:

(?-xism：\bCO\b)

(?-x1sm：\bON\b)

(?-xism：\bMI\b)

(?-xism：\bWI\b)

(?-x1sm：\bMN\b)

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

См. также

Описание оператора qr// в perlop^i).

Проверка правильности шаблона

Проблема

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

Решение

Сначала проверьте шаблон с помощью конструкции 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)

и возвращает это значение. В противном случае следующая команда пропускается, поэтому процедура возвращает 0.

Комментарий

Некомпилируемые шаблоны встречаются сплошь и рядом. Пользователь может по ошибке ввести "<Is*[^">, "*** GET RICH ***" или "+5-1". Если слепо воспользоваться введенным шаблоном в программе, возникнет исключение; как правило, это приводит к аварийному завершению программы.

Крошечная программа из примера 6.6 показывает, как проверяются шаблоны.

Пример 6.6. paragrep

#!/usr/b1n/perl

# paragrep - просте^и^ поиск

die "usage： $0 pat [f1les]\n" unless @ARGV;

$/ =

Spat = shift;

eval { "" =~ /$pat/: 1 } or die "$0: Bad pattern $pat: $@\rT;

while (<>) {

print "$ARGV $.: $_" 1f /$pat/o:

}

Модификатор /о означает, что переменные должны интерполироваться только один раз, даже если позднее их значения изменятся.

Проверку можно инкапсулировать в функции, которая возвращает 1 при успешном завершении блока и 0 в противном случае (см. выше Решение). Хотя исключение можно также перехватить с помощью eval "/$pat/", у такого решения есть два недостатка. Прежде всего, во введенной пользователем строке не должно быть символов / (или других ограничителей шаблонов, выбранных вами). Важнее другое: в системе безопасности открывается зияющая брешь, которую было бы крайне желательно избежать. Некоторые строки могут сильно испортить настроение:

$pat = "You lose @{[ system('rm -rf *')]} big here":

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

$safe_pat = quotemeta($pat):

something О 1f /$safe_pat/；

Или еще проще:

something() 1f /\Q$pat/:

Но если вы делаете нечто подобное, зачем вообще связываться с поиском по шаблону? В таких случаях достаточно простого применения 1 ndex. Впрочем, иногда шаблон должен содержать как литеральную часть, так и регулярное выражение:

someth1 ng() 1f /x\s*\Q$pat\E\s*$/;

Разрешая пользователю вводить настоящие шаблоны, вы открываете перед ним много интересных и полезных возможностей. Это, конечно, хорошо. Просто

придется проявить некоторую осторожность, вот и все. Допустим, пользователь желает выполнять поиск без учета регистра, а вы не предусмотрели в своей программе ключ типа -1 в grep. Работая с полными шаблонами, пользователь сможет установить внутренний модификатор /1 в виде (?i), например, /(?i)stuff/.

Что произойдет, если в результате интерполяции получается пустая строка? Если $pat — пустая строка, с чем совпадет /$pat/ — иначе говоря, что произойдет при пустом поиске //? С началом любой возможной строки? Неправильно. Как ни странно, при поиске по пустому шаблону повторно используется шаблон предыдущего успешного поиска. Подобная семантика выглядит сомнительно, а найти для нее практическое применение в Perl нелегко.

См. также

Описание функции eval в perlfunc(l).

Локальный контекст в регулярных выражениях

Проблема

Требуется преобразовать регистр в другом локальном контексте или заставить метасимвол \w совпадать с символами национальных алфавитов, например, Jose или deja vu.

Предположим, у вас имеется полгигабайта текста на немецком языке, для которого необходимо составить алфавитный указатель. Вы хотите извлекать слова (с помощью \w+) и преобразовывать их в нижний регистр (с помощью 1с или \L). Однако обычные версии \w и 1 с не находят слова немецкого языка и не изменяют регистр символов с диакритическими знаками.

Решение

Регулярные выражения и функции обработки текста Perl имеют доступ к локальному контексту POSIX. Если включить в программу директиву use locale, Perl позаботится о символах национальных алфавитов, конечно, при наличии разумной спецификации LC_CTYPE и системной поддержки.

use locale：

Комментарий

По умолчанию \w+ и функции преобразования регистра работают с буквами верхнего и нижнего регистра, цифрами и подчеркиваниями. Преобразуются лишь простейшие английские слова, и даже в очень распространенных заимствованных словах происходят сбои. Директива use locale помогает справиться с затруднениями.

Пример 6.7 показывает, чем отличаются выходные данные для английского (еп) и немецкого (de) локальных контекстов.

Пример 6.7. localeg

#!/usr/bin/perl -w

# localeg - выбор локального контекста use locale：

use POSIX 'locale_h':

$name = "andreas k\xF6nig"：

@locale{qw(German English)} = qw(de_DE.IS0_8859-l us-ascii);

setlocale(LC_CTYPE. $1ocale{Englishj)

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, ucf什st($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(l) и странице руководства locale(3) вашей системы; рецепт 6.2; раздел «POSIX — попытка стандартизации» главы 3 книги «Регулярные выражения: Библиотека программиста, 2 издание».

Неформальный поиск

Проблема

Требуется выполнить неформальный поиск по шаблону.

Задача часто возникает в ситуации, когда пользовательский ввод может быть неточным или может содержать ошибки.

Решение

Воспользуйтесь модулем CPAN String：: Approx:

use Strin：：Approx qw(amatch)：

if (amatch("ШАБЛОН", ©list)) {

# Совпадение

}

©matches = amatchCШАБЛОН", ©list);

Комментарий

Модуль String：: Approx вычисляет, насколько шаблон отличается от каждой строки списка. Если количество односимвольных вставок, удалений или замен для получения строки из шаблона не превышает определенного числа (по умолчанию 10 процентов длины шаблона), строка «условно совпадает» с шаблоном. В скалярном контексте amatch возвращает количество успешных совпадений. В списковом контексте возвращаются совпавшие строки.

use String：：Approx qw(amatch)：

open(DICT, "/usr/dlct/words"or die "Can't open diet: $!";

while(<DICT>) {

print if amatchC'balast"):

}

ballast ballustrade blast blastula sandblast

Функции amatch также можно передать параметры, управляющие учетом регистра и количеством допустимых вставок, удалений и подстановок. Параметры передаются в виде ссылки на список. Они полностью описаны в документации по String： ：Approx.

Следует заметить, что поисковые функции модуля работают в 10-40 раз медленнее встроенных функций Perl. Используйте String：:Approx лишь в том случае, если регулярные выражения Perl не справляются с неформальным поиском.

См. также

Документация по модулю CPAN String：:Approx; рецепт 1.22.

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

Проблема

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

Решение

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

Found numeral10

Found numeral3

Found rd after the last number.

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

Позиция последнего совпадения читается и задается функцией 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). "\nn：

Got White, position in $a now 43

Если аргумент не указан, pos работает с переменной $_:

$_ = "Nay, I have seen more than thou knowest. Grey Fool."：

/T\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(i).

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

Проблема

Шаблон содержит максимальный квантификатор — *,+,? или {}. Требуется перейти от максимального поиска к минимальному.

Классический пример — наивная подстановка для удаления тегов из HTML- документа. Хотя s#<TT>. *</TT>##gsi выглядит соблазнительно, в действительности будет удален весь текст от первого открывающего до последнего закрывающего тега ТТ. От строки "Even <TT>vi</TT> can edit <TT>troff</TT> effectively." остается лишь "Even effectively" — смысл полностью изменился!

Решение

Замените максимальный квантификатор соответствующим минимальным. Другими словами, *, +, ? или {} соответственно заменяются *?, +?, ?? и {}?.

Комментарий

В Perl существует два набора квантификаторов: максимальные (*,+,? и {}) и минимальные1 (*?, +?, ?? и {}?). Например, для строки "Perl is a Swiss Army Chainsaw!" шаблон /(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". Вероятно, вы рассчитывали на другой результат.

Представьте, что мы хотим извлечь из Н Т М L-доку мента весь текст, оформленный полужирным и курсивным шрифтом одновременно:

<b><1>th1s</1> and <1>that</1> are 1mportant</b> Oh, <b><1>me too!</1></b>

Может показаться, что шаблон для поиска текста, находящегося между парами тегов HTML (то есть не включающий теги), должен выглядеть так:

т{ <Ь><1>(.*?)</1></Ь> }sx；

Как ни странно, шаблон этого не делает. Многие ошибочно полагают, что он сначала находит последовательность "<Ь><1>", затем нечто отличное от "<Ь><1>", а затем — "</1></Ь>", оставляя промежуточный текст в $1. Хотя по отношению к входным данным он часто работает именно так, в действительности делается совершенно иное. Шаблон просто находит ближнюю к левому краю строку

Также часто называемые «жадными» (greedy) и «ленивыми» (lazy) квантификаторами.— Примеч. перев.

минимальной длины, которая соответствует всему шаблону. В данном примере это вся строка. Если вы хотели ограничиться текстом между "<Ь><1>" и парными тегами "</1></Ь>", не включающим другие теги полужирного или курсивного начертания, результат окажется неверным.

Если искомая строка состоит всего из одного символа, инвертированный класс (например, /X[人Х]*)Х/) работает гораздо эффективнее минимального поиска. Однако обобщенный шаблон, который находит «сначала 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#Найти начальную часть

(#Сохранить 「руппу в $1

(?:#Несохраняющая 「руппировка

(?! BEGIN ) # проверка： исключаем другие вхождения BEGIN

(?! END) # проверка： также исключаются вхождения END

# Один произвольный символ

)*# Вся 「руппа 0 и более раз

)# Завершение группы $1

END

}sx

Вместо введения новой опережающей проверки также можно дополнить существующую конструкцией выбора: (?!BEGIN|END). В этом случае наш пример с тегами HTML выглядит приблизительно так:

т{ <Ь><1>( (?: (?!</Ь>|</1>). )* ) </1></Ь> }sx：

или так:

т{ <Ь><1>( (?:(?!〈/[ib]>). )* ) </1></b> }sx：

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

<Ь><1>

[人<]* # Заведомо допустимо (?:

# Символ '<'возможен, если он не входитвнедопустимую конструкцию

(?! </?[ib]>)# Недопустимо

<#Все нормально,найти<

[人<]*#и продолжить

)*

</1></Ь>

}sx

Данное решение является разновидностью методики «раскрутки цикла», описанной в главе 6 книги «Регулярные выражения: Библиотека программиста, 2 издание».

См. также

Описание минимальных квантификаторов в разделе «Regular Expressions» perlred).

6-16- Поиск повторяющихся слов

Проблема

Требуется найти в документе повторяющиеся слова.

Решение

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

Комментарий

Механизм поиска запоминает часть строки, которая совпала с частью шаблона, заключенной в круглые скобки. Позднее в шаблоне конструкция \1 ссылается на первый совпавший фрагмент, \2 — на второй и т. д. Не используйте обозначение $1 — оно интерпретируется как переменная и интерполируется до начала поиска. Шаблон /([A-Z])\l/ совпадает с символом верхнего регистра, за которым следует не просто другой символ верхнего регистра, а именно тот, что был сохранен в первой паре скобок.

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

двумя и более смежными переводами строк. Внутри каждого абзаца программа находит все повторяющиеся слова. Программа не учитывает регистр символов и допускает межстрочные совпадения.

Модификатор /х разрешает внутренние пропуски и комментарии, упрощающие чтение регулярных выражений. Модификатор /1 позволяет найти оба экземпляра "1s" в предложении "Is is this ok?". Модификатор /g в цикле while продолжает поиск повторяющихся слов до конца текста.

$/=''；# Режим чтения абзацев

while (<>) {

while ( m{

\b# Начать с границы слова

(\S+)# Искать последовательность "не-пропусков"

\Ь# До дру「о力 границы слова

(

\s+# Разделяющие пропуски

\1# И тот же самый фрагмент

\Ь # До дру「о力 границы слова

)+# Повторяется один или несколько раз

}xig

{ print "dup word '$Г at paragraph $.\n"：

}

}

Приведенный фрагмент найдет удвоенное test в следующем примере:

This 1s a test

test of the duplicate word funder.

Проверка \S+ между двумя метасимволами границ слов обычно нежелательна, поскольку при этом происходит нечто неожиданное. Граница слова в Perl определяется как переход между \w (алфавитно-цифровым символом или подчеркиванием) и либо концом строки, либо не-Xw. Но между двумя \Ь последовательность \S+ (один и более символов, не являющихся пропусками) приобретает несколько иной смысл — она интерпретируется как последовательность символов, не являющихся пропусками, первый и последний символ которой должны быть алфавитно-цифровыми символами или подчеркиваниями.

Впрочем, иногда именно это и нужно. Рассмотрим следующую строку:

Sstrlng = q("I can't see this," she remarked.):

©a = $string =~ /\b\S+\b/g；

@b = $string =~ /\S+/g;

Массив @d содержит следующие элементы:

0 I

1 can't

see

this

she

remarked

тогда как массив @Ь выглядит так:

О "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:

/人(\w+?)(\w+) \2(\w+)$/

Трудно представить, насколько мощными возможностями обладают обратные ссылки. Пример 6.8 демонстрирует принципиально новый подход к проблеме разложения числа на простые множители (см. главу 2 «Числа»).

Пример 6.8. prime-pattern

#!/usr/bin/perl

# prime_pattern - разложение аргумента на простые множители по шаблону

for ($N = ('o' х shift)： $N =~ /人(oo+?)\l+$/; $N =~ s/$l/o/g) { print length($l),""：

}

print length ($N), "\n"；

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

Приведем другой пример. Гениальная идея, предложенная Дугом Мак-Илроем (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), 1ength($Z));

print "One solution is： x=$x： y=$y: z=$z.\n"：

} else {

print "No solution.\n"；

}

One solution is： x=17; y=3; z=2.

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

(('о' х 281) =~ /х(0+)\1{11}(0+)\2{14}(0+)\3{15}$/))

One solution is： х=17; у=3; z=2.

(('o' х 281) =~ /х(0*?)\1{11}(0*)\2{14}(0*)\3{15}$/))

One solution is: x=0; y=17; z=ll.

(('o' x 281) =~ /х(0+?)\1{11}(0*)\2{14}(0*)\3{15}$/))

One solution is: x=l; y=3; z=14.

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

См. также

Описание обратных ссылок в разделе «Regular Expressions» perlre(t); раздел «Задача с повторяющимися словами» книги «Регулярные выражения: Библиотека программиста, 2 издание».

Поиск вложенных конструкций

Проблема

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

Решение

Используйте рекурсивную интерполяцию шаблона во время поиска:

ту $пр；

$np = qr{

\( (?:

(?> [人()]+ ) # Несохраняющая группа без возврата

(??{ $пр })# 「руппировка с парными круглыми скобками

)* \)

}х；

Также можно воспользоваться функцией extract_bracketed модуля Text: balanced.

Комментарий

Конструкция $(??{ КОД }) выполняет заданный фрагмент кода и интерполирует полученную строку в шаблон. Для примера рассмотрим простую, нерекурсивную программу поиска палиндромов:

If ($word =~ /x(\w+)\w?(??{reverse $1})$/ ) {

print "Sword is a palindronie.\n"：

Допустим, программа находит слово «reviver», которое правильно распознается этим шаблоном как палиндром. В определенный момент поиска в переменной $1 окажется строка "rev". Следующий необязательный метасимвол \w совпадает с "1". После этого выполняется фрагмент reverse $1 и дает строку "ver"; этот результат интерполируется в шаблон.

При поиске парных конструкций приходится использовать рекурсию, что несколько усложняет решение. Откомпилированный шаблон с конструкцией (??{...}) может содержать ссылку на самого себя. Приведенный в Решении шаблон находит парные круглые скобки независимо от глубины вложения. При таком определении $пр поиск круглых скобок при вызове функции может выполняться так:

$text = "пlyfunfun(l.(2*(3+4)),5),,;

$funpat = qr/\w+$np/：# Определение $пр см. выше

$text =~ /x$funpat$/；# Есть совпадение!

Архив CPAN содержит много модулей, предназначенных для поиска вложенных строк. Модуль Regexp:: Common содержит готовые шаблоны для многих нетривиальных ситуаций. Например:

use Regexp：:Common：

$text = ,,пlyfunfun(l,(2*(3+4)).5),,;

If ($text =~ /(\w+\s*$RE{balanced}{-parens=>'( )'})/o) {

print "Got function cal 1： $l\n"；

Другие шаблоны, содержащиеся в этом модуле, предназначены для поиска чисел в разных вариантах записи, а также строк, заключенных в ограничители:

$RE{num}{int}

$RE{num}{real}

$RE{num}{real}{'-base=2'}{'-sep=，‘}{'-group=3'}

$RE{quoted}

$RE{del1m1ted}{-del1пl=>,/,}

Стандартный (начиная с версии 5.8) модуль Text::Balanced содержит общее решение этой проблемы:

use Text：：Balanced qw/extract_bracketed/;

$text = "niyfunfun(l.(2*(3+4))75)":

if (($before, $found. $after) = extract_bracketed($text. "(")) { print "answer is $found\n":

} else {

print "FAILED\n";

}

См. также

Документация по модулю CPAN Regexp::Common и стандартному модулю Text: :Balanced.

Логические операции AND, OR и NOT в одном шаблоне

Проблема

Имеется готовая программа, которой в качестве аргумента или входных данных передается шаблон. В нее невозможно включить дополнительную логику, например, параметры для управления учетом регистра при поиске, AND и NOT. Следовательно, вы должны написать один шаблон, который будет совпадать с любым из двух разных шаблонов (OR), двумя шаблонами сразу (AND) или менять смысл поиска на противоположный (NOT).

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

chomp($pattern = <CONFIG_FH>)： if ( $data =~ /$pattern/ ){...}

Если вы отвечаете за содержимое CONFIG_FH, вам понадобятся средства для передачи программе поиска логических условий через один-единственный шаблон.

Решение

Следующие выражения истинны при совпадении /ALPHA/ или /ВЕТА/ (аналогично /ALPHA/ I I /ВЕТА/):

/ALPHA I ВЕТА/

/(?:ALPHA)I(?:ВЕТА)/ # Работает независимо от содержания ALPHA и ВЕТА

Выражение истинно, если и /ALPHA/ и /ВЕТА/ совпадают с возможными перекрытиями (то есть когда подходит строка "BETALPHA' ). Аналогично /ALPHA/ && /ВЕТА/:

/'(?=.*ALPHA)BETA)/s

Выражение истинно, если и /ALPHA/ и /ВЕТА/ совпадают при запрещенных перекрытиях (то есть когда "BETALPHA" не подходит):

/ALPHA.*BETA|BETA.*ALPHA/S

Выражение истинно, если шаблон /РАТ/ не совпадает (аналогично $var !~ /РАТ/):

/x(?:(?!PAT).)*$/s

Выражение истинно, если шаблон BAD не совпадает, а шаблон GOOD совпадает:

/(?=x(?:(?!BAD).)*$)GOOD/s

(Вообще говоря, нельзя рассчитывать на возможность включения модификатора /s после завершающего символа /, но в конце Комментария будет показано, как включить этот модификатор прямо в шаблон.)

Комментарий

Предположим, вы пишете программу и хотите проверить некоторый шаблон на несовпадение. Воспользуйтесь одним из вариантов:

if (!($string=~/pattern/)){someth!ng()}#Некрасиво

if ( $string!~/pattern/){something。}#Рекомендуется

unless ( $string=~/pattern/){someth!ng()}#Более наглядно

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

if ($string =~ /patl/ && $string =~ /pat2/ ) { something() }

Проверка совпадения хотя бы одного из двух шаблонов выполняется так:

if ($string =~ /patl/ || $string =~ /pat2/ ) { someth!ng() }

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

Пример 6.9. minigrep

#!/usr/bin/perl

# minigrep - тривиальный поиск

$pat = shift: while (<>) { print if /$pat/o：

}

Если потребуется сообщить minigrep, что некоторый шаблон не должен совпадать или что должны совпасть оба мини-шаблона в произвольном порядке, вы оказываетесь в тупике. Программа просто не предусматривает подобных конструкций. Как сделать все в одном шаблоне? Подобные задачи нередко возникают в программах, читающих шаблоны из конфигурационных файлов.

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

В случае с AND придется различать перекрывающиеся и неперекрывающие- ся совпадения. Допустим, вы хотите узнать, совпадают ли в некоторой строке шаблоны "bell" и "lab". Если разрешить перекрытия, слово "labelled" пройдет проверку, а если отказаться от перекрытий — нет. В случае с перекрытиями потребуются две опережающие проверки: "labelled" =~ /'(?=.*bel1)lab/s

Помните: в нормальной программе подобные извращения не нужны. Достаточно указать:

$string =~ /bel1/ && $string =~ /1аЬ/

Чтобы раскрыть смысл этого шаблона, мы воспользуемся модификатором /х с комментариями. Развернутая версия шаблона выглядит так:

if ($murray_hill =~ m{

人#Начало строки

(?=#Опережающая проверка нулевойширины

.*#Любое количество промежуточныхсимволов

bell#Искомая строка bell

)#Вернуться, мы лишь проверяем

lab#Искомая строка labs

}sx )# /s разрешает совпадение . с переводом строки

{

print "Looks like Bel 1 Labs might be in Murray Hill!\n": }

Мы не воспользовались .*? для раннего завершения поиска, поскольку минимальный поиск обходится дороже максимального. Поэтому для произвольных входных данных, где совпадение с равной вероятностью может произойти как в начале, так и в конце строки, .* будет эффективнее нашего решения. Разумеется, выбор между .* и .*? иногда определяется правильностью программы, а не эффективностью, но не в данном случае.

Для обработки неперекрывающихся совпадений шаблон будет состоять из двух частей, разделенных OR. В первой части "lab" следует после "bell", а во второй — наоборот:

"labelled" =~ /(?：'.*bell.*lab)|(?：x.*lab.*bell)/

или в развернутой форме:

$brand = "labelled"： if ($brand =~ m{

(?:# 「pynrmpoBKd без сохранения

人.*?# Любое количество начальных символов

bell # Искомая строка bell

.*?# Любое количество промежуточных символов

lab#Искомая строка lab

)#Конец группировки

I#Или попробовать другой порядок

(?:#「руппировка без сохранения

人.*?#Любое количество начальных символов

lab#Искомая строка lab

.*?# Любое количество промежуточных символов

bel 1#Искомая строка bell

)#Конец 「руппировки

}sx )# /s разрешает совпадение . с переводом строки

{

print "Our brand has bell and lab separate.\n"； }

Такие шаблоны не всегда работают быстрее. $murray_hi 11 =~ /bell/ && $murray_ hllle =~ /lab/ сканирует строку не более двух раз, однако для (?=^.*?bel 1) (?=А.*?1аЬ) механизм поиска ищет "lab" для каждого экземпляра "bel 1", что в наихудшем случае приводит к квадратичному времени выполнения.

Тем, кто внимательно рассмотрел эти два случая, шаблон NOT покажется тривиальным. Обобщенная форма выглядит так:

$map =~ /A(?:(?!waldo).)*$/s

То же в развернутой форме:

if ($map =~ m{

人#Начало строки

(?:#Группировка без сохранения

(?!#Опережающая негативная проверка

waldo #Нашли впереди?

)#Если да, отрицание не выполняется

# Любой символ (благодаря /s)

)*# Повторить 「руппировку 0 и более раз

$# До конца строки

}sx )# /s разрешает совпадение . с переводом строки

{

print "There's no waldo here!\n"：

}

Как объединить в одном шаблоне AND, OR и NOT? Результат выглядит отвратительно, и в обычных программах делать нечто подобное практически никогда не следует. Однако при обработке конфигурационных файлов или командных строк, где вводится всего один шаблон, у вас нет выбора. Объедините все изложенное выше. Будьте осторожны.

Предположим, вы хотите запустить программу UNIX w и узнать, зарегистрировался ли пользователь tchrlst с любого терминала, имя которого начинается не с ttyp; иначе говоря, шаблон "tchrist" должен совпадать, a "ttyp” — нет.

Примерный вывод w в моей системе Linux выглядит так:

7:15am

up 206 days, 13:30,

4 users, load average: 1.04, 1.07, 1.04

USER

TTY

FROM

LOGIN© IDLE

JCPU

PCPU

WHAT

tchrist

ttyl

5:16pm 36days

24:43

0.03s

xinit

tchrist

tty2

5:19pm 6days

0.43s

0.43s

•tcsh

tchrist

ttypO

chthon

7:58am 3days

23:44s

0.44s

•tcsh

gnat

ttys4

coprolith

2：01pm 13:36m

0.30s

0.30s

-tcsh

Посмотрим, как поставленная задача решается с помощью приведенной выше программы minigrep или программы tcgrep, приведенной в конце главы:

%w I minigrep ' (?! .*ttyp)tchrist'

Расшифровка структуры шаблона: m {

(?!# Опережающая проверка нулевой ширины

.*# Любое количество любых символов (быстрее .*?)

ttyp # Строка, которая не должна находиться

)# Опережающая отрицательная проверка： возврат к началу

tchrist # Пытаемся найти пользователя tchrist }х

Неважно, что любой нормальный человек в такой ситуации дважды вызывает grep (из них один — с параметром -v, чтобы отобрать несовпадения):

% w I grep tchrist | grep -v ttyp

Главное — что логические конъюнкции и отрицания можно закодировать в одном шаблоне. Однако подобные вещи следует снабжать комментариями — пожалейте тех, кто займется ими после вас.

И последнее: как внедрить модификатор /s в шаблон, передаваемый программе из командной строки? По аналогии с /1, который в шаблоне превращается в (?1). Модификаторы /s и /т также безболезненно внедряются в шаблоны в виде /(?s) или /(?т). Их даже можно группировать, например, /(?snd). Следующие две строки фактически эквивалентны:

^ grep -1 'ШАБЛОН' ФАЙЛЫ

% minigrep '(?1)ШАБЛОН' ФАЙЛЫ

Модификатор, активизированный таким способом, распространяется на весь шаблон. Также существует альтернативная запись, ограничивающая область действия модификатора, — используйте несохраняющую группировку (?:...) и разместите модификаторы между вопросительным знаком и двоеточием. Вывод регулярного выражения, обработанного оператором qr//, показывает, как это делается: % perl -le 'print qr/pattern/1' (?i-xsm：pattern)

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

См. также

Описание опережающих проверок в разделе «Regular Expressions» perlre(l)] страницы руководства grep(l) и а(1) вашей системы. Работа с конфигурационными файлами рассматривается в рецепте 8.16.

Проверка адресов электронной почты

Проблема

Требуется построить шаблон для проверки адресов электронной почты.

Решение

Задача в принципе неразрешима, проверка адреса электронной почты в реальном времени невозможна. Приходится выбирать один из возможных компромиссов.

Комментарий

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

Дорогой someuser@host.coni.

Просим подтвердить почтовый адрес, сообщенный вами в 10:29:01 29 июня 2003 года. Для зтого достаточно ответить на настоящее сообщение. Включите в ответ строку "Rumpelstiltskin", но в обратном порядке (то есть начиная с "Nik..."). После этого ваш подтвержденный адрес будет занесен в нашу базу данных.

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

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

Многие шаблоны, предлагаемые для решения этой проблемы, попросту неверны. Допустим, адрес thl s&thaWsomewhere. com правилен и по нему возможна доставка почты (на момент написания книги), однако большинство шаблонов, претендующих на проверку почтовых адресов, бесславно споткнутся на нем.

while $dddr =~ s/\([x()]*\)//g;

Вообще говоря, для проверки соответствия RFC можно воспользоваться 6598байтовым шаблоном, приведенным на последней странице первого издания книги «Регулярные выражения: Библиотека программиста», но даже эта чудовищная конструкция не идеальна по трем причинам.

Во-первых, не по всем адресам, соответствующим спецификации RFC, возможна доставка. Например, адрес foo@foo. foo. foo. foo теоретически правилен, но

на практике доставить на него почту невозможно. Некоторые программисты пытаются искать записи MX на серверах DNS или даже проверяют адрес на хосте, обрабатывающем его почту. Такой подход неудачен, поскольку большинство узлов не может напрямую подключиться к любому другому узлу, но даже если бы это было возможно, получающие почту узлы обычно либо игнорируют команду SMTP VRFY, либо откровенно врут.

Во-вторых, почта может прекрасно доставляться по адресам, не соответствующим RFC. Например, сообщение по адресу postmaster почти наверняка будет доставлено, но этот адрес не соответствует канонам RFC 822 — в нем нет символа @.

В-третьих (самая важная причина), даже если адрес правилен и по нему возможна доставка, это еще не означает, что он вам подойдет. Например, адрес pres1dent@whitehouse.gov соответствует стандартам RFC и обеспечивает доставку. И все же крайне мало вероятно, чтобы этот адресат стал поставлять информацию для вашего сценария CGI.

Модуль Email: :Valid предпринимает отважную (хотя и далеко не безупречную) попытку решить задачу проверки почтовых адресов. Эта программа выкидывает множество фортелей, среди которых — проверка регулярного выражения на соответствие RFC-822, просмотр записей MX DNS и стоп-списки для ругательств и имен знаменитостей. Но и такой подход оказывается откровенно слабым. Прием, предложенный в начале Комментария, проще реализуется и в меньшей степени подвержен ошибкам.

См. также

Рецепт 18.16.

Поиск сокращений

Проблема

Предположим, у вас имеется список команд, например, "send", "abort", "list" и "edit". Пользователь вводит лишь часть имени команды, и вы не хотите заставлять его вводить всю команду до конца.

Решение

Воспользуйтесь следующим решением, если все строки начинаются с разных символов или если одни совпадения имеют более высокий приоритет по сравнению с другими (например, если "SEND" отдается предпочтение перед "STOP"):

chomp ($answer = <>)：

1s send\n" 1s stop\n" is abort\n is I1st\n" is ed1t\n"1s send\n" 1s stop\n" is abort\n is I1st\n" is ed1t\n"} }} }if ("SEND" =~ /x\Q$answer\1) { print "Action elsif ("STOP" =~ /x\Q$answer\1) { print "Action elslf ("ABORT" =~ /x\Q$answer\1) { print "Action elsif ("LIST" =~ /x\Q$answer\1) { print "Action elsif ("EDIT" =~ /x\Q$answer\1) { print "Action

1s send\n" 1s stop\n" is abort\n is I1st\n" is ed1t\n"

1s send\n" 1s stop\n" is abort\n is I1st\n" is ed1t\n"

} }

} }

Кроме того, можно воспользоваться модулем Text: :Abbrev:

use Text::Abbrev；

$href = abbrev qw(send abort list edit);

for (print "Action: ": <>; print "Action: ") { chomp：

my $dct1on = $href->{ lc($_) };

print "Action Is $action\n"：

}

Комментарий

В первом решении изменяется стандартный порядок операндов при поиске; обычно слева указывается переменная, а справа — шаблон. Мы бы также могли попытаться определить, какое действие выбрал пользователь, с помощью конструкции $dnswer= =~ /人AB0RT/1. Выражение будет истинным, если $dnswer начинается со строки "ABORT". Однако совпадение произойдет и в случае, если после "ABORT" в $dnswer следует что-то еще, скажем, для строки "ABORT LATER". Обработка сокращений обычно выглядит весьма уродливо: $dnswer =~ /人A(B(O(R(T)?)?)?)?$/i.

Сравните классическую конструкцию "переменная =~ шаблон" с "ABORT" =~ /^\Q$answer/i. \Q подавляет интерпретацию метасимволов, чтобы ваша программа не «рухнула» при вводе пользователем неверного шаблона. Когда пользователь вводит что-нибудь типа "ab", после замены переменной шаблон принимает вид "ABORT" =~ /人db/i. Происходит совпадение.

Стандартный модуль Text::Abbrev работает иначе. Вы передаете ему список слов и получаете ссылку на хэш, ключи которого представляют собой все однозначные сокращения, а значения — полные строки. Если ссылка $href создается так, как показано в Решении, $href->{"a"} вернет строку "abort".

Подобная методика часто используется для вызова функции по имени, вводимому пользователем. В принципе возможно решение с использованием символических ссылок:

$name = 'send'； &$name($niessage): $name->($niessage);# Альтернативный, более простой синтаксис

Впрочем, это небезопасно — пользователь сможет выполнить любую функцию нашей программы, если он знает ее имя. Кроме того, такое решение противоречит директиве use strict 'refs'.

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

# Предполагается, что &1nvoke_ed1tor, &del1ver_message, # $f1le и $PAGER определяются в другом месте.

use Text::Abbrev；

my($href, factions, $errors): factions =(

"edit" => \&1nvoke_editor,

"send" => \&deliver_message,

"list" => sub { system($PAGER, $f11e) }, "abort" => sub {

print "See ya!\n"； exit;

}‘

""=> sub {

print "Unknown command： $cmd\n"； $errors++;

);

$href = abbrev(keys factions)：

for (print "Action： "： my $choice = <>； print "Action： ") {

Schoice =~ s/、s+//;# Отсечение начальных пропусков

$choice =~ s八s+$//:# Отсечение конечных пропусков

next unless $choice；

$actions->{ $href->{ lc($choice) } }->():

}

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

Sabbrevlation = 1с($_);

$expansion = $href->{$abbreviation}；

Scoderef = $actions->{$expansion}：

$coderef->()；

См. также

Документация по стандартному модулю Text: :Abbrev. Интерполяция рассматривается в разделе «Scalar Value Constructors» perldata(l).

Программа: urlify

Программа urlify оформляет URL-адреса, найденные в файлах, в виде ссылок HTML. Она работает не для всех возможных URL, но справляется с наиболее распространенными. Программа старается избежать включения знаков препинания, завершающих предложения, в помеченный URL.

Программа является типичным фильтром Perl и поэтому может использоваться для перенаправления ввода:

% gunzip -с ~/ma11/archive.gz | urlify > archive.urllfied

или с передачей файлов в командной строке:

% urlify -/mail/*.inbox > -/allmall .urllfied

Исходный текст программы приведен в примере 6.10.

Пример 6.10. urlify

#!/usr/bin/perl

# urlify - оформление URL-подобных конструкций в виде ссылок HTML

$protos = '(http|telnet|gopher|file|wais|ftp)':

$ltrs = '\w'；

$gunk = 7#~：.?+=&%@!\」：

$punc = '. :?\-';

$any = "${ltrs}${gunk}${punc}"；

while (<>) {

s{

\b# Начать с 「раниин слова

(# Начать сохранение $1 {

$protos :# Искать имя ресурса и двоеточие.

[$апу] +?# за которыми следует один или более

# любых допустимых символов, но

# проявлять умеренность и брать лишь то.

# что действительно необходимо ....

)# Завершить сохранение $1 }

(?=# Опережающая проверка без смещения

[$рыпс]*#либо 0.либо знакпрепинания

[人$апу]#далееследуетсимвол,невходящий в url

I#или

$#конецстроки

)

}{<А HREF="$1">$1</A>}igox;

print:

}

Программа: tcgrep

Ниже приведена версия программы Unix grep, написанная на Perl. Хотя она работает медленнее версий, написанных на С (особенно GNU-версии grep), зато обладает многими усовершенствованиями.

Первая и самая важная особенность — эта программа работает везде, где работает Perl. Имеется ряд дополнительных возможностей — tcgrep игнорирует все файлы, кроме простых текстовых; автоматически распаковывает сжатые или обработанные утилитой gzip файлы; выполняет просмотр в подкаталогах; ищет полные абзацы или записи, определенные пользователем; ищет более свежие версии файлов, а также подчеркивает или выделяет найденные совпадения. Кроме того, с ключом -с программа выводит количество найденных записей, а с ключом -С — число найденных совпадений, которые могут содержать несколько записей.

Распаковка сжатых файлов выполняется утилитами gzcat или zcat, поэтому данная возможность отсутствует в системах, где эти программы недоступны, а также в системах, не позволяющих запускать внешние программы (например, в старых системах Macintosh).

При запуске программы без аргументов на экран выводится краткая справка по ее использованию (см. процедуру usage в программе). Следующая командная строка рекурсивно и без учета регистра ищет во всех файлах почтового ящика -/mall сообщения с отправителем "kate" и выводит имена найденных файлов:

% tcgrep -ril '人From： .*kate' ~/mail

Исходный текст программы приведен в примере 6.11.

Пример 6.11. tcgrep

#!/usr/bin/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)； # Обработать файлы

exit(2) if $Errors；

exlt(O) If $Grand_Total； exlt(l)： // IIII // // // // // //#// // // // // // // II и // // // // // // // //#// //#// //## 1Г1ППГ1Г1ПППГ7ПППГ1Г1ПППГ1Т1^^ sub Inlt {

($Me = $0) =~ s!.*/!!:# Получить базовое имя просраммн, "tcgrep"

$Errors = $Grand_Totdl = 0:# Инициализировать глобальные счетчики

$Mult = ""；# Флаг для нескольких файлов в @ARGV

$| = 1:# Автоматическая очистка выходного буфера

式oppress = (# Расширения и имена просрамм

z => 'gzcat'.# для распаковки

gz => 'gzcat',

Z => 'zcat', ): } #II II ////// II IIII II

7ППППППгн1Г1Т11ин1Г1ПГ1Г1Гни1Гп1Г^ sub usage {

die «EOF

usage： $Me [flags] [files]

Standard grep options：

i case Insensitive n number lines cgive count of lines matching

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

ffile with expressions

list filenames matching

Specials：

1 match per file

Нhighlightmatches

uunderlinematches

rrecursiveon directoriesor dot ifnone

tprocess directoriesIn'Is-t' order

p paragraph mode (default： line mode) P ditto, but specify separator, e.g. -P '窺\\n' a all files, not just plain text files q quiet about failed file and d1 r opens T trace files as opened

May use a TCGREP environment variable to set default options. EOF }

7П1^1Г7ПТ1Т1ГП7Г1ПГ1Г1Г1Г1Г1ПГ7Г7Г7Г1Г1Г7Г7^^

sub parse_args {

use Getopt:：Std:

my ($optstring, $zeros, $nulls, %opt, $pattern, ©patterns, $match_code);

my ($S0, $SE)：~

if (my $opts = $ENV{TCGREP}) { # Получить переменную окружения TCGREP $opts =~ s/人([人\-])/-$l/； # Если начальный - отсутствует, добавить unshift(@ARGV, $opts);# Включить строку TCGREP в @ARGV

$optstring = "1ncCwsxvhe:f:1IHurtpP:aqT";

$zeros = 'InCwxvhelut';$nulls = 'pP':@opt{ split //, $zeros }= @opt{ split //. $nulls }= getopts($optstring, \%opt) if ($opt{f}) {open(PATFILE, $opt{f})$zeros = 'InCwxvhelut';$nulls = 'pP':@opt{ split //, $zeros }= @opt{ split //. $nulls }= getopts($optstring, \%opt) if ($opt{f}) {open(PATFILE, $opt{f})Параметры, инициализируемые О

$zeros = 'InCwxvhelut';

$nulls = 'pP':

@opt{ split //, $zeros }= @opt{ split //. $nulls }= getopts($optstring, \%opt) if ($opt{f}) {

open(PATFILE, $opt{f})

$zeros = 'InCwxvhelut';

$nulls = 'pP':

@opt{ split //, $zeros }= @opt{ split //. $nulls }= getopts($optstring, \%opt) if ($opt{f}) {

open(PATFILE, $opt{f})

(для отмены препупрежпен疝)

Параметры, инициализируемые ""

(для отмены предупреждений)

(0 ) х length($zeros)；

('')х length($nulls);

or usageO ；

-f файл с шаблонами

$!);$!);or die qq($Me： Can't open '$opt{f}'：

$!);

$!);

Проверить каждый шаблон в файле

while ( defined($pattern = <PATFILE>) ) {

chomp $pattern:

eval { 'foo' =~ /$pattern/, 1 } or

die "$Me： $opt{f}：$.： bad pattern： $@"； push ©patterns, Spattern：

}

close PATFILE：

}

else {# Проверить шаблон

$pattern = $opt{e} || shift(@ARGV) || usage();

eval { 'foo' =~ “pattern/； 1 } or

die "$Me： bad pattern： $@"；

©patterns = ($pattern)；

}

# -H - выделить цветом, -u - подчеркнуть

if ($opt{H} 11 $opt{u}) {

my $term = $ENV{TERM} || 'vtlOO':

my $terminal:

eval {# Попытаться найти служебные

# последовательности для выделения require POSIX:# или подчеркнуть через Term::Сар

use Term：：Сар:

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

my $termios = POSIX::Term1os->new()；

$termios->getattr；

ту $ospeed = $termios->getospeed:

$terminal = Tgetent Term：：Cap { TERM=>undef. OSPEED=>$ospeed } }；

unless ($@) {# Если успешно, получить служебные

# последовательности для выделения (-Н)

local $%! = 0;# или подчеркивания (-и)

($S0. $SE) = $opt{H}

? ($terminal->Tputs('so'). Stermlnal->Tputs('se'))

:(Sterminal^TputsCus'). $terminal->Tputs('ue')):

}

else {# Если попытка использования Term：：Cap

заканчивается неудачей, получить

($S0. $SE) = $opt{H} # служебные последовательности

командой tput

? ('tput -T $term smso', 'tput -T $term rmso')

:('tput -T $term smul', 'tput -T $term rmul') }

}

-1 - поиск без учета регистра символов

if ($opt{i}) {

©patterns = map {"(?i)$_"} ©patterns；

}一

-p или -P - абзацный режим, добавить /m

if ($opt{p} 11 $opt{P}) {

©patterns = map {,,(?m)$_"} ©patterns；

}一

Стандартный абзацный режим

$opt{p} &&($/=")：

Пользовательский абзацный режим

$opt{P} && ($/ = eval(qq("$opt{P}")));# for -Р '統\n‘

-w - только по границам слова (XXX： всегда ли это оптимально?)

$opt{w} && (©patterns = map {'\b' . $_ . '\b'} ©patterns):

-x - только для полных строк

$opt{'x'} && (©patterns = map {"人$_\$"} ©patterns)；

Проверить. нужно ли выводить имя файла перед каждым совпадением if (@ARGV) {

$Mult = 1 if ($opt{r} 11 (@ARGV > 1) 11 -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;

######

Начинается самое трудное： построение функции в текстовом виде

для последующей передачи 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 .= "\$Matches += !/Spattern/；"：

Полный подсчет с несколькими совпадениями в строке

elsif ($opt{C}) {

foreach $pattern (©patterns) {

$match_code .= "\$Matches++ while /$pattern/g；"：

} 一

}

else {

foreach Spattern (©patterns) {

$match_code .= "\$Matches++ If /Spattern/："；

}"

}

Откомпилировать как замыкание и получить указатель на функцию.

Smatcher = eval "sub { $match_code }";

die if $@；

return (\%opt, Smatcher);

}

//////// // // // // // // IIIIЛIIII JI // // // ////##

1Г7ПГ7ПТ1Т1Г7ПГ1Г1Г1Г1ПГ1ПППГ^ sub matchfile {

$opt = shift：# Ссылка на хэш параметров

Smatcher = shift；# Ссылка на функцию поиска совпадений

my ($file, ©list, Stotal, $name)： local($_)；

Stotal = 0;

FILE： while (defined ($file = shift(@_))) {

1f (-d $file) {

if (-1 $file && @ARGV != 1) {

warn "$Me： \"$f11e\" Is a symlink to a dlrectoryXn" if $opt->{T}；

next FILE;

}

if (!$opt->{r}) {

warn "$Me： \"$file\" is a di rectory, but no -r given'rT if $opt->{T}；

next FILE;

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

unless (opendir(DIR, $file)) { unless ($opt->{'q'}) {

warn "$Me: can't opendir $file： $!\n"：

$Errors++：

}

next FILE;

}

list = 0;

for (readdlr(DIR)) {

push(@llst, "$file/$_") unless /人'.{L2}$/；

}

closedir(DIR);

Ключ -t - сортировка по времени (от новых к старым)

Использование алгоритма из рецепта 4.16,

"Сортировка списка по вычисляемому полю" if ($opt->{t}) {

©list = map { $_->[0] }

sort { $a->[l]<=>$b->[l] } map { [ $_, -M $_ ] } ©list;

}

else {

©list = sort ©list;

}

matchfile($opt, $matcher, ©list); # Обработка файлов next FILE:

}

Предотвратить досадную ситуацию, когда grep хочет

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

if ($file eq '-') {

arn "$Me: reading from stdin\n" If -t STDIN && !$opt->{'q'}: $name = '<STDIN>';

}

else {

$name = $file;

unless (-e Sfile) {

warn qq($Me: file "$file" does not exist\n) unless $opt->{'q'}:

$Errors++;

next FILE:

}

unless (-f $file || $opt->{a}) {

warn qq($Me： skipping non-plaln file "$file"\n) if $opt->{T}：

ext FILE;

}

Также можно было использовать File:：Spec

my ($ext) = $file =~ /、.(「.]+)$/;

Проверить, известно ли, как для данного расширения

преобразовать данные в обычный текст при помощи фильтра.

If (defined $ext && exists $Compress{$ext}) {

$file = "$Compress{$ext} <$f11e |:

}

elsif (! (-T $file || $opt->{a})) {

warn qq($Me: skipping binary file "$file"\n) if $opt->{T}；

next FILE:

}

}

warn "$Me： checking $file\n" if $opt->{T}：

unless (open(FILE, $fi1e)) {

unless ($opt->{'q'}) { warn "$Me: $fiie： $!\n"；

$Errors++:

}

next FILE;

$total = 0;

$Matches = 0:

LINE: while (<FILE>) {

$Matches = 0；

开开开开开开开开开开开开开开

&{$matcher}();# Поиск совпадений

###########

next LINE unless $Matches：

$total += $Matches:

if ($opt->{p} II $opt->{P}) {

s/\n{2,}$/\n/ if $opt->{p}:

chomp1f $opt->{P}:

}

prlntC^nameXn"), next FILE 1f $opt->{l};

Следующий закомментированный блок

содержит расширенную (и более понятную)

версию команды, следующей за ним.

Это один из тех случаев, ко「па мы жертвуем

наглядностью ради скорости: команда prlntO

выполняется только один раз вместо четырех, # а блок в фигурных скобках не используется # (обратите внимание： для работы этого фрагмента # переменная $MWt должна быть равна "", а не 0). ######

## unless ($opt->{'s'}) {

#print "$name："if $Mult;

#print "$.:"if $opt{n};

# print;

# print (('-' x 20) . "\n") 1f $opt->{p} || $opt->{P};

# }

#######

$opt->{'s'} 11 print $MWt && "$name：", $opt->{n} ? "$.："：

($opt->{p} И $opt->{P}) && ('-' x 20) . "\n": next FILE if $opt->{l}:# Единица

}

}

continue {

print $Mult && "$name：", $total, "\n" If $opt->{c}；

}

$Grand Total += $total；

6.23. Копилка регулярных выражений

Следующие регулярные выражения показались нам особенно полезными или интересными.

О Перестановка двух первых слов:

s/(\S+))\s+)(\S+)/$3$2$l/

О Ключевое слово = значение:

m/(\w+)\s*=\s*(.*)\s*$/ # Ключевое слово в $1, значение - в $2

О Строка содержит не менее 80 символов:

т/.{80,}/

length() >= 80# А можно и без регулярного выражения...

О мм/дд/гг чч：мм：сс：

m|(\d+)/(\d+)/\d+) (\d+):(\d+):(\d+)|

О Смена каталога:

s(/usr/bin)(/usr/local/bin)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/人.*：：//

О 1Р-адрес:

# XXX： не работает для допустимых IP-адресов 127.1 и 2130706433 叫

'(\d I [01]?\d\d I 2[0-4]\d | 25[0-5])

\.(\dI[01]?\d\dI2[0-4]\d|25[0-5])

\.(\dI[01]?\d\dI2[0-4]\d|25[0-5])

\.(\dIL01]?\d\dI2[0-4]\d|25[0-5])

$

}x

О Удаление пути из полного имени файла:

s("/)()

О Определение ширины строки с помощью TERMCAP:

Scols = ( ($ENV{TERMCAP} || " ") — m/：co#(\d+):/ ) ? $1 : 80:

О Удаление каталогов из имени программы и аргументов:

(Sname = join(" ". map { s「\S+/..; $_ } ($0 @ARGV));

О Проверка операционной системы:

die "This isn't Linux" unless $人0 =~m/11nux/1;

О Объединение строк в многострочных последовательностях:

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 = ш{

(\Ь

[\р{ Upper-case Letter }\р{ Title-case Letter }] \р{ Lower-case Letter } *

\b) }gx;

О Поиск ссылок в простых HTML-документах:

©links = m/<A[^>]+?HREF\s*=\s*["']?(["'" >]+?)['"]?\s*>/1g；

О Поиск среднего инициала в $_:

$initial = ш/人\S+\s+(\S)\S*\s+\S/ ? $1 ：""；

О Замена кавычек парными апострофами:

s/"([",]*)'7''$F,/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:

}

Q ГГГГ-ММ-ДД:

m/(\d{4})-(\d\d)-(\d\d)/ # ГГГГ в $1, ММ в $2 и ДД в $3

О Выборка строк независимо от терминатора (завершающего символа):

push(@lines, $1) while ($input =~ s{

( .# Начало $1： любой отдельный символ (/s)

?*# но по минимуму - даже ни одного

)

(?:

# Заменить сохраняющими скобками, если # терминатор должен сохраняться.

\xOD \хОА

1 \хОА

1 \xOD

1 \хОС

# CRLF

# LF

# CR

# FF

(См. http://www.unicode.org/reports/trl3/trl3-9.html)

1\х{2028}

1\х{2029}

# Unicode LS

# Unicode PS

}{ }$х:

# consumes $1nput

Или воспользуйтесь split:

©lines = split m{ (?:

# Заменить сохраняющими скобками, если # терминатор должен сохраняться.

\xOD \xOA

1 \xOA

1 \xOD

1 \xOC

# CRLF

# LF

# CR

# FF

# (См. http://www.unicode.org/reports/trl3/trl3-9.html)

1\х{2028}

1\х{2029}

# Unicode LS

# Unicode PS

}х. $input；

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

7.0. Введение

Файлы занимают центральное место в обработке данных. Как и во всем остальном в Perl, простые операции с файлами выполняются просто, а сложные... как- нибудь да выполняются. Стандартные задачи (открытие файлов, чтение данных, запись данных) используют простые функции ввода/вывода и операторы, а более экзотические функции способны даже на асинхронный ввод/вывод и блокировку (locking) файлов.

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

Следующий фрагмент выводит все строки файла /usr/1 ocal /wldgets/data, содержащие слово "blue":

open (INPUT, "< /usr/1ocal/widgets/data")

or die "Couldn't open /usr/local/w1dgets/data for reading： $!\n"： while (<INPUT>) {

print If /blue/:

}

close(INPUT)；

Получение файлового манипулятора

Доступ к файлам в Perl организуется при помощи файловых манипуляторов (filehandle), таких, как INPUT в предыдущем примере. Манипулятор — это символическое имя в программе Perl, связываемое с внешним файлом (обычно при помощи функции open). При каждом выполнении операции ввода или вывода в программе используется внутренний манипулятор, а не внешнее имя файла. Функция open связывает файл с манипулятором, а функция close эту связь разрывает. Вообще говоря, для открытия файлов могут использоваться и другие функции, а манипуляторы могут связываться не только с файлами; подробности приводятся в разделе 7.1.

Если пользователи идентифицируют открытые файлы по именам, программы Perl используют для этой цели манипуляторы. Но с точки зрения операционной системы открытый файл представляется файловым дескриптором — маленьким неотрицательным целым числом. Функция f11 eno возвращает системный дескриптор для манипулятора, переданного в аргументе. Для большинства файловых операций хватает манипуляторов Perl, а для остальных случаев в рецепте 7.9 показано, как преобразовать файловый дескриптор в файловый манипулятор, используемый в Perl.

Имена файловых манипуляторов (как и имена меток, процедур и пакетов) представляют собой простые последовательности символов типа INPUT, а не переменные типа $1nput. Тем не менее, за небольшими синтаксическими исключениями, вместо именованных манипуляторов Perl также принимает скалярные выражения, результатом которых является манипулятор или то, что может интерпретироваться как манипулятор (тип-глоб, ссылка на него или объект вво- да/вывода). Обычно в таких ситуациях тип-глоб манипулятора сохраняется в скалярной переменной, которая затем используется в качестве косвенной ссылки на манипулятор. Программа, записанная подобным образом, может быть проще программы с именованными манипуляторами, потому что при работе с обычными переменными вместо символических имен исчезают некоторые нетривиальные проблемы, связанные с определением строк, областью действия и пакетами.

В версии 5.6 Perl допускается использование неявно инициализированных переменных в качестве косвенных файловых манипуляторов. Если функции, которая собирается инициализировать файловый манипулятор (например, open), передать неопределенный скаляр, то функция автоматически создает анонимный тип-глоб и сохраняет ссылку на него в ранее не определенной переменной — эта головоломная фраза обычно сокращается до более понятной: «Perl автоматически оживляет (autovivifies) файловые манипуляторы, передаваемые open в виде неопределенных скаляров».

my $input;# Новая лексическая переменная

# изначально содержит undef open($input. "<", "/acme/widgets/data")

or die "Couldn't open /acme/widgets/data for reading： $!\n"： while (<$input>) {

print if /blue/;

}

close($input):# Также происходит при уборке мусора

За дополнительной информацией о ссылках и автоматическом оживлении обращайтесь к главе И. Впрочем, эта глава в большей степени посвящена обычным ссылкам на данные, а не экзотике вроде ссылок на тип-глобы.

Автоматическое оживление манипуляторов при вызове open является лишь одним из нескольких способов получения косвенных файловых манипуляторов. Другие способы загрузки именованных файловых манипуляторов в переменные, а также иные эзотерические конструкции, которые могут использоваться как косвенные файловые манипуляторы, описаны в рецепте 7.5.

В некоторых рецептах этой главы файловые манипуляторы используются со стандартным модулем 10： ：Handle, в других случаях используется модуль 10: :П1е.

Конструкторы объектов этих классов возвращают новые объекты, которые могут использоваться всюду, где возможно использование обычных файловых манипуляторов, например, при вызове встроенных функций print, readline, close, <...> и т. д. С другой стороны, все методы 10： :Handle могут вызываться для обычных манипуляторов, не преобразованных вызовом bless. Это относится и к автоматически оживленным манипуляторам, и даже к именованным вроде INPUT или STDIN, даже если они не были превращены в объекты вызовом bless.

Синтаксис вызова методов выглядит более громоздким, чем синтаксис вызова функций Perl. Кроме того, вызов методов требует дополнительных затрат по сравнению с вызовом функции (в тех случаях, когда эквивалентная функция существует). Обычно использование методов ограничивается теми случаями, когда соответствующую функциональность трудно или невозможно реализовать на «чистом» Perl без применения дополнительных модулей.

Например, метод blocking, устанавливающий или снимающий блокировку для файловых манипуляторов, гораздо приятнее шаманства с Fcntl, с которым, по крайней мере, один из авторов (а возможно, и большинство читателей) не желает иметь ничего общего. Этот принцип заложен в основу рецепта 7.20.

Большинство методов находится в классе 10： ：Handle, от которого наследует 10: :П1е, и может применяться непосредственно к файловым манипуляторам, которые не являются объектами. Важно лишь то, чтобы Perl воспринимал их как файловые манипуляторы.

Пример:

STDIN->blocking(0)； # Вызов для именованного манипулятора open($fh, "<", $filename) or die: # Автоматическое оживление, затем...

$fh->blocking(0)； # вызов для манипулятора без вызова bless

Как и большинство имен Perl, включая имена процедур и глобальных переменных, именованные манипуляторы размещаются в пакетах. Следовательно, два разных пакета могут содержать манипуляторы с одинаковыми именами. Без явного уточнения пакета именованный манипулятор интерпретируется как принадлежащий текущему пакету. В пакете main запись INPUT в действительности обозначает main： ： INPUT, но если текущим является некий гипотетический пакет SomeMod, то эта же запись будет обозначать SomeMod:: INPUT.

Встроенные манипуляторы STDIN, STDOUT и STDERR занимают особое место. Если манипулятор не уточнен, то вместо текущего пакета используется пакет main. Аналогичное исключение из стандартных правил определения полного имени встречается при использовании встроенных переменных @ARGV и %ENV (см. Введение к главе 12).

В отличие от именованных файловых манипуляторов, которые представляют собой глобальные символические имена в пакетах, создаваемые Perl автоматически оживленные манипуляторы анонимны (то есть не имеют имен) и не имеют собственных пакетов. Еще интереснее другое — они, как и другие ссылки, подвержены автоматической уборке мусора. Когда переменные, в которых они хранятся, выходят из области действия, а других ссылок на переменную или ее значение не существует, начинает действовать механизм уборки мусора, и Perl автоматически закрывает манипулятор (если вы не сделали этого ранее). Это может быть существенно в больших или долго работающих программах, поскольку операци-

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

Как известно, системная память является ограниченным ресурсом, который может быть исчерпан при небрежном использовании; то же самое относится и к системным файловым дескрипторам. Если вы будете открывать множество новых файловых манипуляторов, не закрывая их, то рано или поздно дескрипторы закончатся. Если повезет, в этот момент ваша программа завершится аварийно, а если не повезет — начнет работать с ошибками. Автоматический вызов close при уничтожении автоматически созданных файловых манипуляторов избавит вас от хлопот, возникающих при недостаточно аккуратном выделении ресурсов.

Например, следующие две функции автоматически оживляют файловые манипуляторы в одноименных лексических переменных:

sub versive {

open(my $fh, "<", $SOURCE)

or die "can't open $SOURCE： $!"： return $fh；

}

sub apparent {

open(my $fh, ">", $TARGET)

or die "can't open $TARGET: $!": return $fh：

}

my($from, to) = ( versiveO. apparentO )；

В обычных условиях манипуляторы $fh были бы автоматически закрыты при выходе из функции. Но поскольку обе функции возвращают их значение, манипуляторы останутся открытыми в течение более долгого времени. Они остаются открытыми до тех пор, пока не будут закрыты в программе, или переменные $from и $to вместе со всеми копиями не выйдут из области действия — в этот момент Perl «убирает мусор» и закрывает эти манипуляторы, если они остались открытыми.

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

Стандартные манипуляторы

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

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

Однако ввод и вывод не связаны с конкретными устройствами. В следующем примере стандартный ввод программы связывается с файлом datafile, а стандартный вывод направляется в resultfile, причем это происходит еще до запуска программы:

% program < datafile > resultsfile

Предположим, в программе возникли какие-то проблемы, о которых нужно сообщить пользователю. Если стандартный вывод был перенаправлен, то скорее всего, пользователь не заметит сообщения, направленного в выходные данные. Именно для таких ситуаций был создан манипулятор STDERR. Как и STDOUT, он изначально ассоциируется с экраном, но в случае перенаправления STDOUT в файл или канал приемник STDERR остается неизменным. А значит, предупреждения и ошибки всегда можно направить туда, где они будут скорее замечены пользователем.

В отличие от STDERR, при перенаправлении STDIN для клавиатуры не создается заранее открытый файловый манипулятор. Дело в том, что такая потребность возникает гораздо реже, чем потребность в надежном, логически последовательном диагностическом потоке. Программы относительно редко задают вопросы пользователю и читают его ответы, даже в случае перенаправления. Например, это происходит в программах тоге(1) и /ess(l), поскольку их манипуляторы STDIN обычно связываются с выводом других программ, который должен просматриваться по страницам. В системах семейства Unix для этого открывается специальный файл /dev/tty, представляющий управляющий терминал для текущего сеанса. Если у программы нет управляющего терминала, вызов open завершается неудачей; тем самым система сообщает, что вашей программе попросту не с кем общаться.

Этот принцип позволяет легко связать вывод одной программы с вводом другой программы, и так далее по цепочке.

% first I second | third

Вывод первой программы подается на ввод второй, а вывод второй программы —на ввод третьей. Хотя, на первый взгляд, это и не очевидно, здесь действует та же логика, что и при вложенных вызовах функций вида thjrd(second(f1rst))). Просто конвейерные вызовы командного интерпретатора лучше воспринимаются, потому что они читаются слева направо, а не от внутренней части выражения к наружной.

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

Среда, в которой каждая программа преобразования данных решает только одну задачу, а данные передаются от одной программы к другой посредством перенаправления стандартных потоков ввода/вывода, обладает силой, гибкостью и надежностью, которые не достигаются другими средствами. В данном случае проявляется так называемая модель «утилит и фильтров», заложенная в основу архитектуры не только командного интерпретатора Unix, но и всей операционной системы. Конечно, существуют предметные области, в которых эта модель дает осечку. Более того, само существование Perl обусловлено использованием ее недостатков, и все же эта модель доказала свою фундаментальную прочность и масштабируемость почти за 30 лет.

Операции ввода/вывода

Основные функции для работы с файлами в Perl — open, print, <. .> (чтение записи) и close. Функции ввода/вывода Perl описаны в документацииperlfunc(l) и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 и ： encodl ng (j so - 8859 -1).

При открытии файла или вызове практически любой системной функции1 необходимо проверять возвращаемое значение. Не каждый вызов open заканчивается успешно; не каждый файл удается прочитать; не каждый фрагмент данных, выводимый функцией print, достигает места назначения. Многие программисты для повышения устойчивости своих программ проверяют результаты open, seek, tel 1 и close. Иногда приходится проверять и другие функции.

Если в документации сказано, что в определенных условиях функция возвращает признак ошибки, а вы не проверяете эти условия, будьте уверены — когда- нибудь ваша небрежность обернется против вас. В документации Perl перечислены возвращаемые значения всех функций и операторов. Как правило, при неудачном завершении системная функция возвращает undef (кроме функций wait, wditpid и syscal 1, возвращающих -1). Чтобы получить системное сообщение

Системной функцией называется обращение к сервису операционной системы. Термин не имеет отношения к функции system в языках С и Perl.

в строковом виде и соответствующий ему числовой код, воспользуйтесь переменной $!. Эта информация часто используется в die или сообщениях warn.

Для чтения записей в Perl применяется оператор <МАНИПУЛЯТОР>. В отличие от инфиксных операторов, он не располагается между своими операндами, а наоборот, заключает их в себе (наподобие круглых скобок).

Обычно запись представляет собой одну строку, однако разделитель записей можно изменить (см. главу 8). Если МАНИПУЛЯТОР не указывается, Perl открывает и читает файлы, перечисленные в ©ARGV, а если массив ©ARGV пуст — из STDIN. Нестандартные и просто любопытные применения этого факта описаны в рецепте 7.14.

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

На более высоком уровне абстракции файл представляет собой поток логических символов, не зависящий от физического представления. Поскольку программы Perl обычно работают с текстовыми строками, содержащими символы, этот режим выбирается по умолчанию при вызове open. О том, как изменить настройки по умолчанию, рассказано во Введении к главе 8 и в рецепте 8.11.

Каждый файловый манипулятор ассоциируется с числовым смещением, представляющим позицию, в которой будет выполнена следующая операция ввода/вы- вода. Если рассматривать файл как поток октетов, смещение равно количеству октетов от начала файла (смещение начала потока равно 0). Текущая позиция автоматически обновляется при каждой операции чтения или записи данных ненулевой длины. Ее также можно задать явно при помощи функции seek.

Текстовые файлы находятся на несколько более высоком уровне абстракции, чем октетные потоки. Количество октетов не всегда совпадает с количеством символов. Если не принять особых мер, файловые манипуляторы Perl представляют именно логические потоки символов, а не физические потоки октетов. Количество символов и октетов совпадает только в одном случае: если каждый читаемый или записываемый символ помещается в одном октете (то есть все кодовые пункты меньше 256), а для конца строки не предусмотрено особой обработки (например, преобразования между "\cJ\cM" и "\п"). Только в этом случае позиция логического символа совпадает с текущей позицией в байтовом потоке.

Например, такая ситуация встречается при работе с текстовыми файлами в кодировке ASCII или Latin 1 в системе Unix, где не существует принципиальных различий между текстовыми и двоичными файлами, что существенно облегчает программирование. К сожалению, 7-разрядный ASCII-текст встречается относительно редко, и даже 8-разрядные кодировки семейства ISO 8859—〃 быстро вытесняются многобайтовым текстом в Юникоде.

Другими словами, из-за того, что уровни кодировки типа : utf8 и уровни преобразований типа ：crlf могут изменять количество байтов, передаваемых между программой и внешним миром, текущая позиция в файле не может вычисляться простым суммированием количества переданных символов. Как объяснялось

в главе 1, символы не эквивалентны байтам — по крайней мере, нельзя на это рассчитывать. Вместо этого для получения текущей позиции в файле следует использовать функцию tell. По тем же причинам только значения, возвращаемые 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 minumum safety distance.\n"：

Некоторые специальные переменные Perl изменяют поведение текущего файлового манипулятора вывода. Особенно важна переменная $|, которая управляет буферизацией вывода для файловых манипуляторов. Буферизация рассматривается в рецепте 7.19.

Функции ввода/вывода в Perl делятся на буферизованные и небуферизован- ные (см. таблицу). Несмотря на отдельные исключения не следует чередовать их вызовы в программе. Дело в том, что буферизованные функции хранят свои данные в буферах, о чем не известно небуферизованным функциям. В следующей таблице описаны два семейства функций, которые не желательно смешивать. Связь между функциями, находящимися в одной строке таблицы, весьма условна. Например, по семантике функция sysread отличается от <.. >, однако они находятся в одной строке, поскольку выполняют общую задачу — получение входных данных из файлового манипулятора. Позиционирование рассматривается в главе 8, однако мы также воспользуемся им в рецепте 7.17.

Действие

Буферизованные функции

Небуферизованные функции

ввод

<...>, readline

sysread

вывод

print

syswrite

позиционирование

seek, tell

sysseek

В Perl версии 5.8 появился механизм уровней ввода/вывода, позволяющий совместно вызывать эти функции. Включить буферизацию для небуферизованных функций нельзя, но зато можно отключить ее для буферизованных функций. Теперь Perl позволяет выбрать конкретную реализацию ввода/вывода. Например, при выборе : unix Perl вместо переносимой реализации стандартной библиотеки ввода/вывода (perllo) использует небуферизованные системные вызовы. Уровень небуферизованного ввода/вывода выбирается при открытии файла:

open(FH, "<：un1x", $f11ename) or die：

Открыв манипулятор с небуферизованным уровнем, далее можно спокойно чередовать вызовы функций буферизованного и небуферизованного ввода/вывода, потому что на этом уровне буферизация все равно не выполняется. При вызове print Perl в действительности используется эквивалент syswrite. За дополнительной информацией обращайтесь к рецепту 7.19.

Открытие файла Проблема

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

Решение

Для удобства используйте функцию open с двумя аргументами, а для дополнительных возможностей — с тремя аргументами. Функция sysopen открывает доступ к низкоуровневым возможностям.

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

open(SOURCE. "< Spath")

or die "Couldn't open Spath for reading： $!\n"；

open(SINK, "> Spath")

or die "Couldn't open $path for writing： $!\n"：

При вызове с тремя (и более) аргументами режим отделяется от имени файла (например, если между ними существует какая-то неоднозначность):

open(SOURCE. "<". 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；

sysopen(SOURCE, 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 $fh. "<", Spath)

or die "Couldn't open Spath for reading： $!\n"：

Комментарий

Все операции ввода/вывода осуществляются через файловые манипуляторы, независимо от того, упоминаются манипуляторы в программе или нет. Файловые манипуляторы не всегда связаны с конкретными файлами — они также применяются для взаимодействия с другими программами (см. главу 16 «Управление процессами и межпроцессные взаимодействия») и в сетевых коммуникациях (см. главу 17 «Сокеты»), Функция open также применяется для работы с файловыми дескрипторами, данная возможность рассматривается в рецепте 7.9.

Функция open позволяет быстро и удобно связать файловый манипулятор с файлом. Вместе с именем файла передаются сокращенные обозначения стандартных режимов (чтение, запись, чтение/запись, присоединение). Функция не

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

Большинство программистов начинают работать с open задолго до первого использования sysopen. В табл. 7.1 показано соответствие между режимами функции open («Файл»), константами sysopen («Флаги») и строками fopenQ), передаваемыми 10: :F11e->new («Символы»). Столбцы «Чтение» и «Запись» показывают, возможно ли чтение или запись для данного файлового манипулятора. «Присоединение» означает, что выходные данные всегда направляются в конец файла независимо от текущей позиции (в большинстве систем). В режиме усечения функция open уничтожает все существующие данные в открываемом файле.

Таблица 7.1. Режимы доступа к файлам

Файл

Чтение

Запись

Присоединение

Создание

Усечение

Флаги О__

Символы

< файл

да

нет

нет

нет

нет

RDONLY

"r"

> файл

нет

да

нет

да

да

WRONLY TRUNC CREAT

"w"

» файл

нет

да

да

да

нет

WRONLY APPEND CREAT

"a"

+< файл

да

да

нет

нет

нет

RDWR

"r+"

+> файл

да

да

нет

да

да

RDWR TRUNC CREAT

"w+"

+» файл

да

да

да

да

нет

RDWR

"a+"

APPEND CREAT

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

Функция sysopen получает три или четыре аргумента:

sysopen(FILEHANDLE, Sname, Sflags) or die "Can't open $name : $!"； sysopen(FILEHANDLE, $name, Sflags, Sperms) or die "Can't open $name : $!";

Здесь $name — имя файла без «довесков» в виде < или +; $flags — число, полученное объединением констант режимов O_CREAT, O_WRONLY, O_TRUNC и т. д. операцией OR. Конкретный состав доступных констант 0_* зависит от операционной системы. Дополнительные сведения можно найти в электронной документации (обычно о〃е〃(2), но не всегда) или в файле /usr/lnclude/fcntl .h. Обычно поддерживаются следующие константы:

O_RDONLY

Только чтение

OJRONLY

Только запись

O_RDWR

Чтение и запись

O_CREAT

Создание файла, если он не существует

OJXCL

Неудачное завершение, если файл уже существует

O_APPEND

Присоединение к файлу

O_TRUNC

Очистка содержимого файла

OJONBLOCK

Асинхронный доступ

К числу менее распространенных констант принадлежат 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 $!；

sysopen(FH, Spath, O_WRONLY|O_TRUNC|O_CREAT)or die $!;

sysopen(FH, Spath. O_WRONLY|0JRUNC|O^CREAT, 0600) or die $!;

Открытие файла для записи с созданием нового файла (файл не должен существовать):

sysopen(FH, Spath, O_WRONLY|O_EXCL|O_CREAT)or die $!;

sysopen(FH, Spath, O2WRONLY|OJXCL|O2CREAT, 0600) or die $!:

Открытие файла для присоединения (в случае необходимости файл создается):

open(FH, "»", Spath")or die $!;

sysopen(FH, Spath, O_WRONLY|O_APPEND|O_CREAT)or die $!;

sysopen(FH, Spath, O^WRONLY|O^APPEND|OJREAT, 0600) or die $!;

Открытие файла для присоединения (файл должен существовать):

sysopen(FH, Spath. O_WRONLY|O_APPEND)or die $!:

Открытие файла для обновления (файл должен существовать):

open(FH, "+<", Spath")or die $!;

sysopen(FH, Spath, O_RDWR)or die $!;

Открытие файла для обновления (в случае необходимости файл создается):

sysopen(FH,Spath,O_RDWR|O_CREAT)ordie$!;

sysopen(FH.Spath,O_RDWR|O_CREAT, 0600)ordie$!;

Открытие файла для обновления (файл не должен существовать):

sysopen(FH,$path,O_RDWR|O_EXCL|O_CREAT)ordie$!;

sysopen(FH,Spath,O_RDWR|O_EXCL|O_CREAT, 0600) or die $!;

Маска 0600 всего лишь поясняет, как создаются файлы с ограниченным доступом. Обычно этот аргумент пропускается.

См. также

Описание функций open, sysopen и umask в perlfunc(i)\ документация по стандартным модулям 10: ：File и Fcntl; страницы руководства open⑵,fopenQ) и umashQ); рецепт 7.2; рецепт 9.11.

Открытие файлов с нестандартными именами

Проблема

Требуется открыть файл с нестандартным именем, например "-", начинающимся с символа <, > или |, содержащим начальные или конечные пробелы, заканчивающимся символом I. Функция open не должна принимать эти функции за служебные, поскольку вам нужно совершенно иное.

Решение

При вызове open с тремя (а не с двумя) аргументами передайте режим во втором аргументе:

open(HANDLE, "<", $filename)or die "cannot open $f11 ename : $!\n"；

Или просто воспользуйтесь функцией sysopen:

sysopen(HANDLE, $filename, O_RDONLY) or die "cannot open $filename : $!\n"：

Комментарий

При вызове open с тремя аргументами режим доступа и имя файла передаются по отдельности. Но при вызове только с двумя аргументами функции open приходится извлекать режим доступа и имя файла из одной строки. Если имя файла начинается с символа, обозначающего один из режимов, open вполне может сделать что-нибудь неожиданное. Рассмотрим следующий фрагмент:

$filename = shift @ARGV；

open(INPUT. $filename)or die "cannot open Sfilename ： $!\n"：

Если пользователь указывает в командной строке файл ">/etc/passwd", программа попытается открыть /etc/passwd для записи — со всеми вытекающими последствиями! Режим можцо задать и явно (например, для записи):

open(OUTPUT. ">$f11 ename")

or die "Couldn't open $filename for writing： $!\n"：

но даже в этом случае пользователь может ввести имя ">data", после чего программа будет дописывать данные в конец файла data вместо того, чтобы стереть прежнее содержимое.

Самое простое решение — передать open три аргумента. Во втором аргументе передается режим доступа, а в третьем — путь и имя файла. В этом случае какая-либо путаница или недоразумения полностью исключаются.

open(OUTPUT. ">", $filename)

or die "Couldn't open $filename for writing： $!\n"；

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

use Fcntl:# Для файловых констант

sysopen(OUTPUT. $filename. O_WRONLY|O_TRUNC)

or die "Couldn't open $f11 ename for writing： $!\n"：

Расширенная интерпретация файловых имен в функции open почти всегда оказывается удобной. Вам никогда не приходится беспокоиться о том, сколькими пробелами отделять режим доступа от пути — одним или двумя, или обозначать стандартный ввод или вывод с помощью особой формы "-". Если написать фильтр и воспользоваться простой функцией open, то пользователь сможет передать вместо имени файла строку "gzip -de bible.gz|" — фильтр автоматически запустит программу распаковки.

Вопросы безопасности open актуальны лишь для программ, работающих в особых условиях. Если программа должна работать под управлением чего-то другого, например сценариев CGI или со сменой идентификатора пользователя, добросовестный программист всегда учтет возможность ввода пользователем собственного имени файла, при котором вызов open для простого чтения превратится в перезапись файла или даже запуск другой программы. Параметр командной строки Perl -Т обеспечивает проверку таких ошибок.

В версиях Perl, не поддерживающих open с тремя аргументами (то есть предшествующих версии 5.6.0), для обработки файлов с начальными или конечными пропусками приходилось пускаться на всевозможные ухищрения:

$file =~ sr(\s)#./$l#； open(HANDLE. "> $file\0")

or die "Could't open $file for OUTPUT ： $!\n"：

Такая подстановка защищает исходные пропуски, но не в абсолютных именах типа "/etc/passwd", а лишь в относительных (">passwd"). Функция open не считает нуль-байт ("\0") частью имени файла, но благодаря ему не игнорируются конечные пропуски.

См. также

Описание функций open и sysopen в perlfunc(l); рецепты 7.1, 7.14, 16.2, 19.4 и 19.5.

Тильды в именах файлов

Проблема

Имя файла начинается с тильды (например, ~username/blah или ~/.ma1lrc), однако функция open не интерпретирует тильду как обозначение домашнего каталога (home directory).

Решение

Либо воспользуйтесь функцией glob:

open(FH, glob("〜joebob/somefile")) 11 die "Couldn't open file： $!"：

либо выполните расширение вручную с помощью следующей подстановки:

Sfilename =_ s{人~([人/]* ) } { $1

? (getpwnam($l))E7]

:($ENV{HOME} I I $ENV{LOGDIR}

II (getpwuid($>))E7]

}ex；

Комментарий

Тильда (~) в именах файлов представляет домашний каталог пользователя. Это полезное условное обозначение было впервые использовано в командном интерпретаторе csh системы Unix, а позднее получило широкое распространение в вебадресах вида http://www.examp1e.com/~user/.

~# Домашний катался текуще「о пользователя

~user/blah # Файл blah в домашнем каталоге текущего пользователя

-user# Домашний каталог заданного пользователя

~/blah# Файл blah в домашнем каталоге заданного пользователя.

К сожалению, в Perl функция open не расширяет метасимволы, в том числе и ~. В версии 5.6 при использовании оператора glob использовался модуль File： ：Glob,

поэтому перед вызовом open необходимо предварительно обработать результат оператором glob:

open(MAILRC, "<", "-/.mailre")# ОШИБКА: тильда относится

or die "can't open ~/.mailrc： $!";# к командному интерпретатору

open(MAILRC. "<", glob("-/.mailre"))# Сначала нужно расширить 〜.

or die "can't open -/.mallrc: $!";

В другом решении, основанном на подстановке, используется модификатор /е, чтобы заменяющее выражение интерпретировалось как программный код Perl. Если за тильдой следует имя пользователя, оно сохраняется в $1 и используется функцией getpwnam для получения домашнего каталога пользователя из возвращаемого списка. Найденный каталог образует заменяющую строку. Если за тильдой не указано имя пользователя, подставляется текущее значение переменной окружения НОМЕ или LOGDIR. Если эти переменные не определены, задается домашний каталог текущего пользователя.

Вообще говоря, вызов glob( '~gndt') можно записать в виде <~gnat>, но эта запись слишком сильно напоминает чтение из файлового манипулятора, поэтому делать так не рекомендуется.

См. также

Описание функции getpwnam в ре可unc(V); страница руководства 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 не несет полезной информации, поскольку вы не знаете, с каким файлом он был связан. Если использовать имя файла в качестве косвен-

ного файлового манипулятора, предупреждения и сообщения об ошибках Perl становятся более содержательными:

Argument "3\n" isn't numeric in multiply at tallyweb

line 16, </usr/local/data/mylog3.dat> chunk 17.

К сожалению, этот вариант не работает при включенной директиве strict refs, поскольку переменная $path в действительности содержит не файловый манипулятор, а всего лишь строку, которая иногда ведет себя как манипулятор. Фрагмент (chunk), упоминаемый в предупреждениях и сообщениях об ошибках, представляет собой текущее значение переменной $..

См. также

Рецепт 7.1; описание функции open в perlfunc(l).

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

Проблема

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

Решение

Простейший способ сохранить манипулятор в переменной — поручить эту задачу open:

open(my $fh, "<", $f11ename) or die "$0： can't open $filename： $!":

Чтобы сохранить именованный файловый манипулятор в переменной, передать или вернуть его из функции, воспользуйтесь синтаксисом тип-глоба (*...):

Svariable = *FILEHANDLE； # Сохранение в переменной subroutine(*FILEHANDLE)：# Передача функции

sub subroutine {

my $fh = shift；

print $fh "Hello, filehandle!\n"；

}

Комментарий

Если при вызове open в первом аргументе передается неопределенная скалярная переменная, Perl создает анонимный тип-глоб и сохраняет ссылку на него в этой скалярной переменной, то есть фактически создает файловый манипулятор по требованию. Как и другие ссылки, автоматически оживленные файловые

манипуляторы уничтожаются системой уборки мусора, поэтому следующий код не создает утечки ресурсов:

{

open(my $fh, "< /etc/motd") or die；

local $/：# Режим поглощающего ввода

$text = <$fh>：

}

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

Автоматически оживляемые манипуляторы анонимны и уже хранятся в переменных, поэтому они не помогут вам понять, как передать именованные файловые манипуляторы в параметрах функций или сохранять их в переменных, в том числе и в элементах массивов или хэшей. Под «именованными файловыми манипуляторами» подразумеваются манипуляторы в форме FH, включая все стандартные манипуляторы типа STDIN или ARGV. Итак, давайте посмотрим, что же собой представляют манипуляторы FH и как извлечь из них скалярное значение, которое можно было бы использовать для наших целей.

Во фрагментах вида

print STDERR "stuff\n"：

$1nput = <STDIN>:

open(TTY, "+<". "/dev/tty"): if (eof(ARGV)) { .... }

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

$fh = SOMEHANDLE;

somefunc(SOMEHANDLE);

Дело в том, что при отсутствии явных указаний на обратное, SOMEHANDLE в обоих случаях является строкой, не заключенной в ограничители (unquoted), а директива use strict это запрещает. Но даже если директива strict subs не используется, у вас все равно возникнут проблемы с передачей манипулятора процедуре, которая была откомпилирована под действием strict subs или находится в разных пакетах с кодом, содержащим вызов.

Четыре именованных манипулятора (STDERR, STDIN, TTY и ARGV), о которых говорилось выше, не требуют специального обхождения, но не потому, что они являются встроенными; более того, TTY таковым не является. Мы можем использовать их лишь потому, что для встроенных операций, которым эти манипуляторы передаются в качестве аргументов, определены прототипы с аргументом-манипулятором.

Следовательно, вы должны выбрать один из двух вариантов. Необходимо либо определить для функции прототип, как объясняется в рецепте 7.6, либо использовать нечто такое, что Perl воспринимал бы как имя файлового манипулятора —строку, тип-глоб, ссылку на тип-глоб или объект ввода/вывода. Все эти данные можно сохранять в переменных или передавать функциям для последующего использования в качестве косвенных файловых манипуляторов:

somefunc( SOMEHANDLE ) somefunc( "SOMEHANDLE" ) somefunc( *SOMEHANDLE ) somefunc( \*SOMEHANDLE )somefunc( SOMEHANDLE ) somefunc( "SOMEHANDLE" ) somefunc( *SOMEHANDLE ) somefunc( \*SOMEHANDLE )somefunc( *SOMEHANDLE{IO})somefunc( *SOMEHANDLE{IO})Только с прототипом somefunc(*)

somefunc( SOMEHANDLE ) somefunc( "SOMEHANDLE" ) somefunc( *SOMEHANDLE ) somefunc( \*SOMEHANDLE )

somefunc( SOMEHANDLE ) somefunc( "SOMEHANDLE" ) somefunc( *SOMEHANDLE ) somefunc( \*SOMEHANDLE )

somefunc( *SOMEHANDLE{IO})

somefunc( *SOMEHANDLE{IO})

Строка в кавычках

Тип-глоб

Ссылка на тип-глоб

Объект ввода/вывода

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

print { $fd[l] } "funny stuff\n"：

prlntf { $fd[l] } "Pity the poor ^x.\n", 3_735_928_559;

Pity the poor deadbeef.

Такой блок является полноценным во всех отношениях и может содержать более сложный код. Например, следующий фрагмент отправляет сообщение в одно из двух мест: $ок = -х "/bin/cat":

print { $ок ? $fd[l] : $fd[2] } "cat stat $ok\n"； print { $fd[ 1 + ($ok 11 0) ] } "cat stat $ok\n"：

Это пример так называемой «косвенной объектной записи» (эта тема подробно рассматривается в главе 13 «Классы, объекты и связи»). Запрет на использование в косвенных объектах чего-либо, кроме простых скалярных переменных, распространяется на все разновидности объектов. Как и в случае с пользовательскими объектами, инфиксная форма -> помогает избежать всевозможных синтаксических недоразумений. При наличии загруженного модуля 10: :Handle или производных от него воспользуйтесь выражением, для вызова методов можно воспользоваться выражением, результатом которого является файловый манипулятор:

$fd[l]->print("funny stuff\n"):

($ok ? $fd[l] : $fd[2])->pr1nt("cat stat $ok\n")；

Интерпретация print и printf как вызовов методов объекта не подходит для оператора <.. >. Если предположить, что тип-глобы хранятся в структуре, как это делалось выше, встроенная функция readline читает записи точно так же, как это делает конструкция <.. >. Для приведенной выше инициализации @fd эта команда будет работать:

$got = readline($fd[O])；

А если доступен модуль 10::Handle, можно воспользоваться методом getHne:

$got = $fd[O]->getline()；

Модуль 10::Handle не заменяет read! 1 ne лишь одним методом — он использует два метода для разных контекстов. Если вы предпочитаете контекстно-зависимое поведение readline, его всегда можно реализовать «на ходу», дополнив класс новыми возможностями:

sub 10：:Handle：：readline {

my $fh = shift;

if (wantarray) {

return $fh->getlines()；

} else {

return $fh->getline()；

}

}

См. также

Описание функции open в perlfunc(l); рецепт 7.1; документация по стандартному модулю 10: :Handle.

7-6- Написание процедуры, получающей файловые манипуляторы

Проблема

Функциям Perl (таким, как eof) при вызове можно напрямую передавать файловые манипуляторы. Вы хотите, чтобы такая возможность поддерживалась пользовательскими функциями.

Решение

Используйте метод quailfy_t°_re^ модуля Symbol в сочетании с прототипом *:

use Symbol qw(qualify_to_ref)；

sub my_eof (*) {

my $handle = shift：

Shandie = qualify_to_ref(Shandle, caller());

# Использовать Shandie

}

Комментарий

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

my_eof(HANDLE):

Такое решение работает даже при активной директиве use strict 'subs'. Впрочем, в аргументе функции передается строка. Чтобы аргумент можно было использовать как файловый манипулятор, нужно при помощи модуля Symbol преобразовать его в ссылку на тип-глоб. А поскольку ссылка на тип-глоб может использоваться всюду, где допускается использование именованных файловых манипуляторов, вы можете сохранить эту ссылку в скалярной переменной и использовать ее в процедуре в качестве косвенного файлового манипулятора.

Если функции передается файловый манипулятор, который уже является ссылкой на тип-глоб (например, автоматически оживленный при вызове open), Perl и quailfy_t°_re^ все равно сделают то, что требуется:

open(my $fh, "<", $filename) or die： my_eof($fh):

Эта методика используется в рецепте 7.23.

См. также

Документация по стандартному модулю Symbol; раздел «Prototypes, страницы руководства perlsub( 1); рецепт 7.23.

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

Проблема

Требуется открыть для вывода больше файлов, чем разрешает ваша система.

Решение

Воспользуйтесь стандартным модулем Fil eCache:

use FileCache：

cacheout ($path)：# При каждом использовании манипулятора

print $path "output";

Комментарий

Функция cacheout модуля FileCache позволяет работать с большим количеством выходных файлов, чем позволяет одновременно открыть ваша операционная система. Если функция вызывается для открытия существующего файла, который FileCache раньше не встречался, то файл без лишних слов усекается до нулевой длины. Но при открытии и закрытии файлов в фоновом режиме cacheout отслеживает ранее открывавшиеся файлы и не стирает их, а присоединяет к ним новые данные. Каталоги при этом не создаются, поэтому если потребовать открыть файл /usr/1 оса!/dates/merlno.ewe, а каталог /usr/local/dates не существует, то вызов cacheout завершается по die.

Функция cacheout проверяет значение константы С NOFILE из стандартного системного включаемого файла sys/param.h и определяет, сколько файлов может одновременно быть открыто в системе. В некоторых системах это значение может быть неверным, а кое-где вообще отсутствует (например, если максимальное количество открытых файловых дескрипторов ограничивается на уровне ресуров процесса и задается командами Umlt/ullmlt). Если cacheout не может получить значение NOFILE, присвойте $F11 eCache::cacheout_maxopen величину на 4 меньше правильной или подберите разумное значение методом проб и ошибок.

В примере 7.1 файл xferlog (создаваемый большинством современных серверов FTP) разбивается на несколько разных файлов, которые называются по именам аутентифицированных пользователей. Поля в xferlog разделяются пробелами, четвертое поле с конца содержит имя аутентифицированного пользователя.

Пример 7.1. splitwulog

#!/usr/bin/perl

# splitwulog - разбиение журнала wuftpd по пользователям use FileCache；

$outdir = "/var/log/ftp/by-user"； while (<>) {

unless (defined ($user = (split)[-4])) { warn "Invalid line： $.\n"； next;

}

Spath = "$outdir/$user"；

cacheout $path： print $path $_;

}

См. также

Документация по стандартному модулю F11 eCache; описание функции open в perl- fimc ⑴.

7・8・ Одновременный вывод по нескольким манипуляторам

Проблема

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

Решение

Чтобы решить проблему без ветвления (forking), напишите цикл foreach с перебором манипуляторов:

foreach $filehandle (©FILEHANDLES) { print $f1lehandle $stuff_to_print:

}~ ~

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

open(MANY, "| tee.fllel file2 f1le3 > /dev/null") or die $!：

print MANY "data\n"or die $!:

close(MANY)or die $!;

Если программа tee недоступна, воспользуйтесь модулем 10: :Тее из архива CPAN:

use 10::Тее；

$tee = 10::Tee->new(@FILEHANDLES): print $tee $stuff_to_pr1nt;

Комментарий

Файловый манипулятор позволяет передавать данные только одному файлу или программе. Чтобы продублировать вывод в нескольких приемниках, придется многократно вызвать print или связать манипулятор с программой типа tee,

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

for $fh (*FH1, *FH2, *FH3){ print $fh "whatever\n" }

Впрочем, если в вашей системе доступна программа tee или ее Perl-аналог из рецепта 8.25, можно открыть канал к программе tee и поручить ей всю работу по копированию файла по нескольким приемникам. Помните, что tee обычно также копирует свои входные данные в STDOUT, поэтому если вы не хотите получить лишнюю копию, ее стандартный вывод необходимо перенаправить в /dev/null:

open (FH. "I tee fllel file2 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 = IO::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(i); документация по модулю CPAN 10: :Тее; примеры использования в рецептах 8.25 и 13.15.

7-9- Открытие и закрытие файловых дескрипторов

Проблема

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

Решение

Чтобы открыть файловый дескриптор, включите в строку режима доступа при вызове open символы "<&" или "<&":

open(FH, "<&=", $FDNUM)# Открыть FH для самого дескриптора

open(FH, "<&", $FDNUM)# Открыть FH для копии дескриптора

Или воспользуйтесь методом new_from_fd модуля 10::Handle:

use 10：：Handle；

$fh = 10::Handle->new_from_fd($FDNUM, "г")；

Чтобы закрыть файловый дескриптор по числовому значению, либо вызовите функцию POSIX: ：close, либо откройте его так, как показано выше.

Комментарий

Иногда бывает так, что вам известен файловый дескриптор, но не манипулятор. В системе ввода/вывода Perl вместо дескрипторов используются манипуляторы, поэтому вам приходится создавать новый манипулятор для уже открытого дескриптора. Режимы доступа "<&", ">&" и "+<&" функции open решают эту задачу соответственно для чтения, записи и обновления. Добавление знака равенства ("<&=", ">&=" и "+<&=") приводит к более экономному расходованию файловых манипуляторов, и почти всегда следует использовать именно этот способ. Это объясняется тем, что в базовой реализации команды Perl open используется только функция fdopen⑶ из библиотеки С, а не вызов системной функции dup(2).

Метод new_from_1 d объекта 10: :Handle эквивалентен следующему фрагменту:

use 10:：Handle；

$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);POSIX：：close(3);# Закрыть fd 3# Закрыть fd 3

POSIX：：close(3);

POSIX：：close(3);

# Закрыть fd 3

# Закрыть fd 3

См. также

Описание функции open в perlfunc(i); документация по стандартным модулям POSIX и 10: :Handle; страница руководства fdopenQ) для вашей системы.

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

Проблема

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

Решение

Синонимы для файловых манипуляторов создаются конструкциями вида

MLIAS = ORIGINAL:

Для создания независимой копии файлового дескриптора используется функция open с режимом доступа &:

openCOUTCOPY, ">&STDOUT") or die "Couldn't dup STDOUT： $!"： open(INCOPY, "<&STDIN") or die "Couldn't dup STDIN : $!";

Чтобы создать синоним для манипулятора или дескриптора, вызовите open с режимом &=:

open(OUTALIAS.">&=STDOUT")or die"Couldn'taliasSTDOUT: $!":

open(INALIAS."<&=STDIN")or die"Couldn'taliasSTDIN : $!":

open(BYNUMBER.">&=5")or die"Couldn'taliasfile descriptor5: $!":

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

кировками и флагами, но с независимыми буферами. Закрытие одного манипулятора никак не отражается на его копии. Впрочем, одновременная работа с файлом через два манипулятора — верный путь к катастрофе. Обычно эта методика применяется только для сохранения и восстановления STDOUT и STDERR:

Копирование файловых дескрипторов

open(OLDOUT, ">&STDOUT"):

open(OLDERR, ">&STDERR"):

Перенаправление stdout и stderr

open(STDOUT, "> /tmp/program.out") or die "Can't redirect stdout: $!";

open(STDERR. ">&STDOUT")or die "Can't dup stdout: $!":

Запуск программы

system($joe_random_program)；

Закрытие перенаправленных манипуляторов

close(STDOUT)ordie"Can'tclose STDOUT: $!";

close(STDERR)ordie"Can'tclose STDERR: $!";

Восстановление stdout и stderr

open(STDERR. ">&OLDERR")ordie"Can'trestore stderr： $!":

open(STDOUT, ">&OLDOUT")ordie"Can'trestore stdout: $!";

Закрытие независимых копий для предотвращения утечки ресурсов close(OLDOUT)or die "Can't close OLDOUT: $!";

close(OLDERR)or die "Can't close OLDERR: $!":

При создании синонима для дескриптора командой open(ALIAS, ">=&HANDLE") в действительности вызывается функция fdopenQ) из стандартной библиотеки ввода/вывода или ее эквивалент. Вы получаете единый дескриптор с двумя буферами ввода/вывода, доступ к которым осуществляется через разные манипуляторы. Закрытие одного манипулятора приводит к закрытию файловых дескрипторов всех синонимов, но не их манипуляторов — при попытке вызова print для манипулятора, чей синоним был закрыт функцией close, Perl не выдает предупреждение "print on closed filehandle", хотя попытка завершилась неудачей. Короче говоря, работа с файлом через два манипулятора ведет к беде. За дополнительной информацией по этой теме обращайтесь к рецепту 7.9.

См. также

Описание функции open в perlfunc(l); страница руководства dup(2) для вашей системы.

Создание временных файлов

Проблема

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

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

Решение

Воспользуйтесь функцией tmpfile модуля File： ：Temp:

use File::Temp qw/ tempdir /：

$fh = tempfile(): # Просто манипулятор

Возможно, наряду с временным файлом вам понадобится временный каталог:

use File：：Temp qw/ tempdir /；

или задать каталог

$d1r = tempdir( CLEANUP => 1 ):

($fh, $f1lename) = tempf1le( DIR => $d1r )；

Stemplate = "myprogtempXXXXXX"; # Суффикс X заменяется другими символами

($fh, $filename) = tempf1le( $template, DIR => $d1r)：

($fh, $filename) = tempfile( $template, SUFFIX => ".data");

Комментарий

Временные файлы можно создавать разными способами, но лучше всего использовать функции модуля File： :Temp. Во-первых, они чрезвычайно удобны; во-вторых, они лучше адаптируются для других платформ, чем прямые вызовы функций операционной системы. Но, вероятно, важнее всего другое — эти функции учитывают всевозможные нетривиальные проблемы безопасности и особенно потенциальные возможности перехвата.

Хотя модуль содержит немало различных функций для создания временных файлов, большинство функций нужны лишь для поддержки унаследованных интерфейсов. В большинстве случаев пользователям достаточно базовой функции tempfi 1е(). Эта функция выполняет надежную атомарную операцию создания и открытия нового пустого файла в режиме чтения/записи. В скалярном контексте возвращается манипулятор временного файла, а в списковом контексте — манипулятор и полное имя:

use File：：Temp qw(tempflle)；

Только манипулятор

$fh = tempflleO ；

Манипулятор и полное имя файла

($fh, $filename) = tempflleO；

Функции tempfl 1 e могут передаваться необязательные аргументы: шаблон и пары именованных аргументов. Именованные аргументы определяют различные параметры временного файла: каталог, который должен использоваться вместо текущего; расширение файла, а в системах, в которых это возможно,— признак немедленного удаления временного файла при выходе из программы (что затрудняет поиск временных файлов злоумышленниками). Символы X в конце шаблона заменяются случайными символами в имени временного файла.

($fh, $filename) = tempfile(DIR => $dir);

($fh, $filename) = tempfile(Stempl ate):

($fh, $filename) = tempfile(Stempl ate, DIR => $dir):

($fh, $filename) = tempfile(Stempl ate, SUFFIX => ".dat");

($fh. $filename) = tempfile(Stempl ate. UNLINK => 1);

Если не задан параметр OPEN => 0, временный файл автоматически уничтожается при выходе из программы или при закрытии файла.

В последних версиях функция Perl open поддерживает простой способ создания временных файлов с неизвестными именами. Для этого вместо имени открываемого файла передается undef:

open(my $fh. "+>". undef)

or die "$0: can't create temporary file： $!\n"；

См. также

Документация по стандартному модулю File： :Temp; описание функции open вperl- func{\.)\ рецепт 7.9.

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

Проблема

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

Решение

Лексемы —DATA_ и —END— после исходного текста программы отмечают начало блока данных, который может быть прочитан программой или модулем через файловый манипулятор DATA.

В модулях используется лексема —DATA—:

while (<DATA>) {

Обработка строки

}

_DATA_

# Данные

Аналогично используется —END— в главном файле программы:

while (<main:：DATA>) {

Обработать строку

}

_END_

# Данные

Комментарий

Лексемы —DATA_ и —END— обозначают логическое завершение модуля или программы перед физическим концом файла.

Текст, находящийся после —DATA— или —END—, может быть прочитан через файловый манипулятор DATA уровня пакета. Предположим, у нас имеется гипотетический модуль Primes; текст после —DATA— в файле Primes.pm может быть прочитан через файловый манипулятор Primes: :DATA.

Лексема —END— представляет собой синоним —DATA_ в главном пакете. Текст, следующий после лексем —END— в модулях, недоступен.

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

Манипулятор DATA также применяется для определения даты последней модификации текущей программы или модуля. В большинстве систем переменная $0 содержит полное имя файла для работающего сценария. В тех системах, где значение $0 оказывается неверным, можно воспользоваться манипулятором DATA для определения размера, даты модификации и т. д. Вставьте в конец файла специальную лексему —DATA— (и предупреждение о том, что —DATA— не следует удалять), и файловый манипулятор DATA будет доступен в файле сценария, use POSIX qw(strftlme);

$raw_t1me = (stat(DATA))[9];

$s1ze = -s DATA：

$k1losize = 1nt($size / 1024) . 'k':

print "<P>Scr1pt size 1s $k1losize\n"；

print strftime("<P>Last script update： %c (^Z)\n", localt1me($raw_time)):

_DATA_

而 NOT~REMOVE THE PRECEDING LINE

Everything else in this file will be ignored.

Если в программе нужно сохранить сразу несколько файлов, обращайтесь к рецепту 7.13.

См. также

Раздел «Scalar Value Constructors» perldata(l).

7-13- Сохранение нескольких файлов в области DATA

Проблема

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

Решение

Воспользуйтесь модулем С PAN Inline： :F1les. Будьте внимательны!

use Inline：:Files；

while (<SETUP>) {

}

while (<EXECUTION>) {

everything for the SETUP filehandle goes here

_ _EXECUTION_ _

everything for the EXECUTION filehandle goes here

Комментарий

У синтаксиса —DATA— есть одно важное ограничение: он позволяет внедрить только один виртуальный файл данных в физический файл. Модуль CPAN Inline： :F1les обходит это ограничение и позволяет создавать логические виртуальные файлы. Он используется примерно так:

use Inline：：F1les:

Сначала идет весь код файла, затем...

_ _ALPHA_ _

Th1 s 1s the data 1n the first virtual file, ALPHA.

_ _BETA_ _

This 1s the data 1n the next virtual file, BETA.

_ _OMEGA_ _

This 1s the data in yet another v1rtual file, OMEGA.

_ _ALPHA_ _

This 1s more data 1n the second part of virtual file. ALPHA.

Предполагается, что программа читает из файловых манипуляторов, имена которых соответствуют символическим именам в двойных подчеркиваниях, в данном случае — ALPHA, ВЕТА и OMEGA. Одна программа может содержать несколько секций с одинаковыми именами, а разноименные секции не обязаны читаться в каком-то определенном порядке. Эти манипуляторы имеют много общего с манипулятором ARGV. Прежде всего, они автоматически открываются при первом использовании. Например, при выполнении фрагмента

while (<OMEGA>) {

print "omega data： $_"：

}_

while (<ALPHA>) {

print "alpha data： $_"：

}_

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

omega data: This is the data 1n yet another virtual file, OMEGA, omega data：

alpha data： This 1s the data 1n the first virtual file, ALPHA.

alpha data：

alpha data： This is more data 1n the second part of virtual file, ALPHA.

alpha data：

Кроме того, по аналогии с манипулятором ARGV, при чтении из манипулятора список доступных виртуальных файлов хранится в массиве, а текущий открытый виртуальный файл — в скаляре с соответствующим именем. Также имеется хэш с указанным именем, в котором хранится разнообразная информация о данном наборе виртуальных файлов, включая текущий файл, номер строки и смещение в байтах. Если воспользоваться отладчиком Perl для приведенной выше программы и вывести значения переменных, результат может выглядеть так: DB2> \$ALPHA. '©ALPHA, \ШРНА О SCALAR(0х362е34)

-> '/home/tchr1 st/inilne-demo(00000000000000000291)'

1 ARRAY(0x362e40)

0 '/home/tchrlst/Inllne-demoCOOOOOOOOOOOOOOOOOagi)'

1 '/home/tchrlst/1nl1ne-demo(00000000000000000476)'

2 HASH(0x362edc)

'file' => undef

'line' => undef

'offset' => undef

'writable' => 1

О чем говорится в последней строке? О том, что виртуальный файл доступен для записи. По умолчанию в сценариях, доступных для записи, виртуальные файлы тоже доступны для записи, и открываются в режиме чтения/записи! Отсюда следует, что вы можете обновлять их и даже добавлять новые виртуальные файлы в исходный текст программы, просто запустив ее на выполнение. Такая возможность может привести к любым бедам и катастрофам, поскольку ничто не помешает уничтожению данных, полученных с огромным трудом. По этой причине рекомендуется сначала заархивировать всю ценную информацию. В самом модуле предусмотрен механизм автоматического решения этой задачи. Команда

use Inline：:F1les -backup:

сохраняет оригинал в файле с суффиксом " ,bak". Имя файла для резервной копии также может явно задаваться в программе:

use Inline：:Files -backup => "/tmp/safety_net":

См. также

Документация по модулю CPAN Inline：:Files; рецепт 7.12.

7-14. Создание фильтра

Проблема

Вы хотите написать программу, которая получает из командной строки список файлов. Если файлы не заданы, входные данные читаются из STDIN. При этом пользователь должен иметь возможность передать программе "-" для обозначения STDIN или "someprogram |" для получения выходных данных другой программы. Программа может непосредственно модифицировать файлы или выводить результаты на основании входных данных.

Решение

Читайте строки оператором <>:

while (<>) {

# Сделать что-то со строкой

}

Комментарий

Встречая конструкцию:

while (<>) {

#

}

Perl преобразует ее к следующему виду1:

unshift(@ARGV. '-') unless @ARGV: while($ARGV = shirt @ARGV) { unless (open(ARGV, $ARGV)) { warn "Can't open $ARGV: $!\n"： next：

}

while (defined($_ = <ARGV>)) {

}

}

Внутри цикла с помощью ARGV и $ARGV можно получить дополнительные данные или узнать имя текущего обрабатываемого файла. Давайте посмотрим, как это делается.

Общие принципы

Если пользователь не передает аргументы, Perl заносит в ©ARGV единственную строку, Это сокращенное обозначение соответствует STDIN при открытии для чтения и STDOUT — для записи. Кроме того, пользователь может передать "-" в командной строке вместо имени файла для получения входных данных из STDIN.

В программе показанный фрагмент не будет работать из-за внутренней специфики ARGV.

Далее в цикле из ©ARGV последовательно извлекаются аргументы, а имена файлов копируются в глобальную переменную $ARGV. Если файл не удается открыть, Perl переходит к следующему файлу. В противном случае начинается циклическая обработка строк открытого файла. После завершения обработки открывается следующий файл и процесс повторяется до тех пор, пока не будет исчерпано все содержимое ©ARGV.

При вызове open не используется форма open(ARGV, ">". $ARGV). Это позволяет добиться интересных эффектов — например, передать в качестве аргумента строку "gzip -de file.gz |", чтобы программа получила в качестве входных данных результаты команды "gzip -de file.gz". Такое применение open рассматривается в рецепте 16.6.

Массив ©ARGV может изменяться перед циклом или внутри него. Предположим, вы хотите, чтобы при отсутствии аргументов входные данные читались не из STDIN, а из всех программных и заголовочных файлов С и C++. Вставьте следующую строку перед началом обработки <ARGV>:

QARGV = globC*.[Cch]") unless QARGV;

Перед началом цикла следует обработать аргументы командной строки — либо с помощью библиотек Getopt (см. главу 15 «Интерактивность»), либо вручную:

Аргументы 1： Обработка необязательного флага -с

1f (@ARGV && $ARGV[O] eq '-с') {

$chop_f1rst++；

shift；

Аргументы 2： Обработка необязательного флага -NUMBER 1f (QARGV && $ARGV[O] =~ /人-(\d+)$/) {

Scolumns = $1;

shift;

Аргументы 3： Обработка сгруппированных флагов -а. -1 -п. и -и while (QARGV && $ARGV[O] =~ /人-(.+)/ & (shift. ($_ = $1), 1)) { next 1f /'$/;

s/a// && (++$append, redo)；

die "usage： $0 [-a1nu] [filenames] ..An"： }

Если не считать неявного перебора аргументов командной строки, <> работает так же, как обычно. Продолжают действовать все специальные переменные, управляющие процессом ввода/вывода (см. главу 8). Переменная $/ определяет разделитель записей, а $. содержит номер текущей строки (записи). Если $/ присваивается неопределенное значение, то при каждой операции чтения будет получено не объединенное содержимое всех файлов, а полное содержимое одного файла: undef $/： while (<>) {

Теперь в $_ находится полное содержимое файла.

имя которого хранится в $ARGV

Если значение $/ локализовано, старое значение автоматически восстанавливается при выходе из блока:

{# Блок для local

local $/；# Разделитель записей становится неопределенным

while (<>) {

Сделать что-то； в вызываемых функциях

значение $/ остается неопределенным

}

}# Восстановить $/

Поскольку при обработке <ARGV> файловые манипуляторы никогда не закрываются явно, номер записи $. не сбрасывается. Если вас это не устраивает, самостоятельно организуйте явное закрытие файлов для сброса $.:

while (<>) {

print "$ARGV:$.:$_";

close ARGV 1f eof:

}

Функция eof проверяет достижение конца файла при последней операции чтения. Поскольку последнее чтение выполнялось через манипулятор ARGV, eof сообщает, что мы находимся в конце текущего файла. В этом случае файл закрывается, а переменная $. сбрасывается. С другой стороны, специальная запись eof () с круглыми скобками, но без аргументов проверяет достижение конца всех файлов при обработке <ARGV>.

Параметры командной строки

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

Параметр -п помещает исходный текст программы внутрь цикла while(<>). Обычно он используется в фильтрах типа grep или программах, которые накапливают статистику по прочитанным данным. Одна из таких программ приведена в примере 7.2.

Пример 7.2. findloginl

#!/usr/bin/perl

findloginl - вывести все строки, содержащие подстроку "login"

while (<>) {# Перебор файлов в командной строке

print 1f /login/： }

Программу из примера 7.2 можно записать так, как показано в примере 7.3.

Пример 7.3. findlogin2

#!/usr/bin/perl -n

f1ndlog1n2 - вывести все строки, содержащие подстроку "login" print 1f /login/：

Параметр -n может объединяться с -е для выполнения кода Perl из командной строки:

% perl -ne 'print 1f /login/'

Параметр -р аналогичен -п, однако он добавляет команду print в конец цикла. Обычно он используется в программах для преобразования входных данных.

Пример 7.4. find lowercase 1

#!/usr/bin/perl

lowercase - преобразование всех строк в нижний регистр

use locale；

while (<>) {# Перебор в командной строке

s/(\p{Letter})/\l$l/g； # Перевод всех букв в нижний регистр print：

}

Программу из примера 7.4 можно записать так, как показано в примере 7.5.

Пример 7.5. findlowercase2

#!/usr/bin/perl -р

lowercase - преобразование всех строк в нижний регистр use locale；

s/(\p{Letter})/\l$l/g； # Перевод всех букв в нижний регистр

Или непосредственно в командной строке следующего вида:

% perl -ре 's/(["\W0-9J)/\l$l/g'

При использовании -п или -р для неявного перебора входных данных для всего цикла негласно создается специальная метка LINE:. Это означает, что из внутреннего цикла можно перейти к следующей входной записи командой next LINE (аналог next в awk). При закрытии ARGV происходит переход к следующему файлу (аналог nextfile в awk). Обе возможности продемонстрированы в примере 7.6.

Пример 7.6. countchunks

#!/usr/bin/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

#+0894382288 telnet home

Простейшая однострочная программа приводит его к удобному формату:

%ре门-ре 's/"#\+(\d+)\n/localt1me($l) . " "/е

less /etc/motd vi ~/.exrc date whotel net homeless /etc/motd vi ~/.exrc date whotel net homeTue Мау 5 09:30:37 1998

less /etc/motd vi ~/.exrc date who

tel net home

less /etc/motd vi ~/.exrc date who

tel net home

Тие Мау 5 09:30:39 1998

Тие Мау 5 09:30:42 1998

Тие Мау 5 09:30:42 1998

Тие Мау 5 09:30:28 1998

Параметр -i изменяет каждый файл в командной строке. Он описан в рецепте 7.16 и обычно применяется в сочетании с -р.

См. также

рег1гип(1); рецепт 7.16; рецепт 16.6.