Шаблонизаторы — зло.
use XSLT or die.
Шаблонизаторы — зло.
use XSLT or die.
В рассылке Moscow.pm обсуждают интересную мысль — выделить один день из Perl Mova + YAPC::Russia на проведение хакмита.
Сразу предложили массу тем:
Предлагайте идеи и регистрируйтесь!
Продолжается регистрация на конференцию Perl Mova + YAPC::Russia, которая состоится в Киеве 12—14 июня.
На сегодня список докладов выглядит так:
Самое время зарегистрироваться и подать заявку на доклад!
Много лет назад, когда еще не было интернета, я слышал историю о том, что то ли американские, то ли советские ученые потеряли спутник из-за опечатки в программе: вместо запятой стояла точка (или точка с запятой, или вообще не было запятой).
Никогда не думал, что история повторится со мной лично, к счастью, не в таких масштабах и с куда меньшими (фактически, нулевыми) последствиями.
После переделки скрипта (тех же времен, что и история со спутником) вместо точки с запятой оказалась запятая:
my $user = new XML::LibXML::Element('user'),
$messagelist->appendChild($user);
При компилировании крамола не выявлялась, но при выполнении возникала ошибка, что узел еще не узел:
XML::LibXML::Node::appendChild() -- nNode is not a blessed SV reference
Страх преодолен. Мы официально используем вызовы Perl-функций из XSLT, преобразуемого из перла.
sub register_functions {
my $xslt = shift || 'XML::LibXSLT';
my $ns = 'http://whoyougle.com';
$xslt->register_function($ns, 'uri-encode',
\&URI::Escape::uri_escape_utf8);
$xslt->register_function($ns, 'js-encode',
\&escapeJS);
$xslt->register_function($ns, 'declension',
\&Lingua::RU::Numeric::Declension::numdecl);
}
Соответственно, в нужных местах теперь достаточно написать
<a href="{w:uri-encode(@href)}">
<xsl:value-of select="text()"/>
</a>
Функция, склоняющая слова после числительных, написанная на XSLT, осталась только в архивах :-)
Теперь хочется сравнить производительность чисто-XSLT-решения, решения, когда перл готовит все данные сам, и случая, когда из XSLT мы вызываем функции на Perl.
Кстати, оказалось, что libxslt регистрирует все функции в одной куче, вплоть до того, что их возможно регистрировать не на инстансе парсера (созданном вызовом new XML::LibXSLT), а непосредственно через функцию модуля:
XML::LibXSLT->register_funcion(...);
Какое-то время назад обнаружилось, что ссылки на наш калькулятор расстояний между городами, которые размещают в ЖЖ, открываются, но параметры из строки запроса при этом игнорируются.
Оказалось, что это происходит только с MSIE, и именно с теми ссылками, которые находятся в блогах на livejournal.com. В строке запроса (QUERY_STRING) в таких ссылках обычно четыре параметра — два текстовых и два числовых:
Значения параметров from и to — то, что пользователь вводил в полях ввода, а from_which и to_which уточняют запрос, выбирая из нескольких одноименных названий одно конкретное. (В общем-то, несколько избыточно, и от первых двух параметров мы уже отказались, но суть не в этом.)
После перехода по ссылке в адресной строке вместо URI-escaped-последовательности оказывались русские буквы, и первое подозрение было — MSIE не очень хорошо работает с такими адресами и передает на сервер что-то искаженное.
MSIE, однако, хорош тем, что щелкает при загрузке страницы, и вместо одного щелчка при переходе по ссылке было два. Оказалось, что товарищи жжсты подменяли ссылку и превращали ее в ссылку на их бесконечно хитрый редиректер (который сначала загружал ту же страницу ЖЖ, а потом делал редирект):
После этого происходил переход на адрес, в котором вместо from=%D0%9F%D0%B0%D1%80%D0%B8%D0%B6 оказывалась неэкранированная последовательность байт, эквивалентная запросу from=%c1%e0%f0%f1%e5%eb%ee%ed%e0. А это уже не изначальный UTF-8, а почему-то голый Windows-1251.
Реальные же непонятки возникли, когда оказалось, что оставшиеся параметры from_which и to_which были вообще не видны на сервере. Но такого же не может быть! В переменной $ENV{QUERY_STRING} строка была вся и целиком.
Мы пользуемся библиотекой libapreq2 для разбора параметров, чтения кук и загрузки файлов. Perl-модули Apache2::Request и др. предоставляют интерфейс, аналогичный традиционному CGI.pm, и в нехохошем до сих пор замечены не были.
А тут в списке параметров, возвращаемых вызовом $req->param(), оказывались только те, которые стояли в строке запроса до первой пары со значением в кодировке Windows-1251.
Круто, лезем с Сергеем в код libapreq2 (предварительно обновившись до последней версии, но неадекватное поведение осталось).
Сказать, что я был удивлен, — ничего не сказать. Libapreq2 при разборе строки делает бешеное число действий для того, чтобы распознать кодировку запроса. Казалось бы, зачем она это делает, если Apache2::Request все равно в итоге отдает октеты?
Алгоритм выявления кодировки (см. файл util.c) такой:
Да-да, Latin-1 и CP1252. (Сразу видно, что писано моноглотами.) Функция, выполняющая эти эвристики, кстати, называется apreq_charset_divine. Divine — англ. гадать, предсказывать, пророчествовать.
Первый байт строки %c1%e0%f0%f1%e5%eb%ee%ed%e0 содержит два единичных старших бита, и функция-пророк считала его началом UTF-последовательности. Правда, на втором же байте понимало, что это не так, и... и в итоге функция apreq_parse_query_string (см. файл param.c) завершала работу:
s = apreq_param_decode(¶m, pool, start, nlen, vlen);
if (s != APR_SUCCESS)
return s;
apreq_param_tainted_on(param);
apreq_value_table_add(¶m->v, t);
Ни сама пара, в которой содержалась строка в кодировке Windows-1251, ни все последующие не попадали в таблицу параметров строки запроса.
Теперь понятно, как по-быстрому исправить ошибку. Если декодирование не удалось, то просто не делаем действий по сохранению пары ключ=значение в таблице, но продолжаем разбор строки со следующего символа.
s = apreq_param_decode(¶m, pool, start, nlen, vlen);
if (s == APR_SUCCESS) {
apreq_param_tainted_on(param);
apreq_value_table_add(¶m->v, t);
}
Собираем libapreq2, подменяем libapreq.so, и — вуаля! — видим значения всех параметров после тех, что проигнорировали.
P. S. В исходниках есть моноглотские определения типа
enum apreq_charset_t { APREQ_CHARSET_ASCII = 0, APREQ_CHARSET_LATIN1 = 1, APREQ_CHARSET_CP1252 = 2, APREQ_CHARSET_UTF8 = 8 }
и самописаня функция apreq_cp1252_to_utf8, реализация которой напоминает мой код 2002 года :-)
В начале века я пользовался функцией на парсере, не уверен, что точно знаю, кем написанной, и не знаю, где сегодня найти в архиве. Она умела выбирать правильный падеж существительного, поставленного после числа. Хорошо помню, что она называлась ^rightCase[], но сходу не смог найти ее в бекапах. Но зато нашел ее предшественницу:
@grammar[count]
$count[0$count]
$last2[^count.match[(\d\d)^$]]
$last2[$last2.1]
^if(^last2.match[[02-9]1]){
$ending[]
}{
^if(^last2.match[[2-4]^$]){
$ending[а]
}{
$ending[ов]
}
}
$result[язык$ending]
Потом долгое время пользовался (и продолжаю) функцией на перле, переписанной по мотивам этого алгоритма, и размещенной на спане в модуле Lingua::RU::Numeric::Declension:
sub numdecl {
my ($number, $nominative, $genitive, $plural) = @_;
return $plural if $number =~ /1.$/;
my ($last_digit) = $number =~ /(.)$/;
return $nominative if $last_digit == 1;
return $genitive if $last_digit > 0 && $last_digit < 5;
return $plural;
}
А сегодня еще раз скопировал этот алгоритм, но уже на XSLT:
<func:function name="w:declension">
<xsl:param name="number"/>
<xsl:param name="nominative"/>
<xsl:param name="genitive"/>
<xsl:param name="plural"/>
<xsl:variable name="length" select="string-length(string($number))"/>
<xsl:variable name="last" select="substring(string($number), $length, 1)"/>
<func:result>
<xsl:choose>
<xsl:when test="$length > 1 and substing(string($number), $length - 1, 1) = '1'">
<xsl:value-of select="$plural"/>
</xsl:when>
<xsl:when test="$last = '1'">
<xsl:value-of select="$nominative"/>
</xsl:when>
<xsl:when test="$last > 0 and $last < 5">
<xsl:value-of select="$genitive"/>
</xsl:when>
<xsl:otherwise>
<xsl:value-of select="$plural"/>
</xsl:otherwise>
</xsl:choose>
</func:result>
</func:function>
Какая из этого мораль? Да такая, что в большинстве случаев выбор языка не важен.
19 апреля 2009
Сегодня утром мне захотелось посмотреть, как над Европой распространяется облако вулканического пепла (тем более, что моя коллега, на прошлой неделе поехавшая в Берлин, до сих пор не может оттуда выбраться).
Хотелось, чтобы эта карта автоматически обновлялась, хотя бы отдаленно напоминала спутниковые снимки, и была в минимальной степени похожа на метеосводки.
Интересных источников не обнаружилось, зато (в очередной раз) нашелся сайт flightradar24.com, с которого можно было снимать регулярные скриншоты.
10:57. Коммит. Ревизия 5022.

Карта хорошая, но обновлять ее вручную совсем не хочется. Ищу дальше, где бы разжиться списком закрытых аэропортов. Находится (в очередной раз) нечто лучшее — сайт flightstats.com, на котором текущий статус аэропорта не только показан, но еще и проградуирован по пятибальной шкале. Ура, на коленке пишу скрипт.
#!/usr/bin/perl
use v5.10;
use strict;
use LWP::Simple;
my $xml = "<?xml version=\"1.0\"?>\n<delays>\n";
open my $list, '<', 'europe.list';
while (<$list>) {
chomp;
my ($cc, $iata, $name) = split /\t/;
my $page = get_airport_status($iata);
$xml .= <<XML;
<item cc="$cc" iata="$iata" name="$name" index="$delay_index"/>
XML
}
close $list;
$xml .= "</delays>\n";
if (length $xml > 100) {
open my $out, '>', 'airport-status.xml';
print $out $xml;
close $out;
}
12:24. Копи-пейст XSLT, формирующего список, коммит. Ревизия 5024.

Эта первая версия сохраняет все данные в XML-файле, который очень легко подключается к сайту, избавляя от массы хлопот при быстром старте.
Прошу коллегу поставить скрипт в крон, подвязать к аэропортам координаты и отправляюсь в офис.
Тем временем проект анонсируется и мы получаем первые пользовательские баг-репорты.
В офисе коллегиально решили, что по разным причинам будет удобнее перенести информацию в базу данных, и мимоходом (совсем неожиданно) приходит мысль дополнить наш движок методом, который одним махом превращает SQL-запросы в XML-данные, избавляя от необходомости многократно писать мелкие функции, извлекающие данные. (В частности, в примере, идущем в составе с WWW::Page, часть методов примитивно дампят в XML соответствующие таблицы базы, и этот подход — тупо вывалить данные из базы, переложив их обработку на XSLT, — оказался очень продуктивным и работает не первый год.)
17:37. Ревизия 5042.
sub sql {
my ($this, $page, $node, $args) = @_;
my $sql = $args->{sql} or return $node;
$node->setAttribute('name', $args->{name});
my $sth = dbh->prepare_cached($sql);
$sth->execute();
while (my $row = $sth->fetchrow_hashref) {
add_node($node, 'item', $row);
}
return $node;
}
Опять колбасим XSLT, чтобы переключиться на новый формат данных, а попутно переводим фетчер на работу с базой данных. (Тем временем, сайт продолжает исходно работать, регулярно обновляя список закрытых аэропортов.)
В это время подключается третий коллега, который улучшает клиентскую JavaScript-сортировку таблицы со списком. А четвертый потом делает еще одно изменение в коде, которое улучшило сортировку колонки со статусом задержек рейсов.
Тем временем созревает (зреющая еще с обеда) идея вместо скриншотов показывать гугловую карту и насыпать на нее разноцветное конфети, отображающиее статус европейских аэропортов.
19:12. Ревизия 5051.
Perl-программист берется за JavaScript-API Гугл-карт, и находит, что сделать замыкание в яваскрипте — это совсем не так просто, как в перле. Тем не менее, коммит, все работает, а карта обновляется автоматически (а вдобавок еще и зумится, а каждый маркер — еще и ссылка).

Добавляю легенду, прошу перекрасить конфети.
Можно с честной совестью идти домой, но хочется — раз уж мы все знаем про аэропорты — поместить статус и на страницу аэропорта.
20:14. Раз, два, ревизия 5058.

Имеем работающее, полезное и злободневное приложение — «Задержки рейсов в аэропортах Европы», списком и на карте.
Итого, за день — пяток тикетов, сорок коммитов, фан и радость.
Любители методик разработки, составители техзаданий, идеологи фокус-групп никогда, неуместноых тестирования и рефакторинга не смогли бы добиться такого.
P. S. 22:44. Коммит, ревизия 5062. Коллега сообщает о том, что закончил еще один геосервис, который мы давно хотели сделать.
17 и 18 мая в Москве проходит конференция DevConf. В ее рамках запланированы такие доклады про Perl:
Мастер-классы (18 мая):
P. S. Расписание не окончательное, возможны изменения.
Onperl.ru, sayperl.org, moscow.pm.org, perl6.ru, yapc.tv — все эти сайты работают на Perl 5.12.
Server: Apache/2.2.10 (Unix) mod_apreq2-20090110/2.7.1 mod_perl/2.0.4 Perl/v5.12.0
В отличие от перехода с 5.8.8 на 5.10, нынешний апгрейд прошел вдвое быстрее.
Мой блиц-доклад о том, что такое sayperl.org, почему он появился, и какие проблемы вскрылись по пути.
В рамках конференции May Perl на РИТ++ в первый день запланировано:
11:45, зал 1
Джонатан Вортингтон. Rakudo Perl 6: сегодняшние возможности. (Автор приедет днем позже, а его доклад прочитаю я и по-русски).
13:15, зал 2
Анатолий Шарифулин. Mojolicious. Веб в коробке!
13:45, зал 2
Владимир Перепелица. Высоконагруженные приложения на скорую руку.
15:00, зал 3
Наим Шафиев. Использование фреймворка AnyEvent.
Во второй день:
18:00, зал 1
Павел Кудинов. Костыли — это кошерно!
Кроме того, в 19:15 во вторник в первом зале пройдет сессия блиц-докладов, вход на нее свободный.
Гугл-карты с третьей версией API научились рисовать путь между двумя пунктами на Земле по «большому кругу» (great circle), поэтому без жалости можно отправить в архив фрагмент кода, вычисляющий координаты дуги.
my $span = 10;
$span = int($distance) / 100 if int($distance) > $span * 100;
my $arc = (new Geo::GoogleEarth::Pluggable)
->GreatCircleArcSegment(
startPoint => {
lat => $coords_pair[0],
lon => $coords_pair[1]
},
endPoint => {
lat => $coords_pair[2],
lon => $coords_pair[3]
},
span => $span * 1000, # meters
);
my $arcNode = add_node($pairNode, 'arc');
for (@{$arc->coordinates}) {
add_node(
$arcNode,
'point', {
lat => $_->lat,
long => $_->lon,
},
);
}
Еще большая часть ушла из яваскрипта. Перед этим мой коллега проверил, насколько расходятся пути Гугла и наш. Чтобы заметить разницу, пришлось сократить число точек, иначе обе линии полностью сливались.

Сегодня открыл свой CGI-скрипт 2002 года, который до сих пор, кстати, работает, сто раз дописанный и истерзанный, но выполненный за это время 105 миллионов раз. Хочу показать тот фан, на который сегодня смотреть смешно, но девять лет назад приходилось с трудом выцарапывать из книг и интернетов.
binmode STDIN;
binmode STDOUT;
our $dbh;
our $sth;
Разбор дат после чтения из базы данных.
my ($year, $month, $day, $hour, $min, $sec) = $date =~ /^(\d{4})-?(\d\d)-?(\d\d) ?(\d\d):?(\d\d):?(\d\d)/;
Дорисовка ведущего нуля.
$mday = "0$mday" if $mday =~ /^\d$/;
$hour = "0$hour" if $hour =~ /^\d$/;
$min = "0$min" if $min =~ /^\d$/;
$sec = "0$sec" if $sec =~ /^\d$/;
return "$days[$wday], $mday-$mons[$mon]-$year $hour:$min:$sec GMT";
Сохранение даты в хеше.
%datetime = ();
($datetime{"sec"}, $datetime{"min"}, $datetime{"hour"},
$datetime{"day"}, $datetime{"month"}, $datetime{"year"},
$datetime{"wday"}, $datetime{"yday"}, $datetime{"isdst"}) = localtime (time);
$datetime{'month'}++;
$datetime{'year'} += 1900;
Декодирование строки запроса.
sub _urldecode{
local($val)=@_;
$val=~s/\+/ /g;
$val=~s/%([0-9A-H]{2})/pack('C',hex($1))/ge;
return $val;
}
Отдельный фетиш — ручное декодирование UTF. В частности, есть такая таблица. И еще пара нетривиальных функций, которые я здесь не привожу.
sub init_utftable{
%utftable = (
0xD020 => 0x20,
0xD082 => 0x80,
0xD083 => 0x81,
0xE2809A => 0x82,
0xD193 => 0x83,
0xE2809E => 0x84,
. . .
0xD18D => 0xFD,
0xD18E => 0xFE,
0xD18F => 0xFF);
}
Смена регистра.
sub lower_case{
my $word = shift;
$word =~ tr /АБВГДЕЁЖЗИКЛМНОПРСТУФХЦЧШЩЪЫЬЭЮЯ/ абвгдеёжзиклмнопрстуфхцчшщъыьэюя/;
return lc $word;
}
sub upper_case{
my $word = shift;
$word =~ tr /абвгдеёжзиклмнопрстуфхцчшщъыьэюя/ АБВГДЕЁЖЗИКЛМНОПРСТУФХЦЧШЩЪЫЬЭЮЯ/;
return lc $word;
}
В феврале этого года O’Reilly издало книгу «RESTful Web Services Cookbook», и в этой связи есть смысл упомянуть модуль, который появился на спане в начале прошлого года, а сегодня обновился, — REST::Client, который, возможно будет в чем-то удобнее традиционных LWP et. al.
Использование весьма прямолинейно (хотя и не без странностей): названия методов REST::Client совпадают с именами методов HTTP-протокола: GET, PUT, POST, DELETE, OPTIONS, HEAD.
use v5.10;
use strict;
use REST::Client;
my $client = new REST::Client;
$client->OPTIONS('http://onperl.ru/');
say $client->responseCode();
say $client->responseContent();
$client->HEAD('http://onperl.ru/');
say $client->responseCode();
$client->GET('http://onperl.ru/');
say $client->responseCode();
Дополнительно имеется возможность использовать SSL, и, что интересно, создать для полученного XML-ответа XPath-контекст.
Вот пример того, как переписать скрипт, получающий курс для любой пары валют, с использованием модуля REST::Client, и с честным разбором XML.
#!/usr/bin/perl
use v5.10;
use strict;
use REST::Client;
my ($from, $to) = map {uc} @ARGV;
unless ($from) {
say "Usage: rate FROM [TO]\n";
exit;
}
$to //= 'RUB';
my $client = new REST::Client;
$client->GET("http://whoyougle.com/money/api/$from/$to");
say $client
->responseXpath
->findvalue('/currency/rate/value/text()');
Проверка:
$ ./rate usd
29.2416
$ ./rate eur usd
1.3393
Некоторое время назад в файле perl5110delta появился странный раздел о том, что метасимволы \w и \d в регулярных выражениях должны совпадать только с ASCII-символами:
digit \d [0-9]
word \w [0-9A-Z_a-z]
К счастью, это пока не перекочевало в Perl 5.12, причем независимо от того, определен ли при компиляции символ PERL_LEGACY_UNICODE_CHARCLASS_MAPPINGS или нет.
Программа, от которой ожидается совпадение \w с русскими буквами, по-прежнему работает:
use v5.10;
use utf8;
use open qw(:utf8 :std);
"123abcабв" ~~ /(\w+)/;
say $1;
На печать выводится 123abcабв.
Есть такой модуль — Data::Maker, с помощью которого возможно готовить наборы тестовых (или, если угодно, фейковых) данных в разных форматах.
Простейший пример по мотивам примера из документации все объясняет:
use v5.10;
use strict;
use Data::Maker;
my $maker = Data::Maker->new(
record_count => 5,
fields => [
{
name => 'phone',
format => '+7 \d\d\d \d\d\d-\d\d-\d\d',
},
]
);
while (my $item = $maker->next_record) {
say $item->phone->value;
}
Эта программа печатает пять телефонных номеров в формате, указанном при создании объекта Data::Maker:
+7 536 209-69-11
+7 119 599-52-63
+7 778 591-94-25
+7 723 863-71-04
+7 894 976-58-35
Теперь более сложный пример. В каждом случайном объекте помимо телефона будут формироваться имя, фамилия, а заодно и дата рождения.
Если номер телефона генерировался по заданной маске, напоминающей регулярное выражение, то логика для остальных полей реализована внутри соответствующих классов, например, Data::Maker::Field::DateTime. Ему, кстати, возможно передать параметры (какие именно, видно в исходнике).
use v5.10;
use strict;
use Data::Maker;
use Data::Maker::Field::Person::FirstName;
use Data::Maker::Field::Person::LastName;
use Data::Maker::Field::DateTime;
my $maker = Data::Maker->new(
record_count => 10,
fields => [
{
name => 'phone',
format => '+7 \d\d\d \d\d\d-\d\d-\d\d',
},
{
name => 'firstname',
class => 'Data::Maker::Field::Person::FirstName',
},
{
name => 'lastname',
class => 'Data::Maker::Field::Person::LastName',
},
{
name => 'birthday',
class => 'Data::Maker::Field::DateTime',
args => {
start => 1980,
end => 1990,
},
},
]
);
while (my $item = $maker->next_record) {
say $item->firstname->value, ' ',
$item->lastname->value, "\t",
$item->phone->value, "\t",
$item->birthday->value;
}
Результат работы:
Sherrie Webster +7 001 585-82-85 1985-12-07T07:56:59
Opal Merrill +7 235 817-78-63 1985-07-28T05:10:55
Erik Miles +7 252 016-71-82 1988-05-30T08:47:48
Darlene Peters +7 038 976-13-95 1981-12-10T02:53:20
Michael Salinas +7 039 850-43-23 1982-09-22T09:44:26
Sallie Roth +7 404 102-02-88 1989-04-06T23:47:54
Renee Lowe +7 975 958-07-91 1981-04-10T23:00:27
Deanna Rocha +7 442 730-46-48 1987-05-26T15:11:47
Rena Benson +7 535 737-78-68 1987-12-01T17:11:34
Ella Obrien +7 064 783-65-38 1986-03-20T11:36:36
Автор честно признается, что скорость работы генератора довольно низкая. Тем не менее, это интересный модуль, который может быть полезен для тестов.
P. S. Moose настолько проникает в разработчика, что даже краткое описание модуля Data::Maker::Field содержит технические детали: a Moose role that is consumed by all Data::Maker field classes; the ones included with Data::Maker and the ones that you write yourself to extend Data::Maker's capabilities.