Создание серверных приложений на языке PERL

         

Очень простое решение для зеркала новостной ленты


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

#!/usr/bin/perl -w $/="\001"; print "content-type: text/html\n\n"; $dir="/var/www/docs/html/news/images"; $imgurl="http://www.qwerty.ru/news/images"; use LWP::Simple; use LWP::UserAgent; $page=get "http://www.astronomynow.com"; $page=~s/face="(.*?)"//igs; &getimg($page); $page=~s!/images/grafix/listdot.gif!../../listdot.gif!igs; $page=~s!/images/grafix/spacer.gif!../../spacer.gif!igs; $page=~s!images/grafix/spacer.gif!../../spacer.gif!igs; if($page=~m!<TABLE WIDTH="400" BORDER="0" CELLPADDING="0" CELLSPACING="0">(.*?)</TD></TR></TABLE>!igsm){ $file=$1; &getlink($page); foreach $names(@res){ $names=~s|.*/||ig; $file=~s|src="http://(.*?)$names"|src=$imgurl/$names|igs; } $html=qq~ <TABLE BORDER="0" CELLPADDING="0" CELLSPACING="0"> $file </TD></TR></TABLE>~; } open F, ">$dir/news.txt"; print F $html or die "\n\n\n ERROR: $!\n\n\n"; close F; sub getimg{ &getlink($_[0]); foreach $img(@res){ my $res = LWP::UserAgent->new->request(new HTTP::Request GET => $img); if ($res->is_success) { $img=~s|.*/||; open (ABC, ">$dir/$img") or die "\n\n\nERROR: $!\n\n\n"; binmode(ABC); print ABC $res->content; close ABC or die "\n\n\nERROR: $!\n\n\n"; } else { print $res->status_line; } } return @res; } sub getlink{ local $_=$_[0]; push(@res, "http://$2") while m{SRC\s*=\s*(["'])http://(.*?)\1\s*(.*?)WIDTH="100" HEIGHT="100"(.*?)>}igs; return @res; }



Содержание раздела