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';

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

P.S. Оригинал - http://laziness-impatience-hubris.blogspot.com/2008/10/perl-http.html

Quote: надо было

Quote:

надо было закачать несколько десятков web тысяч страниц.

.. десятков тысяч WEB страниц.
------------------
#!/usr/bin/perl
print("goto rulez!!!!!!1");

Спасибо,

Спасибо, исправил.