Вы хотите получить или создать cookie для хранения параметров сеанса или настроек пользователя.
Решение
В модуле CGI.pm получение существующей cookie выполняется так:
$preference_value = cookie("preference name"); Cookie создаются следующим образом:
$packed_cookie = cookie( -NAME => "preference name",
-VALUE => "whatever you'd like",
-EXPIRES => "+2y"); Чтобы сохранить cookie в клиентском броузере, необходимо включить ее в заголовок HTTP (вероятно, с помощью функций header или redirect):
print header(-COOKIE => $packed_cookie);
Комментарий
Cookies используются для храпения информации о клиентском броузере. Если вы работаете с Netscape в UNIX, просмотрите файл -/.netscape/cookies, хотя в нем содержатся не все cookies, а лишь те, которые присутствовали на момент последнего выхода из броузера. Cookies можно рассматривать как пользовательские настройки уровня приложения или как средство упростить обмен данными. Преимущества cookies заключаются в том, что они могут совместно использоваться несколькими разными программами и даже сохраняются между вызовами броузера.
Однако cookies также применяются и для сомнительных штучек типа анализа графика. Нервные пользователи начинают гадать, кто и зачем собирает их личные данные. Кроме того, cookies привязаны к одному компьютеру. Если вы работаете с броузером у себя дома или в другом офисе, в нем не будет cookies из броузера, находящегося у вас на работе. По этой причине не следует ожидать, что каждый броузер примет cookies, которые вы ему даете. А если этого покажется недостаточно, броузеры могут уничтожать cookies по своему усмотрению. Ниже приведена выдержка из чернового документа "Механизм управления состоянием HTTP" (HTTP State Management Mechanism") по адресу http://portal.research.bell-labs.com/ -dmk/cookie-2.81-3.1-txt.
"Поскольку пользовательские агенты обладают ограниченным пространством для хранения cookies, они могут удалять старые cookies, чтобы освободить место для новых - например, используя алгоритм удаления по сроку последнего использования в сочетании с ограничением максимального числа cookies, создаваемых каждым сервером."
Cookies ненадежны, поэтому на них не стоит чрезмерно полагаться. Используйте их для простых транзакций с конкретным состоянием. Избегайте анализа тра-фика, это может быть принято за вмешательство в личные дела пользователей.
В примере 19.7 приведена законченная программа, которая запоминает последний выбор пользователя.
Пример 19.7. ic_cookies
#!/usr/bin/perl -w
# ic_cookies - пример сценария CGI с использованием cookie
use CGI qw(:standard);
use strict;
my $cookname = "favorite ice cream":
my $favorite = param("flavor");
my $tasty = cookie($cookname) || "mint";
unless ($favorite) {
print header(), start_html("Ice Cookies"), h1("Hello Ice Cream"), hr(), start_form(),
p("Please select a flavor: ", textfield("flavor",$tasty)), end_form(), hr();
exit:
}
my $cookie = cookie(
-NAME => $cookname,
-VALUE => $favorite,
-EXPIRES => "+2y",
}
print header(-COOKIE => $cookie),
start_html("Ice Cookies, #2"),
h1("Hello Ice Cream"),
p("You chose as your favorite flavor '$favorite'.");
> Смотри также -------------------
Документация по стандартному модулю CGI.
Вы хотите, чтобы по умолчанию в полях формы отображались последние использованные значения. Например, вы хотите создать форму для поисковой системы наподобие AltaVista (http://www.altavista.com), где над результатами отображаются искомые ключевые слова.
Решение
Создайте форму с помощью вспомогательных функций HTML, которые автоматически заносят в поле предыдущее значение:
print textfield("SEARCH"); # Предыдущее значение SEARCH и используется по умолчанию
Комментарий
В примере 19.8 приведен простой сценарий для получения информации о пользователях, зарегистрированных в настоящее время.
Пример 19.8. who.cgi
#!/usr/bin/perl -wT
# who.cgi - вызвать who(1) для пользователя и отформатировать результат
$ENV{IFS}=";
$ENVuse CGI qw(:standard);
# Вывести поисковую форму
print header(), start_html("Query Users"), h1("Search");
print start_form(), p("Which user?", textrield("WHO")); submit(), end_form();
# Вывести результаты поиска $name = param("who");
if ($name) {
print h1("Results");
$html = ";
# Вызвать who и построить текст ответа
foreach ('who') {
next unless /"$name\s/o; # Только строки, совпадающие с $name
s/&/&/g;
s/s/>/>/g;
$html .= $_;
}
# Если пользователь не найден, вывести сообщение
$html = $html || "$name is not logged in";
print pre($html);
}
print end_html(); Функция textfield генерирует HTML-код для текстового поля с именем параметра WHO. После вывода формы мы проверяем, было ли присвоено значение параметру WHO, и если было - ищем в результатах who строки данного пользователя.
> Смотри также --------------------------------
Документация но стандартному модулю CGI; рецепты 19.4; 19.7.
Требуется написать сценарий CGI, который бы возвращал броузеру несколько страниц. Допустим, вы хотите написать сценарий CGI для работы с базой данных продуктов. Он должен выводить несколько форм: общий список продуктов, формы для добавления новых и удаления существующих продуктов, для редактирования текущих атрибутов продуктов и т. д. Многостраничный сценарий CGI образует простейший вариант "электронного магазина".
Решение
Сохраните информацию о текущей странице в скрытом поле.
Комментарий
Модуль CGI позволяет легко генерировать устойчивые скрытые поля. Функция hidden возвращает HTML-код скрытого элемента и использует его текущее значение в том случае, если ей передается только имя элемента:
use CGI qw(:standard);
print hidden("bacon");
Отображаемая страница ("Общий список продуктов", "Список заказанных продуктов", "Подтверждение заказа" и т. д.) выбирается по значению скрытого поля. Мы назовем его . State, чтобы избежать возможных конфликтов с именами других полей. Для перемещения между страницами используются кнопки, которые присваивают .State имя новой страницы. Например, кнопка для перехода к странице "Checkout" создается так:
print submit(-NAME => ".State", -VALUE => "Checkout"); Для удобства можно создать вспомогательную функцию:
sub to_page { return submit( -NAME => ".State", -VALUE => shift ) }
Чтобы выбрать отображаемый код, достаточно проверить параметр . State:
$page = param(".state") || "default"; Код, генерирующий каждую страницу, размещается в отдельной подпрограмме. Вообще говоря, нужную подпрограмму можно выбирать длинной конструкцией
if...elsit...elsif:
if ($page eq "Default") {
front_page();
} elsif ($page eq "Checkout") {
checkout();
} else {
no_such_page(); # Если .State ссылается на несуществующую страницу
} Получается некрасивое, громоздкое решение. Вместо этого следует использовать хэш, ассоциирующий имя страницы с подпрограммой. Это еще один из вариантов реализации С-подобной конструкции switch на Perl.
%States = (
'Default' => \&front_page, 'Shirt' => \&shirt, 'Sweater' => \&sweater, 'Checkout' => \&checkout, 'Card' => \&credit_card, 'Order' => \&order, 'Cancel' => \&front_page,
}
if ($States{$page}) {
$States{$page}->(); # Вызвать нужную подпрограмму
} else {
no_such_page():
} На каждой странице найдется несколько устойчивых элементов. Например, страница для заказа футболок должна сохранить количество заказанных товаров, даже если пользователь переходит на страницу для заказа кроссовок. Для этого подпрограмма, генерирующая страницу, вызывается с параметром, который определяет, является ли данная страница активной. Если страница не является активной, возвращаются лишь значения скрытых полей для любых устойчивых данных:
while (($state, $sub) = each %states) { $sub->( $page eq $state );
} Оператор сравнения eq возвращает irue, если страница является активной, и false в противном случае. Подпрограмма, генерирующая страницу, принимает следующий вид:
sub t_shirt {
my $active = shift:
unless ($active) {
print hidden("size"), hidden("color"):
return;
}
print p("You want to buy a t-shirt?");
print p("Size: ", popup_menu("size", [ qw(XL L M S XS) ]));
print p("Color:", popup_menu("color", [ qw(Black White) ]));
print p( to_page("Shoes"), to_page("Checkout") );
} Поскольку все подпрограммы генерируют HTML-код, перед вызовом необходимо вывести заголовок HTTP и начать HTML-документ и форму. Это позволит использовать стандартные колонтитулы для всех страниц, если мы захотим. Следующий фрагмент предполагает, что у нас имеются процедуры standard heade' и standard_footer для вывода верхних и нижних колонтитулов страниц:
print header("Program Title"), begin_html();
print standard_header(), begin_form();
while (($state, $sub) = each %states) { $sub->( $page eq $state );
} print standard_footer(), end_form(), end_html(); Кодирование цены в форме будет ошибкой. Вычисляйте цены на основании значений скрытых элементов и как можно чаще проверяйте информацию. Например, сравнение со списком существующих продуктов позволяет отбросить явно неразумные заказы.
Скрытые данные обладают большими возможностями, чем cookies, поскольку вы не можете твердо рассчитывать на поддержку cookies или на то, что броузер согласится принять их. Более полная информация приведена в рецепте 19.10.
В конце главы приведена программа chemiserie - простейшее приложение для обслуживания электронного магазина.
> Смотри также --------------------------------
Документация по стандартному модулю CGI.
Сценарии CGI должен сохранить все содержимое формы в файле или передать его в канал.
Решение
Для сохранения формы воспользуйтесь функцией save_parameters или методом save модуля CGI; их параметром является файловый манипулятор. Сохранение в файле выполняется так:
# Сначала открыть и монопольно заблокировать файл
open(FH, ""/tmp/formlog") or die "can't append to formlog: $!";
flock(FH, 2) or die "can't flock formlog: $!";
# Используется процедурный интерфейс
use CGI qw(:standard);
save_parameters(*FH); # CGI::save
# Используется объектный интерфейс use CGI;
$query = cgi->new():
$query->save(*FH);
close(FH) or die "can't close formlog: $!"; Или форма сохраняется в канале - например, соединенном с процессом sendmail:
use CGI qw(:standard);
open(MAIL, "1/usr/lib/sendmail -oi -t")
or die "can't fork sendmail: $!";
print MAIL "EOF;
From: $0 (your cgi script) To: hisnameX@hishost.com Subject: mailed form submission
EOF
save_parameters(*MAIL);
close(MAIL) or die "can't close sendmail; $!";
Комментарий
Иногда данные формы сохраняются для последующего использования. Функция save_parameters и метод save модуля CGI.pm записывают параметры формы в открытый манипулятор. Манипулятор может быть связан с открытым файлом (желательно - открытым в режиме дополнения и заблокированным, как в решении) или каналом, другой конец которого подключен к почтовой программе.
Данные сохраняются в файле в виде пар переменная=значение, служебные символы оформляются но правилам ljrl. Записи разделяются строками, состоящими из единственного символа =. Как правило, чтение осуществляется методом cgi->new с аргументом-манипулятором, что обеспечивает автоматическое восстановление служебных символов (см. ниже).
Если вы хотите перед сохранением включить в запрос дополнительную информацию, вызовите функцию рагат (или метод, если используется объектно-ориентированный интерфейс) с несколькими аргументами и установите нужное значение (или значения) параметра формы. Например, текущее время и состояние окружения сохраняется следующим образом:
param("_timestamp", scalar localtime);
param("_environs", %ENV); После сохранения формы в файле дальнейшая работа с ней ведется через объектно-ориентированный интерфейс.
Чтобы загрузить объект-запрос из файлового манипулятора, вызовите метод new с аргументом-манипулятором. При каждом вызове возвращается законченная форма. При достижении конца файла будет возвращена форма, не имеющая параметров. Следующий фрагмент показывает, как это делается. Он накапливает сумму всех параметров "items requested", но лишь в том случае, если форма поступила не с сайта perl.com. Напомним, что параметры _environs и _timestamp были добавлены при записи файла.
use CGI;
open(FORMS, "< /tmp/formlog") or die "can't read formlog: $!";
Hock(FORMS, 1) or die "can't lock formlog: $i":
while ($query = cgi->new(*FORMS)) {
last unless $query->param(); # Признак конца файла
%his_env = $query->param('_environs');
$count += $query->param('items requested')
unless $his_env{REMOTE_HOST} =' /("|\.)perl\.com$/ } print "total orders: $count\n";
Как всегда при создании файлов в сценариях CGI, важную роль играют права доступа и права владельца файла.
Сценарий CGI из примера 19.9 предназначен для заказа футболок и свитеров через Web. В нем использованы приемы, описанные в рецепте 19.12. Вывод не отличается особой элегантностью или красотой, но продемонстрировать многостраничную работу в короткой программе слишком сложно, чтобы заботиться об эстетике.
Подпрограммы shirt и sweater проверяют значения соответствующих элементов формы. Если цвет или размер окажется неправильным, в элемент заносится первое значение из списка допустимых цветов или размеров.
Пример 19.9. chemiserie
#!/usr/bin/perl -w
# chemiserie - простой сценарий CGI для заказа футболок и свитеров
use strict;
use CGI qw(:standard);
use CGI::Carp qw(fatalsToBrowser);
my %States; # Хэш состояний - связывает страницы
# с функциями my $Current_Screen; # Текущий экран
# Хэш страниц и функций.
%States = (
'Default' => \&front_page,
'Shirt' => \&shirt,
'Sweater' => \&sweater,
'Checkout => \&checkout,
'Card' => \&credit_card,
'Order' => \&order,
'Cancel' => \&front_page,
);
$Current_Screen = param(".state") || "default";
die "No screen for $Current_Screen" unless $States{$Current_Screen};
# Сгенерировать текущую страницу,
standard_header();
while (my($screen_name, $function) = each %states) { $function->($screen_name eq $Current_Screen);
} standard_footer();
exit;
################################
# Колонтитулы формы, функции меню
##################################
sub standard_header {
print header(), start_html(-Title => "Shirts", -BGCOLOR=>"White");
print start_form(); # start_multipart_form()
if file upload
}
sub standard_footer { print end_form(), end_html() }
sub shop_menu {
print p(defaults("Empty My Shopping Cart"),
to_page("Shirt"), to_page("Sweater"),
to_page("Checkout"));
}
#################################
# Подпрограммы для каждого экрана
#################################
# Страница по умолчанию.
sub front_page {
my $active = shift;
return unless $active;
print "H1>Hi!\n";
print "Welcome to our Shirt Shop! Please make your selection from print "the menu below.\n";
shop_menu();
}
# Страница для заказа футболок.
sub shirt {
my $active = shift;
my @sizes = qw(xl l m s);
my @colors = qw(black white);
my ($size, $color, $count) =
(param("shirt_size"), param("shirt_color"), param("shirt_count"));
# Проверка
if ($count) {
$color = $colors[0] unless grep { $_ eq $color } @>colors;
$size = $sizes[0] unless grep { $_ eq $size } @sizes;
param("shirt_color", $color);
param("shirt_size", $size);
}
unless ($active) {
print hidden("shirt_size") if $size;
print hidden("shirt_color") if $color;
print hidden("shirt_coLint") if $count;
return;
}
print h1("T-Shirt");
print p("What a shirt! This baby is decked out with all the options. "It comes with full luxury interior, cotton trim, and a collar", "to make your eyes water! Unit price: \$33,00");
print h2("0ptions");
print p("How Many?", textfield("shir't_count"));
print p("Size?", popup_menu("shirt_size", \@sizes ), "Color?", popup_menu("shirt_color", \@colors));
shop_menu();
}
# Страница для заказа свитеров. sub sweater {
my $active = shift;
my @sizes = qw(xl l m):
my colors = qw(chartreuse puce lavender):
my ($size, $color, $count) =
(param("sweater_size"), param("sweater_color"), param("sweater_count"));
# Проверка
if ($count) {
$color = $colors[0] unless grep { $_ eq $color } @colors;
$size = $sizes[0] unless grep { $_ eq $size } @sizes;
param("sweater_color", $color);
param("sweater_size", $size):
unless ($active) {
print hidden("sweater_size") if $size;
print hidden("sweater_color") if $color;
print hidden("sweater_count") if $count;
return,
print h1("Sweater");
print p("Nothing implies pretty elegance more than this fine", "sweater. Made by peasant workers from black market silk,", "it slides onto your lean form and cries out ''Take me,", "for I am a god!''. Unit price: \$49.99.");
print h2("Options");
print p("How Many?", textfield("sweater_count"));
print p("Size7", popup_menu("sweater_size", \@sizes));
print p("Color?", popup_menu("sweater_color", \@>colors)):
shop_menu();
}
# Страница для подтверждения текущего заказа.
sub checkout {
my $active = shirt:
return unless $active;
print h1("0rder Confirmation");
print p("You ordered the following:");
print order_text();
print p("Is this right9 Select 'Card' to pay for the items'
"or 'Shirt' or 'Sweater' to continue shopping,");
print p(to_page("Card"),
to_page("Shirt"),
to_page("Sweater")):}
# Страница для ввода данных кредитной карты.
sub credit_card {
my $active = shift;
my @widgets = qw(name addressi address2 city zip state phone card expiry);
unless ($active) {
print map { hidden($_) } widgets;
return;
}
print pre(p("Name: ", textfield("Name")),
p("Address: ", textfield("Address1")),
p(" ", textfield("Address2")),
p("City: ", textfieldC'City")),
p("Zip: ", textfield("Zip")),
p("State: ", textfield("State")),
p("Phone: ", textfield("Phone")),
p("Credit Card #: ", textfield("Card")),
p("Expiry: ", textfield("Expiry")));
print p("Click on 'Order' to order the items. Click on 'Cancel' to return shopping.");
print p(to_page("0rder"), to_page("Cancel"));
}
# Страница для завершения заказа.
sub order {
my $active = shift;
unless ($active) { return;
}
# Проверка данных крндижии карты
print h1("0rdered!");
print p("You have ordered the following toppings:");
print order_text();
print p(defaults("Begin Again");
}
# Возвращает HTML-код текущего заказа ("Вы заказали ...")
sub order_text { my $html = '';
if (param("shirt_count")) {
$html .= p("you have ordered ", param("shirt_count"), shirts of size ", param("shirt_size"), and color ", param("shirt_color"), ",");
} if (param("sweater_count")) {
$html .= p("you have ordered ", param("sweater_count"), sweaters of size ", param("sweater_size"), and color ", param("sweater_color"), ".");
} $html = p("nothing!") unless $html;
$html .= p("for a total cost of ", calculate_price());
return $html;
}
sub calculate_price {
my $shirts = param("shirt_count") || 0;
my $sweaters = param("sweater_count") || 0;
return sprintf("\$%.2f", $shirts*33 + $sweaters * 49.99);
}
sub to_page { submit(-NAME => ".State", -VALUE => shift) }
