Создание индекса для сайта

Вы, может, знаете, что HTML разрешает вставлять META-тэги в заголовок документа. Тогда вы, я просто уверен, знаете для чего они нужны. Кто не в курсе – кратенько поясню: Существуют поисковые сервера, которые ползают по зарегистрировавшимся в их базе сайтах и индексируют странички. При этом они обращают пристальное внимание на МЕТА-тэги, а особенно на keywords и description («ключевые слова» и «описание»).

Синтаксис этих двух МЕТА-тэгов выглядит так:

<meta name=description content="CGI&Perl – Документация  и скрипты">
<meta name=keywords content="perl cgi documentation scripts скрипты документация перл">

Ну а теперь непосредственно о скрипте. Скрипт осматривает все странички сайта на предмет meta description и meta keywords и составляет итоговую таблицу – индекс, или предметный указатель.

Строки 1-3: Обычное начало программы.
5-26: Часть скрипта, которую нужно сконфигурировать под свои нужды.
7: Список URLов, которые необходимо проиндексировать. Но если все страницы сайта связаны гиперссылками – то необходима лишь один URL.

9-24: Определение процедуры OK_TO_FOLLOW. Принимает URI-объект (http), возвращает единицу, если эту ссылку надо сканировать и нуль, если не надо.
11-13: Необходимо, чтобы скрипт не выходил за пределы сайта.
14-16: Не нужно также запускать никакие CGI-скрипты
17-22: Убираем из процесса индексации картинки и другие не-HTML файлы.
Отметьте небольшую хитрость: цикл for здесь вовсе не цикл, он нужен лишь для того, чтобы переменная $_ равнялась тому, что внутри скобок for ()
23: Передано то, что необходимо проиндексировать – вернем единицу.

28-31: Подключаем модули: CGI::Pretty – стандартный, LWP::UserAgent, HTML:Entities, WWW::Robot – входят в библиотеку LWP.
33-35: Определение глобальных переменных. %description – хэш, ключами которого являются URLы, а значениями – описания (meta description). %keywords – URL- >ключевые слова (keywords). %keywords_caps содержит регистр (верхний или нижний) написания ключевого слова.
37-45: Настройки индексатора. За подробностями обратитесь к документации по WWW::Robot. Здесь же устанавливаем, что индексатор идентифицирует себя как MetaBot, версии 0.15, ну и e-mail адрес. USERAGENT - будет LWP::UserAgent, отключена проверка MIME-типов.
47: Включает проверку конфигурации прокси-сервера, вобщем-то это и не нужно. 49-54: Одна из двух callback-функций, которую вызывает WWW::Robot. Как только найден URL, вызывается follow-url-test callback. Здесь вызываем функцию OK_TO_FOLLOW, чтобы отсеять лишнее.
55-76: Вытаскиваем информацию с каждой странички.
58-61: Нам нужны только keywords и description
63-67: Сохраним описание, предварительно очистив его от переносов строк и символов табуляции, заменив их на пробелы.
68-75: Запомним ключевые слова и их регистр. В данном скрипте предполагается, что слова разделены запятыми. Можно разделителями сделать пробелы, заменив split(/,/,... на split (/ /, ... Или и пробелы и запятые – split (/[, ]/,...
77: Запуск индексации. Для большого сайта займет довольно длительное время.

В строке 81 содержится оператор print, который продолжается до конца скрипта и выводит таблицу-индекс.
79: хэш %seen_letter нужен для того чтобы вверху странички выдать ссылки в виде букв алфавита, например: «Jump to: A B K L P R S W Z»
Для каждого ключевого слова выдается ссылка на документ, где оно встречается и описание из этого документа (3 колонки в таблице).
Вот и все.

Листинг:

        =1=     #!/usr/bin/perl -w
        =2=     use strict;
        =3=     $|++;
        =4=     
        =5=     ## config
        =6=     
        =7=     my @URL = qw(http://www.stonehenge.Xcom/);
        =8=     
        =9=     sub OK_TO_FOLLOW {
        =10=      my $uri = shift; # URI object, known to be http only
        =11=      for ($uri->host) {
        =12=        return 0 unless /.stonehenge.Xcom$/i;
        =13=      }
        =14=      for ($uri->query) {
        =15=        return 0 if defined $_ and length;
        =16=      }
        =17=      for ($uri->path) {
        =18=        return 0 if /^/(cgi|fors|-)/;
        =19=        return 0 if /coldd|index/;
        =20=        return 0 if /Pictures/;
        =21=        return 0 unless /(.html?|/)$/;
        =22=      }
        =23=      return 1;
        =24=    }
        =25=    
        =26=    ## end config
        =27=    
        =28=    use WWW::Robot;
        =29=    use LWP::UserAgent;
        =30=    use CGI::Pretty qw(-no_debug :html);
        =31=    use HTML::Entities;
        =32=    
        =33=    my %description;
        =34=    my %keywords;
        =35=    my %keyword_caps;
        =36=    
        =37=    my $robot = WWW::Robot->new
        =38=      (
        =39=       NAME => 'MetaBot',
        =40=       VERSION => '0.15',
        =41=       EMAIL => 'merlyn@stonehenge.Xcom',
        =42=       USERAGENT => LWP::UserAgent->new,
        =43=       CHECK_MIME_TYPES => 0,
        =44=       ## VERBOSE => 1,
        =45=       );
        =46=    
        =47=    $robot->env_proxy;
        =48=    
        =49=    $robot->addHook
        =50=      ("follow-url-test" => sub {
        =51=         my ($robot, $hook, $url) = @_;
        =52=         return 0 unless $url->scheme eq 'http';
        =53=         OK_TO_FOLLOW($url);
        =54=       });
        =55=    $robot->addHook
        =56=      ("invoke-on-contents" => sub {
        =57=         my ($robot, $hook, $url, $response, $structure) = @_;
        =58=         my %meta = map {
        =59=           my $header = $response->header("X-Meta-$_");
        =60=           defined $header ? ($_, $header) : ();
        =61=         } qw(Description Keywords);
        =62=         return unless %meta;
        =63=         if (exists $meta{Description}) {
        =64=           $_ = $meta{Description};
        =65=           tr/ tn/ /s;
        =66=           $description{$url} = $_;
        =67=         }
        =68=         if (exists $meta{Keywords}) {
        =69=           for (split /,/, $meta{Keywords}) {
        =70=             s/^s+//;
        =71=             s/s+$//;
        =72=             $keywords{lc $_}{$url}++;
        =73=             $keyword_caps{lc $_} = $_;
        =74=           }
        =75=         }
        =76=       });
        =77=    $robot->run(@URL);
        =78=    
        =79=    my %seen_letter;
        =80=    
        =81=    print
        =82=      table({ Cellspacing => 0, Cellpadding => 10, Border => 2 },
        =83=            do {
        =84=              my %letters;
        =85=              @letters{map /^([a-z])/, keys %keywords} = ();
        =86=              %letters ? 
        =87=                Tr(td({Colspan => 3},
        =88=                      p("Jump to:",
        =89=                        map a({Href => "#index_$_"}, uc $_), sort keys %letters)))
        =90=                  : 0;
        =91=            },
        =92=            map {
        =93=              my $key = $_;
        =94=              my @value =
        =95=                map {
        =96=                  my $url = $_;
        =97=                  my $text = exists $description{$url} ?
        =98=                    $description{$url} : "(no description provided)";
        =99=    
        =100=                 [a({Href => encode_entities($url)}, encode_entities($url)),
        =101=                  encode_entities($text),
        =102=                 ];
        =103=               } sort keys %{$keywords{$key}};
        =104=             my $key_text = $keyword_caps{$key};
        =105=             if ($key =~ /^([a-z])/ and not $seen_letter{$1}++ ) {
        =106=               $key_text = a({ Name => "index_$1" }, $key_text);
        =107=             }
        =108=   
        =109=             map {
        =110=               Tr(($_ > 0 ? () : td({Rowspan => scalar @value}, $key_text)),
        =111=                  td($value[$_]));
        =112=               } 0..$#value;
        =113=           } sort keys %keywords
        =114=          );

Михаил Анисимов