686 Глава 19 . Программирование CGI Пример 19.3 (продолжение)

while (larow = $sth->fetchrow()) { print Tr( td( \iarow ) ),

print VTABLEAn";

$sth->finish;

$dbh->disconnect;

print end html();

> Смотри также-

Документация но стандартному модулю CGI; рецепт 14.10,

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

Проблема

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

Решение

Вместо обычного заголовка выведите перенаправление и заверщите программу. Не забудьте о дополнительной пустой строке в конце заголовка:

$url = "http7/www. perl com/CPAN/", print "Location $url\n\n; exit;

Комментарий

Иногда программа CGI не генерирует документ сама. Она лищь сообщает клиенту о том, что ему следует получить другой документ. В этом случае заголовок HTTP содержит слово Location, за которым следует новый URL. Обязательно используйте абсолютный, а не относительный URL.

Прямолинейного рещения, показанного выще, обычно вполне хватает. Но если модуль CGI уже загружен, воспользуйтесь функцией redirect. В примере 19.4 эта возможность применяется при построении cookie.

Пример 19.4. oreobounce

((i/usr/bin/perl -w

# oreobounce - установить cookie и перенаправить броузер use CGI qw(.cgi);

$oreo = cookie( -NAME => filling,

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

-VALUE => vanilla creme",

-EXPIRES => +3M, О М - месяц, m - минута

-DOMAIN => .perl com);

$whither = "http: somewhere.perl com/nonesuch, html";

print redirect( -URL => $whither, -COOKIE => $oreo);

Результат выглядит так:

Status: 302 Moved Temporarily

Set-Cookie: filling=vanilla)!20cr)!E4me; domain=. perl.com;

expires=Tue, 21-Jul-1998 11:58:55 GMT Date: Tue, 21 Apr 1998 11:55:55 GMT Location: http: somewhere.pe rlcom/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}) {

Spage = /Мае/ && "m/Macintrash.html"

II /Win(dows )NT/ && "e/evilandrude.html" II /WinMSIEWebTV/ && "m/MicroslothWindows html" II /Linux/ && "1/Linux.html"

11 /HP-UX/ && "h/HP-SUX.html"

11 /SunOS/ && "s/ScumOS html"

li "a/AppendixB.html";

print "Location: $dir/$page\n\n";

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

Сообщить клиентскому броузеру, что вы не собираетесь выдавать никаких данных - далеко не то же самое, что перенаправить его «в никуда»:

use CGI qw(:standard);

print header( -STATUS => "204 No response" );

Результат выглядит так:

Status: 204 No response Content-Type: text/html <blank line here>

Например, этот вариант используется в ситуации, когда от пользователя приходит запрос, а вы не хотите, чтобы его страница изменилась или даже просто обновилась.

Выглядит немного глуно - сначала мы указываем тип содержимого, а потом говорим, что содержимого не будет, - но модуль поступает именно так. При ручном кодировании это бы не понадобилось.

#1/bin/sh cat «ЕОСАТ

Status- 204 No response ЕОСАТ

t> Смотри также-

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

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

Проблема

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

Решение

Создайте фиктивный Web-сервер (см. пример 19.6) и подключитесь к нему в своем броузере.

Пример 19.6. dummyhttpd

#t/usr/bin/perl -w

О dummyhttpd - запустить демона HTTP и выводить данные, й получаемые от клиента

use strict;

use HTTP::Daemon, # Требуется LWP-5.32 и выше

my Sserver = HTTP::Daemon->new(Timeout => 60);

print "Please contact me at- <URL:", $server->url, ">\n",

while (my Sclient = Sserver->accept) { CONNECTION-

while (my Sanswer = Sclient->get request) { print Sanswer->as string;