Perl - статьи

         

использования модулей 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='http://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")){ # проверяем существование директории для кэш-файлов


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>&nbsp;<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','http://perl.dp.ua/cgi-bin/book.cgi?text='.$arr[1].'&page='.$1);}

142      else{$a->attr('href','http://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','http://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('&nbsp;');


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('&nbsp;');

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('&nbsp;');

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, и это должно ускорить и упростить работу с Озоном при помощи подобных(отдалённо) скриптов. Остальные баги и недостатки Вы можете обсудить на
Но в целом, скрипт должен быть полезным для начала работы с парсингом html(xml) файлов.

Также, эта статья доступна по адресу:
С уважением,

Дмитрий Николаев

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







Forekc.ru
Рефераты, дипломы, курсовые, выпускные и квалификационные работы, диссертации, учебники, учебные пособия, лекции, методические пособия и рекомендации, программы и курсы обучения, публикации из профильных изданий