Гипер-, редакшн- и кроссоператоры в Perl6

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

Еще в 1748 году М. В. Ломоносов открыл закон сохранения магии. Или все-таки вещества? - да какая разница! Этот закон гласит: "Так, ежели где убудет несколько магии, то умножится в другом месте".

В соответствии с законом сохранения магии в Perl6, когда многие вещи стали простыми, появились очень интересные новые возможности. Среди нововведений - гипероператоры, reduction и cross операторы. Это операторы предназначены для работы со списками. Кстати, подобные им операторы изначально имеются в магических языках семейства APL.

Наличие таких нововведений в Perl6 позволяет выражать мысли более компактно и ясно. Рассмотрим некоторые примеры и сравним их с примерами на языке J (http://jsoftware.com), который является потомком языка APL. Для простоты в нижеприведенных примерах код обозначен отступом вправо, а результат работы - отступом влево.

Примеры выполнены при помощи Rakudo (компилятор Perl 6, основанный на Parrot) Rakudo - сокращение от японского Rakuda-do, что означает "Путь верблюда".

Перед основыми примерами создаем списки (массивы, вектора):

     Perl                  |     J
 ------------------------------------------------
     @x = (1 .. 3)         |     x=. 1 2 3
     @y = (4 .. 6)         |     y=. 4 5 6

В J списки создаем вручную, чтобы не забегать вперед.


Гипероператоры

Гипероператоры производят операции над списками поэлементно. Смотрите http://perlcabal.org/syn/S03.html#Hyper_operators. Сложение двух списков при помощи гипероператора и прибавление к списку числа:

     Perl                  |     J
 ------------------------------------------------
     @x >>+<< @y           |  x + y
 5, 7, 9                   | 5 7 9
     @x >>+>> 3            |     x + 3
 4, 5, 6                   | 4 5 6

В J оператор является аналогом Perl гипероператора, что не удивительно, ведь APL - язык векторных вычислений.


Reduction операторы

Эти операторы работают не с единичными элементами списка, а с учетом результата действий над предыдущими элементами. http://perlcabal.org/syn/S03.html#Reduction_operators

     Perl                  |     J
 ------------------------------------------------
     [+] @x                |    +/ x
 6                         | 6

Для достижения аналогичного результата в J оператор модифицируется наречием "поэлементно".

Следующий пример еще не работает в Rakudo (parrot revision 35576). Отличие этого примера от предыдущего в том, что сумма считаеться не для всего списка, а для каждой его части:

     Perl                  |     J
 ------------------------------------------------
     [\+] @x               |     +/\ x
 1, 3, 6                   | 1 3 6

В J это делается при помощи наречия "префиксно".


Cross операторы

Эти операторы производят действие над каждой комбинацией элементов списков.
http://perlcabal.org/syn/S03.html#Cross_operators

Сделаем фрагмент таблицы умножения:

     Perl                       |     J
 ------------------------------------------------
     @x X*X @y                  |     x */ y
 4, 5, 6, 8, 10, 12, 12, 15, 18 |  4  5  6
                                |  8 10 12
                                | 12 15 18

В J оператор модифицируется наречием "таблично". Отличие Perl от J в том, что в J сразу создается матрица, а Perl придется список преобразовать в таблицу. Просто у Perl и J разное распределение магии.

Выводы

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

Для "профессиональных" векторных вычислений рекомендуется использовать Perl Data Language (http://pdl.perl.org).

"Закрытые объекты" в 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, он лишь принимает формы привычные многим.

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

Иногда 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");

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

Использование 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.

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 писались приблизительно в одно время. :-)

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. Его просто использовать для пакетной обработки, создания индекса и кастомизации.

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