CGI-программа гостевой книги.
Создание файла:
touch /usr/tmp/chatfile chmod 0666 /usr/tmp/chatfile
Блокирование доступа:
use Fcntl qw(:flock); # импортирует LOCK_EX, ... ... flock(CHANDLE, LOCK_EX) bail("Cannot flock $CHATNAME: !$");
Другие компоненты формы.
Пример:
#/usr/bin/perl5 -w
use strict; use CGI qw(:standard);
print header; print start_html("Ice Cream Stand"), h1("Ice Cream Stand"); if(param()) { my $who = param("name"); my $flavor = param("flavor"); my $scoops = param("scoops"); my $taxrate = 1.0743; my $cost = sprintf("%.2f", $taxrate * (1.00 + $scoops*0.25)); print p("Ok, $who, have $scoops scoops of $flavor for\$$cost."); } else { print hr(); print start_form(); print p("What is your name? ", textfield("name")); print p("What flavor: ", popup_menu("flavor", ['mint', 'cherry', 'mocha'])); print p("How many scoops? ", popup_menu("scoops", [1..3])); print p(submit("order"), reset("clear")); print end_form(), hr(); } print end_html();
Другие вызывающие последовательности.
Прокручиваемый список:
print scrolling_list( -NAME => "flavors", -VALUES => [qw(mint chocolate cherry vanilla peach)], -LABELS => { mint => "Mightly Mint", chocolate => "Cherished Chocolate", cherry => "Cherry Cherry", vanilla => "Very Vanilla", peach => "Perfectly Peach", }, -SIZE => 3, -MULTIPLE => 1 # 1 - true, 0 - false );
-NAME - имя компонента формы,
-LABELS - ссылка на анонимный хеш,
-VALUES - ссылка на анонимный массивa ключей хеша,
-SIZE - сколько элементов списка видно одновременно,
-MULTIPLE - если 1 - можно выбирать более одного элемента списка.
Если -MULTIPLE в положении истина, можно делать:
@choices = param("flavors");
Еще один способ:
%flavors = ( "mint", "Mightly Mint", "chocolate", "Cherished Chocolate", "cherry", "Cherry Cherry", "vanilla", "Very Vanilla", "peach", "Perfectly Peach", ); print scrolling_list( -NAME => "flavors", -LABELS => \%flavors, -VALUES => [keys %flavors], -SIZE => 3, -MULTIPLE => 1 # 1 - true, 0 - false );
Генерирование формы.
HTML-страница, содержащая заполняемую форму:
<HTLM> <HEAD> <TITLE> Hello Ice Cream </TITLE> </HEAD> <BODY> <H1>Hello Ice Cream!</H1> <FORM ACTION="http://serv.edu.kiae.ru/~stsss/cgi-bin/ice_cream.cgi" METHOD="GET"> What is your flavor?<INPUT NAME="favorite" TYPE="text" VALUE="mint"> <P> <INPUT TYPE="submit"> </FORM> </BODY> </HTLM>
Вариант с использованием одного CGI-файла:
#!/usr/bin/perl5 -w
use CGI qw(:standard); my $favorite = param("flavor"); print header(); print start_html("Hello Ice Cream!"), h1("Hello Ice Cream!"); if($favorite) { print p("Your favorite flavor is $favorite"); } else { print hr, start_form; print p("Pleace select a flavor: ", textfield("flavor", "mint")); print end_form, hr } print end_html();
Обьектно-ориентированное программирование на PERL.
Пусть модуль CGI возвращает обьект $query
$he_said = $query->param("answer");
Имя класса - имя модуля без расширения .pm (обычно).
Конструктор, необходимый для создания обьекта:
$query = CGI->new(); # or $query = new() CGI;
Обьекты в модуле CGI.pm.
CGI-модуль можно рассматривать либо как традиционный модуль с экспортируемыми функциями, либо как обьектный модуль.
#!/usr/bin/perl5 -w
use 5.004; use strict; use CGI qw(:standard); use Fcntl qw(:flock);
sub bail { # функция ошибок my $error = "@_"; print h1("Unexpected Error"), p($error), end_html; die $error; }
my ( $CHATNAME, # имя файла гостевой книги $MAXSAVE, # какое количество хранить $TITLE, # название и заголовок страницы $cur, # все текущие записи $entry, # одна конкретная запись );
$TITLE = "Simple Guestbook"; $SHATNAME = "/usr/tmp/chatfile"; $MAXSAVE = 10;
print header, start_html($TITLE); h1($TITLE);
my(@entries);
$cur = CGI -> new(); # текущий запрос if($cur -> param("message")) { # мы получили сообщение $cur -> param("data", scalar localtime); # установить текущее время @entries = ($cur); # записать сообщение в массив }
# открыть файл для чтения и записи (с сохранением предыдущего содержимого) open(CHANDLE, "+< $CHATNAME") bail("canot open $CHATNAME: $!");
# получить эксклюзивную блокировку на гостевую книгу # (LOCK_EX == exclusive lock) flock(CHANDLE, LOCK_EX) bail("canot flock $CHATNAME: $!");
# занести в $MAXSAVE старые записи (первой - самую новую) while(!eof(CHANDLE) && @entries < $MAXSAVE) { $entry = CGI -> new(\*CHANDLE); # передать дескриптор файла по ссылке push @entries, $entry; } seek(CHANDLE, 0, 0) bail("canot rewind $CHATNAME: $!"); foreach $entry (@entries) { $entry -> save(\*CHANDLE); } truncate(CHANDLE, tell(CHANDLE)) bail("canot truncate $CHATNAME: $!"); close(CHANDLE) bail("canot close $CHATNAME: $!");
print hr, start_form; print p("Name:", $cur -> textfield(-NAME => "name")); print p("Message:", $cur -> textfield( -NAME => "message", -OVERRIDE => 1, # стирает предыдущее сообщение -SIZE => 50 ) ); print p(submit("send"), reset("clear")); print end_form, hr;
print h2("Prior Messages"); foreach $entry (@entiries) { printf("%s [%s]: %s", $entry -> param("date"), $entry -> param("name"), $entry -> param("message")); print br(); } print end_html;
Передача параметров через CGI.
Используется модуль CGI.pm. Программа, которая запрос: serv.edu.kiae.ru/~gds/cgi-bin/test.cgi?flavor=mint:
#!/usr/bin/perl5 -w use CGI qw(param); print <<END_of_Multiline_Text; Content-type: text/html
<HTML> <HEAD> <Hello World!<TITLE> </HEAD> <BODY> <H1>Greetings, Terrians!<H1> End_of_Multiline_Text
my $favorilte = param("flover"); print "<P>Your favorite flavor is $favorite."; print <<All_Done; </BODY> </HTML> All_Done
Простейшая CGI-программа.
Пример:
#!/usr/bin/perl5 -w print <<END_of_Multiline_Text; Content-type: text/html
<HTML> <HEAD> <Hello World!<TITLE> </HEAD> <BODY> <H1>Greetings, Terrians!<H1> </BODY> </HTML>
End_of_Multiline_Text
Сокращение обьема вводимого текста.
В модуле CGI.pm имеются директивы импорта - метки, которые обозначают группы импортируемых функций. В модуле имеются следущие директивы: :cgi, :form, :html2, :html3, :netscape, :shortcuts, :standard, :all.
Пример использования сокращений:
#!/usr/bin/perl5 -w
use CGI qw(:standard); print header(); print start_html("Hello World!"), h1("Hello World!"); my $favorite = param("flavor"); print p("Your favorite flavor is $favorite"); print end_html();
Ссылки.
В функции popup_menu() квадратные скобки создают ссылку на анонимный массив. Другой способ создания ссылки на массив:
@choises = ('mint', 'cherry', 'mocha'); print p("What flavor: ", popup_menu("flavor",\@choises));
Ссылки работают примерно как ссылки в C. Они указывают на другие значения или переменные. Сылки PERL нельзя приводить. Если область памяти, на которую указывают ссылки, больше не используется, автоматически возвращается в использование.
Методом \@array можно создавать ссылки на именованные массивы, а посредством указания [ list ] - на анонимные массивы.
Методом \%hesh можно создавать ссылки на именованные хеши, а посредством указания { key1, val1, key2, val2, .. } - на анонимные хеши.
