HTML page
 |
 |
1.9. Преобразование регистра
Проблема
Строку с символами верхнего регистра необходимо преобразовать в нижний регистр, или наоборот.Решение
Воспользуйтесь функциями 1с и ис со служебными командами \L и \U:use locale; # Необходимо в 5.004 и выше
$big = uc($little); # "bo peep" -> "BO PEEP"
$little = lc($big);
# "JOHN" -> "John"
$big = "\u$little"; #"bo peep" -> "BO PEEP"
$little = "\l$big";
" "JOHN" -> "John" Для замены отдельного символа используйте функции Icfirst и ucfirst со служебными командами \1 и \и: $big = "\u$little"; # "bo" -> "Во"
$little = "\l$big"; # "bopeep" -> "BоРеер"
Комментарий
Функции н служебные команды выглядят по-разному, но делают одно и то же. Допускается указание регистра как первого символа, так и целой строки. Вы даже можете форсировать применение верхнего регистра для первого символа и нижнего - для всех остальных. Встречая директиву use locale, функции преобразования регистра Perl и механизм поиска по шаблону начинают "уважать" правила вашего национального языка. Благодаря ей становится возможным поиск символов с диакритическими элементами н т. д. Одна из распространенных ошибок - преобразование регистра с помощью tr///. Да, мы хорошо помним, что в одном из старых изданий этой книги рекомендовали использовать tr/A-Z/a-z/. В свое оправдание можем лишь сказать, что в то время другого способа не существовало. Такое решение работает не всегда, поскольку из него выпадают все символы с умляутами, седилями и прочими диакритическими элементами, встречающимися во многих языках. Команды преобразования регистра и с и \U понимают эти символы и обеспечивают их правильное преобразование (по крайней мере, если в программе присутствует директива use locale). Исключение составляет немецкий язык; символ Я в верхнем регистре выглядит как SS, но в Perl такое преобразование не поддерживается.use locale;
$beast = "dromedary";
# Изменить регистр разных символов
$beast $capit = ucfirst($beast); # dromedary
$capit = "\u\l$beast"; # (то же)
$capall = "uc($beast);
и
DROMEDARY $capall = "\u$beast"; # (то же)
$caprest = lcfirst(uc($beast)); # dromedary
$caprest = "\l\#$beast"; # (то же) Как правило, служебные команды обеспечивают согласованное применение регистра в строке: # Преобразовать первый символ каждого слова в верхний регистр,
# а остальные символы - в нижний
$text = "this is a long line";
$text =~ s/(w+)/\u\l$1/g;
print $text;
This Is A Long Line
Ими также можно пользоваться для выполнения сравнений без учета регистра:
if (uc($a) eq uc($b)) {
print."a and b are the same\n";
}
Программа randcap из примера 1.2 случайным образом преобразует в верхний регистр примерно 20 процентов вводимых символов. Пользуясь ей, можно свободно общаться с 14-летними WaREz dOODz.
Пример 1.2. randcap
#!/usr/bin/perl -p
# randcap: фильтр, который случайным образом
# преобразует к верхнему регистру 20% символов
# В версии 5.004 вызов srand() необязателен.
BEGIN {srand(time() ~ ($$ + ($$ " 15))) }
sub randcase { rand(100) < 20 ? "\u$_[0]" : "\1$_[0]" }
s/(\w)/randcase($1)/ge,
% randcap < genesis ] head -9 boOk 01 genesis
001:001 in the BEginning goD created the heaven and tHe earTH,
001:002 and the earth wAS without ForM, 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.
Более изящное решение - воспользоваться предусмотренной в Perl возможностью применения поразрядных операторов для строк:
sub randcase {
rand(100) < 20 ? ("\040" " $1) : $1 }
Этот фрагмент изменяет регистр примерно у 20 процентов символов. Однако для 8-разрядных кодировок он работает неверно. Аналогичная проблема существовала и в исходной программе randcase, однако она легко решалась применением директивы use locale. Следующий пример поразрядных строковых операций быстро отсекает у всех символов строки старшие биты:
$string &= "\177" х length($string);
Впрочем, о человеке, ограничивающем строки 7-разрядными символами, будут говорить все окружающие - и не в самых лестных выражениях.
> Смотри также -------------------------------- Описание функций uc, lc, ucflrst и Icfirst в perlfunc(1); описание метасимволов \1_, \U, \1 и \и в разделе "Quote and Quote-like Operators" perlop(i).
1.10. Интерполяция функций и выражений в строках
Проблема
Требуется интерполировать вызов функции или выражение, содержащиеся в строке. По сравнению с интерполяцией простых скалярных переменных это позволит конструировать более сложные шаблоны.Решение
Выражение можно разбить на отдельные фрагменты и произвести конкатенацию:$answer = $var1 . func(). $var2; # Только для скалярных величин
Также можно воспользоваться неочевидными расширениями @{ [ LIST EXPR ]} или${\(ЗСА1АР EXPR)}: $answer = "string @{[list expr]} more string" $answer = "string ${\(scalar expr)} more string";
Комментарий
В следующем фрагменте продемонстрированы оба варианта. В первой строке выполняется конкатенация, а во второй - фокус с расширением: $phrase = "i have " . ($п + 1) . "guanacos.";Sphrase = "i have ${\($n + 1)} guanacos.";
В первом варианте строка-результат образуется посредством конкатенации более мелких строк; таким образом, мы добиваемся нужного результата без интерполяции. Функция print фактически выполняет конкатенацию для всего списка аргументов, и, если вы собираетесь вызвать print $phrase, можно было бы просто написать: print "I have ", $n + 1 . "guanacos.\n";
Если интерполяция абсолютно неизбежна, придется воспользоваться вторым вариантом, изобилующим знаками препинания. Только символы @, $ и \ имеют особое значение в кавычках и обратных апострофах. Как и в случаях с т// и s///, синоним qx() не подчиняется правилам расширения для кавычек, если в качестве ограничителя использованы апострофы! $home = qx'echo home is $home'; возьмет переменную $НОМЕ из командного интерпретатора, а не из perl! Итак, единственный способ добиться расширения произвольных выражений - расширить ${} или @{}, в чьих блоках присутствуют ссылки. Однако вы можете сделать нечто большее, чем просто присвоить переменной значение, полученное в результате интерполяции. Так, в следующем примере мы конструируем строку с интерполированным выражением и передаем результат функции: some_func("What you want is @{[ split /:/, $rec ]} items"):
Интерполяция может выполняться и во встроенных документах:
die "Couldn't send mail" unless send_mail(""EOTEXT", $target);
To: $naughty
From: Your bank
Cc: @{ get_manager_list($naughty) }
Date: @{[ do { my $now = 'date'; chomp $now; $now} ]} (today)
Dear $naughty,
Today, you bounced check number @{[ 500 + int rand(100) ]} to us, Your account is now closed. Sincerely, the management EOTEXT
Расширение строк в обратных апострофах ('') оказывается особенно творческой задачей, поскольку оно часто сопровождается появлением ложных символов перевода строки. Создавая блок в скобках за @ в разыменовании анонимного массива @{ [ ]}, как это было сделано в последнем примере, вы можете создавать закрытые (private) переменные. Все эти приемы работают, однако простое разделение задачи на несколько этапов или хранение всех данных во временных переменных почти всегда оказывается более понятным для читателя. В версии 5.004 Perl в выражении ${\EXPR } значение EXPR ошибочно вычислялось в списковом, а не скалярном контексте. Ошибка была исправлена в версии 5.005.
> Смотри также ------------------------------- perlref(1).
1.11. Отступы во встроенных документах
Проблема
При использовании механизма создания длинных строк {встроенных документов) текст должен выравниваться вдоль левого поля; в программе это неудобно. Требуется снабдить отступами текст документа в программе, но исключить отступы из окончательного содержимого документа.Решение
Воспользуйтесь оператором s/// для отсечения начальных пропусков:# Все сразу
($var = <
ваш текст HERE_TARGET
# Или за два этапа $var = "here_target;
далее следует
ваш текст HERE_TARGET
$var =~ s/"\s+//gm;
Комментарий
Подстановка получается весьма прямолинейной. Она удаляет начальные пропуски из текста встроенного документа. Модификатор /т позволяет символу " совпадать с началом каждой строки документа, а модификатор /д заставляет механизм поиска повторять подстановку с максимальной частотой (то есть для каждой строки встроенного документа).($definition = "'finis') =~s/"\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 vicuca. FINIS
Учтите: во всех шаблонах этого рецепта используется модификатор \s, разрешающий совпадение с символами перевода строки. В результате из встроенного документа будут удалены все пустые строки. Если вы не хотите этого, замените в шаблонах \s на ["\S\n]. В подстановке используется то обстоятельство, что результат присваивания может использоваться в левой стороне =~. Появляется возможность сделать все в одной строке, но она работает лишь при присвоении переменной. При непосредственном использовании встроенный документ интерпретируется как неизменяемый объект, и вы не сможете модифицировать его. Более того, содержимое встроенного документа нельзя изменить без предварительного сохранения его в переменной. Впрочем, для беспокойства нет причин. Существует простой обходной путь, особенно полезный при частом выполнении этой операции. Достаточно написать подпрограмму:
sub fix {
my $string = shift;
$string =~ s/"\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 perlshed-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';
@@@ 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 poeni:\n\n$poem\n";
Результат будет выглядеть так:
Here's your роет:
Now far ahead the Road has gone,
And I must follow, if I can, Pursuing it with eager feet,
Until it joins some larger way Where may paths and errands meet,
And whither then? I cannot say.
--Bilbo in /usr/src/perl/pp_ctl.c
Приведенная ниже функция dequote справляется со всеми описанными проблемами. При вызове ей в качестве аргумента передается встроенный документ. Функция проверяет, начинается ли каждая строка с общей подстроки (префикса), и если это так - удаляет эту подстроку. В противном случае она берет начальный пропуск из первой строки и удаляет его из всех последующих строк. sub dequote {
local $_ = shift;
my ($white, $leader); # пропуск и префикс, общие для всех строк if (/"\s*(?:(["\w\s]+)(\s*)..\n)^:\s*\1\2?.*\n)+$/) { ($white, $leader) = ($2, quotemeta($1));
} else {
($white, $leader_ = (/"(\s+)/, '');
}
s/"\s*?$leader(?:$white)?//gm;
return $_;
}
Если при виде этого шаблона у вас стекленеют глаза, его всегда можно разбить на несколько строк и добавить комментарии с помощью модификатора /х: if (m{
" # начало строки
\s *< 0 #и более символов-пропусков
(?: # начало первой несохраненной группировки
( # начать сохранение $1
["\w\s] # один байт - не пробел и не буквенный символ
+ # 1 или более
) # закончить сохранение $1
( \s*) # занести 0 и более пропусков в буфер $2
.* \п # искать до конца первой строки
) # конец первой группировки
(?: # начало второй несохраненной группировки
\s * # 0 и более символов-пропусков
\1 # строка, предназначенная для $1
\2 ? # то, что будет в $2, но дополнительно
.* \n # искать до конца строки
) + #повторить идею с группами 1 и более раз
$ #"до конца строки
}x
}
{
($white, $leader) = ($2, quotemeta($1));
} else {
($white, $leader) = (/"(\s+)/. ' ");
}
y{ # начало каждой строки (из-за /m)
\s * # любое количество начальных пропусков
9 # с минимальным совпадением
$leader (7: # сохраненный префикс
$white ) ? }{}xgm; # начать несохраненную группировку
# то же количество
# если после префикса следует конец строки
Разве не стало понятнее? Пожалуй, нет. Нет смысла уснащать программу банальными комментариями, которые просто дублируют код. Возможно, перед вами один из таких случаев.
> Смотри также ------------------------------- Раздел "Scalar Value Constructors" perldata(1), описание оператора s/// в perlre( 1) и perlop( 1).
|
|
|