Строку с символами верхнего регистра необходимо преобразовать в нижний регистр, или наоборот.
Решение
Воспользуйтесь функциями 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 и механизм поиска по шаблону начинают "уважать" правила вашего национального языка. Благодаря ей становится возможным поиск символов с диакритическими элементами н т. д. Одна из распростр
символ Я в верхнем регистре выглядит как 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).
Требуется интерполировать вызов функции или выражение, содержащиеся в строке. По сравнению с интерполяцией простых скалярных переменных это позволит конструировать более сложные шаблоны.
Решение
Выражение можно разбить на отдельные фрагменты и произвести конкатенацию: $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 "I have ", $n + 1 . "guanacos.\n";
Если интерполяция абсолютно неизбежна, придется воспользоваться вторым вариантом, изобилующим знаками препинания. Только символы @, $ и \ имеют особое значение в кавычках и обратных апострофах. Как и в случаях с т// и s///, синоним qx() не подчиняется пра
Однако вы можете сделать нечто большее, чем просто присвоить переменной значение, полученное в результате интерполяции. Так, в следующем примере мы конструируем строку с интерполированным выражением и передаем результат функции:
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
Расширение строк в обратных апострофах ('') оказывается особенно творческой задачей, поскольку оно часто сопровождается появлением ложных символов перевода строки. Создавая блок в скобках за @ в разыменовании анонимного массива @{ [ ]}, как это было сдела
Все эти приемы работают, однако простое разделение задачи на несколько этапов или хранение всех данных во временных переменных почти всегда оказывается более понятным для читателя.
В версии 5.004 Perl в выражении ${\EXPR } значение EXPR ошибочно вычислялось в списковом, а не скалярном контексте. Ошибка была исправлена в версии 5.005.
> Смотри также -------------------------------
perlref(1).
При использовании механизма создания длинных строк {встроенных документов) текст должен выравниваться вдоль левого поля; в программе это неудобно. Требуется снабдить отступами текст документа в программе, но исключить отступы из окончательного содержимого
Решение
Воспользуйтесь оператором 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).
