Сегодня займемся парсингом html-страниц. Я хочу показать, как при помощи Perl можно легко и быстро разобрать страницу, найти на ней частовстречающиеся слова (посчитав их количество) и получить интересную статистику о любой странице в интернете. Кроме того, предлагаю уделить внимание словам, находящимся в тексте заголовков.
В этой статье расскажу о моем методе решения этой задачи и продемонстрирую готовый рабочий код, который разбирает страничку и выводит частовстречающиеся слова, отсортированными по количеству вхождений в текст.
Начнем с того, что мы пишем не поисковую машину. Поэтому нам не нужно определять в каком теге расположено слово. Кроме того, нам без разницы, в первых ли строках расположено слово или в последних. Нам важно лишь его наличие. Однако, заголовки будем считать отдельно и слова, входящие в заголовки будем выделять особо.
Кроме того, хотелось бы реализовать возможность грабить текст страниц прямо из сети. Для удобства. Еще было бы неплохо, если бы можно было задавать чувствительность фильтра. То есть, стоит ли выводить слова, встречающиеся в тексте по одному разу? А по два? Для разных случаев ответ может быть разным. Поэтому, пусть это можно будет задавать извне.
Для начала, нужно определиться как и что мы будем делать. В тонкости вдаваться не буду — по ходу дела разберетесь, но общий план действий все же, стоит накидать:
Теперь, когда стратегия битвы наметана, можно приступать к разбору кода.
Для начала, нам потребуется модуль LWP. Он нам нужен для того, чтобы можно было взять код страницы прямо из сети. Так как мы не собираемся мудрствовать, воспользуемся LWP::Simple.
Кроме того, нужно бы сразу написать функцию, которая убирает мусор из переданного ей текста и оставляет только слова. Эта функция в любом случае нам пригодится. И, как мы увидим, не раз.
#########Удаляем html-теги, делаем текст#########
sub clearHtml
{
my $text = shift;
my $punkt = ".,—:?!;'\""; #"Задаем список знаков пунктуации
my $count = $$text =~ s/<.+?>//gs; #Удаляем теги
my $ent = $$text =~ s/&\w{3,5};//g; #Удаляем html-сущности типа
my $pu = $$text =~ s/[$punkt]/ /g; #Заменяем знаки препинания на пробелы
}
Эта функция удаляет все html-теги и сущности, а так же, заменяет все знаки препинания на пробелы. Она принимает ссылку на большой текст и работает с ним через нее. То есть, если мы скажем clearHtml(\$text), изменения произойдут прямо в тексте, клон создаваться не будет. Это экономит память.
После того, как мы получили код страницы, самое время посчитать слова в заголовках (пока еще html-разметка жива). Сделать это я предлагаю по простому алгоритму, согласно которому, мы будем проходить по всему тексту, разыскивая все, что похоже на заголовок и разбирая его содержимое. Слова из заголовков будем держать в хеше, чтобы было удобно их считать и обращаться к ним.
#########Собираем содержимое заголовков для дополнительного анализа#########
sub getHeaders
{
my $text = shift;
my @hs;
my %headers;
my @hs = grep {$_ !~ /^\d+$/} $$text =~ /(.*?)<\/h\1>/ig;
foreach (@hs)
{
clearHtml(\$_);
$headers{$_}++ foreach (split / +/, $_);
}
return %headers;
}
Немного поясню. Строка "my @hs = grep {$_ !~ /^\d+$/} $$text =~ /(.*?)<\/h\1>/ig;" делает следующее: находит в тексте заголовок и захватывает его номер (цифру от html-кодов заголовка h1, h2, h3). Эту цифру можно было бы использовать, но сейчас у нас другие цели, поэтому мы просто отбрасываем их. grep принимает массив захваченных регуляркой выражений и выбирает из них только те, которые не являются числами (могут возникнуть проблемы, если сам текст заголовка являлся числом, но кому нужны такие заголовки?). В результате, тексты заголовков скапливаются в массиве @hs.
Итак, в массиве @hs у нас тексты заголовоков. Теперь нужно вычистить из них мусор, разбить на слова и записать в хеш. Этим мы и занимаемся в цикле foreach. После того, как мы получили хеш, ключами которого являются слова, а значениями — количество вхождений этих слов в текст заголовков, мы возвращаем этот хеш.
Итак, подготовительный этап закончен. Пора уже посчитать слова во всем тексте! Сначала приведу код, потом прокомментирую.
#########Парсим текст#########
sub parse
{
my $text = shift; #Ссылка на текст
my $limit = shift;
my %words;
my @sorted;
foreach my $word (split / +/, $$text) #Гуляем по массиву слов
{
next if (length $word <= 3); #Слова из трех и менее символов не учитываем
$words{$word}{count}++; #Считаем количество вхождений слова
}
#Сортируем слова по количеству вхождений в текст
@sorted = sort {$words{$a}{count} <=> $words{$b}{count}} keys %words;
for (my $i=0; $i<=$#sorted; $i++)
{
#Если колчиество вхождений меньше лимита, то удаляем это слово из хеша
if ($words{$sorted[$i]}{count} < $limit)
{delete $words{$sorted[$i]}}
#Иначе - запоминаем позицию этого слова в отсортированном списке
else
{$words{$sorted[$i]}{id} = $i}
}
return \%words;
}
Функция parse принимает два параметра: ссылку на текст (уже очищенный от мусора) и минимальное количество вхождений слова в текст, достаточное для того, чтобы оно было учтено. Сначала мы просто считаем все слова. Затем сортируем их в порядке убывания количетва вхождений в текст. Потом мы удаляем слова, вошедшие в текст меньшее, чем мы задавали, число раз. Параллельно, мы запоминаем порядок слов в отсортированном списке для тех слов, которые прошли фильтр. Это нужно, поскольку данные о словах у нас хранятся в хеше, который является неупорядоченной структурой. Возвращает наша функция ссылку на структуру с данными о словах.
Итак, мы написали нужные функции и насатало время ими воспользоваться и собрать уже воедино наше чудо-приложение.
use CGI::Carp qw(fatalsToBrowser);
use strict;
use LWP::Simple;
print qq(Content-type: text/html\n\n);
#Счетчики времени
my $start = times;
my ($gett, $gett2, $parset, $parset2);
my $limit = 10; #Минимальное число вхождений
my $addr = 'http://localhost/learn/search/text.txt'; #Адрес страницы
my $gett = times;
my $text = get $addr; #Получаем текст страницы
my $gett2 = times;
if($text)
{
$parset = times;
$text =~ s/(?:\r?\n\r?)|\t+/ /g; #Заменяем переводы строк и табуляции на пробелы
my %headers = getHeaders(\$text); #получаем заголовки
clearHtml(\$text); #Удаляем мусор
my $words = parse(\$text, $limit); #получаем слова
#$words->{$word}{count | id} - памятка
print "<h2>Заголовки</h2>";
foreach (keys %headers)
{print "$_ -> $headers{$_}<br/>"}
print "<hr/>";
print "<h2>Текст страницы</h2>";
print "Всего слов (разных), встречающихся не менее $limit раз: ", scalar keys %$words, "<br/>";
my $counter;
foreach (keys %$words)
{$counter += $words->{$_}{count}}
print "Всего слов (с повторами): $counter <hr/>";
#Выводим все слова. Если оно встречалось в заголовке, выводим сообщение об этом
foreach my $word (sort {$words->{$b}{id} <=> $words->{$a}{id}} keys %$words)
{
print "$word — $words->{$word}{count}";
if ($headers{$word})
{print "<b>В т.ч. в заголовке $headers{$word}</b>"}
print "<br/>";
}#от foreach
}
else
{print 'Error in connect to ', $addr;}
#Если еще не заметили, мы засекали время работы некоторых частей программы. Самое время вывести эти данные
print '<hr/>';
print "Время работы: ", times-$start, "<br/>";
print "Время получения данных: ", $gett2-$gett, "<br/>";
print "Время разбора: ", ($parset2 - $parset), "<br/>";
Ну вот и все. Слова посчитаны, а статистика красиво выведена на экран. Без изысков, но информативно. Я тестировал скрипт на книге Чака Паланика "Бойцовский Клуб", которая есть у меня в html-версии. Книга весит 343кб и насчитывает 5645 строк, что не мало. Этот текст парсился в среднем около 0.5 секунды. По моему — неплохой результат.
Ну и, конечно, я даю скачать этот скрипт, кроме того, вы можете попробовать работу приложения (в силу отсутствия на хосте модуля LWP, вам придется ввести текст страницы в текстовое поле, а не указать урл страницы). Если у вас есть предложения по его оптимизации или модернизации — с радостью выслушаю их, потому что тема для меня насущная.