, которому должна соответствовать (функция tr(), и встроенным оператором Perl tr///. Следовательно, для построения строк таблицы следует использовать функцию Тr(). Следующий пример генерирует таблицу HTML по хэшу массивов. Ключи хэша содержат заголовки строк, а массивы значений - столбцы.
use CGI qw(:standard :html3);
%hash = (
"Wisconsin" => [ "Superlor", "Lake Geneva", "Madison" ],
"Colorado" => [ "Denver", "Fort Collins", "Boulder" ],
"Texas" => [ "Piano", "Austin", "Fort Stockton" ],
"California" => [ "Sebastopol", "Santa Rosa", "Berkeley" ],
);
$\ = "\n":
print " TABLE> CAPTION>Cities I Have Known";
print Tr(th [qw(State Cities)]);
for $k (sort keys %hash) {
print Tr(th($k), td( [ sort @{$hash{$k}} ] ));
}
print " /TABLE>";

Генерируется следующий текст:
TABLE>



HTML page

Глава 19 Программирование CGI

19.5. Повышение эффективности сценариев CGI

Проблема

От частых вызовов вашего сценария CGI снижается производительность сервера. Вы хотите уменьшить нагрузку, связанную с работой сценария.

Решение

Используйте модуль mod_perl Web-сервера Apache и включите в файл httpd.conf следующую секцию:
Alias /perl/ /real/path/to/perl/scripts/
SetHandler perl-script PerlHandler Apache::Registry Options ExecCGI

PerlModule Apache::Registry PerlModule CGI PerlSendHeader On

Комментарий

Модуль mod_perl Web-сервера Apache позволяет писать код Perl, который может выполняться па любой стадии обработки запроса. Вы можете написать своп собственные процедуры регистрации и аутентификации, определить виртуальные хосты и их конфигурацию и написать собственные обработчики для некоторых типов запросов.
Приведенный выше фрагмент сообщает, что URL, начинающиеся с /perl/, в действительности находятся в /real/path/to/perl/scripts и обрабатываются Apache:: Registry. В результате они будут выполняться в среде CGI. Строка PerlModule CGI выполняет предварительную загрузку модуля CGI, a PerlSendHandler On позволяет большинству сценариев CGI работать с mod_perl. /perl/ работает аналогично /cgi-bin/. Чтобы суффикс .perl являлся признаком сценариев CGI mod_perl, подобно тому, как суффикс .cgi является признаком обычных сценариев CGI, включите в конфигурационный файл Apache следующий фрагмент:
SetHandler perl-script
PerlHandler Apache::Registry
Options ExecCGI

Поскольку интерпретатор Perl, выполняющий сценарий CGI, не выгружается из памяти при завершении сценария (что обычно происходит, когда Web-сервер выполняет сценарий как отдельную программу), не следует полагаться на то, что при запуске программы глобальные переменные имеют неопределенные значения. Флаг -w и use strict проверяют многие недостатки в сценариях такого рода. Существуют и другие потенциальные ловушки - обращайтесь к странице руководства mod__perl_traps.
Не беспокойтесь о том, насколько снизится быстродействие Web-сервера от предварительной загрузки всех сценариев. Все равно когда-нибудь придется загружать их в память; желательно, чтобы это произошло до того, как Apache начнет плодить потомков. В этом случае каждый сценарий будет находиться в памяти в единственном экземпляре, поскольку в любой современной операционной системе потомки используют общие страницы памяти. Иначе говоря, предварительная загрузка только на первый взгляд увеличивает расходы памяти - на самом деле она их уменьшает!
По адресу http://www.perl.com/CPAN-local/modules/by-modules/Netscape/nsapi_ perl-0.24.tar.gz имеется интерфейс к серверу Netscape, который также повышает производительность за счет отказа от порождения новых процессов.

> Смотри также -------------------------------
Документация по модулям Bundle::Apache, Apache, Apache::Registry от CPAN; http://perl.apache.org/, http://perl.apache.org/faqa/, man-страницы mod_perl(3) и cgi_to_mod_perl( 1) (если есть).

19.6. Выполнение команд без обращений к командному интерпретатору

Проблема

Пользовательский ввод должен использоваться как часть команды, но вы не хотите, чтобы пользователь заставлял командный интерпретатор выполнять другие команды или обращаться к другим файлам. Если просто вызвать функцию system или '. . . ' с одним аргументом (командной строкой), то для выполнения может быть использован командный интерпретатор, а это небезопасно.

Решение

В отличие от одноаргументной версии, списковый вариант функции system надежно защищен от обращений к командному интерпретатору. Если аргументы команды содержат пользовательский ввод от формы, никогда не используйте вызовы вида:
system("command $input @files"); # НЕНАДЕЖНО

Воспользуйтесь следующей записью:
system("command", $input, (Sfiles); # НАДЕЖНЕЕ

Комментарий

Поскольку Perl разрабатывался как "язык-клей", в нем легко запустить другую программу - в некоторых ситуациях даже слишком легко. Если вы просто пытаетесь выполнить команду оболочки без сохранения ее вывода, вызвать system в многоаргументной версии достаточно просто. Но что делать, если вы используете команду в '. . . ' или она является аргументом функции open? Возникают серьезные трудности, поскольку эти конструкции в отличие. от system не позволяют передавать несколько аргументов. Возможное решение - вручную создавать процессы с помощью fork и ехес. Работы прибавится, но, по крайней мере, непредвиденные обращения к командному интерпретатору не будут портить вам настроение.
Обратные апострофы используются в сценариях CGI лишь в том случае, если передаваемые аргументы генерируются внутри самой программы:
chomp($now = 'date');

Но если команда в обратных апострофах содержит пользовательский ввод - например:
@output = 'grep $input (nifties)';

приходится действовать намного осторожнее.
die "cannot fork: $!" unless defined ($pid = open(safe_kid, "|-"));
if ($pid == 0) {
exec('grep', $input, Ofiles) or die "can't exec grep: $!";
} else {
@output = ;
close SAFE_KID; # $? содержит информацию состояния
}

Такое решение работает, поскольку ехес, как и system, допускает форму вызова, свободную от обращений к командному интерпретатору. При передаче списка интерпретатор не используется, что исключает возможные побочные эффекты.
При выполнении команды функцией open также потребуется немного потрудиться. Начнем с открытия функцией open конвейера для чтения. Вместо ненадежного кода: open(KID_TO"READ, "$program $options @args |"); # НЕНАДЕЖНО используется более сложный, но безопасный код:
# Добавить обработку ошибок die "cannot fork: $!"
unless defined($pid = open(kid_to_read, "-!"));
if ($pid) { # Родитель while () {
# Сделать что-то интересное
}
close(KID_TO_READ) or warn "kid exited $?";
} else { # Потомок
# Переконфигурировать, затем
exec($prograni, @options, @iargs) or die "can't exec program: $!";
}

Безопасный конвейерный вызов open существует и для записи. Непадежный вызов:
open(KID_TO_WRITE, "|$program $options @args");

# НЕНАДЕЖНО заменяется более сложным, но безопасным кодом:
$pid = open(kid_to_write, "|-");
die "cannot fork: $!" unless defined($pid = open(kid_to_write, "|-"));
$SIG{ALRM} = sub { die "whoops, $program pipe broke" };
if ($pid) { # Родитель
for (@data) { print KID_TO_WRITE $_ } close(KID_TO_WRITE) or warn "kid exited $?";
} else { # Потомок
# Переконфигурировать, затем
exec($program, @options, @args) or die "can't exec program: $!":
}

Там, где комментарий гласит "Переконфигурировать", предпринимаются дополнительные меры безопасности. Вы находитесь в порожденном процессе, и вносимые изменения не распространяются на родителя. Можно изменить переменные окружения, сбросить временный идентификатор пользователя или группы, сменить каталог или маску umask и т. д. Разумеется, все это не поможет в ситуации, когда вызов system запускает программу с другим идентификатором пользователя. Например, почтовая программа sendmail является setuid-программой, часто запускаемой из сценариев CGI. Вы должны хорошо понимать риск, связанный с запуском sendmail или любой другой setuid-программы.

> Смотри также --------------------------------
Описание функций system, exec и open в perlfunc{1}; perhec(1); рецепты 16.1-16.3.

19.7. Форматирование списков и таблиц средствами HTML

Проблема

Требуется сгенерировать несколько списков и таблиц. Нужны вспомогательные функции, которые бы упростили вашу работу.

Решение

Модуль CGI содержит вспомогательные функции HTML, которые получают ссылку на массив и автоматически применяются к каждому элементу массива:
print ol( li([ qw(red blue green)]) );
  1. red
  2. blue
  3. green @names = qw(larry Мое curly):
    print ul( li({ -TYPE => "disc" }, \@names) );
    • Larry
    • Moe
    • Curly

      Комментарий

      Свойство дистрибутивности функций CGI.pm, генерирующих HTML-код, заметно упрощает процесс генерации списков и таблиц. При передаче простой строки эти функции просто выдают HTML-код для данной строки. Но при передаче ссылки на массив они применяются ко всем строкам. print li("alpha");
    • alpha
    • print И( [ "alpha", "omega"] );
    • alpha
    • omega
    • Вспомогательные функции для списков загружаются при использовании тега : standard, но для получения вспомогательных функций для работы с таблицами придется явно запросить : html3. Кроме того, возникает конфликт между тегом
Cities I Have Known
State Cities
California Berkeley Santa Rosa Sebastopol
Colorado Boulder Denver Fort Collins
Texas Austin Fort Stockton PIano
Wisconsin Lake Geneva Madison Superlor /TABLE>
Те же результаты можно получить всего одной командой print, хотя это несколько сложнее, поскольку вам придется создавать неявный цикл с помощью тар. Следующая команда print выдает результат, идентичный приведенному выше:
print table
caption('Cities I have Known'),
Tr(th [qw(State Cities)]),
map { Tr(th($_), td( [ sort @{$hash{$_}} ] )) } sort keys %hash;

Эти функции особенно удобны при форматировании результатов запроса к базе данных, как показано в примере 19.3 (см. главу 14 "Базы данных"). Пример 19.3. salcheck
#!/usr/bin/perl
# salcheck - проверка жалованья
use DBI;
use CGI qw(:standard :html3);
$limit = param("limit");
print header(), start_html("Salary Query"), h1("Search"), start_form(),
p(Enter minimum salary", textfield("LIMIT")), submitO, end_form();
if (defined $limit) {
$dbh = dbi->connect("dbi:mysql:somedb:server.host.dom:3306",
"username", "password")
or die "Connecting: $DBI::errstr";
$sth = $dbh->prepare("SELECT name,salary FROM employees
WHERE salary > $limit")
or die "Preparing: ", $dbh->errstr;
$sth->execute
or die "Executing: ", $sth->errstr;
print h1("Results"), "'
while (Orow = $sth->fetchrow()) { print Tr( td( \@row ) );
}
print " /TABLE>\n' $sth->finish;
$dbh->disconnect;
}
print end_html()

[> Смотри также
Документация по стандартному модулю CGI; рецепт 14.10.

19.8. Перенаправление клиентского броузера

Проблема

Требуется сообщить клиентскому броузеру о том, что страница находится в другом месте.

Решение

Вместо обычного заголовка выведите перенаправление и завершите программу. Не забудьте о дополнительной пустой строке в конце заголовка:
$url = "http://www.perl.com/cpan/";
print "Location: $url\n\n";
exit;

Комментарий

Иногда программа CGI не генерирует документ сама. Она лишь сообщает клиенту о том, что ему следует получить другой документ. В этом случае заголовок HTTP содержит слово Location, за которым следует новый URL. Обязательно используйте абсолютный, а не относительный URL. Прямолинейного решения, показанного выше, обычно вполне хватает. Но если модуль CGI уже загружен, воспользуйтесь функцией redirect. В примере 19.4 эта возможность применяется при построении cookie. Пример 19.4. oreobounce
#!/usr/bin/perl -w
# oreobounce - установить cookie и перенаправить броузер
use CGI qw(:cgi);
$oreo = cookie( -name => 'filling',
-VALUE => "vanilla creme",
-EXPIRES => '+3M', ff M - месяц, m - минута
-DOMAIN => '.perl.corn'):
$whither = "http://somewhere.perl.com/nonesuch.html";
print redirect( -URL => $whither,
-COOKIE => $oreo);

Результат выглядит так:
Status: 302 Moved Temporarily Set-Cookie: filling=vanilla!l!20crxe4n'ie;
domain=.perl.corn;
expires=tue, 21-jul-1998 11:58:55 gmt date: tue, 21 apr 1998 11:55:55 gmt location:
http://somewhere.perlcom/nonesuch.html Content-Type: text/html B"blank line here" В примере 19.5 приведена закопченная программа, которая определяет имя клиентского броузера и перенаправляет его на страницу "Файла жаргона" Эрика Реймонда, где говорится о соответствующей операционной системе. Кроме того, в программе хорошо продемонстрирован альтернативный подход к созданию конструкций switch в Perl. Пример 19.5. os_snipe
#!/usr/bin/perl
# os_snipe - перенаправить в статью Файла жаргона,
# посвященную текущей операционной системе
$dir = "http://www.wins.uva.nl/%7emes/jargon";
for ($ENV{HTTP_USER_AGENT}) {
$page = /mac/ && "m/macintrash.html"
|| /Win(dows )?NT/ && "e/evilandrude.html"
|| /Win|MSIE|WebTV/ && "m/MicroslothWindows.html"
|| /Linux/ && "1/Linux.html"
|| /HP-UX/ && "h/HP-SUX.html"
|| /SunOS/ && "s/ScumOS.html"
|| "a/AppendixB.html'
}
print "Location: $dir/$page\n\n'

В программе os_snipe использовано динамическое перенаправление, поскольку разные пользователи отсылаются на разные страницы. Если перенаправление всегда ведет к одному месту, разумнее включить статическую строку в конфигурационный файл сервера - это обойдется дешевле, чем запуск сценария CGI для каждого перенаправления.
Сообщить клиентскому броузеру, что вы не собираетесь выдавать никаких данных - далеко не то же самое, что перенаправить его "в никуда":
use CGI qw(:standard);
print header( -STATUS => "204 No response" ):

Результат выглядит так:
Status: 204 No response Content-Type: text/html

Например, этот вариант используется в ситуации, когда от пользователя приходит запрос, а вы не хотите, чтобы его страница изменилась или даже просто обновилась. Выглядит немного глупо - сначала мы указываем тип содержимого, а потом говорим, что содержимого не будет, - но модуль поступает именно так. При ручном кодировании это бы не понадобилось.
#!/bin/sh
cat "EOCAT Status: 204 No response
EOCAT


> Смотри также -------------------------------
Документация по стандартному модулю CGI.

19.9. Отладка на уровне HTTP

Проблема

Сценарий CGI странно ведет себя с броузером. Вы подозреваете, что в заголовке HTTP чего-то не хватает. Требуется узнать, что именно броузер посылает серверу в заголовке HTTP.

Решение

Создайте фиктивный Web-сервер (см. пример 19.6) и подключитесь к нему в своем броузере. Пример 19.6. dummyhttpd
#!/usr/bin/perl -w
# dummyhttpd - запустить демона HTTP и выводить данные,
# получаемые от клиента
use strict;
use HTTP::Daemon; и Требуется ШР-5.32 и выше
my $server = http::daemon->new(Timeout => 60);
print "Please contact me at: url, ">\n";
while (my Sclient = $server->accept) { CONNECTION:
while (my $answer = $client->get_request) { print $answer->as_string;
$client->autoflush;
RESPONSE:
while () {
last RESPONSE if $_ eq ".\n";
last CONNECTION if $_ eq "..\iT print $client $_;
} print "\nEOF\n";
}
print "CLOSE: ", $client->reason, "\n";
$client->close;
undef $client;
}

Комментарий

Трудно уследить за тем, какие версии тех или иных броузеров все еще содержат ошибки. Фиктивная программа-сервер может спасти от многодневных напряженных раздумий, поскольку иногда неправильно работающий броузер посылает серверу неверные данные. На своем опыте нам приходилось видеть, как броузеры теряли cookies, неверно оформляли URL, передавали неверную строку состояния и совершали менее очевидные ошибки.
Фиктивный сервер лучше всего запускать на том же компьютере, что и настоящий. При этом броузер будет отправлять ему все cookies, предназначенные для этого домена. Вместо того чтобы направлять броузер по обычному URL:
http://somewhere.com/cgi-bin/whatever
воспользуйтесь альтернативным портом, указанным в конструкторе new. При использовании альтернативного порта необязательно быть привилегированным пользователем, чтобы запустить сервер.
http://somewhere.com:8989/cgi-bin/whatever

Если вы решите, что клиент ведет себя правильно, и захотите проверить сервер, проще всего воспользоваться программой telnet для непосредственного общения с удаленным сервером.
% telnet www.perl.com 80
GET /bogotic HTTP/1.0

HTTP/1.1 404 File Not Found
Date: Tue, 21 Apr 1998 11:25:43 GMT
Server: Apache/1,2.4
Connection: close
Content-Type: text/html

TITLE 404 File Not Found /TITLE

File Not Found


The requested URL /bogotic was not found on this server,



Если в вашей системе установлены модули LWP, вы сможете использовать синоним GET для программы Iwprequest. При этом будут отслеживаться все цепочки перенаправлений, что может пролить свет на вашу проблему. Например:
% GET -esuSU http://mox.perl.com/perl/bogotic
GET http://language.perl,com/bogotic Host: mox.perl.com User-Agent: lwp-request/1.32
GET http://mox.perl.com/perl/bogotic -> 302 Moved Temporarily
GET http://www.perl.com/perl/bogotic -> 302 Moved Temporarily
GET http://language.perl.com/bogotic -> 404 File Not Found
Connection: close
Date: Tue, 21 Apr 1998 11:29:03 GMT
Server: Apache/1.2.4
Content-Type: text/html
Client-Date: Tue, 21 Apr 1998 12:29:01 GMT
Client-Peer: 208.201.239.47:80
Title: Broken perl.corn Links

An Error Occurred</TITLEx/HEAD> <br> BODY <br> H1 An Error Occurred /h1 <br>404 File Not Found <br></BODY X /HTML></i> <br><br>> Смотри также -------------------------------- <br>Документация по стандартному модулю CGI; рецепт 14.10. <hr> <center> <table> <tr><td width=200> <a href="19_1.htm"><img src="../image/back.gif" border=0 align="left"></img></a></td> <td width=400><center><font face="arial"> copyright 2000 Soft group</font></center></td> <td width=200><a href="19_3.htm"><img src="../image/forvard.gif" border=0 align="right"></img></a><td></tr></table> </center> </p></font> </div> </td> <td id="sidebar-right" class="sidebar"> <table id="block-block-3" class="clear-block block block-block"> <tr> <td class="block-tl"></td> <td class="block-tc"> </td> <td class="block-tr"></td> </tr> <tr> <td class="block-bl"></td> <td class="block-bc"> <div class="content"><div class="sape"> <noindex>Тут могла бы быть ваша реклама!</noindex></div></div> </td> <td class="block-br"></td> </tr> </table> </td> </tr> </table> </div><!-- end of div#container --> <div id="footer"></div> </div><!-- end of div#wrapper --> </body> </html>