Практический пример — гостевая книга или лента комментариев
Рассмотрим возможный код приложения, позволяющего посетителям сайта оставлять свои комментарии и читать уже оставленные другими пользователями реплики.
001 #!C:/apache/bin/perl/perl
002
003
004 # Вывод поля заголовка о типе содержимого
005 print "Content-type: text/html\n\n";
006
007
008 # Подключаемые модули
009 require '_stdlib.pl';
010
011
012 # Вызов подпрограммы формирования начального блока кода
013 &start('Комментарии');
014
015
016 # Вызов подпрограммы разбора пользовательского запроса,
? переданного методом POST
017 &recvquery_post;
018
019
020 #Добавление новой записи
021 if(($userdata{'comment'} ne '') && ($userdata{'nick'} ne '') &&
? ($userdata{'email'} ne ''))
022 {
023 $userdata{'comment'} = anti_html($userdata{'comment'});
024 $userdata{'nick'} = anti_html($userdata{'nick'});
025 $userdata{'email'} = anti_html($userdata{'email'});
026 $userdata{'comment'} =~ s/\r//g;
027
028 $date = russian_date();
029
030 open(OutFile, '>>comments.dat');
031 flock(OutFile, LOCK_EX);
032 print OutFile "$userdata{'comment'}\n<a
? href=\"mailto:$userdata{'email'}\">$userdata{'nick'}</a>,
? $date\n";
033 flock(OutFile, LOCK_UN);
034 close(OutFile);
035 }
036 elsif(($userdata{'comment'} ne '') || ($userdata{'nick'} ne '') ||
? ($userdata{'email'} ne ''))
037 {
038 print "<p style=\"color: #c00\">Все поля должны быть
? заполнены!</p>\n";
039 }
040
041
042 # Начальное число оставленных комментариев
043 $qty = 0;
044
045
046 # Вывод существующих записей
047 if(-e 'comments.dat')
048 {
049 open(InFile, 'comments.dat');
050
051 while($inline = <InFile>)
052 {
053 chomp($inline);
054 if($inline ne '')
055 {
056 if($inline =~ /<a href="mailto:/)
057 {
058 print "<p style=\"text-align: right; font-style: italic;
? border-bottom: solid 1px #000; padding-bottom:
? .5em\">$inline</p>\n";
059 $qty++;
060 }
061 else
062 {
063 print "<p>$inline</p>\n";
064 }
065 }
066 }
067
068 close(InFile);
069 }
070
071
072 # Вывод формы
073 print "<p>Всего комментариев: $qty.</p>\n";
074 print "<form action=\"comments.pl\" method=\"post\">\n";
075 print "<p>Ваш комментарий<span style=\"color:
? #c00\"><sup>*</sup></span>:<br /><textarea cols=\"30\" rows=\"5\"
? name=\"comment\"></textarea></p>\n";
076 print "<p>Как вас зовут<span style=\"color:
? #c00\"><sup>*</sup></span>:<br /><input type=\"text\" size=\"30\"
? maxlength=\"100\" name=\"nick\" /></p>\n";
077 print "<p>Ваш e-mail<span style=\"color:
? #c00\"><sup>*</sup></span>:<br /><input type=\"text\" size=\"20\"
? maxlength=\"50\" name=\"email\" /></p>\n";
078 print "<p><input type=\"submit\" value=\"Отправить!\" /></p>\n";
079 print "</form>\n";
080
081
082 # Вызов подпрограммы формирования конечного блока кода и завершения
? работы
083 &stop;
084
085
086 # Подпрограмма замены угловых скобок и амперсанда на соответствующие
? мнемоподстановки
087 sub anti_html
088 {
089 my $string = shift(@_);
090 $string =~ s/&/&/g;
091 $string =~ s/</</g;
092 $string =~ s/>/>/g;
093 return $string;
094 }
095
096
097 # Подпрограмма формирования даты и времени, представленных в формате,
? принятом в России
098 sub russian_date
099 {
100 my @date = localtime();
101 $date[0] = '0' . $date[0] if($date[0] < 10);
102 $date[1] = '0' . $date[1] if($date[1] < 10);
103 $date[2] = '0' . $date[2] if($date[2] < 10);
104 $date[3] = '0' . $date[3] if($date[3] < 10);
105 $date[4]++;
106 $date[4] = '0' . $date[4] if($date[4] < 10);
107 $date[5] += 1900;
108 return "оставлено $date[3].$date[4].$date[5] в
? $date[2]:$date[1]:$date[0]";
109 }