Библиотека Интернет Индустрии I2R.ru

Каждый, кто начинает программировать на Перле, сталкивается с аббревиатурой CPAN, что значит Comprehensive Perl Archive Network ("всеобъемлющий архив по Перлу") CPAN - прекрасный ресурс, где можно отыскать все что угодно, связанное с Перлом. В мире много зеркал CPAN, так что выбирайте то, которое вам ближе географически. Для этого сходите на ftp://ftp.funet.fi/pub/languages/perl/CPAN/CPAN, где есть список всех зеркал.

Немного об организации архива. Каждое зеркало центрального сервера содержит файл CPAN/Roadmap или CPAN/Roadmap.html, а также CPAN/modules/Readme, где есть описания всех содержащихся модулей. Вы скажете - Зачем нам эти модули? Мы и сами можем написать... Ну если так - то пожалуйста, пишите сами. А те, кто желает сэкономить время и силы, зайдите на CPAN и найдите для себя уже готовый модуль.

Не так давно передо мной стала задача - сделать что-то наподобие news-reader'а прямо на веб-странице. То есть: при обращении к серверу пользователь получает список сообщений в группе новостей (конференции) в виде ссылок на сами сообщения. Щелкнув по ссылки пользователь сможет поглядеть картинку, содержащуюся в сообщении. Доступ к конференции осуществляется по протоколу NNTP.

Мне нужен был CGI, NNTP и base64 для декодирования картинок внутри сообщений. Для обеспечения CGI-интерфейса был взят модуль CGI.pm (CPAN/authors/id/LDS/CGI.pm-2.13.tar.gz). Для того, чтобы общаться с news-сервером по NNTP протоколу я нашел NNTPClient все там же на CPAN - CPAN/authors/id/RVA/NNTPClient-0.22.pm.gz. Ну и последний компонент - base64 декодировщик я нашел в модуле LWP (MIME:Base64) (CPAN/authors/id/LDS/CGI-modules-2.74.tar.gz.)

Использование библиотек, написанных не мной самим позволило отвлечься от низкоуровневых задач, и сконцентрироваться на самом высоком уровне функционирования скрипта. Да и время сэкономило немало.

Вот такой скрипт получился в результате:

Скрипт 1

        =1=     #!/usr/bin/perl
        =2=     
        =3=     use CGI;                        # must be version 2 or higher
        =4=     use News::NNTPClient;
        =5=     use MIME::Base64;
        =6=     
        =7=     $nntpserver = "news.teleport.com"; # location of news server
        =8=     
        =9=     ## because of the copyright nature of this material, you should
        =10=    ## put this script in a directory that has an appropriate htaccess file.
        =11=    
        =12=    @groups = (
        =13=               ["clari.living.comics.bizarro", "Bizarro"],
        =14=               ["clari.living.comics.cafe_angst","Cafe Angst"],
        =15=               ["clari.living.comics.doonesbury","Doonesbury"],
        =16=               ["clari.living.comics.forbetter","For Better or For Worse"],
        =17=               ["clari.living.comics.foxtrot","Foxtrot"],
        =18=               ["clari.living.comics.ozone_patrol","Ozone Patrol"],
        =19=               ["clari.editorial.cartoons.toles","Toles"],
        =20=               ["clari.editorial.cartoons.worldviews","Worldviews"],
        =21=               ["clari.news.photos","News photos (not a comic, but handy)"],
        =22=               );
        =23=    
        =24=    $Q = new CGI;
        =25=    $Qself = $Q->self_url;
        =26=    
        =27=    unless ($group = $Q->param('group')) { # nothing at all, give index
        =28=        $links = join "\n",
        =29=        map { "<p><a href=\"$Qself?group=$_->[0]\">$_->[1]</a>" } @groups;
        =30=    
        =31=        print <<"GROK"; q/"/;
        =32=    @
        =33=    @
        =34=    <h1>Read the Comics</h1>
        =35=    <p>Select the group you want to read:
        =36=    <HR>
        =37=    $links
        =38=    <HR>
        =39=    <p>Please respect the copyrights and license agreements of this service.
        =40=    @
        =41=    GROK
        =42=    q/"/;
        =43=        exit 0;
        =44=    }
        =45=    
        =46=    unless ($article = $Q->param('article')) { # group but no art, give group
        =47=        $N = new News::NNTPClient($nntpserver,119,0);
        =48=        for ($N->xover($N->group($group))) {
        =49=            ($numb,$subj) = split /\t/;
        =50=            $links .= "<p><a href=\"$Qself&article=$numb\">$subj</a>\n";
        =51=        }
        =52=        
        =53=        print <<"GROK"; q/"/;
        =54=    @
        =55=    @
        =56=    <h1>Read the Comics</h1>
        =57=    <p>Select the article you wish to view:
        =58=    <HR>
        =59=    $links
        =60=    <HR>
        =61=    <p>Please respect the copyrights and license agreements of this service.
        =62=    @
        =63=    GROK
        =64=    q/"/;
        =65=        exit 0;
        =66=    }
        =67=    
        =68=    ## $group and $article both valid:
        =69=    $N = new News::NNTPClient($nntpserver,119,0);
        =70=    $N->group($group);
        =71=    @art = $N->article($article);
        =72=    shift @art while @art and $art[0] !~ /^Content-Type: (image\/[-a-z]+)/;
        =73=    $type = $1;
        =74=    shift @art while @art and $art[0] !~ /^\s*$/;
        =75=    pop @art;                       # heh
        =76=    $gif = decode_base64(join "", @art);
        =77=    print "Content-type: $type\n\n";
        =78=    print $gif;
        =79=    exit 0;

Комментарии:

Строки 3-5: подключение модулей

Строка 7: Адрес news-сервера можно конечно же поменять.

Строки 12-22 определяют массив названий групп, в длинной форме - для сервера и в короткой - для человека. Длинное имя можно получить, например, так - $groups[2][0], а короткое - $groups[2][1]

В строке 24 создается CGI-объект $Q. Входные данные скрипт может получать из командной строки, через переменную окружения и из стандартного потока ввода.

Строка 25 позволяет получитьURL скрипта, который используется в дальнейшем.

В 27 строке проверяется входной параметр 'group'. И если его нет - то выводится полный список групп. Строки 28-44 создают страничку со списком доступных групп на основе массива @groups 28-29 строки создают переменную $links, содержащую ссылки на группы в виде:

	<p><a href="SOMEWHERE?group=clari.living.comics.doonesbury">Doonesbury</a>
	Где SOMEWHERE - это как раз URL скрипта.

Строки с 32 по 40 выводят результат - заголовок, начало HTML-документа, список ссылок и конец HTML-документа. Конструкция @ - это вывод 'thing' в списковом контексте. Можно было вместо этого просто разбить оператор print на несколько операторов print.

Строка 46: проверка на наличие входного параметра article.

Строки с 47 по 65 выводят список сообщений в выбранной группе.

Строка 47: установление соединения с news-сервером (порт 119 - стандартный)

Строки с 48 по 51: вывод тем всех сообщений в данной конференции. Выражение в строке 48 возвращает массив строк, где символом табуляции разделены номер и тема сообщения. 49 строка разбивает строки, а 50тая - создает строку со списком уже в HTML-виде, где на каждое сообщение - своя ссылка:

<p><a href="SOMEWHERE?group=clari.living.comics.doonesbury&article=123">Doonesbury 950101</a>

Строки 52-60: вывод результатов

Строка 69 начинает часть скрипта, которая непосредственно выдает картинки, содержащиеся в отдельных сообщениях. Снова устанавливается соединение с news-сервером, и забирается уже конкретное сообщение.

Строка 71: сообщение укладывается в массив @art

Строка 72: так как важна только та часть сообщения, которая начинается с Content-type, то все остальные строки можно выкинуть. При этом сохраняется тип картинки (строка 73).

Строки 74-75: Пустая строка после Content-type пропускается

Строка 76: непосредственно декодирование из base64

Строки 77-78: вывод картинки браузеру

Вы, может, знаете, что 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 нужен для того чтобы вверху странички выдать ссылки в виде букв алфавита, например:
Для каждого ключевого слова выдается ссылка на документ, где оно встречается и описание из этого документа (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 /col\d\d|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 => '[email protected]',
        =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) {
        =64=           $_ = $meta;
        =65=           tr/ \t\n/ /s;
        =66=           $description = $_;
        =67=         }
        =68=         if (exists $meta) {
        =69=           for (split /,/, $meta) {
        =70=             s/^\s+//;
        =71=             s/\s+$//;
        =72=             $keywords{lc $_}++;
        =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 ?
        =98=                    $description : "(no description provided)";
        =99=    
        =100=                 [a({Href => encode_entities($url)}, encode_entities($url)),
        =101=                  encode_entities($text),
        =102=                 ];
        =103=               } sort keys %};
        =104=             my $key_text = $keyword_caps;
        =105=             if ($key =~ /^([a-z])/ and not $seen_letter++ ) {
        =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=          );