$entry, # одна конкретная запись

$TITLE = "Simple Guestbook";

$CHATNAME = "/usr/tmp/chatflie"; # где все это в системе находится $MAXSAVE = 10;

print header, start html($TITLE), hl($TITLE);

$cur = CGI->new(); # текущий запрос

if ($cur->param("message")) { # хорошо, мы получили сообщение

$cur->param("date", scalar localtime); # установить текущее время (gentries = ($cur); # записать сообщение в массив

# открыть файл для чтения и записи (с сохранением предыдущего содержимого) open(CHANDLE, "+< $CHATNAME") bail("cannot open $CHATNAME: $");

# получить эксклюзивную блокировку на гостевую книгу

# (LOCK EX == exclusive lock)

flock(CHANDLE, LOCK EX) I I bail("cannot flock $CHATNAME: $");

# занести в $MAXSAVE старые записи (первой - самую новую) while С eof (CHANDLE) SS (Jentries < $MAXSAVE) {

$entry = CGI->new (\*CHANDLE); # передать дескриптор файла по ссылке push (gentries, $entry;

seek(CHANDLE, 0, 0) M bail("cannot rewind $CHATNAME: $i"); foreach $entry ((entries) (

$entry->save(\*CHANDLE); # передать дескриптор файла по ссылке

truncate(CHANDLE, tell(CHANDLE)) bail("cannot truncate $CHATNAME: $"); close(CHANDLE) bail ("cannot close $CHATNAME: $");

print hr, start form; # hr()проводит горизонтальную линию: <HR>

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 forra, hr;

print h2("Prior Messages"); foreach $entry ((entries) (

printf("%s [%s]: %s",

$entry->param("date"),

$entry->param("name"),

$entry->param("message"));

print br 0;

print end html;

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

Netscape - [Simple Gueslboot [

Go lo hKp www pefl com/cgi-bifi/guesfbook

Simple Guestbook

Name:

Message:

send

clear:

Prior Messages

Tue Nov 18 17:25 ;50 1997 [Princess Leia Organa]; Help me Obi Wan, youre my only hope.

.Document: Done [ £3

Puc. 19.5. Форма простой гостевой книги

Обратите внимание на то, что программа начинается с оператора

use 5.004;

Если вы хотите запускать ее с помощью более ранние версии Perl 5, то нужно превратить в комментарий строку

use Fcntl qw(:flock)

и заменить lock ex в первом вызове flock на z.

Поскольку каждое выполнение программы приводит к возврату HTML-формы в броузер, который обратился к программе, то программа начинается с задания HTML-кода:

print lieader, start html ($TITLE) , hl($TITLE);

Затем создается новый CGI-объект:

$cur = CGI->new(); # текущий запрос

if ($cur->param("message")) { # хорошо, мы получили сообщение

$cur->param("date", scalar localtime); # установить текущее время

(gentries = ($cur); # записать сообщение в массив

Если нас вызывают посредством заполнения и передачи формы, то объект $cur должен содержать информацию о тексте, введенном в форму. Форма, которую мы предлагаем (см. ниже), содержит два поля ввода: поле имени для ввода имени пользователя и поле сообщения для ввода сообщения. Кроме того, приведенный выше код ставит на введенные в форму данные (после их получения) метку даты. Передача в метод param () двух аргументов - это способ присваивания параметру, заданному первым аргументом, значения, указанного во втором аргументе.

Если нас вызывают не посредством передачи формы, а выполняя щелчок мышью на ссылке Please sign our guestbook, то объект запроса, который мы создаем, будет пуст. Проверка if даст значение "ложь", и в массив @entries никакой элемент занесен не будет.

В любом случае мы переходим к проверке наличия записей, созданных ранее в нашем сохраняемом файле. Эти записи мы будем считывать в массив @entries. (Вспомните о том, что мы только что сделали текущие данные, если они имеются в форме, первым элементом этого массива.) Но сначала мы должны открыть сохраняемый файл:

open(CHANDLE, "+< $CHATNAME") М bail("cannot open $CHATNAME. $");

Эта функция открывает файл в режиме неразрушающего чтения-записи. Вместо open можно использовать sysopen (). При таком способе посредством единственного вызова открывается старый файл, если он существует (без уничтожения его содержимого), а в противном случае создается новый файл:

# нужно импортировать две "константы" из модуля Fcntl для sysopen use Fcntl qw( 0 RDWR 0 CREAT );

sysopen(CHANDLE, $CHATFILE, 0 RDWR0 CREAT, 0666) II bail "cant open $CHATFILE: $";

Затем мы блокируем файл, как описывалось выше, и переходим к считыванию текущих записей из $ мах save в (aentnes:

flocl< (CHANDLE, L0CK EX) ball ("cannot flocl< $CHATNAME: $"); while ( I eof (CHANDLE) SS (Jentries < $MAXSAVE) (

$entry = CGI->new(\*CHANDLE); # передать дескриптор файла по ссылке

push (Sentries, $entry;