| ||||||||||||||||
 | ||||||||||||||||
| ||||||||||||||||
 | ||||||||||||||||
| ||||||||||||||||
|
|
Программирование для Web. Создание индекса для сайта Каждый, кто начинает программировать на Перле, сталкивается с аббревиатурой 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= @{[$Q->header]}
=33= @{[$Q->start_html('Comics','merlyn@stonehenge.com')]}
=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= @{[$Q->end_html]}
=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= @{[$Q->header]}
=55= @{[$Q->start_html('Comics','merlyn@stonehenge.com')]}
=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= @{[$Q->end_html]}
=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]} - это вывод '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: Обычное начало программы.
9-24: Определение процедуры OK_TO_FOLLOW. Принимает URI-объект (http),
возвращает единицу, если эту ссылку надо сканировать и нуль, если не надо.
28-31: Подключаем модули: CGI::Pretty – стандартный, LWP::UserAgent, HTML:Entities,
WWW::Robot – входят в библиотеку LWP.
В строке 81 содержится оператор print, который продолжается до конца скрипта и
выводит таблицу-индекс. Листинг:
=1= #!/usr/bin/perl -w
=2= use strict;
=3= $|++;
=4=
=5= ## config
=6=
=7= my @URL = qw();
=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 => '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/ \t\n/ /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= );
|
|
|
| ||||||||||||||||
| ||||||||||||||||
| ||||||||||||||||
|