Пример работы с LWP и HTML::Tree
В статье речь пойдёт об использовании
модулей LWP и HTML::Tree, причём сделано это будет на реальном примере, работу
которого Вы можете посмотреть здесь:
//perl.dp.ua/cgi-bin/book.cgi.
Сама
идея написать скриптик //perl.dp.ua/cgi-bin/book.cgi -
возникла после того, как встал вопрос о том, что раздел "книги" сайта //perl.dp.ua -
надоело дополнять/редактировать и т.д. вручную. Захотелось это дело автоматизировать,
сделать поиск и т.д. Первая идея, которая возникла, - это было создание мини
интернет-магазина, куда вносились бы книги и т.д. Но, это опять таки требовало
присутствия человека. И тогда, я подумал, а почему бы не сделать скриптик, который
бы скачивал нужную страницу с Озона, парсил бы её, как мне надо, и передавал
бы броузеру. Методом решения стали модули(пакеты модулей :)) LWP и HTML::Tree.
В данный момент скрипт выполняет следующее: при запросе - "смотрит
в свой кэш" и в случае, если ничего там не находит, то производит скачивание
нужной страницы с Озона, парсинг её и складирование в кэш + вывод броузеру...
Естественно, при парсинге меняются некоторые ссылки, в частности ссылки перехода
на следующую страницу результатов поиска и т.д.
Итак, давайте приступим к разбору кода:
1 #!/usr/bin/perl
2 use strict;
# далее грузим модули, которые нам понадобятся
3 use LWP;
4 use CGI;
5 use CGI::Carp qw(fatalsToBrowser);
6 use HTML::TreeBuilder;
7 use Lingua::DetectCharset;
8 use Convert::Cyrillic;
9 use URI::Escape;
10 my $flock_allow=1; # рарешать
ли блокировку файлов
11 my $mainhost='//perl.dp.ua'; #
Ваш хост...
12 my $books_cache_dir = 'dir_for_cache'; #
директория, в которой будут хранится кэшированные файлы
13 my $coi = new CGI;
14 print $coi->header(); #
выводим заголовки
15 if(!(-d "./$books_cache_dir")){ #
проверяем существование директории для кэш-файлов
16 system("/bin/mkdir", "-m", "0777", "$books_cache_dir");
#Unix
17 system("mkdir", "$books_cache_dir"); #Windows
18 }
19 my $phrase= uri_escape($coi->param('text')); #
получаем запрос, по которому ведётся поиск, переводим всё в escape последовательности
20 $phrase = 'perl' unless $phrase or $coi->param('path'); #
по умолчанию - запрос 'perl', остальное - для совметимости со старой версией
скрипта,поисковики о ней ещё помнят :)
21 my $path;
22 my $page_num;
23 if($coi->param('page')){ #
определяем номер текущей страницы для отображения( в Озоне, если количество
книг > 20,
то происходит разбивка книг по 20 на страницу)
24 $page_num = int($coi->param('page'));
25 $page_num = 0 if $page_num<0;
26 }
27 if($page_num){ # вычисляем, какую страницу на
нужно качать
28 $path = '//www.ozon.ru/?context=advsearch_book&partner=d392&title='.$phrase.'&page='.$page_num;
29 }
30 else{
31 unless($coi->param('path')){
32 $path = '//www.ozon.ru/?context=advsearch_book&partner=d392&title='.$phrase;
33 }
34 else{
35 my $add_path = uri_unescape($coi->param('path'));
36 $path = '//www.ozon.ru'.$add_path."&partner=d392";
37 if($add_path =~m /title=(.*)&/i){$phrase=$1;}
38 }
39 }
40 open(cache_list,"$books_cache_dir/list.cache"); #
"смотрим на текущее состояние кэша"
41 if ($flock_allow){lockfile('cache_list');} #
если разрешено блокирование файла, то блокируем
42 my @cache=<cache_list>; #cause the number of searches is
small
43 if ($flock_allow){unlockfile('cache_list');} #
соответственно - разблокируем
44 close(cache_list);
46 my $cache_time = 604800; #
делаем время обновление кэша равным 1-ой неделе
47 my $page = undef;
48 for(my $i=0; $i<=$#cache; $i++){ #
перебераем кэш и пытаемся найти нужный файл
49 my $line=$cache[$i];
50 chomp $line;
51 my @temp_cache= split /%unreal_delimiter%/, $line; #
разбираем потихоньку информацию
52 if(($temp_cache[1] eq $path)and((int(time())-int($temp_cache[0]))<$cache_time)){ #
в случае, если кэш - не старый, то берём его и далее работаем с ним
53 open(cache, '$books_cache_dir/'.$temp_cache[0].'.cache');
54 if ($flock_allow){lockfile('cache');}
55 undef $/;
56 $page=<cache>;
57 $/="\n";
58 if ($flock_allow){unlockfile('cache');}
59 close(cache);
60 last;
61 }
62 elsif($temp_cache[1] eq $path){ #
в противном случае обновляем этот кэш
63 my $browser = LWP::UserAgent->new(); #
Качаем страницу
64 my $response = $browser->get($path,
65 'User-Agent' => 'Mozilla/4.76
[en] (Win98; U)',
66 'Accept' => 'image/gif,
image/x-xbitmap, image/jpeg, image/pjpeg,
image/png, */*',
67 'Accept-Charset' => 'iso-8859-1,*,utf-8',
68 'Accept-Language' => 'en-US',
69 ); # Прикидываемся
броузером
70 $page = razbor($response->content, $phrase); #
razbor - это функция парсинга страницы с Озона, см. ниже
71 while (-e '$books_cache_dir/'.time().'.cache') {
sleep(2); } #в
случае, если файл существует(два пользовтеля одновременно запросили обновление
или добавление), то немного "спим"
72 my $temp_time = time();
73 open(cache, ">$books_cache_dir/".$temp_time.'.cache'); #
сохраняем информацию в файл
74 if ($flock_allow){lockfile('cache');}
75 print cache $page;
76 if ($flock_allow){unlockfile('cache');}
77 close(cache);
78 $cache[$i] = join('%unreal_delimiter%',$temp_time,$path,
$coi->param('text'))."\n"; unlink($books_cache_dir.'/'.$temp_cache[0].'.cache');
# обновляем информацию, удаляем старый кэш
79 open(cache_list,">$books_cache_dir/list.cache"); #
сохраняем список сохранённых страниц
80 if ($flock_allow){lockfile('cache_list');}
81 foreach my $string(@cache){
82 print cache_list $string;
83 }
84 if ($flock_allow){unlockfile('cache_list');}
85 close(cache_list);
86 last;
87 }
88 }
89 unless($page){ # производим
новое добавление страницы, которая ранее известна скрипту не была
# Очень всё похоже на вышеописанный процесс обновления
кэша, поэтому комментарии здесь излишни
90 my $browser = LWP::UserAgent->new();
91 my $response = $browser->get($path,
92 'User-Agent' => 'Mozilla/4.76 [en]
(Win98; U)',
93 'Accept' => 'image/gif, image/x-xbitmap,
image/jpeg, image/pjpeg, image/png, */*',
94 'Accept-Charset' => 'iso-8859-1,*,utf-8',
95 'Accept-Language' => 'en-US',
96 );
97 $page = razbor($response->content,
$phrase);
98 while (-e '$books_cache_dir/'.time().'.cache')
{ sleep(2); }
99 my $temp_time = time();
100 open(cache, ">$books_cache_dir/".$temp_time.'.cache');
101 if ($flock_allow){lockfile('cache');}
102 print cache $page;
103 if ($flock_allow){unlockfile('cache');}
104 close(cache);
105 my $new_cache_string = join('%unreal_delimiter%',$temp_time,$path)."\n";
106 open(cache_list,">>$books_cache_dir/list.cache");
107 if ($flock_allow){lockfile('cache_list');}
108 print cache_list $new_cache_string;
109 if ($flock_allow){unlockfile('cache_list');}
110 close(cache_list);
111 }
112 $phrase = uri_unescape($phrase); # преобразуем
escape-последовательности к нормальному виду
113 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>";
114 print $page;
115 sub razbor(@_){ # функция
разбора информации
116 my @arr = @_;
117 my $page = $arr[0]; #
получаем содержимое Озоновской страницы
118 my $charset = Lingua::DetectCharset::Detect
($page); #
определяем кодировку документа, у Озона она win-1251, но делается это на всякий
случай, а вдруг они перейдут на Кои-8 или данные попадают скрипту через какой-нибудь
кэш-сервер, который перекодирует документы
119 $page = Convert::Cyrillic::cstocs ($charset,
'win', $page); #
преобразуем в кодировку win-1251
120 my $root = HTML::TreeBuilder->new_from_content($page); #
создаём объект HTML::TreeBuilder на основании содержания страницы
121 my $text_string2;
122 foreach my $table ($root->look_down(_tag
=> 'td')){ #
ищем столбцы в таблицах и убираем ненужную информацию
123 my $table_html = $table->as_HTML("<>%");
124 if($table_html =~ m%Результаты поиска%ig){
125 $text_string2 = $table_html;
126 }
127 }
128 undef $root;
129 $root = HTML::TreeBuilder->new_from_content($text_string2); #
пересоздаём объект на основании исправленных данных
130 my $basic_html = $root->as_HTML("<>%");
131 $basic_html =~ s/#6699cc/#38549C/g; #
изменение цвета верхней полосы
132 $basic_html =~ s/#336699/#38549C/g; #
изменение цвета верхней полосы
133 $basic_html =~ s/bgcolor="#ffffff"/bgcolor="#F4f4f4"/g; #
изменение цвета фона текущей страницы(в ссылках)
134 $basic_html =~ s/bgcolor="White"/bgcolor="#F4f4f4"/ig; #
изменение цвета фона страницы
135 $basic_html =~ s%<small class="micro">Книгопечатная
продукция</small><br>%%ig; #
убираем лишнюю информацию
136 $basic_html =~ s%<big class="BIG2">Результаты
поиска</big><br><b><small>Найдено
(\d+)</small></b>%%i;
137 $basic_html =~ s%style="padding-top:12;"%%i;
138 undef $root;
139 $root = HTML::TreeBuilder->new_from_content($basic_html);
140 foreach my $a ($root->look_down(_tag
=> 'a')){ #
измененяем ссылки в документе на те, что нам нужно: в случае ссылки на другую
страницу - изменяем эту ссылку на ссылку на скрипт; в случае ссылки на книгу
подставляем партнёрский идентификатор
141 if($a->attr('href')=~ m/page=(\d+)/){$a->attr('href','//perl.dp.ua/cgi-bin/book.cgi?text='.$arr[1].'&page='.$1);}
142 else{$a->attr('href','//ozon.ru'.$a->attr('href')."?partner=d392");$a->attr('target','_new_'.int(100000*rand()));}
143 }
144 $root->pos(undef);
145 foreach my $img ($root->look_down(_tag
=> 'img')){ #
правим адреса картинок
146 my $temp = $img->attr('src');
147 $temp =~ s%//%/%ig;
148 $img->attr('src','//ozon.ru'.$temp);
149 }
150 $root->pos(undef);
151 foreach my $td ($root->look_down(_tag
=> 'td', class
=> 'salecol')){ # убираем ненужную информацию
152 if($td->as_HTML("<>%")
=~ m%buy%){
153 $td->replace_with(' ');
154 }
155 }
156 $root->pos(undef);
157 foreach my $td($root->look_down(_tag
=> 'table', cellspacing => '1')){
158 if($td->as_HTML("<>%")
=~ m%<small style="color:FFFFFF"><b>(.*)</b>%){
159 $td->replace_with(' ');
160 }
161 }
162 foreach my $td($root->look_down(_tag
=> 'table', cellpadding => '3')){
163 if($td->as_HTML("<>%")
=~ m%<td class="paddleft"><small
style="color:FFFFFF"><b>(.*)</b></small>%){
164 $td->replace_with(' ');
165 }
166 }
167 $text_string2 = $root->as_HTML("<>%"); #
выводим получившуюся изменённую страницу. Если не указать параметров "<>%"-
то для русского языка будут проблемы в том, что документ будет непонятно
в какой кодировке(по крайне мере в этой версии HTML::Tree), хотя для английского
языка будет всё ок, хотя автор модуля рекомендует использовать именно так
этот метод для совместимости со старыми версиями модуля.
168 return $text_string2;
169 }
170 sub lockfile # функция
блокировки файла
171 {
172 my $handle=shift;
173 my $count = 0;
174 until (flock($handle,2)){
175 sleep . 10;
176 if(++$count > 50){
177 print "<center><h1><font
color=red>Sorry, Server is
too busy. Please visit later.</font></h1></center>";
178 exit;
179 }
180 }
181 }
182 sub unlockfile # функция
разблокировки файла
183 {
184 my $handle=shift;
185 flock($handle,8);
186 }
Итак, вроде с кодом разобрались и нужно
отметить, что этот скрипт, кроме его достоинста в том, что он работает и то,
что использован как учебный материал, имеет несколько недостатков,.. например
то, что, наверное, стоило бы объединить добавление новой страницы и обновление
старой в одну функцию, ведь эти две "процедуры" - очень похожи... не очень
хорошие игры с пересозданием объектов в функцие "разбора" информации. Также
к недостаткам можно отнестито, что сейчас Озон предоставляет доступ к своей
базе при помощи XML, и это должно ускорить и упростить работу с Озоном при
помощи подобных(отдалённо) скриптов. Остальные баги и недостатки Вы можете
обсудить на форуме
сайта //perl.dp.ua
Но в целом, скрипт
должен быть полезным для начала работы с парсингом html(xml) файлов.
Также, эта статья доступна по адресу: //perl.dp.ua/practice/bookcgi.html
С уважением,
Дмитрий Николаев
//perl.dp.ua
| 
|| разделы::
