пятница, 26 декабря 2008 г.

"Закрытые объекты" в Perl5 и Perl6

Введение

Как вы знаете на геральдическом гербе Perl красуется надпись TMTOWTDI (There's More Than One Way To Do It - есть более одного способа сделать это). Но чтобы использовать один из способов, необходимо обладать свободой - свободой выбора. Идея свободы выбора насквозь пронизывает Perl. Кстати, как и христианство.

Используя Perl, вы полностью свободны! Свободны и в том, насколько быть свободным и открытым.

Обычно и вас не ограничивают. Просто там, куда не следует лезть без особой на то нужды, вывешивают табличку с предупреждающей надписью. Некоторые таблички являются табличками по умолчанию и продиктованы здравым смыслом. Конечно вам никто не запрещает проигнорировать предупреждение, но тогда только вы сами будете отвечать за все последствия. Вспомните, что произошло с Адамом и Евой, когда они съели то злополучное яблоко.

Но соблазн велик. К тому-же нарушитель попытается повесить всех собак на других. Как попытался это сделать в свое время Адам, сказав: "Это все Ева, а ведь ТЫ дал мне ее в жены". Так вот, чтобы такие Адамы не лезли куда ни попадя, можно ограничить свободу при использовании вашего модуля.

Если в качеств Эдемского сада рассмотреть объекты, то Адам может получить или изменить свойства класса в обход методов доступа, вызвать приватный метод или даже посягнуть на самое святое - изменить родительский класс.

При разработке Perl6 учли все это и предоставили возможность оградить Адама от самого себя: у объектов Perl6 имеются защищенный атрибуты, методы, а также дружественные методы.

А как же Perl5?! Perl - гибкий язык, поэтому можно и в Perl5 предпринять кое-что для защиты объектов. Одним из самых популярных способов сделать это является "выворачивание объекта наизнанку" :-).


Inside-out объекты

Классические Perl объекты - это просто структуры данных, благословленные быть объектами при помощи функции bless. Методами объекта являются подпрограммы пакета, который привязан к объекту при благословении. Благословить быть объектом можно ссылку как на скаляр, так и на массив, хеш или замыкание.

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

package Foo;

sub new {
my $self = { name => "My name" };
bless $self;
return $self;
}

sub name {
my $self = shift;
return $$self{name};
}

1;

Можно получить значения foo в обход одноименного метода:

my $foo = Foo->new();
print $foo->{name};

Чтобы предотвратить это, необходимо запрятать от внешнего взора значение foo. Вопрос только как и где?! Например, в лексической области пакета. То есть объект перестает быть совокупностью данных с привязанными к нему процедурами, он становиться некоторым идентификатором с привязанными к нему процедурами, которые в свою очередь по этому идентификатору знают о местоположении данных.

Такие объекты называются Inside-out объектами. Кстати, в стандартной поставе Perl 5.10 имеется модуль Hash::Util::FieldHash, предназначенный для создания таких объектов.

Рассмотрим пример Inside-out объекта:

package Foo;

use Scalar::Util 'refaddr';
my %name;
sub new {
my $self = bless \do {my $anon_scalar}, "Foo";
$name{ refaddr $self } = "My name";
return $self;
}

sub name {
my $self = shift;
return $name{ refaddr $self };
}

sub DESTROY {
my $self = shift;
delete $name{ refaddr $self };
}

1;

Этот объект функционально полностью идентичен первому, и работа с ним осуществляется как с обычными объектами:

my $foo = Foo->new();
print $foo->name();

А вот получить значение name в обход метода доступа невозможно. Строка print $foo->{name}; приведет к ошибке: "Not a HASH reference".

Чтобы облегчить создание Inside-out объектов и, не дай Бог, не забыть о DESTROY существует множество модулей-конструкторов, среди которых особое место занимают Class::InsideOut и Object::InsideOut. Объекты, созданные при помощи их, можно клонировать, сериализовать и
использовать под mod_perl.

О наследовании

При всех своих преимуществах Inside-out объекты не лишены недостатков. А именно, при их использовании возникают определенные трудности с наследованием.

Вообще-то наследование и закрытость - это взаимоисключающие вещи. И приходиться чем-то жертвовать.

Например, объекты, созданные при помощи Class::InsideOut могут наследовать другие, но от них наследоваться невозможно. А при использовании Object::InsideOut, наследование реализовано как делегирование.

Маленький хак

Закрытость - закрытостью, но насколько это закрытость сильна?!

Попробуем добраться до приватных атрибутов Inside-out объекта, внедрив в модуль объекта маленькую подпрограмму-шпиона по имени hook:

use Scalar::Util 'refaddr';

# Внедряем метод доступа.
sub Foo::hook {
my $self = shift;
return $name{ refaddr $self };
}

my $foo = Foo->new();
print $foo->hook();

И, вуаля, все тайное становиться явным!

О Perl6

Если внимательно посмотреть на вышеприведенный хак, то можно увидеть что-то очень знакомое... Да это же аналог роли из Perl6!

Роль добавляет к объектам как методы, так и атрибуты. Добавляет либо на этапе компиляции, либо на этапе исполнения.

По сути роли, кроме всего прочего, открывают то, что cкрыто за приватными методами и атрибутами!

А когда роль добавляется на этапе исполнения, это привносит в class-based объекты черты prototype-based. Если пойти еще дальше: то там, где есть роли, в классическом наследовании вообще нет необходимости.

Но prototype-based стиль не приемлет закрытости. С другой стороны, как говорит, Stevan Little, один из основных разработчиков Moose, нужда в private методах и атрибутах - это социальная проблема и должна решаться именованием, документированием и хорошей поркой.

Подводя итоги

В perl можно сделать закрытые объекты. Но такие объекты в первую очередь предназначены для защиты от случайных изменений.

Если нужно, то "закрытой" объект можно "открыть". Кончено, кроме объекта, построенного на замыкании, но такой объект является вещью в себе - он не может ни наследовать, ни наследоваться.

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

среда, 26 ноября 2008 г.

Многоликие объекты

Иногда Perl обвиняют что у него "неправильные объекты". В ответ так и хочется спросить: "у Вас мания "объектно-ориентированного величия" или вы любитель "священных войн"? Кто сказал, что объекты должны быть основаны только на классах?

Вон в List вообще нет "классических" объектов, зато есть CLOS, которая заткнет за пояс многие объектно-ориентированные языки программирования. А в perl, если не нравятся perl5 объекты можно использовать все что угодно, например:

Moose - A postmodern object system for Perl 5.
Mouse - Moose minus the antlers
Class::Prototyped - Fast prototype-based OO programming in Perl
Class::Closure - Encapsulated, declarative class style
Class::Spiffy - Spiffy Framework with No Source Filtering

А сколько разных генераторов классов есть.

Уверен, что и к perl6 будет претензии: дескать зачем так все сложно, зачем эти
role, если можно все можно сделать наследованием?

Ради бога! Делайте, никто не связывает руки. Perl позволяет многое, почти все. Можно даже использовать нижеследующие:

use strict;
use warnings;

use Clone qw(clone);

sub new {
my $protos = ref $_[0] eq "ARRAY" ? shift || [] : [];
my $data = shift || {};
my $methods = shift || {};

my $self;
return $self = sub {
my $method = shift;

if ($method eq "clone") {
return new(clone($protos), clone($data), clone($methods));
}

if ($method eq "add_slot") {
%{$methods} = (%{$methods}, @_);
return $self;
}

if ($method eq "get_slot") {
return $$methods{$_[0]};
}
if ($method eq "slot_names") {
return keys %$methods;
}

if (my $sub = $$methods{$method}) {
return $sub->($self, $data, @_);
}

foreach (@$protos) {
if (my $sub = $_->("get_slot", $method)) {
return $sub->($self, $data, @_);
}
}
}
}


# Пример использования.

use Test::More tests => 12;

my $c1 = new(
{ foo => 3 },
{
foo => sub { my ($self, $data) = @_;
return $$data{foo};
},
add => sub {
my ($self, $data, $delta) = @_;
$$data{foo} += $delta;
return $self;
},
},
);

is($c1->("foo"), 3, "c1");

my $c2 = $c1->("clone");
is($c2->("foo"), 3, "c2");

ok($c1->("add", 2), "c1: add 2");

is($c1->("foo"), 5, "c1");
is($c2->("foo"), 3, "c2");

is($c1->("add", 3)->("foo"), 8, "c1: add 3 and return");


$c1->("add_slot", multiply => sub {
my ($self, $data, $y) = @_;
$$data{foo} *= $y;
return $self;
});

ok($c1->("multiply", 2), "multiply");
is($c1->("foo"), 16, "multiply, get");

ok(ref $c1->("get_slot", "multiply") eq "CODE", "get_slot");

is(join(" ", sort $c1->("slot_names")), "add foo multiply", "slot_names");



my $c3 = new(
[$c1], # inheritance
{ foo => 3 },
{
baz => sub { my ($self, $data) = @_;
return join " ", "baz", $$data{foo};
},
}
);

is($c3->("baz"), "baz 3", "c3, baz");
is($c3->("foo"), 3, "c3, foo");

Так что, если нечто отличается от привычного, не следует стразу обвинять это нечто в "неправильности", может просто мы столкнулись с тем, что является лишь немного другим. Другим, а не неправильным!

четверг, 13 ноября 2008 г.

Использование Perl Data Language для расчета Page Rank

В среде SEO (search engine optimization) долгое время ходила, а может и сейчас продолжает ходить, легенда о том, что добавление ссылки на страницу приводит к "утеканию" с нее Page Rank. Другая легенда гласит, что можно так расставить внутренние ссылки на сайте, что Google Page Rank сайта подскочит до небес.

Вообще-то SEO мне чет-то нравятся: из забавно слушать сразу после обеду, когда ничего делать не хочется, разве что послушать какую-то забавную историю или легенду.

Так вот о Page Rank. Как-то во время одной беседы с SEO, слушая легенду о Page Rank, вспомнил о передаче "Разрушители легенд", которая шла по каналу "Дискавери", и подумал: "а не разрушить ли в среде знакомых SEO некоторые легенды о Page Rank?"

Перед тем как делать скрипт расчета локального Page Rank, заглянул на CPAN. Оказалось, что там имеется модуль Algorithm::PageRank. Но при ближайшем рассмотрении оказалось, что в этом модуле используется какие-то другая формула, а не

PR(A) = (1-d) + d (PR(T1)/C(T1) + ... + PR(Tn)/C(Tn))

(http://infolab.stanford.edu/~backrub/google.html)

Пришлось немного подправить модуль. Во время правки выяснилось, что модуль использует PDL (Perl Data Language, http://pdl.perl.org), но не слишком оптимально.

Кстати, при первом знакомстве с PDL, я столкнулся с подобным нюансом. Объекты pdl можно создавать таким способом:

my $foo = pdl(1 .. n);

Это вектор со значениями от 1 до n. Создавая таким образом объекты, я в один прекрасным момент столкнулся с нехваткой памяти. Расследование того, почему PDL так требователен к памяти, показало, что PDL был напрасно обвинен. В вышеприведенном примере сначала создается perl массив (!), а PDL затем достаются лишь крохи памяти, которые не были использованы perl для создания гигантского массива.

Но вернемся к Page Rank. Поскольку алгоритм расчета ранга прост - решил написать пару строк самостоятельно. Тем более если посмотреть на формулу со стороны матричной алгебры:

R = (1 - d) + d * M * R,

где: R - вертикальный вектор рангов страниц,
M - матрица взвешенных ссылок.

Матрица взвешенных ссылок получаемся посредством деления элементов матрица
ссылок на количество ссылок со ссылающихся станиц.

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

use PDL;
my ($from, $to) = rcols 'links.dat';

Затем определяем максимальной значение, которыми закодированы конкретные страницы:

my $size = 1 + maximum(pdl(maximum($from), maximum($to)));

Это необходимо для создания матрицы связей:

(my $M = zeroes(double, $size, $size))->index2d($to, $from) .= 1;

Функция zeroes создает матрицу, заполненную нулями, а index2d на основе информации от ссылках заменяет значения ее соответствующих элементов единицами.

Из матрицы связей получаем взвешенную матрицу:

$M->inplace->divide($M->sumover->transpose, 0);

inplace говорит, что не будет копирования, а - замена значений по месту.

На следующем этапе создаем вектор первоначальных значений ранга и коэффициент затухания:

my $R = ones(double, $size);
my $d = 0.85;

Затем за 30 итераций рассчитываем ранг:

for (my $i = 0; $i<=30; $i++) { $R = 1 - $d + $d * $R x $M; }

Конечно, в реальном скрипте число итераций определяется автоматически на основе требуемого значения погрешности расчета.

Сохраняем результаты расчета в файл r.dat при помощи следующего кода:

wcols sequence($size->sclr), $R->slice(',(0)'), 'r.dat';

Ну вот и все. Надеюсь, я смог заинтересовать вас познакомиться c Perl Data Language.

среда, 22 октября 2008 г.

Background execution of subroutines in child processes

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

Для решения этой и подобных задач написал маленький модуль BGS - Background execution of subroutines in child processes. Модуль позволяет упростить выполнение подпрограмм в дочерних процессах, ожидание их завершения и возврат результатов работы подпрограмм из дочерних процессов в основной.

Пример использования:

use BGS;

my @foo;

foreach my $i (1 .. 2) {

bgs_call {
# child process
return "Start $i";
}

bgs_back {
# callback subroutine
my $r = shift;
push @foo, "End $i. Result: '$r'.\n";
};

}

bgs_wait();

print foreach @foo;

Код, который будет выполняться в дочерних процессах, помещается в блок bgs_call.

Код, который выполниться в основном процессе, при завершении bgs_call, находиться в блоке bgs_back. Ответ bgs_call (скаляр или ссылка, но не список) передается в bgs_back в качестве аргумента.

Механизм запускается командой bgs_wait. Не забудьте перед созданием дочерних процессов, закрыть все соединения к базе. Почему это желательно сделать, смотрите в заметке "Отцы и дети или perl, fork и деструкторы".

Внимание, код, который будет вызываться из bgs_call, на данный момент ничего не должен печатать на STDOUT! Надо, все таки, собраться и устранить этот недостаток. А может еще добавить timeout ожидания?

Кстати, на CPAN недавно обнаружил модуль Parallel::SubFork с похожим функционалом. Судя по датам BGS и Parallel::SubFork писались приблизительно в одно время. :-)

вторник, 21 октября 2008 г.

Cooking Plain Old Documentation

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

Я, например, предпочитаю читать не с экрана монитора, а с бумажной копии, сидя в уютном кресле с чашечкой ароматного зеленого чая.

Документацию пишу в Plain Old Documentation.
Конечно, если необходимы математические формулы или графика, то привлекаю более мощные средства, но сейчас разговор не о них. Кстати, не забывайте о podchecker, а то некоторые трансляторы с POD слишком снисходительны.

Но вернемся к подготовке POD к печати.
Под Windows самым простым способом является преобразование POD в HTML и печать его из под MS Office. А чтобы документ был более красивым, то можно использовать свой шаблон со стилями.

Под UNIX, как все знают, MS Office нет :-), а Open Office тогда еще не было.
Да и изучать Open Office нет желания, так как считаю не рациональным знать и MS Office, и Open Office, тем более, что есть альтернативы. Например, pod2man или pod2latex.

Вариант с man и groff мне как-то не пришелся по душе, поэтому я даже не пытался его использовать. А вот вариант с LaTeX применял, но все таки ставить TeX систему ради одного POD - это, по моему, перебор, тем более, что есть крошка lout.

Lout - система форматирования текста, подобная TeX и производящая PostScript файл.
http://lout.wiki.sourceforge.net В lout входит также программа prg2lout, предназначенная для трансляции исходников в lout разметку. Среди поддерживаемых языков имеется Perl и POD.

Например, чтобы распечатать документацию по модулю Foo, я набираю следующие команды:

podselect Foo.pm > Foo.pod
prg2lout -l pod -n Foo.pod | lout -s | ps2pdf - > Foo.pdf
lpr Foo.pdf

Кончено, я это делаю не вручную, а при помощи make (кроме вызова lpr, разумеется).

Но листы формата A4 иногда не очень мне нравятся...
Какой я все таки бываю капризным: "хочу книжечку читать и точка!"

В таком случаете, я использую вот такой конвейер команд:

prg2lout -l pod -n Foo.pod | lout -s | psbook | psnup -2 | ps2pdf - > Foo.pdf

Несколько сгибов, две скрепки - и у меня имеется красивая брошюра формата А5!
Осталось только сделать чай. :-)

А как вы "готовите" POD?


P.S.
Когда необходимо сделать документацию в виде набора HTML документов с перекрестными ссылками,
более всех понравился мне модуль Pod::Simple::HTML. Его просто использовать для пакетной обработки, создания индекса и кастомизации.

понедельник, 13 октября 2008 г.

Perl: Асинхронный конвейер HTTP клиентов

Как-то давным давно почувствовал я на работе запах дыма. Думал - пожар, но выглянув в коридор, увидел, что дым не так уж и велик, и валит из офиса SEO (search engine optimization).

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

Когда мне наконец-то удалось привлечь к себе внимание, выяснил, что для какого-то исследования оптимизатором надо было закачать несколько десятков тысяч web страниц. Что за исследования и где они взяли этот список url я уточнять не стал, просто пожелал им плодотворной работы, а сам запомнил где лежит этот список url.

Да, придется ликвидировать причину дымa, - подумал я на обратной дороге. Нет, оптимизаторов я ликвидировать не собирался, просто решил им сделать скриптик, которых закачает все эти странички, тем более, что у меня уже был опыт работы с модулем LWP::Parallel::UserAgent.

Задача сводилась к тому, чтобы по мере обработки читать с файла новые url, асинхронно запрашивать страницы и записывать HTTP ответы в файлы. Конечно можно было все сделать последовательно, но уж больно много времени потребовалось бы на это.

Как оказалось, для организации такого конвейера более подходит модуль HTTP::Async, а не LWP::Parallel::UserAgent.

Вот примерный код, который использовался для этого (работа с файлами опущена):

use HTTP::Message 1.57;
use HTTP::Request;
use HTTP::Async;

my @urls = (
'http://www.perl.com',
'http://www.perl.org',
'http://perlmonks.org',
'http://www.pm.org',
'http://kiev.pm.org',
'http://www.parrot.org',
'http://www.parrotcode.ks.ua',
);

my $async = HTTP::Async->new;

my $max_connects = 3;
my $cnt = @urls > $max_connects ? $max_connects : @urls;
add_request() foreach (1 .. $cnt);


while ( my $res = $async->wait_for_next_response ) {
if($res->is_success()) {
print "Succeeded for '", $res->request->url, "'\n";
# print $res->content, "\n";
}
add_request();
}


sub add_request {
my $url = shift @urls or return;
my $req = HTTP::Request->new(GET => $url,
['User-Agent' => "Mozilla/4.0 (compatible; MSIE 5.0; Windows 98; DigExt)"]);
$async->add($req);
}

В это пример первоначально создается $max_connects запросов и по мере их завершения, создаются все новые и новые.

Все очень просто. Но опять у меня проснулась любопытство: а нельзя это все таки для такой конвейерной обработки приспособить модуль LWP::Parallel::UserAgent?

Оказалось можно. Для этого просто нужно переопределить события on_return и on_failure:

$SIG{PIPE} = 'IGNORE';
use LWP::Parallel::UserAgent;

my @urls = (
'http://www.perl.com',
'http://www.perl.org',
'http://perlmonks.org',
'http://www.pm.org',
'http://kiev.pm.org',
'http://www.parrot.org',
'http://www.parrotcode.ks.ua',
);

my $ua = LWP::Parallel::UserAgent->new();
$ua->agent("Mozilla/4.0 (compatible; MSIE 5.0; Windows 98; DigExt)");
$ua->nonblock(1);

my $max_connects = 3;
my $cnt = @urls > $max_connects ? $max_connects : @urls;
add_request() foreach (1 .. $cnt);


sub add_request {
my $url = shift @urls or return;
my $req = HTTP::Request->new(GET => $url);
$ua->register($req);
}


{
no warnings;
sub LWP::Parallel::UserAgent::on_return {
my ($self, $request, $response, $entry) = @_;
if($response->is_success()) {
print "Succeeded for '", $response->request->url, "'\n";
}
add_request();
}

sub LWP::Parallel::UserAgent::on_failure { add_request() }
}

my $entries = $ua->wait(3);

Что ж не так красиво, как при использовании HTTP::Async, но свою задачу этот код выполняет. Разве что очень не понравилась необходимость установить $SIG{PIPE} = 'IGNORE';

Ну вот и все история... :-) Да... давно это было... Но тем не-менее, кому-то может и пригодиться этот опыт и сейчас.

Копия: http://kiev.pm.org/node/253

четверг, 18 сентября 2008 г.

О ключике -w замолвите слово

Прагм strict и warnings обычно достаточно.
Ключик -w использую в основном в однострочниках.
Но, как оказалось, о нем забывать не стоит!

Вот реальная история.

При разработке системы, использующих подгруздку модулей, в одном из таких модулей была сделана ошибка. По какой-то причине кто-то поставил двоеточие после слова package, подобно вот этому:

> cat Foo.pm
package: Foo;

use strict;
use warnings;

# ...

1;

Однако, при загрузке этого модуля никаких предупреждений не выводится:

> perl -c -MFoo -e 1
-e syntax OK

Хотя перед загрузкой включены и strict, и warnings:

> perl -c -Mstrict -Mwarnings -MFoo -e 1
-e syntax OK

Все дело в том, что в файле Foo.pm прагма warnings подключается после объявления модуля.
Если в подключать прагму до объявления модуля, то ошибка легко диагностируется:

> cat Foo.pm
use strict;
use warnings;

package: Foo;

# ...

1;

> perl -c -MFoo -e 1
Bareword "Foo" not allowed while "strict subs" in use at Foo.pm line 4.
Compilation failed in require.
BEGIN failed--compilation aborted.

Но писать так как-то не очень привычно и не хочется, да и где гарантия, что другой разработчик будут также писать так?

Вот тут и приходит на помощь ключик -w:

> perl -wc -MFoo -e 1
Useless use of a constant in void context at Foo.pm line 1.
-e syntax OK

Хотя файл Foo.pm и загружен, но предупреждение позволяет легко понять, что имеется ошибка.

Так что ключик -w рано выкидывать на свалку истории, как это можно подумать из perldoc perllexwarn.

Копия: http://kiev.pm.org/node/235

четверг, 19 июня 2008 г.

Perl: Cooking warnings

Данная заметка касается некоторых тактических приемов обработки предупреждений и не претендует на полноценный обзор систем логирования будь-то Log::Dispatch или Log::Log4perl.

Обработка предупреждений

Обычно имея лишь предупреждение подобное этому: "Use of uninitialized value in hash element at ...", - практически не возможно установить, что привело к нему. Необходима дополнительная информация: минимум входящие данные. Поэтому обработку предупреждений можно разделить на два уровня.

Первый уровень обработки предупреждений простой: он отлавливает предупреждения и ошибки, которые возникают до того, как заработает второй уровень. Для этого можно использовать CGI::Carp, например:

use CGI::Carp qw(carpout);
open (LOG, ">>/var/log/.../foo.log");
carpout(*LOG);

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

Простейшая реализация обработки предупреждений второго уровня показана ниже.

Подключение обработчика и вызов подпрограммы записи предупреждений:

use Foo::Log;

sub main {
# ...
local SIG{__WARN__} = warn_trap();
# ...
write_warn($id_source, $id_input_data);
}

Непосредственно модуль обработки (без экспорта имен и полезных прагм):

package Foo::Log;

my @warnings = ();

sub warn_trap() {
@warnings = ();
my $old_warn_trap = $SIG{__WARN__};
return sub {
my $warn = shift;
push @warnings, $warn;
if ($old_warn_trap) {
# Конечно, если хотим передать сообщение
# вышестоящему обработчику.
local $SIG{__WARN__} = $old_warn_trap;
eval { &$old_warn_trap($warn) };
}
};
}

sub write_warn(;$$) {
my ($id_source, $id_input_data) = @_;
if (@warnings) {
# Открываем лог файл и
# сохраняем $id_source, $id_input_data и @warnings.
# ...
}
}

Почему не устанавливаю ловушку для __DIE__?
Потому что предпочитаю ловить die в eval и вызывать warn $@, да и первый уровень на страже.

Отладка

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

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

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

Нет проблем: используем callar и @DB::args в __WARN__ обработчике.

Но когда поток обработки входных данных зависит от уже имеющихся данных в базе и эти данные изменяются во времени, иметь аргументы подпрограммы бывает не достаточно для поиска ошибки, нужно также знать эти "уже имеющиеся в базе данные" на момент возникновения ошибки.

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

Более красивым решением может быть тактика точечных обработчиков предупреждений.

Локальный точечный обработчик устанавливается максимально близко к месту возникновения ошибки и ему указывается что необходимо сделать при возникновении предупреждения.

Пример реализации точечного обработчика:

use Data::Dumper;

sub pointed_warn_trap(@) {
my @data = @_;
my $old_warn_trap = $SIG{__WARN__};
return sub {
my $message = join "", shift, Dumper @data;
$old_warn_trap ? eval { &$old_warn_trap($message) } :
warn $message;
};
}

Пример использования точечного обработчика:

local $SIG{__WARN__} = pointed_warn_trap($foo, $too);

В этом примере $foo может быть обрабатываемыми данными, а $too - информацией из базы.

После того как разместили точечный обработчик остается только, подобно рыбаку, набраться немного терпения и словить "рыбку".

Заключение

Эти приемы обработки предупреждений хоть и просты, но очень помогают отлавливать ошибки и сделать код более качественным.

P.S.
Копия: http://kiev.pm.org/node/188.

вторник, 27 мая 2008 г.

Один нюанс использования map

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

Примеры.

Простой блок - perl понимает сам, что имеет дело с анонимным хешем:

> perl -MData::Dumper -e 'print Dumper [map { { 1 .. 4 } } (1 .. 2)]'
$VAR1 = [
{
'1' => 2,
'3' => 4
},
{
'1' => 2,
'3' => 4
}
];

Сложный блок - perl думает, что имеет дело с лексической областью видимости:

> perl -MData::Dumper -e 'print Dumper [map { 1; { 1 .. 4 } } (1 .. 2)]'
$VAR1 = [
1,
2,
3,
4,
1,
2,
3,
4
];

Подсказка про анонимный хеш при помощи круглых скобок:

> perl -MData::Dumper -e 'print Dumper [map { 1; ({ 1 .. 4 }) } (1 .. 2)]'
$VAR1 = [
{
'1' => 2,
'3' => 4
},
{
'1' => 2,
'3' => 4
}
];

Кстати, когда анонимный хеш возвращается из обычной подпрограммы при помощи return, то нет нужды в подсказке в виде круглых скобок, так как return устраняет вышеописанную неопределенность. А вот если return отсутствует и подпрограмма возвращает последние вычисленное значение, то подсказка необходима. В блоке map return использовать нельзя.

http://kiev.pm.org/node/182

пятница, 22 февраля 2008 г.

Осторожно, Perl!

Шуточная на половину статья, в которой упоминаются некоторые перловые хаки. Perl самый опасный язык программирования, поскольку он развивает "отвратительные" качества в людях. Некоторые их называют "добродетелями" программистов: лень, нетерпение, высокомерие (laziness, impatience, hubris).

Первоначально задумывалось достоинства Perl показать как недостатки, а недостатки - как достоинства. Но, кажется, немного отклонился в сторону. Даже думал, как Гоголь, предать огню эту статью, чтобы не пугать неокрепших духом, но потом решил оставить. Правильно поступил или нет - об этом судить читателю.

Вот собственно статья.

Среди множества языков программирования один занимает особое место. Это язык Perl! Если вы его не знает и получите предложения его освоить - бегите как можно дальше, иначе...

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

Причем это происходит постепенно и от того более коварным является этот процесс. Человек этого не замечает и даже потом, когда Perl полностью им завладевает, человек не будет это осознавать. Более того, он будет даже превозносить эти отвратительные черты, как великие добродетели программистов. Но какие это же добродетели!

Возьмем, например, высокомерие. Оно, якобы, помогает писать замечательные программы. Глупости все это. Высокомерие Perl программистов настолько велико, что они даже встревают в спор С++ и OCaml программистов о производительности их языков. Сам был очевидцем такого спора. В споре шел разговор как оптимально генерируется ассемблерный код, а также затрагивались вопросы оптимизации хвостовой рекурсии... Решили провести тесты, например, посредством вычисления чисел Фибоначчи.

А тут мимо проходил Perl программист. И что вы себе думает, он посмел высокомерно утверждать, что вычислит на Perl числа Фибоначчи быстрей чем они. Поспорили на бутылку коньяка. Программисты C++ и Ocaml знали, что из себя представляет Perl, поэтому сразу согласились на спор. Но они не знали, что из себя представляют Perl программисты. Кто бы мог подумать, что этот Perl программист выиграет спор! Он первый вычислил числа Фибоначчи! Когда остальные участники спора, отказываясь верить словам, подошли увидеть все своими глазами, Perl программист запустил на исполнение следующий код:

use strict;
use warnings;
use Memoize;
memoize('fib');

sub fib {
my $n = shift;
return $n if $n < 2;
fib($n-1) + fib($n-2);
}

my $n = $ARGV[0];
print "fin($n) = ", fib($n), "\n";

Конечно, для тех, кто знаком с модулем Memoize, все становиться ясно с первого взгляда.

Perl самый быстрый язык, не потому, что его интерпретатор быстр, а потому, что быстры и ясны мысли Perl программистов. Когда другие жонглирую байтами, Perl программисты не забывают об оптимизаций алгоритмов.

С дрогой стороны, Perl не только "самый быстрый язык", но и самый ленивый. Нет, не надо говорить, что самый ленивый - это Haskell. Вы бы посмотрели, как иногда Haskell программисты борются с ленивостью своего языка. Perl ленив по другому. Правильно, он ленив, потому, что ленивы его использующие люди. Кстати, и потому что они ленивы, они даже не нагружают свой компьютер лишней работой: вспомните про модуль Memoize. А ленивые списки и прочие есть и у Perl, например: Data::Lazy, Scalar::Defer, Object::Lazy, Tie::Scalar, Tie::StdScalar и даже DBIx::LazyMethod.

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

Ну а поскольку Perl очень быстр и ленив, то он делает людей его использующих очень нетерпеливыми.
Быстро сделав свою работу, вы будете с нетерпением ждать, когда, например, программисты, реализующие клиентскую часть проекта, напишут и отладят свой код. Вы будите скучать от безделья, нервничать от осознания того, что вас сдерживают и проект движется черепашьими темпами. Придется пить валерьянку.

Многие не в силах выдержать это, ломаются - бреют голову, посыпают ее пеплом и уходят в монастырь (http://perlmonks.org). Там они в спокойной обстановке, вдалеке от суетного мира занимаются каллиграфией, то есть обфускацией (http://www.perlmonks.org/index.pl?node=Obfuscated%20Code).

Лень привела также к тому, что Perl является сосредоточением множество закорлючер и заклинаний. (Про семейство APL языков скромно умолчу.) И все это преподноситься под соусом "cуществует более одного способа сделать это". Да ни один силач не поднимет книгу Perl рецептов.

А посмотрите, что Perl программисты сделали с совершенной и строгой концепцией Объектно-Ориентированного программирования!
Ну разве это объекты? Правда Damian Conway (Tie::SecureHash, Class::Contract) пытался образумить Perl программистов, да что толку. Как-бы в ответ, появились модули, позволяющие делать всевозможные хаки, залезать в чужие области видимости и менять значения локальных структур! Ужас! (Перечень модулей, опасных для неокрепших духом, вырезан цензором.) Хотя, надо отдать должное, на основе этих идей появилась реализация Аспектно-Ориентированного программирования на Perl (Aspect).

Так что, программисты, берегитесь Perl - это очень опасный язык! Когда Perl проникнет в ваши умы, вы никогда больше не сможете нормально писать на других языках программирования. И этому также будет способствовать то, что Perl из всех языков программирования дальше всего находиться от компьютера и ближе всего к человеку. Не дай Бой, вы из программиста станете писателем или поэтом. А ведь были уже прецеденты, например, королева поэзии Perl Sharon Hopkins.

С другой стороны, чтобы стать настоящим мастером, надо пройти через все это. Но берегись.
Perl - это как обоюдоострый меч, которым можно делать чудеса, а можно серьезно пораниться.

Вы спросите, как же мне, использующему Perl, удалось избежать его пагубного влияния?
А у меня иммунитет - я же не программист. Я химик! :-

Коментарии и пожелания оставляте в http://kiev.pm.org/?q=node/157

среда, 6 февраля 2008 г.

Perl JSON модули с поддержкой UTF-8

Введение

Статья представляет обзор perl модулей для работы с JSON в контексте UTF-8. Подразумевается работа с UTF-8 на уровне символов, а не байтов. Если нужна работа на уровне байт, то подойдет любой из нижеперечисленных моделей, который устроит по скорости.

На CPAN существуют следующие модули:

  • JSON - parse and convert to JSON (JavaScript Object Notation).

  • JSON::XS - JSON serialising/deserialising, done correctly and fast

  • JSON::Syck - JSON is YAML

  • JSON::PC - fast JSON Parser and Converter (JSON::PC is a XS version of JSON).

  • JSON::DWIW - JSON converter that Does What I Want

В качестве тестовых данных будем использовать следующий JSON:

 { "hello":"Hello, \u00ab\u043f\u0440\u0438\u0432\u0435\u0442\u00bb \u2116 \u263a. Good by." }

В JSON содержится фраза ``Hello, <<привет>> #. Good by.'', в которой кавычки, номер и смайлик ``уникодные''. Именно как \uxxxx в JSON кодируются UTF-8 символы (http://json.org).

Этому JSON соответствует следующая Perl структура:

 { 'hello' => "Hello, \x{ab}\x{43f}\x{440}\x{438}\x{432}\x{435}\x{442}\x{bb} \x{2116} \x{263a}. Good by." }

Ну что-ж теперь приступим к тесту моделей.

Обзор модулей

JSON.

Для работы у UTF-8 в конструкторе необходимо это указать:

 JSON->new(utf8 => 1);

Модуль корректно ставит UTF-8 флаги, и обратном преобразовании кодирует UTF-8 символы. Но есть большое но: модель споткнулся на символах кавычки елочкой.

JSON::PC.

Как указано в документации на модуль, JSON::PC является XS версией модуля JSON, и как истинный приемник наследует туже проблему с русскими или французскими кавычками.

Модуль сам разбирается где UTF-8, ничего явно указывать не нужно.

JSON::Syck.

Модуль JSON::Syck написан сообразительной китаянкой, которая заметила что JSON по сути является YAML, и просто использовала библиотеку libsyck.

UTF-8 не поддерживается вообще, модель ориентирован на работу с октетами, о чем честно написано в документации. Подразумевается \uxxxx, а не ImplicitUnicode опция.

JSON::XS.

А вот модуль JSON::XS показал себя достойно со всех сторон. Правда перед преобразованием из JSON в Perl надо указать флаг utf8, а при обратном преобразовании - флаг ascii.

Из JSON в Perl:

 use JSON::XS;
my $json_xs = JSON::XS->new();
$json_xs->utf8(1);
$json_xs->decode($json_data);

Из Perl в JSON:

 use JSON::XS;
my $json_xs = JSON::XS->new();
$json_xs->ascii(1);
$json_xs->encode($perl_data);

Можно также задать флаг pretty для красивого форматирования результирующего JSON.

JSON::DWIW.

Последний модуль JSON::DWIW также ведет себе отлично, необходимо лишь в конструкторе сообщить об UTF-8:

 use JSON::DWIW;
my $json_dwiw = JSON::DWIW->new({ escape_multi_byte => 1 });
$json_dwiw->from_json($json_data);
$json_dwiw->to_json($perl_data);

Бонусы

Два пакета JSON::XS и JSON::DWIW нормально обрабатывают ситуацию, когда передаваемая им JSON строка не является последовательностью октетов, а является perl строкой с UTF-8 - не надо делать лишнюю проверку.

Benchmark

До этапа тестирования производительности успешно добрались лишь два модуля: JSON::XS и JSON::DWIW, - к которым нет ни одной претензии.

Собственно тест скорости на не слишком большой структуре:

 use Benchmark qw(cmpthese);
 cmpthese(10000, {
'JSON::XS' => sub {
my $json_xs = JSON::XS->new();
$json_xs->utf8(1);
$json_xs->decode($json_data_u);
$json_xs->ascii(1);
$json_xs->encode($perl_data_expected)
},
'JSON::DWIW' => sub {
my $json_obj = JSON::DWIW->new({ escape_multi_byte => 1 });
$json_obj->from_json($json_data_u);
$json_obj->to_json($perl_data_expected)
},
});

А вот и результаты:

               Rate JSON::DWIW   JSON::XS
JSON::DWIW 5246/s -- -78%
JSON::XS 24151/s 360% --

Вывод

Для меня вывод однозначен --- JSON::XS. Модуль ведет себя отлично с UTF-8, корректно преобразовывает данные в Perl строки и к тому же обладает приличной скоростью.

P.S. Для комментарий - http://kiev.pm.org/?q=node/153

понедельник, 28 января 2008 г.

Объекты? Зачем?! Точнее, не всегда. Замыкания!

Заметка не предназначена для разжигания священной войны: хорошо или плохо объектно ориентированное программирование. Я сам использую его наравне с другими.

Цель заметки --- показать, что иногда проще обойтись без объектов, а использовать замыкания.

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

Рассмотрим подобный объект на примере абстрактного "сумматора" чисел. При инициализации "сумматору" передается первоначальное значение, а при каждом вызове метода к текущему значению прибавляется передаваемое. Вот код такого "сумматора" в объектно-ориентированном стиле:

package Foo;

sub new {
my $class = shift;
my $foo = shift;
return bless \$foo;
}

sub foo {
my $self = shift;
$$self += shift;
print $$self, "\n";
}

1;

Пример использования:

use Foo;
my $foo = Foo->new(3);
$foo->foo(1);
$foo->foo(1);
$foo->foo(2);
$foo->foo(2);

Теперь сделаем аналогичный по функционалу "сумматор" с использованием замыкания:

sub make_foo {
my $foo = shift;
return sub {
$foo += shift;
print $foo, "\n";
};
}

Пример использования:

my $foo = make_foo(3);
$foo->(1);
$foo->(1);
$foo->(2);
$foo->(2);

Как видим вариант с замыканием проще, компактней и элегантней.

Пожалуй на этом и остановимся --- читатель дальше сможет сам развить тему. Приведу лишь цитату Стива Маджевски: "Объект --- это совокупность данных вместе с привязанными к ним процедурами... Замыкание --- это процедура вместе с привязанной к ней совокупностью данных."


P.S.
Кстати, Parrot оперирует объектами (PMC),
но при вызовах подпрограмм использует стиль передачи продолжений, который не мыслим без замыканий.

P.P.S
Копия и комментарии находятся на kiev.pm.org