.
$раrа = get_paragraph(*fh); # Передать glob файлового манипулятора
$para = get_paragraph(\"fh); # Передать манипулятор по ссылке на
glob $раrа = get_paragraph(*io{fh}); # Передать манипулятор по ссылке на 10
sub get_paragraph {
my $fh = shift;
local $/='';
my $paragraph = <$fh>;
chomp($paragraph);
return $paragraph;
Применение local() для создания локальных манипуляторов Вторая ситуация возникает в случае, когда требуется локальный манипулятор файла или каталога, реже - локальная функция. Начиная с Perl версий 5.000, можно воспользоваться стандартными модулями Symbol, Filehandle или IO::Handle. но и привычная методика с тип-глобом по-прежнему работает. Например:
$contents = get_motd();
sub get_motd {
local *MOTD;
open(MOTD, "/etc/motd") or die "can't open mold: $!";
local $/ = undef; # Читать весь файл
local $_ = ;
close (MOTD);
return $_;
}
Открытый файловый манипулятор возвращается следующим образом:
return *MOTD;
Применение lосаl() в массивах и хэшах
Третья ситуация на практике почти не встречается. Поскольку оператор local в действительности является оператором "сохранения значения", им можно воспользоваться для сохранения одного элемента массива или хэша, даже если сам массив или хэш является лексическим!
my @nums = (0 .. 5);
sub first {
local $nums[3] = 3,14159;
second();
} sub second {
print "@nums\n";
} second();
012345 first();
0 1 2 3.14159 4 5
Единственное стандартное применение - временные обработчики сигналов.
sub first {
local $SIG{INT} = 'ignore';
second();
}
Теперь во время работы second () сигналы прерывания будут игнорироваться. После выхода из first () автоматически восстанавливается предыдущее значение $SIG{INT}.
Хотя local часто встречается в старом коде, от него следует держаться подальше, если это только возможно. Поскольку local манипулирует значениями
глобальных, а не локальных переменных, директива use strict ни к чему хорошему не приведет.
Оператор local создает динамическую область действия. Она отличается от другой области действия, поддерживаемой Perl и значительно более понятной на интуитивном уровне. Речь идет об области действия my - лексической области действия, иногда называемой "статической".
В динамической области действия переменная доступна в том случае, если она находится в текущей области действия - или в области действия всех кадров (блоков) стека, определяемых во время выполнения. Все вызываемые функции обладают полным доступом к динамическим переменным, поскольку последние остаются глобальными, но получают временные значения. Лишь лексические переменные защищены от вмешательства извне. Если и это вас не убедит, возможно, вам будет интересно узнать, что лексические переменные примерно на 10 процентов быстрее динамических.
Старый фрагмент вида:
sub func {
1оса1($х, $у) = @_;
#... .
}
почти всегда удается заменить без нежелательных последствий следующим фрагментом:
sub func {
my($x, $y) = @_:
#.... }
Единственный случай, когда подобная замена невозможна, - если работа программы основана на динамической области действия. Это происходит в ситуации, когда одна функция вызывает другую и работа второй зависит от доступа к временным версиям глобальных переменных $х и $у первой функции. Код, который работает с глобальными переменными и вместо нормальной передачи параметров издалека вытворяет нечто странное, в лучшем случае ненадежен. Хорошие программисты избегают подобных выкрутасов как чумы.
Если вам встретится старый код вида:
&func(*Global_Array);
sub func {
local(*aliased_array) = shift;
for (@aliased_array) { .... } }
вероятно, его удастся преобразовать к следующей форме:
func(\@Global_Array);
sub func {
my $array_ref = shift;
for ((g>$array_ref) { .... }
}
До появления в Perl нормальной поддержки ссылок, использовалась старая стратегия передачи тип-глобов. Сейчас это уже дело прошлое.
> Смотри также -------------------------------
Описание функций local и ту в perlfunc(1); разделы "Private Variables via my()" и "Temporary Values via local()" perlsub(1); рецепты 10.2; 10.16.
Проблема
Требуется временно или постоянно переопределить функцию, однако функциям нельзя "присвоить" новый код.
Решение
Чтобы переопределить функцию, присвойте ссылку на новый код тип-глобу имени функции. Используйте local для временной замены.
undef &grow; # Заглушить жалобы -w на переопределение
*grow = \&expand;
grow(); # Вызвать expand()
}
local *grow - \&shrink, # Только в границах олока
grow(); # Вызывает shrink()
}
Комментарий
В отличие от переменных (но по аналогии с манипуляторами) функции нельзя напрямую присвоить нужное значение. Это всего лишь имя. Однако с ней можно выполнять многие операции, выполняемые с переменными, поскольку вы можете напрямую работать с таблицей символов с помощью тип-глобов вида *foo и добиваться многих интересных эффектов.
Если присвоить тип-глобу ссылку, то при следующем обращении к символу данного типа будет использовано новое значение. Именно это делает модуль Exporter при импортировании функции или переменной из одного пакета в другой. Поскольку операции выполняются непосредственно с таблицей символов пакета, они работают только для пакетных (глобальных) переменных, но не для лексических.
*one::var = \%two::table; # %one::var становится синонимом для %two::table
*one::big = \&two::small; # &one::big становится синонимом для &two::small
С тип-глобом можно использовать local, но не ту. Из-за local синоним действу-oo т только в границах текущего блока.
local *fred = \&barney; # временно связать &rred с &barney
Если значение, присваиваемое тип-глобу, представляет собой не ссылку, а другой тип-глоб, то замена распространяется на все типы с данным именем. Полное присваивание тип-глоба относится к скалярным величинам, массивам, хэшам, функциям, файловым манипуляторам, манипуляторам каталогов и форматам. Следовательно, присваивание *Тор = * bottom сделает переменную $Тор текущего пакета синонимом для $bottom, @Тор - для bottom, %Тор - для %bottom и &Тор -для &bottom. Замена распространяется даже на соответствующие манипуляторы файлов и каталогов и форматы! Вероятно, это окажется лишним.
Присваивание тип-глобов в сочетании с замыканиями позволяет легко и удобно дублировать функции. Представьте, что вам понадобилась функция для генерации html-кода, работающего с цветами. Например:
$string = red("careful here");
print $string;
careful here
Функция red выглядит так:
sub red { "@_" }
Если вам потребуются другие цвета, пишется нечто подобное:
sub color_font {
my $color = shift;
return "@)_";
}
sub red { color_font("red", @_)
} sub green { color_font("green", @_)
} sub blue { color_font("blue", @_)
} sub purple { color_font("purple", @_) } # И т. д.
Сходство функций наводит на мысль, что общую составляющую можно как-то выделить. Для этого следует воспользоваться косвенным присваиванием тпп-глобы. Если вы используете рекомендуемую директиву use strict, сначала отключите strict "refs" для этого блока.
@colors = qw(red blue green yellow orange purple violet);
for my $name (@colors) {
no strict ' refs';
*$name = sub { "@>_" };
}
Функции кажутся независимыми, однако фактически код был откомпилирован лишь один раз. Подобная методика экономит время компиляции и память. Для создания полноценного замыкания все переменные анонимной подпрограммы должны быть лексическими. Именно поэтому переменная цикла объявляется с ключевым словом ту.
Перед вами одна из немногочисленных ситуаций, в которых создание прототипа для замыкания оправдано. Если вам захочется форсировать скалярный контекст для аргументов этих функций (вероятно, не лучшая идея), ее можно записать в следующем виде:
*$name = sub ($) { "$_[0]" };
Однако прототип проверяется во время компиляции, поэтому приведенное выше присваивание произойдет слишком поздно и никакой пользы не принесет. Следовательно, весь цикл с присваиваниями следует включить в BEGIN-блок, чтобы форсировать его выполнение при компиляции.
> Смотри также -------------------------------
Описание замыканий в perlref(l); раздел "Symbol tables" perlmod(i); ре-цепты 10.11; 11.4.
Проблема
Требуется перехватить вызовы неопределенных функций и достойно обрабо-| ать их.
Решение
Объявите функцию с именем AUTOLOAD для пакета, вызовы неопределенных функций которого вы собираетесь перехватывать. Во время ее выполнения переменная $AUTOLOAD этого пакета содержит имя вызванной неопределенной функции.
Комментарий
В подобных ситуациях обычно применяются вспомогательные функции (proxy). При вызове неопределенной функции вместо автоматического инициирования исключения также можно перехватить вызов. Если пакет, к которому принадлежит вызываемая функция, содержит функцию с именем AUTOLOAD, то она будет нызвана вместо неопределенной функции, а специальной глобальной переменной пакета $AUTOLOAD будет присвоено полное имя функции. Затем функция AUTOLOAD (может делать все, что должна была делать исходная функция.
sub AUTOLOAD {
use vars qw($AUTOLOAD);
my $color = $autoload;
$color ="o s/.*:://;
return "";
}
# Примечание: функция sub chartreuse не определена
print chartreuseC'stutf");
При вызове несуществующей функции main: : chartreuse вместо инициирования исключения будет вызвана функция main: : AUTOLOAD с аргументами, переданными chartreuse. Пакетная переменная $AUTOLOAD будет содержать строку
main::chartreuse.
Методика с присваиваниями тип-глобов из рецепта 10.14 быстрее и удобнее. Быстрее - поскольку вам не приходится запускать копию и заниматься подстановками. Удобнее - поскольку вы сможете делать следующее:
{
local *yellow = \&violet;
local (*red, *green) = (\&green, \&red);
print_stuff();
}
При работе print_stuff или любой вызванной ей функции все, что должно выводиться желтым цветом, выводится фиолетовым; красный цвет заменяется зеленым, и наоборот.
Однако подстановка функций не позволяет обрабатывать вызовы неопределенных функций. AUTOLOAD справляется с этой проблемой.
Смотри также: Раздел "Autoloading" perlsub(1); документация по стандартным модулям Auto-Loader и AutoSplit; рецепты 10.12; 12.10; 13.11.
Проблема
Требуется реализовать вложение подпрограмм, чтобы одна подпрограмма была видна и могла вызываться только из другой. Если попытаться применить очевидный вариант sub FOO { sub BAR { } . . .}, Perl предупреждает о переменных, которые "не останутся общими".
Решение
Вместо того чтобы оформлять внутренние функции в виде обычных подпрограмм, реализуйте их в виде замыканий и затем временно присвойте их тип-глобу правого имени, чтобы создать локальную функцию.
Комментарий
Вероятно, в других языках программирования вам приходилось работать с вложенными функциями, обладающими собственными закрытыми переменными. В Perl для этого придется немного потрудиться. Интуитивная реализация приводит к выдаче предупреждения. Например, следующий фрагмент не работает:
sub outer {
my $x = $_[0] + 35;
sub inner { return $x * 19 } # НЕВЕРНО
return $x + inner();
Обходное решение выглядит так:
sub outer {
my $x = $_[0] + 35;
local *inner = sub { return $x * 19 };
return $x + inner();
}
Теперь благодаря временно присвоенному замыканию inner() может вызываться только из outer(). При вызове inner() получает нормальный доступ к лексической переменной $х из области действия outer().
В сущности, мы создаем функцию, которая является локальной для другой функции - подобная возможность не поддерживается в Perl напрямую. Впрочем, ее реализация не всегда выглядит понятно.
> Смотри также -------------------------------
Описание замыканий в perlref(l); раздел "Symbol tables" perlmod(i); рецепты 10.13-10.14.
Программа из примера 10.1 сортирует почтовый ящик по темам. Для этого она читает сообщения по абзацам и ищет абзац, начинающийся с "From:". Когда такой абзац будет найден, программа ищет тему, удаляет из нее все пометки "Re:", преобразует в нижний регистр и сохраняет в массиве @sub. При этом сами сообщения сохраняются в массиве @msgs. Переменная $msgno следит за номером сообщения.
Пример 10.1. bysubl
#!/usr/bin/perl
# bysubl - simple sort by subject
my(@msgs, @sub);
my $msgno = -1;
$/=''; # Чтение по абзацам
while (<>) {
if (/-From/m) {
/"Subject:\s*(?:Re:\s*)*(.*)/mi;
$sub[++$msgno] = lc($1) || '';
}
$msgs[$msgno] ,= $_;
} for my $i (sort { $sub[$a] cmp $sub[$b] || $a <=> $b } (0 .. $#msgs)) {
print $msgs[$i];
}
}
В этом варианте сортируются только индексы массивов. Если темы совпадают, cmp возвращает 0, поэтому используется вторая часть | |, в которой номера сообщений сравниваются в порядке их исходного следования.
Если функции sort передается список (0,1,2,3), после сортировки будет получена некоторая перестановка - например, (2, 1,3,0). Мы перебираем элементы списка в цикле fo г и выводим каждое сообщение.
В примере 10.2 показано, как бы написал эту программу программист с большим опытом работы на awk. Ключ -00 используется для чтения абзацев вместо строк.
Пример 10.2. bysub2
#!/usr/bin/perl
# bysub2 - сортировка по темам в стиле awk
BEGIN { $msgno = -1 }
$sub[++$msgno] = (/"subject:\s*(?:re:\s*)*(.*)/mi)[0] if /"from/m:
$msg[$msgno] .= $_;
END { print @msg[ sort { $sub[$a]
cmp $sub[$b] || $a <=> $b } (0 .. $ftmsg) ] }
Параллельные массивы широко использовались лишь на ранней стадии существования Perl. Более элегантное решение состоит в том, чтобы сохранять сообщения в хэше. Анонимный хэш (см. главу 11) сортируется по каждому полю.
Программа из примера 10.3 построена на тех же принципах, что и примеры 10.1 и 10.2.
Пример 10.3. bysub3
#!/usr/bin/perl -00
# bysub3 - sort by subject using hash records
use strict;
my @msgs = ();
while (<>) {
push @msgs, {
SUBJECT => /"Subject:\s.(?;Re:\s*)*(.*)/mi, NUMBER => scalar @msgs,
# Номер сообщения TEXT =>
} if /~From/m;
$msgs[-1]{TEXT} ,= $_;
}
for my $msg (sort {
$a->{SUBJECT} cmp $b->{SUBJECT}
$a->{NUMBER} <=> $b->{NUMBER} } @msgs
}
{
print $msg->{TEXT}, }
Работая с полноценными хэшами, нетрудно добавить дополнительные критерии сортировки. Почтовые ящики часто сортируются сначала по теме, а затем по дате сообщения. Основные трудности связаны с анализом и сравнением дат. Модуль Date::Manip помогает справиться с ними и возвращает строку, которую можно сравнивать с другими. Тем не менее программа datesort из примера 10.4, использующая Date::Manip, работает в 10 раз медленнее предыдущей. Анализ дат в непредсказуемых форматах занимает слишком много времени.
Пример 10.4. datesort
#!/usr/bln/perl -00
# datesort - сортировка почтового ящика по теме и дате
use strict;
use Date::Manip;
my @msgs = ();
while (<>) {
next unless /"From/m;
my $date = ' ';
if (/"Oate:\s*(.*)/m) {
($date = $1) =~ s/\s+\(.*//;
$date = parsedate($date);
} push Omsgs, {
SUBJECT => /"Subject:\s*(?:Re:\s*)*(.*)/mi,
DATE => $date, NUMBER => scalar $msgs, TEXT => '' };
} continue {
$msgs[-1]{TEXT} .= $_;
}
for my $msg (sort {
$a->{SUBJECT} cmp $b->{SUBJECT}
$a->{DATE} cmp $b->{DATE}
||
$a->{NUMBER} <=> $b->{NUMBER} }
@msgs ) {
print $msg->{TEXT};
Особого внимания в примере 10.4 заслуживает блок continue. При достижении конца цикла (нормальном выполнении или переходе по next) этот блок выполняется целиком. Он соответствует третьему компоненту цикла for, но не ограничивается одним выражением. Это полноценный блок, который может состоять из нескольких команд.
> Смотри также -------------------------------
Описание функции sort в perlfunc(1); описание переменной $/ в perlvar(1) и во введении главы 8 "Содержимое файлов"; рецепты 3.7, 4.15, 5.9 и 11.9.
