Отправляет email-рассылки с помощью сервиса Sendsay

Perl - подпишись и учись!

Подписаться Бесплатная «Серебряная» новостная рассылка . Подписчиков 5.084 RSS
←   Февраль 2001   →
 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28


За последние 60 дней ни разу не выходила


Сайт рассылки: http://perl.dp.ua
Открыта: 03-12-2000

Автор
Nick

Статистика

5.084 подписчиков
0 за неделю
←   Все выпуски   →

Perl - подпишись и учись!


Служба Рассылок Subscribe.Ru проекта Citycat.Ru

Привет всем!

Как и обещал, в этом выпуске приведу простейший чат, который не претендует ни на какую крутость или что-то подобное, откровенно говоря, это - сырой материал, пример и всё.
Но прежде чем приступить к самому скрипту скажу, с какими проблемами сталкивается программист, создавая чат.
Во-первых необходимо осуществлять замену "<" на "&lt;", таким образом убирая тэги HTML из текста сообщений. Также, поскольку многие пользователи пытаются получить доступ к файлу одновременно, во избежание конфликтов на время чтения и записи, сценарий блокирует файл, функцией flock. Выбран вариант монопольной блокировки( в отличие от разделяемой блокировки), даже на чтение, поскольку он оказался наиболее живучим в различных системах(как показала практика, некоторые из них просто не поддерживают разделяемую блокировку). Если flock задаёт монопольную блокировку, ни одна другая программа не сможет использовать файл до тех пор, пока он не будет разблокирован. Это не означает, что остальные программы не смогут использовать его(в Unix, например, смогут), - это просто обозначает, что они не смогут получить от функции flock значение "истина". Этот сценарий использует flock для координации доступа к файлу многих пользователей, пред началом работы с файлом, ожидая, пока flock не вернёт значение "истина".
Если же в состоянии ожидания файла с беседой сценарий заблокируется, он сделает ещё десять попыток доступа с интервалом от одной до пяти секунд. Если это не поможет, то пользователю будет выдано сообщение о загруженности сервера.
Вот как работает приложение: пользователь переходит к chat.htm, которое создаёт две формы. Верхняя выводит текущий текст беседы с помощью сценария chat1.cgi, а в нижней сценарий chat2.cgi генерирует текстовую область, в которой пользователь может ввести текст, и кнопку подтверждения для его отправки. Верхняя форма использует тэг <META>, чтобы указать броузеру на необходимость регулярного обновления странички.
Для установки приложения вам необходимо разместить chat.htm, chat1.cgi, chat2.cgi, а также два файла chat1.dat и chat2.dat в одном каталоге.
Наверняка вам захочется изменить одно - это пятисекундный период обновления, используемый данным приложением. Для этого в строке: 

"<META HTTP-EQUIV=\"refresh\" CONTENT=\"10\""
файла chat1.cgi просто впишите требуемое кол-во секунд.
Также нада сделать ещё одно замечание. Оно касается CGI.pm. Когда пользователь посылает форму, элементы управления которой содержат данные, а ваш сценарий возвращает её без изменений, то CGI.pm копирует данные из старых элементов управления в новые. Друними словами, предположим, что форма включает текстовую область: 
$co->textarea(
           -name=>'textarea',
           -default=>'',
           -rows=>4,
           -columns=>40);
Если пользователь вводит текст, а затем передаёт его сценарию, тот может прочитать данные стандартными CGI-методами. однако, когда вы возвращаете Web-страницу с аналогичной формой, CGI.pm восстанавливает в текстовой области исходный текст(даже, если в качестве текста по умолчанию задана пустая строка). В приложении результат будет таков: когда пользователь отсылает набранный текст, он воспринимается сценарием, но не исчезает из текстовой области. Чтобы CGI.pm обновлял элементы управления значениями по умолчанию, атрибут -override нужно установить в значение "истина": 
$co->textarea(
           -name=>'textarea',
           -default=>'',
           -override=>1,
           -rows=>4,
           -columns=>40);
Теперь текстовая область будет очищаться после ввода данных, к чему, собственно, мы и стремились.
Далее приведу тексты chat.htm, chat1.cgi, chat2.cgi
<HTML>
<HEAD>
<TITLE>CHAT</TITLE>
<FRAMESET ROWS="*,150">
<NOFRAMES>Извините, но для просмотра страницы вам нужна поддержка Фреймов вашим броузером</NOFRAMES>
<FRAME NAME="_display" SRC="chat1.pl">
<FRAME NAME="_data" SRC="chat2.pl">
</FRAMESET>
</HTML>
#!/usr/bin/perl
#chat1.cgi
use CGI;
$co=new CGI;

open(DATA1,"chat1.dat") or die "Could not open Data file";
lockfile(DATA1);
$text1=;
unlockfile(DATA1);
close(DATA1);

open(DATA2,"chat2.dat") or die "Could not open Data file";
lockfile(DATA2);
$text2=;
unlockfile(DATA2);
close(DATA2);

print
$co->header,
"",
$co->start_html(
-title=>'Chat Example',
-target=>'_display',
-BGCOLOR=>'white'),
$co->center($co->h1('Многопользовательский Чат')),
$co->p,$co->p,
$co->center($text1),
$co->p,
$co->center($text2),
$co->end_html;

sub lockfile
{
my $attemps=0;
my $handle=shift;
until (flock($handle,2)){
sleep . 10;
if(++$count > 50){
$co->header,
"<meta HTTP-EQUIV=\"refresh\" CONTENT=\"10\">",
$co->start_html(
-title=>'Chat Example',
-target=>'_display',
-BGCOLOR=>'white'),
print "<center><h1><font color=red>Сервер занят. Попробуйте позже.</font></h1></center>";
exit;
}
}
}
sub unlockfile
{
my $handle=shift;
flock($handle,8);
}
#!/usr/bin/perl
#chat2.cgi
use CGI;
$co=new CGI;

if($co->param()){
$name=$co->param('username');
$name=~ s/ $text=$co->param('textarea');
$text=~ s/ if ($text){

open(OLDDATA,">>chat2.dat") or die "Could not open Data file";
lockfile(OLDDATA);
$oldtext=;
unlockfile(OLDDATA);
close(OLDDATA);

open(DATA,">>chat1.dat") or die "Could not open Data file";
lockfile(DATA);
print DATA $oldtext;
unlockfile(DATA);
close(DATA);

open(NEWDATA,">>chat2.dat") or die "Could not open Data file";
lockfile(NEWDATA);
print NEWDATA "<B>", $name, ": ", "</B>",$text,"<br>";
unlockfile(NEWDATA);
close(NEWDATA);}}

&printpage;

sub printpage{
print
$co->header,
$co->start_html(
-title=>'Chat Example',
-BGCOLOR=>'white'),
$co->startform,
$co->center(
"Введите ваше имя", $co->textfield(-name=>'username', -default=>'', -override=>1),
"и введите сообщение<br>",
$co->textarea(
-name=>'textarea',
-default=>'',
-override=>1,
-rows=>4,
-columns=>40)),
$co->center(
$co->submit(-value=>'Сказать'),
$co->reset),
$co->endform,
$co->end_html;}

sub lockfile
{
my $attemps=0;
my $handle=shift;
until (flock($handle,2)){
sleep . 10;
if(++$count > 50){
$co->header,
"<meta HTTP-EQUIV=\"refresh\" CONTENT=\"10\">",
$co->start_html(
-title=>'Chat Example',
-target=>'_display',
-BGCOLOR=>'white'),
print "<center><h1><font color=red>Сервер занят. Попробуйте позже.</font></h1></center>";
exit;
}
}
}

sub unlockfile
{
my $handle=shift;
flock($handle,8);
}
                                                That's all, Folks!
                                                                Nick
P.s. Рабочий вариант скрипта доступен по адресу http://perl.bos.ru/cgi-bin/examples/chat.htm.
В последнее время сайт был оптимизирован также и под Netscape Communicator.
На сайте также продолжает работать форум. Заходите и задавайте вопросы, "ибо именно в общении познаете истину", а пользователи И-нета помогут вам в этом.
P.p.s. В позапрошлом выпуске я рассказывал о работе с теневыми посылками при помощи CGI.pm, так вот работающий пример из листинга рассылки доступен по адресу:http://perl.bos.ru/cgi-bin/examples/hellocookie.pl.
http://subscribe.ru/
E-mail: ask@subscribe.ru
Поиск
В избранное