19.14. Программа: chemiserie

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

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

Пример 19.9. chemiserie

#i/usr/bin/perl -w

и chemiserie - простой сценарий CGI для заказа футболок и свитеров use strict;

use CGI qw(.standard);

use CGIiCarp qw(fatalsToBrowser);

my %States; # Хэш состояний - связывает страницы

tt с функциями 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{SCurrent Screen>;

tt Сгенерировать текущую страницу.

standard header();

while (my($screen name, Sfunction) = each %States) { $function->($screen narae eq $Current Screen);

standard footer(); exit;

uuuttttuttttttttuuttuttttuuttttttuttttuuuuttuutttt

19.14. Программа: chemiserie 699

# Колонтитулы формы, функции меню

тшшпппппшпттптппш

sub standard header {

print headerO, 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 Sactive = shift; return unless Sactive;

print "<H1>Hi!</H1>\n";

print "Welcome to our Shirt Shop Please make your selection from "; print "the menu below.\n";

shop menu();

# Страница для заказа футболок, sub shirt {

my Sactive = shift;

my ©sizes = qw(XL L M S);

my ©colors = qw(Black White);

my (Ssize, Scolor, Scount) =

(param("shirt size"), param("shirt color"), param("shirt count"));

# Проверка if (Scount) {

Scolor = ScolorsCO] unless grep { S eq Scolor } ©colors; Ssize = $sizes[0] unless grep { $ eq Ssize } ©sizes; param("shirt color", Scolor); param("shirt size", Ssize);

700 Глава 19 • Программирование CGI Пример 19.9 (продолжение)

unless (Sactive) {

print hidc(en( shirt size ) if $size, print hidden( shirt color ) if $color, print hidden( shirt count ) if Scount, 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 \S33 00 ),

print h2( Options )

print p( How Many , textfield( shirt count )), print p( Size , popup menu( shirt size , \@sizes ), Color , popup menu( shirt color , \@colors)),

shop menu(),

# Страница для заказа свитеров sub sweater {

my Sactive = shift,

my @sizes = qw(XL L M),

my ©colors = qw(Chartreuse Puce Lavender),

my (Ssize, Scolor, Scount) =

(param( sweater size ), param( sweater color ), param( sweater count ))

# Проверка If (Scount) {

Scolor = $colors[0] unless grep { S eq Scolor } ©colors, Ssize = $sizes[0] unless grep { $ eq Ssize } ©sizes, param( sweater color , Scolor), param( sweater size , Ssize),

unless (Sactive) {

print hidden( sweater size ) if Ssize, print hidden( sweater color ) if Scolor, print hidden( sweater count ) if Scount, 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 ),