Perl для IP-Телефонии (31 – Примеры LWP, часть 42)

Для поддержки зеркальной копии изображений, например, с сайта по продаже систем музыкальной трансляции , в актуальном состоянии этот сценарий можно выполнять неоднократно. По мере выполнения этот сценарий выводит имя файла изображения, в котором оно хранится на локальном компьютере; Например, ниже показано, какие результаты получены после того, как в вызове этого сценария был задан адрес http://cckomplect.ru.

% mirror_images.pl http://cckomplect.ru
m5v2.gif: OK
messengerpromo.gif: OK
sm.gif: OK

После выполнения этого сценария второй раз без перерыва были получены три сообщения “Not Modified”.

#!/usг/local/bin/реrl -w
# Файл: mirror_images.pl
use strict;
use LWP;
use Promptutil;
use HTTP::Cookies;
use HTML::Parser;
use URI;
use vars '@ISA';
@ISA = 'LWP::UserAgent';
my $agent = __PACKAGE__ ->new;
$agent->cookie__jar (HTTP::Cookies->new('file=>$ENV{HOME} /lwp-cookies', autosave=>l);
while (my $url = shift) {
my $request = HTTP: :Request->new (GET => $url) ;
my $parser = HTML::Parser->new(api_version => 3); $parser->handler(start => &start,self,tagname,attr);
my $response = $agent->request($request,
sub {
my ($data,$response,$protocol) =_@ ;
die "Not an HTML fi.len"
unless $response->content_type eq 'text/html';
$parser->{base} | |= $response->base;
$parser->{agent} | |= $agent;
$parser->parse($data);
});
warn "$url: ",$response->header('X-Died'),"n"
if $respdnse->header('X-Died'); warn "$url: ", $response->message,"n"
if !$respbrise->is success;
}
sub start {
my ($parser,$tag,$attr) = @_;
return unless $tag eq 'img';
return unless my $url = $attr->{src};
my $remote_name =URI->new_abs($url,$parser->{base});
my ($local_name) = $url =~ m! ([^/]+)$!;
my $response = $parser-> {agent} ->mirror ($remote_name, $local_name);
print STDERR ,$local_name: ", $response->message;
}
sub get_basic_credentials {
my ($self, $ realm, $uri) = _@;
print STDERR "Enter username and password for realm "$realm".n";
print STDERR "username: ";
chomp (my $name = <>) ; return unless $name; my $passwd = get_passwd ();
return ($name,$passwd);

Строки 1-15. Загрузка модулей, создание объекта агента пользователя, создание объекта запроса и объекта синтаксического анализатора.

Строки 16-24. Выдача запроса. Вызывается метод request () объекта агента пользователя, что приводит к созданию объекта ответа. Как и в последнем примере, в качестве второго параметра вызова метода request () передается ссылка на код, поэтому объект агента пользователя передает входящие данные этой подпрограмме по мере их поступления.

В этом случае ссылка на код представляет собой анонимную подпрограмму. Вначале происходит проверка того, имеет ли объект ответа тип MIME text/html. Если это не так, вызывается функция die с сообщением об ошибке. Это не приводит к аварийному завершению всего сценария в целом, но вызывает аварийное прекращение обработки текущего URL и запись сообщения об ошибке в специальное поле заголовка ответа x-Died:.

В ином случае входящий документ может быть подвергнут синтаксическому анализу как файл HTML. Обработчику для этого необходимо два фрагмента дополнительной информации: базовый URL текущего объекта ответа для преобразования относительных URL в абсолютные и объект агента пользователя, с помощью которого можно будет выдавать запросы на получение встроенных изображений. Применяется тот же метод, что и в листинге ранее, и эта информация записывается в стек с использованием ссылки на хеш синтаксического анализатора.

Строки 25-27. Предупреждение об аварийных ситуациях. После завершения обработки запроса вызывается объект ответа для проверки наличия поля заголовка x-Died: и, если оно имеется, выдается предупреждающее сообщение. Аналогичным образом выводится сообщение с кодом состояния ответа, если метод is_success () возвращает ложное значение.

2014-04-24 11:50:43

предыдущая часть ««

»» следующая часть