Рубрика: Сайт OnPerl.ru

Часть задач, опубликованных на сайте Project Euler, удобно решать с помощью перла.

Некоторые задачи — исключительно математические, а некоторые требуют посимвольной обработки чисел или строк.

Например, задача на поиск чисел-палиндромов, то есть чисел вида 78987. С одной стороны, они представимы в виде суммы 7·10⁴ + 8·10³ + 9·10² + 8·10¹ + 7·10⁰, но с другой — это последовательность символов, которые легко преобразовать в массив односимвольных элементов:

my @digits = split //, $number;

В задаче, где предлагается отсыкать максимальное произведение пяти последовательных цифр в числе из 1000 цифр, это число также удобно рассматривать как строку, выделяя ее часть встроенной функцией substr:

$product *= $_ for split //, substr $n, $c, 5;

Кроме того, некоторые задачи подразумевают большие числа — настолько большие, что размера стандартных переменных (например, long long в C++) недостаточно для их представления. Для работы с такими числами в перле удобно воспользоваться модулем Math::BigInt или прагмой bigint, после чего программа, вычисляющая сумму цифр факториала ста, становится тривиальной:

$i = $i->bmul($_) for 2..100;
. . .
$s += $_ for split //, $i;

22 и 23 октября в Пизе пройдет пятый итальянский Perl-воркшоп.

Итальянский воркшоп (как и недавний Nordic Perl Workshop в Осло) собрал участников не только из Италии. В списке числятся 13 стран: Италия, Великобритания, Германия, Ирландия, Испания, Норвегия, Россия, Голландия, Иран(!), Бельния, США, Австрия, Словакия.

Второе изменение в работе when — возможность использования оператора //.

Оператор defined-or (//), появившийся в Perl 5.10, теперь может быть использован и как булево выражение в операторе when.

Работает он так, как интуитивно и ожидается:

use v5.10.1;

my $approx1 = undef;
my $approx2 = 3;
my $approx3 = 3.14;

given (3) {
    when($approx1 // $approx2) {say '1 or 2'}
    when($approx2 // $approx3) {say '2 or 3'}
    default {say 'None'}
}

В этом примере сработает первое условие.

Наиболее очевидное применение оператора // — подстановка значения по умолчанию. В следующем примере показана функция, которая ищет либо явно указанное число, либо 123 по умолчанию:

use v5.10.1;

my @data = <DATA>;

find(\@data);
find(\@data, 456);

sub find {
    my $a_ref = shift;
    my $value = shift;   

    say "find called";

    for (@$a_ref) {
        when ($value // 123) {say "Number $_"}
        when (/^\w+$/) {say "String $_"}
    }
}

__DATA__
alpha
123
beta
456
gamma
7.89

Поиск адекватных примеры из реальных приложений, в которых применяются новшества, по-видимому потребует не один месяц ожидания 🙂

В недавно вышедшем релизе Perl 5.10.1 слегка изменилась работа оператора when.

В частности, оператор when теперь понимает конструкцию «флип-флоп».

«Флип-флоп» — это оператор диапазона .. в булевом контексте. В документации приводится пример выражения для поиска POD-комментариев:

when (/^=begin/ .. /^=end/) {
   # do something
}

Аналогично возможно, например, находить определение функций во многих языках программирования, в частности, PIR:

use v5.10.1;

my $lineno = 0;
for (<DATA>) {
    chomp;
    print 'Line ', ++$lineno, ': ';
    when (/^\.HLL/) {say "switching language to $_"}
    when (/^\.sub/ .. /^\.end/) {say "subroutine body: $_"}
}

__DATA__
.HLL unknown
.sub main :main
    say "Demonstrating inc"
    $I = 2
    inc $I
    say $I
.end

Эта программа напечатает комментарии к каждой строке кода, объясняя его назначение:

Line 1: switching language to .HLL unknown
Line 2: subroutine body: .sub main :main
Line 3: subroutine body:     say "Demonstrating inc"
Line 4: subroutine body:     $I = 2
Line 5: subroutine body:     inc $I
Line 6: subroutine body:     say $I
Line 7: subroutine body: .end

Cледует обратить внимание на два момента. Во-первых, выражение, переданное when, срабатывает на всех строках подпрограммы, включая первую и последнюю, заданные границами /\^.sub/ и /\^.end/.

Во-вторых, оператор ведет себя «нежадно», что позволяет находить непересекающиеся последовательности. Вот программа, в которую дописана дополнительная подпрограмма на PIR, и строка when, находящая пустую строку:

use v5.10.1;

my $lineno = 0;
for (<DATA>) {
    chomp;
    print 'Line ', ++$lineno, ': ';
    when (/^\.HLL/) {say "switching language to $_"}
    when (/^\.sub/ .. /^\.end/) {say "subroutine body: $_"}
    when (/^$/) {say "empty line"}
}

__DATA__
.HLL unknown
.sub main :main
    say "Demonstrating inc"
    $I = 2
    inc $I
    say $I
.end

.sub another
    say 'Hey, you!'
.end

Вывод программы подтверждает правильность ее работы:

Line 1: switching language to .HLL unknown
Line 2: subroutine body: .sub main :main
Line 3: subroutine body:     say "Demonstrating inc"
Line 4: subroutine body:     $I = 2
Line 5: subroutine body:     inc $I
Line 6: subroutine body:     say $I
Line 7: subroutine body: .end
Line 8: empty line
Line 9: subroutine body: .sub another
Line 10: subroutine body:     say 'Hey, you!'
Line 11: subroutine body: .end

Другой пример использования — поиск и сохранение фрагмента алфавитно отсортированного списке, как это делают в бумажных словарях по двум-трем начальным буквам.

use v5.10.1;

my @programming_languages = qw(
    Pascal Pawn PCASTL PCF PEARL Perl PHP Phrogram Pico Pict Piet Pike PIKT PILOT Pizza PL/0 PL/B PL/C PL/I PL/M PL/P PL/SQL PL360 PLANC Plankalkül PLEX PLEXIL Pliant POP-11 Poplog PostScript PortablE Powerhouse PPL Processing Prograph PROIV Prolog Promela PROTEL Proteus ProvideX Pure Python
);

for (@programming_languages) {
    when (/^pa/i .. /^pi/i) {push @page, $_}
}
pop @page;
say join ', ', @page;

Программа подготовит данные для страницы словаря PA—PI:

Pascal, Pawn, PCASTL, PCF, PEARL, Perl, PHP, Phrogram

Разумеется, в последнем примере возможно было воспользоваться одним регулярным выражением:

my @page = ();
for (@programming_languages) {
    when (/^p[a-h]/i) {push @page, $_}
}

say join ', ', @page;

Но первый вариант в данном случае более нагляден и, к тому же, более расширяем. Напрмер, метод возможно вынести в отдельную функцию и передавать ей границы диапазона в виде параметров:

say join ', ', select_range('pa', 'pi');

sub select_range {
    my ($from, $to) = @_;

    my @page = ();
    for (@programming_languages) {
        when (/^$from/i .. /^$to/i) {push @page, $_}
    }
    pop @page;
   
    return @page;
}

Мой коллега подготовил и опубликовал модуль TinyURL::RU для работы с сайтом byst.ro (он же — tinyurl.ru).

Интерфейс модуля предельно прост и содержит две функции: shorten для сокращения адреса и lenghen для обратного преобразования:

use TinyURL::RU qw(shorten lengthen);

say shorten("http://ironman.enlightenedperl.org/");
say lengthen("77d");

Наш tinyurl.ru выгодно отличается от других подобных сервисов тем, что дает возможность самостоятельно выбрать, как будет выглядеть короткий адрес: а именно, попробовать запросить и часть адреса после слеша, и даже поддомен третьего уровня:

my $tower = shorten("http://maps.google.com/maps. . .", "pisa", "tower");

Этот пример создаст адрес pisa.byst.ro/tower (если он, конечно, был доступен на момент запроса).

Модуль содержит плагин WWW::Shorten::TinyURL::RU, который может работать вместе с WWW::Shorten Дейва Кросса.

Я использую подход, заложенный в модуле WWW::Page, уже несколько лет, постоянно изменяя его код. Не будет преувеличением утверждение, что на каждом сайте работают разные варианты модуля.

Однако, мне хочется несколько поменять идеологию, сократив на треть число файлов, которые необходимы для развертывания сайта.

Сейчас URI запрошенной страницы отображается на один из нескольких XML-файлов с описаниями страниц. Иными словами, некий диспатчер определяет тип страницы и смотрит его описание в соответствующем файле. В таких XML, в частности, подключается один из кастомных модулей, отвечающих за логику приложения, дана ссылка на файл с XSLT-преобразованиями и записаны вызовы функций (из кастомного модуля). Типичный пример подобного файла описания входит в поставку.

Со временем стало ясно, что такая структура, хотя и позволяет полную свободу, отнимает много времени при добавлении на сайт новых страниц (точнее, типов страниц). Дело даже не в том, что это отнимает время; дело в том, что каждая такая операция — типовая: обновить диспатчер, научив его разпознавать новые адреса, создать описание страницы в XML, создать файл с XSLT.После выхода Perl 5.10 в диспатчерах применяется конструкция given/when, и на каждый тип страниц обычно приходится одна строка:

given($uri) {
    when(m{^/?$})
       {$path = 'index.xml'}
    when(m{^/api/(rate)/[^/]+/?$})
       {$path = "api/$1.xml"}
    when(m{^/api/[^/]+/?$})
       {$path = 'api/rates-all.xml'}
    when(m{^/(currency|list|cloud)/?$})
       {$path = "$1.xml"}
 ...

Не слишком утомительно и вполне расширяемо. Однако задача такого распределителя — подготовить переменную $path, записав в нее имя соответствующего XML-файла с описанием страницы.

Сами по себе файлы кешируются, поэтому сильных опасений о скорости работы в этом месте не возникает. Напрягает другое — типичный XML-файл оказывается совсем небольшим по размеру и кроме упомянутых выше инструкций обычно содержит только заголоков.

Сейчас (на самом деле лет уже 10 как, еще до появления WWW::Page) я вижу такое развитие подхода. Вместо имен файлов диспатчер сразу будет возвращать объекты страниц соответствющих классов. Есть, например, страница «Новости», для нее возвращается MySite::Page::News.

given($uri) {
    when(/^news$/)
       {return new MySite::Page::News::List}
    when(/^news/(.*)$)
       {return new MySite::Page::News::Detail($1)}

Этот подход я опробую на сайте books.perl.org.