Приглашаем посетить
Клюев (klyuev.lit-info.ru)

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

Назад
Глава 1 Строки
Вперед

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

Проблема


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

Решение


Воспользуйтесь функцией split с пустым шаблоном, чтобы разбить строку на отдельные символы, или функцией unpack, если вам нужны лишь их ASCII-коды: @array = split(//, $string);
@аrrау = unpack("C*", $string):
Или последовательно выделяйте очередной символ в цикле:
while (/(.)/g) { и . здесь не интерпретируется как новая строка " Сделать что-то полезное с $1

Комментарий

Как говорилось выше, фундаментальной единицей текста в Perl является строка, а не символ. Необходимость посимвольной обработки строк возникает достаточно редко. Обычно такие задачи легче решаются с помощью высокоуровневых операций Perl (например, поиска по шаблону). Пример приведен в рецепте 7.7, где для поиска аргументов командной строки используются подстановки. Если вызвать split с шаблоном, который совпадает с пустой строкой, функция возвращает список отдельных символов строки. При намеренном использовании эта особенность оказывается удобной, однако с ней можно столкнуться и случайно. Например, /X*/ совпадает с пустой строкой. Не исключено, что вам встретятся и другие ненамеренные с9впадения. Ниже приведен пример, который выводит символы строки "an apple a day", отсортированные в восходящем порядке ASCII-кодов: %seen =)_;
$string = "an apple a day";
foreach $byte (split //, $string) {
$seen($1)++;
}
print "unique chars are: ", sort(keys %seen), "\n";
unique chars are: adelnpy
Решения с функциями split и unpack предоставляют массив символов, с которым можно работать. Если массив не нужен, воспользуйтесь поиском по шаблону в цикле while с флагом /g, который будет извлекать по одному символу: %seen =();
$string "an apple a day";
while ($string =~ /(.)/g) { $seen($1)++;
}
print "unique chars are: sort(keys %seen),"\n"
unique chars are: adelnpy
Как правило, посимвольная обработка строк не является оптимальным решением. Вместо использования index/substr или split/unpack проще воспользоваться шаблоном. В следующем примере 32-разрядная контрольная сумма вычисляется вручную, но лучше поручить работу функции unpack - она сделает то же самое намного эффективнее. Следующий пример вычисляет контрольную сумму символов $string в цикле to reach. Приведенный алгоритм не оптимален; просто мы используем традиционную и относительно легко вычисляемую сумму. За более достойной реализацией контрольной суммы обращайтесь к модулю MD5 на С PAN. $sum =0;
fоreach $ascval (unpack("C*", $string)) {
$sum += $ascval;
} .
print "sum is $sum\n";
# Для строки "an apple a day" выводится сумма 1248
Следующий вариант делает то же самое, но намного быстрее:

$sum= unpack("%32C", $string);
Это позволяет эмулировать программу вычисления контрольной суммы SysV:
#!/usr/bin/perl
# sum - Вычисление 16-разрядной контрольной' суммы всех входных файлов
#checksum =0
while (<>) { $checksum+=unpack("%16C*", $_)}
$checksum %= (2** 16)- 1;
print'"$checksum\n";
На практике пример использования выглядит так:
% Perl sum /etc/termcap
1510
Если у вас установлена GNU-версия sum, для получения идентичного ответа для того же файла ее следует вызвать с параметром -sysv: % sum -sysv /etc/termcap 1510 851 /etc/termcap
В примере 1.1 приведена еще одна крошечная программа, в которой также реализована посимвольная обработка входных данных. Идея заключается в том, что-
бы вывод каждого символа сопровождался небольшой паузой - текст будет появляться перед аудиторией в замедленном темпе, и его будет удобнее читать. Пример 1.1. slowcat
#!/usr/bin/регl
# slowcat -замедленный вывод
# использование: slowcat [-DELAY] [files...],
#где DELAY - задержка
SDELAY = ($ARGV[0] =~ /"-([.\d]+)/) ? (shift, $1) : 1;
$1=1;
while (<>) {
for (split(//)) {
print;
select(undef,undef,undef. 0.005 * $DELAY);
} }

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

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

Проблема

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

Решение

Для перестановки байтов воспользуйтесь функцией reverse в скалярном контексте:
$revbytes = reverse($string);
Для перестановки слов воспользуйтесь reverse в списковом контексте с функциями split и join: $revwords = join(" ". reverse split(" ", $string);

Комментарий

У функции reverse существуют два варианта применения. В скалярном контексте функция объединяет аргументы и возвращает полученную строку в обратном порядке. В списковом контексте функция возвращает аргументы в обратном порядке. При использовании reverse для перестановки символов в неочевидной ситуации используйте функцию scalar для форсированного применения скалярного контекста.
'$gnirts= reverse<$string;); # Перестановка 'символов i$string
$sdrow = reverse(@words); # Перестановка элементов @sdrow
$confused = reverse(@words); #Перестановка букв в join("", @words)
Приведем пример обратной перестановки слов в строке. Пробел (" ") в качестве шаблона split является особым случаем. Он заставляет split использовать в качестве разделителя смежные пропуски (whitespace) и отбрасывать начальные пустые поля (по аналогии с awk). Обычно split отбрасывает только конечные пустые поля. # Обратная перестановка слов
$string = "Yoda said, "can you see this?"";
@allwords = split(" ". $string);
@revwords = join(" ", reverse @allwords);
print $revwords, "\n";
this?" see you "can said, Yoda
Временный массив @allwords можно убрать и сделать все в одной строке:
$revwords = join(" ", reverse split(" ", $string);
Смежные пропуски в $string превращаются в один пробел в $revwords. Чтобы сохранить существующие пропуски, поступите так: $revwords = join("", reverse split (/(S+)/, $string";
С помощью функции reverse можно проверить, является ли слово палиндромом (то есть читается ли одинаково в обоих направлениях): $word = "reviver";
$is_palindronie.=($wordeqreverse($word));
Программа для поиска длинных палиндромов в файле /usr/diet/words записывается в одну строку: % Perl -nie 'print if $_ eq reverse && length >5' /usr/dict/words
deedeed
degged
deified
denned
hallah
kakkak
murdrum
redder
repaper
retter
reviver
rotator
sooloos
tebbet
terret
tut-tut

Смотри также: Описание функций split, reverse и scalar в perlfunc(1); раздел "Switches" perlrun(1)

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

Проблема

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

Решение

Примените подстановку весьма странного вида:
while ($string =~ s/\t+/' ' х length($&) * 8 - length($') % 8)/e)
{
# Выполнять пустой цикл до тех пор
# пока выполняется условие подстановки
}

Также можно воспользоваться стандартным модулем Text::Tabs:
use Text: :Tabs;
@expanded_lines = ехраnd(@lines_with_tabs);
@tabulated_lines = unexpand(@lines_without_tabs);

Комментарий

Если позиции табуляции следуют через каждые N символов (где N обычно равно 8), их несложно преобразовать в пробелы. В стандартном, "книжном" методе не используется модуль Text::Tabs, однако разобраться в нем непросто. Кроме того, в нем используется переменная $', одно упоминание которой замедляет поиск по шаблону в программе. Причина объясняется в разделе "Специальные переменные" введения к главе 6. while (<>)
{
1 while g/\t+/' ' х length($&) * 8 - length($') % 8)/e;
print;
}
Вы смотрите на второй цикл while и не можете понять, почему его нельзя было включить в конструкцию s///g? Потому что вам приходится каждый раз заново пересчитывать длину от начала строки (хранящуюся в $'), а не от последнего совпадения. Загадочная конструкция 1 while CONDITION эквивалентна while (CONDITION){}, но более компактна. Она появилась в те дни, когда первая конструкция работала в Perl несравнимо быстрее второй. Хотя сейчас второй вариант почти не уступает по скорости, первый стал удобным и привычным. Стандартный модуль Text::Tabs содержит функции преобразований в обоих направлениях, экспортирует переменную $tabstop, которая определяет число пробелов на символ табуляции. Кроме того, эти не приводит к снижению быстродействия, потому что вместо $& и $' используются $1 и $2; use Text::Tabs;
$tabstop =4;
while (<>)
{ print expand($_) }
Модуль Text::Tabs также может применяться для "сжатия" табуляции. В следующем примере используется стандартное значение $tabstop, равное 8: use Text::Tabs;
while (о) { print unexpand($_) }

Смотри также: Страница руководства модуля Text::Tabs; описание оператора s/// в perlre(1) и perlop(1).

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

Проблема

Имеется строка, внутри которой присутствует ссылка на переменную:
You owe $debt to me.
Требуется заменить имя переменной $debt в строке ее текущим значением.

Решение

Если все переменные являются глобальными, воспользуйтесь подстановкой с символическими ссылками:
$text =~s/\$(\w+)/${$1}/g;
Но если среди переменных могут встречаться лексические (mу) переменные, следует использовать /ее:
$text =~ s/(\$\w+)/$1/gee;

Комментарий

Первый способ фактически сводится к следующему: мы ищем нечто похожее на имя переменной, а затем интерполируем ее значение посредством символического разыменования (dereferencing). Если $"( содержит строку somevar, то ${$1} будет равно содержимому $somevar. Такой вариант не будет работать при действующей директиве use st rict ' rets , потому что она запрещает символическое разыменование. Приведем пример:
use vars qw($rows $cols);
no strict 'rets'; # для приведенного ниже ${$1} my $text;
($rows, $cols) = (,^, 80):
$text = q(i am $ rows high and $cols long); # апострофы! $text =~ s/\$(\w+)/${$1}/g;
print $text;
1 am 24 high and 80 long
Возможно, вам уже приходилось видеть, как модификатор подстановки /е используется для вычисления заменяющего выражения, а не строки. Допустим, вам потребовалось удвоить каждое целое число в строке: $text = "i am 17 years old";
$text ="" s/(\d+)/2 * $1/eg;
Перед запуском программы, встречая /е при подстановке, Perl компилирует код заменяющего выражения вместе с остальной программой, задолго до фактической подстановки. При выполнении подстановки $1 заменяется найденной строкой. В нашем примере будет вычислено следующее выражение: 2 * 17
Но если попытаться выполнить следующий фрагмент:
$text = 'i am $age years old'; # Обратите внимание на апострофы!
$text =~ s/(\$\w+)/$1/eg; # НЕВЕРНО при условии, что $text содержит имя переменной $AGE, Perl послушно заменит $1 на $AGE и вычислит следующее выражение: '$AGE'
В результате мы возвращаемся к исходной строке. Чтобы получить значение переменной, необходимо снова вычислить результат. Для этого в строку добавляется еще один модификатор /е: $text =~ s/(\$\w+)/$1/eeg; # Находит переменные mу() Да, количество модификаторов /е может быть любым. Только первый модификатор компилируется вместе с программой и проверяется на правильность синтаксиса. В результате он работает аналогично конструкции eval {BLOCK}, хотя и не перехватывает исключений. Возможно, лучше провести аналогию с do {BLOCK}. Остальные модификатора! /е ведут себя иначе и больше напоминают конструкцию eval "STRING". Они не компилируются до выполнения программы. Маленькое преимущество этой схемы заключается в том, что вам не придется вставлять в блок директиву no strict ' refs'. Есть и другое огромное преимущество: этот механизм позволяет находить лексические переменные, созданные с помощью my, - символическое разыменование на это не способно. В следующем примере модификатор /х разрешает пропуски и комментарии в шаблоне подстановки, а модификатор /е вычисляет правостороннее выражение на программном уровне. Модификатор /е позволяет лучше управлять обработкой ошибок или других экстренных ситуаций:
# Расширить переменные в $text. Если переменная не определена,
#вставить сообщение об ошибке. $text =~ s{
}{
\$ # Найти знак доллара (\w+) #Найти "слово" и сохранить его в $1 no strict 'refs';
if (defined $$1) {
$$1; # Расширять только глобальные переменные
} else {

"[NO VARIABLE: \$$1]; # Сообщение об ошибке
} }еgх;
Обратите внимание на изменение синтаксиса $$1 в Perl 5.004; когда-то это выражение означало ${$}!, а теперь оно означает ${$1}. Для обеспечения обратной совместимости в строках оно сохраняет старый смысл (но выдает предупреждение с -w). Запись ${$1} используется в строках для того, чтобы предотвратить разыменование PID. Если значение $$ равно 23448, то $$1 в строке превращается в 234481, а не в значение переменной, имя которой хранится в $1.

Смотри также: Описание оператора perlre(1) и рerlор(1) описание функции eval в perlfunc(1). Аналогичное использование подстановок встречается в рецепте 20.9


Назад
Вперед