В статье речь пойдёт об использовании модулей LWP и HTML::Tree, причём сделано это будет на реальном примере.
В данный момент скрипт выполняет следующее: при запросе - "смотрит в свой кэш" и в случае, если ничего там не находит, то производит скачивание нужной страницы с Озона, парсинг её и складирование в кэш + вывод броузеру... Естественно, при парсинге меняются некоторые ссылки, в частности ссылки перехода на следующую страницу результатов поиска и т.д.
Итак, давайте приступим к разбору кода:
#!/usr/bin/perl
use strict;
# далее грузим модули, которые нам понадобятся
use LWP;
use CGI;
use CGI::Carp qw(fatalsToBrowser);
use HTML::TreeBuilder;
use Lingua::DetectCharset;
use Convert::Cyrillic;
use URI::Escape;
my $flock_allow=1; # рарешать ли блокировку файлов
my $mainhost='http://perl.dp.ua'; # Ваш хост...
my $books_cache_dir = 'dir_for_cache'; # директория, в которой будут хранится кэшированные файлы
my $coi = new CGI;
print $coi->header(); # выводим заголовки
if(!(-d "./$books_cache_dir")){ # проверяем существование директории для кэш-файлов
system("/bin/mkdir", "-m", "0777", "$books_cache_dir"); #Unix
system("mkdir", "$books_cache_dir"); #Windows
}
my $phrase= uri_escape($coi->param('text')); # получаем запрос, по которому ведётся поиск, переводим всё в escape последовательности
$phrase = 'perl' unless $phrase or $coi->param('path'); # по умолчанию - запрос 'perl', остальное - для совметимости со старой версией скрипта,поисковики о ней ещё помнят :)
my $path;
my $page_num;
if($coi->param('page')){ # определяем номер текущей страницы для отображения( в Озоне, если количество книг > 20, то происходит разбивка книг по 20 на страницу)
$page_num = int($coi->param('page'));
$page_num = 0 if $page_num<0;
}
if($page_num){ # вычисляем, какую страницу на нужно качать
$path = 'http://www.ozon.ru/?context=advsearch_book&partner=d392&title='.$phrase.'&page='.$page_num;
}
else{
unless($coi->param('path')){
$path = 'http://www.ozon.ru/?context=advsearch_book&partner=d392&title='.$phrase;
}
else{
my $add_path = uri_unescape($coi->param('path'));
$path = 'http://www.ozon.ru'.$add_path."&partner=d392";
if($add_path =~m /title=(.*)&/i){$phrase=$1;}
}
}
open(cache_list,"$books_cache_dir/list.cache"); # "смотрим на текущее состояние кэша"
if ($flock_allow){lockfile('cache_list');} # если разрешено блокирование файла, то блокируем
my @cache=<cache_list>; #cause the number of searches is small
if ($flock_allow){unlockfile('cache_list');} # соответственно - разблокируем
close(cache_list);
my $cache_time = 604800; # делаем время обновление кэша равным 1-ой неделе
my $page = undef;
for(my $i=0; $i<=$#cache; $i++){ # перебераем кэш и пытаемся найти нужный файл
my $line=$cache[$i];
chomp $line;
my @temp_cache= split /%unreal_delimiter%/, $line; # разбираем потихоньку информацию
if(($temp_cache[1] eq $path)and((int(time())-int($temp_cache[0]))<$cache_time)){ # в случае, если кэш - не старый, то берём его и далее работаем с ним
open(cache, '$books_cache_dir/'.$temp_cache[0].'.cache');
if ($flock_allow){lockfile('cache');}
undef $/;
$page=<cache>;
$/="\n";
if ($flock_allow){unlockfile('cache');}
close(cache);
last;
}
elsif($temp_cache[1] eq $path){ # в противном случае обновляем этот кэш
my $browser = LWP::UserAgent->new(); # Качаем страницу
my $response = $browser->get($path,
'User-Agent' => 'Mozilla/4.76 [en] (Win98; U)',
'Accept' => 'image/gif, image/x-xbitmap, image/jpeg, image/pjpeg, image/png, */*',
'Accept-Charset' => 'iso-8859-1,*,utf-8',
'Accept-Language' => 'en-US',
); # Прикидываемся броузером
$page = razbor($response->content, $phrase); # razbor - это функция парсинга страницы с Озона, см. ниже
while (-e '$books_cache_dir/'.time().'.cache') { sleep(2); } #в случае, если файл существует(два пользовтеля одновременно запросили обновление или добавление), то немного "спим"
my $temp_time = time();
open(cache, ">$books_cache_dir/".$temp_time.'.cache'); # сохраняем информацию в файл
if ($flock_allow){lockfile('cache');}
print cache $page;
if ($flock_allow){unlockfile('cache');}
close(cache);
$cache[$i] = join('%unreal_delimiter%',$temp_time,$path, $coi->param('text'))."\n"; unlink($books_cache_dir.'/'.$temp_cache[0].'.cache'); # обновляем информацию, удаляем старый кэш
open(cache_list,">$books_cache_dir/list.cache"); # сохраняем список сохранённых страниц
if ($flock_allow){lockfile('cache_list');}
foreach my $string(@cache){
print cache_list $string;
}
if ($flock_allow){unlockfile('cache_list');}
close(cache_list);
last;
}
}
unless($page){ # производим новое добавление страницы, которая ранее известна скрипту не была
# Очень всё похоже на вышеописанный процесс обновления кэша, поэтому комментарии здесь излишни
my $browser = LWP::UserAgent->new();
my $response = $browser->get($path,
'User-Agent' => 'Mozilla/4.76 [en] (Win98; U)',
'Accept' => 'image/gif, image/x-xbitmap, image/jpeg, image/pjpeg, image/png, */*',
'Accept-Charset' => 'iso-8859-1,*,utf-8',
'Accept-Language' => 'en-US',
);
$page = razbor($response->content, $phrase);
while (-e '$books_cache_dir/'.time().'.cache') { sleep(2); }
my $temp_time = time();
open(cache, ">$books_cache_dir/".$temp_time.'.cache');
if ($flock_allow){lockfile('cache');}
print cache $page;
if ($flock_allow){unlockfile('cache');}
close(cache);
my $new_cache_string = join('%unreal_delimiter%',$temp_time,$path)."\n";
open(cache_list,">>$books_cache_dir/list.cache");
if ($flock_allow){lockfile('cache_list');}
print cache_list $new_cache_string;
if ($flock_allow){unlockfile('cache_list');}
close(cache_list);
}
$phrase = uri_unescape($phrase); # преобразуем escape-последовательности к нормальному виду
print "<center><form style='margin: 0.1px' action='book.cgi' method=post><font size=\"2\" face=\"Arial, Helvetica, sans-serif\"><strong>Искать по названию:</strong></font> <input type=text name=text value='$phrase' size=30><input type=submit value='Искать'></form><br>";
print $page;
sub razbor(@_){ # функция разбора информации
my @arr = @_;
my $page = $arr[0]; # получаем содержимое Озоновской страницы
my $charset = Lingua::DetectCharset::Detect ($page); # определяем кодировку документа, у Озона она win-1251, но делается это на всякий случай, а вдруг они перейдут на Кои-8 или данные попадают скрипту через какой-нибудь кэш-сервер, который перекодирует документы
$page = Convert::Cyrillic::cstocs ($charset, 'win', $page); # преобразуем в кодировку win-1251
my $root = HTML::TreeBuilder->new_from_content($page); # создаём объект HTML::TreeBuilder на основании содержания страницы
my $text_string2;
foreach my $table ($root->look_down(_tag => 'td')){ # ищем столбцы в таблицах и убираем ненужную информацию
my $table_html = $table->as_HTML("<>%");
if($table_html =~ m%Результаты поиска%ig){
$text_string2 = $table_html;
}
}
undef $root;
$root = HTML::TreeBuilder->new_from_content($text_string2); # пересоздаём объект на основании исправленных данных
my $basic_html = $root->as_HTML("<>%");
$basic_html =~ s/#6699cc/#38549C/g; # изменение цвета верхней полосы
$basic_html =~ s/#336699/#38549C/g; # изменение цвета верхней полосы
$basic_html =~ s/bgcolor="#ffffff"/bgcolor="#F4f4f4"/g; # изменение цвета фона текущей страницы(в ссылках)
$basic_html =~ s/bgcolor="White"/bgcolor="#F4f4f4"/ig; # изменение цвета фона страницы
$basic_html =~ s%<small class="micro">Книгопечатная продукция</small><br>%%ig; # убираем лишнюю информацию
$basic_html =~ s%<big class="BIG2">Результаты поиска</big><br><b><small>Найдено (\d+)</small></b>%%i;
$basic_html =~ s%style="padding-top:12;"%%i;
undef $root;
$root = HTML::TreeBuilder->new_from_content($basic_html);
foreach my $a ($root->look_down(_tag => 'a')){ # измененяем ссылки в документе на те, что нам нужно: в случае ссылки на другую страницу - изменяем эту ссылку на ссылку на скрипт; в случае ссылки на книгу подставляем партнёрский идентификатор
if($a->attr('href')=~ m/page=(\d+)/){$a->attr('href','http://perl.dp.ua/cgi-bin/book.cgi?text='.$arr[1].'&page='.$1);}
else{$a->attr('href','http://ozon.ru'.$a->attr('href')."?partner=d392");$a->attr('target','_new_'.int(100000*rand()));}
}
$root->pos(undef);
foreach my $img ($root->look_down(_tag => 'img')){ # правим адреса картинок
my $temp = $img->attr('src');
$temp =~ s%//%/%ig;
$img->attr('src','http://ozon.ru'.$temp);
}
$root->pos(undef);
foreach my $td ($root->look_down(_tag => 'td', class => 'salecol')){ # убираем ненужную информацию
if($td->as_HTML("<>%") =~ m%buy%){
$td->replace_with(' ');
}
}
$root->pos(undef);
foreach my $td($root->look_down(_tag => 'table', cellspacing => '1')){
if($td->as_HTML("<>%") =~ m%<small style="color:FFFFFF"><b>(.*)</b>%){
$td->replace_with(' ');
}
}
foreach my $td($root->look_down(_tag => 'table', cellpadding => '3')){
if($td->as_HTML("<>%") =~ m%<td class="paddleft"><small style="color:FFFFFF"><b>(.*)</b></small>%){
$td->replace_with(' ');
}
}
$text_string2 = $root->as_HTML("<>%"); # выводим получившуюся изменённую страницу. Если не указать параметров "<>%"- то для русского языка будут проблемы в том, что документ будет непонятно в какой кодировке(по крайне мере в этой версии HTML::Tree), хотя для английского языка будет всё ок, хотя автор модуля рекомендует использовать именно так этот метод для совместимости со старыми версиями модуля.
return $text_string2;
}
sub lockfile # функция блокировки файла
{
my $handle=shift;
my $count = 0;
until (flock($handle,2)){
sleep . 10;
if(++$count > 50){
print "<center><h1><font color=red>Sorry, Server is too busy. Please visit later.</font></h1></center>";
exit;
}
}
}
sub unlockfile # функция разблокировки файла
{
my $handle=shift;
flock($handle,8);
}
Итак, вроде с кодом разобрались и нужно отметить, что этот скрипт, кроме его достоинста в том, что он работает и то, что использован как учебный материал, имеет несколько недостатков,.. например то, что, наверное, стоило бы объединить добавление новой страницы и обновление старой в одну функцию, ведь эти две "процедуры" - очень похожи... не очень хорошие игры с пересозданием объектов в функцие "разбора" информации. Также к недостаткам можно отнестито, что сейчас Озон предоставляет доступ к своей базе при помощи XML, и это должно ускорить и упростить работу с Озоном при помощи подобных(отдалённо) скриптов. Но в целом, скрипт должен быть полезным для начала работы с парсингом html(xml) файлов.