» Главная
eXcode.ru » Статьи » Perl
» Новости
» Опросы
» Файлы
» Журнал



Пользователей: 0
Гостей: 7





Чат на Perl.




Автор: Ковязин Дмитрий, P-Lib(www.p-lib.narod.ru)

Написание чата ничем особенным не отличается. Та же запись в файлы, чтение из них информации и вывод ее на экран. Однако есть кое-какие тонкости. Сообщения в чат поступают в режиме реального времени, поэтому для поддержания этого режима необходимо периодически обновлять содержимое html-страницы. Это осуществляется с помощью мета-инструкции <meta http-equiv="Refresh" content="10"> .В данном случае будем обновлять страницу с интервалом в 10 секунд, этого вполне достаточно. Итак, приступим непосредственно к чату. Для удобства, разобьем его как и форум на части и рассмотрим каждую в отдельности.
Вход в чат

Сгенерируем форму для входа в чат.


<html>
<style>
BODY
{
background-color:#e6e8fa;font-family:arial;font-size:10pt;color:#000080;
}
</style>
<body>
<h3 align=center><font color="ff0000">Вход в чат.</font></h3>
<form action="chat.cgi" method="GET">
<table align=center>
<tr><td>Введите ваш ник:<td><input type="text" name="nick" size=20>
<tr><td>Выберите цвет сообщений:<td><select name="color">
<option>black</option>
<option>red</option>
<option>blue</option>
<option>green</option>
<option>darkred</option>
<option>yellow</option>
</select>
<tr><td colspan=2><input type="hidden" name="enter" value="1">
<tr><td colspan=2><input type="hidden" name="action" value="login">
<tr><td colspan=2><input type="submit" value="Enter">
</table>
</form>
</html>


Посетитель выбирает себе ник и цвет, под которым будут выводиться его сообщения. Далее,скрипт получает эти данные и обрабатывает их.



#!/usr/local/bin/perl
$request=$ENV{′REQUEST_METHOD′};
$content=$ENV{′CONTENT_LENGTH′};
$file="chat.txt"; # Файл для записи сообщений
$syslog="log.txt"; # Cистемный журнал
$online="online.txt"; # Файл для записи онлайновых посетителей.
$dir="f:/usr/local/apache/cgi-bin";
$path="f:/usr/local/apache/cgi-bin/images/";
# Путь к папке с картинками (смайликами)
# Назначаем переменные для смайликов.
@images=([smile.gif],"frown.gif","redface.gif","biggrin.gif","wink.gif",
[tongue.gif],"cool.gif","rolleyes.gif",
[mad.gif],"eek.gif","confused.gif");
$img0=$images[0];
$src0="$path$img0";
$img1=$images[1];
$src1="$path$img1";
$img2=$images[2];
$src2="$path$img2";
$img3=$images[3];
$src3="$path$img3";
$img4=$images[4];
$src4="$path$img4";
$img5=$images[5];
$src5="$path$img5";
$img6=$images[6];
$src6="$path$img6";
$img7=$images[7];
$src7="$path$img7";
$img8=$images[8];
$src8="$path$img8";
$img9=$images[9];
$src9="$path$img9";
$img10=$images[10];
$src10="$path$img10";
if ($request eq ′GET′) {
$query=$ENV{′QUERY_STRING′};
} else {
sysread(STDIN,$query,$content);
}
# Функция для декодирования полей форм.

@pairs = split(/&/, $query);
foreach $pair (@pairs) {
($name, $value) = split(/=/, $pair);
$name =~ tr/+/ /;
$name =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack([C], hex($1))/eg;
$name =~ s///g;
$name =~ s/<([^>]|n)*>//g;
$value =~ tr/+/ /;
$value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack([C], hex($1))/eg;
$value =~ s///g;
$value =~ s/</</g;
$value =~ s/>/>/g;
$value =~ s/n//g;
$value =~ s/cM/ /g;
$value =~ s/|/ /g;
$value =~ tr/ / /s;
$value =~ s/<([^>]|n)*>//g;
$value =~ s/"/"/g;
$value=~s/:)/<img src=′$src0′>/g;
$value=~s/:(/<img src=′$src1′>/g;
$value=~s/:o/<img src=′$src2′>/g;
$value=~s/:D/<img src=′$src3′>/g;
$value=~s/;)/<img src=′$src4′>/g;
$value=~s/:p/<img src=′$src5′>/g;
$value=~s/:cool:/<img src=′$src6′>/g;
$value=~s/:rolleyes:/<img src=′$src7′>/g;
$value=~s/:mad:/<img src=′$src8′>/g;
$value=~s/:eek:/<img src=′$src9′>/g;
$value=~s/:confused:/<img src=′$src10′>/g;
$input{$name} = $value;
}
#####################Вход в чат#########################
($action eq [login]) && do {
# Получаем переменные
$enter=$input {′enter′};
$color=$input {′color′};
$nick=$input {′nick′};
$time=scalar localtime;
if ($enter eq [1]) {
# Проверяем,ввел ли посетитель ник и если да то записываем в системный
# журнал имя и время входа.
if ($nick ne "") {
open (LOG,">>$syslog");
$string="Системное сообщение: $nick вошел в чат $time";
print LOG [$stringn];
close (LOG);
# Добавляем имя посетителя также в файл для показа онлайна.
open (NET,">>$online");
print NET [$nickn];
close (NET);
# Установим количество записей в журнале. Я выбрал их равным 10.
open (LOG,"$syslog");
@strings=<LOG>;
$count=@strings;
close (LOG);
# Если их количество больше 10, удаляем
самую первую запись и перезаписываем журнал.
if ($count>10) {
shift (@strings);
}
open (LOG,">$syslog");
print LOG @strings;
close (LOG);
# Теперь посетитель находится в чате и может добавлять сообщения.
# Генерируем форму.
print [Content-type:text/htmlnn];
print <HTML;
<html><style>
BODY {background-color:#e6e8fa;font-family:arial;font-size:10pt;color:#000080;}
</style>
<body>
<center><h3>Здравствуйте,<font color="$color">$nick!</font></h3>
Вы успешно вошли в чат.

Вы можете добавлять ваши сообщения.Ваш цвет-<font
color="$color">$color</font>.</center>
<form action="chat.cgi" method="GET" ID="Form1">
<input type="hidden" name="action" value="add" ID="Hidden1">
<input type="hidden" name="nick" value="$nick" ID="Hidden2">
<input type="hidden" name="color" value="$color" ID="Hidden3">
<input type="hidden" name="send" value="1" ID="Hidden4">
<table align=center ID="Table8">
<tr><td><textarea name="message" wrap="virtual" rows=5 cols=40 ID="Textarea1"></textarea>
<td><input type="submit" value="Отправить" ID="Submit1" NAME="Submit1"></form><p>
<form action="chat.cgi" method="GET" ID="Form3">
<input type="hidden" name="action" value="add" ID="Hidden5">
<input type="hidden" name="nick" value="$nick" ID="Hidden6">
<input type="submit" value="<<Выход>>" ID="Submit2" NAME="Submit2">
</form>
</table>
HTML
}
# Если посетитель не ввел ник,выдается ошибка.
else {
print [Content-type:text/htmlnn];
print <<HTML;
<html><style>
BODY {background-color:#e6e8fa;font-family:arial;font-size:10pt;color:#000080;}
</style>
<body>
<h3 align=center>Вы не ввели ник!</h3>
Пожалуйста,вернитесь и введите ник.
<p><center><a href="chat.cgi?action=login">Назад</a></center>
HTML
}
}


Добавление сообщения в чат

После того, как посетитель ввел сообщение и нажал кнопку [Отправить], сообщение записывается в файл. Ник посетителя и цвет сообщений передаются в скрытых полях формы.



#########################Добавление
сообщения#########################
($action eq [add]) && do {
$time=time; # Получаем текущее время в секундах.
$time1=scalar localtime; # Время в нормальном формате.
$nick=$input {′nick′};
$color=$input {′color′};
$send=$input {′send′};
$exit=$input {′exit′};
$message=$input {′message′};
# Если посетитель нажал кнопку [Отправить].
if ($send eq [1]) {
# Проверяем,чтобы поле сообщения не было пустым.
if ($message ne "") {
# Если все ОК открываем файл на добавление и записываем данные.
open (FILE,">>$file");
$string=join (′&′,$nick,$time,$color,$message);
print FILE [$stringn];
close (FILE);
# Читаем файл в массив и подсчитываем количество сообщений.
open (FILE,"$file");
@lines=<FILE>;
$count=@lines;
close (FILE);
# Устанавливаем количество сохраняемых сообщений равным 20.
# Если этот лимит превышен,первое сообщение удаляется и т.д.
if ($count>20) {
shift (@lines);
}
# Перезаписываем измененный файл.
open (FILE,">$file");
print FILE @lines;
close (FILE);
# Сообщение записано и через 10 секунд появится на экране.
# Снова выводим форму для отправки сообщения.
print [Content-type:text/htmlnn];
print <<<HTML>;
<html><style>
BODY {background-color:#e6e8fa;font-family:arial;font-size:10pt;color:#000080;}
</style>
<body>
<center><h3>Новое сообщение.lt;/h3>
Вы уже в чате.Добавьте новое сообщение.
<вr>Ващ ник-<font color="$color">$nick</font>,цвет-<font color="$color">
$color</font>.</center>
<form action="chat.cgi" method="GET">
<input type="hidden" name="action" value="add">
<input type="hidden" name="nick" value="$nick">
<input type="hidden" name="color" value="$color">
<input type="hidden" name="send" value="1">
<table align=center>
<tr><td><textarea name="message" wrap="virtual" rows=5 cols=40></textarea>
<td><input type="submit" value="Отправить"></form><p>
<form action="chat.cgi" method="GET">
<input type="hidden" name="action" value="add">
<input type="hidden" name="nick" value="$nick">
<input type="submit" value="<<Выход>>">
</form>
</table>
<HTML>
}
# Если посетитель не ввел сообщение.
else {
print [Content-type:text/htmlnn];
print <<<HTML>
<html><style>
BODY {background-color:#e6e8fa;font-family:arial;font-size:10pt;color:#000080;}
</style>
<body>
<center><h3>Ошибка!</h3>
Поле сообщения не должно быть пустым.

Ваш ник-<font color="$color">$nick</font>,цвет-
<font color="$color">$color</font>.
<form action="chat.cgi" method="GET">
<input type="hidden" name="action" value="add">
<input type="hidden" name="nick" value="$nick">
<input type="hidden" name="color" value="$color">
<input type="hidden" name="send" value="1">
<table align=center>
<tr><td><textarea name="message" wrap="virtual" rows=5
cols=40></textarea>
<td><input type="submit" value="Отправить"></form><p>
<form action="chat.cgi" method="GET">
<input type="hidden" name="action" value="add">
<input type="hidden" name="nick" value="$nick">
<input type="submit" value="<<Выход>>">
</form>
</table>
<HTML>
}


Выход из чата

Если посетитель нажал кнопку [Выход].


#######################Выход из чата#########################

} else
{
# Записываем сообщение в системный журнал.
open (LOG,">>$syslog");
$string="Системное сообщение: $nick вышел из чата $time1";
print LOG [$stringn];
close (LOG);
# Снова удаляем лишние сообщения.
open (LOG,"$syslog");
@strings=<LOG>;
$count=@strings;
close (LOG);
if ($count>10) {
shift (@strings);
}
# Перезаписываем файл.
open (LOG,">$syslog");
print LOG @strings;
close (LOG);
# Говорим посетителю до свидания :)
print [Content-type:text/htmlnn];
print <<<HTML>;
<html><style>
BODY
{background-color:#e6e8fa;font-family:arial;font-size:10pt;color:#000080;}
</style>
<body>
<h3 align=center>Спасибо за посещение нашего чата,
<font color="0000ff">$nick</font>!</h3>
Заходите еще!
<p><center><a href="chat.cgi?action=login">Войти в чат</a></center>
<HTML>
# Удаляем посетителя из онлайна.Для этого обновляем файл online.txt
open (NET,"$online");
@users=<NET>; # Читаем содержимое
foreach $user (@users) {
if ($user !~ /$nick/) { # Сравниваем ник посетителя,выщедшего из чата с каждым
# ником в файле и если они не равны помещаем их в массив.
push (@online,$user);
}
}
close (NET);
# Перезаписываем файл уже без ушедшего посетителя.
open (NET,">$online");
print NET @online;
close (NET);
}
#Таким образом поддерживается самая свежая информация


о посетителях, или я не прав? x:)))

Показ посетителей,в данный момент находящихся в чате


########################Кто в онлайне#########################
($action eq [online]) && do {
# Эта страница также будет обновляться каждые 10 секунд.
print [Content-type:text/htmlnn];
print <<<HTML>;
<html><meta http-equiv="Refresh" content="10"><style>
BODY
{background-color:lightsteelblue;font-family:arial;font-size:10pt;}
</style>
<body>
# Выводим на экран табличку со смайликами.
<p><h5 align=center><font color="000080">Смайлики</font></h5>
<p><table align=center width=100>
<tr><td><img src="$path$img0"><td><font color="000000">:)</font>
<tr><td><img src="$path$img1"><td><font color="000000">:(</font>
<tr><td><img src="$path$img2"><td><font color="000000">:o</font>
<tr><td><img src="$path$img3"><td><font color="000000">:D</font>
<tr><td><img src="$path$img4"><td><font color="000000">;)</font>
<tr><td><img src="$path$img5"><td><font color="000000">:p</font>
<tr><td><img src="$path$img6"><td><font color="000000">:cool:</font>
<tr><td><img src="$path$img7"><td><font color="000000">:rolleyes:</font>
<tr><td><img src="$path$img8"><td><font color="000000">:mad:</font>
<tr><td><img src="$path$img9"><td><font color="000000">:eek:</font>
<tr><td><img src="$path$img10"><td><font color="000000">:confused:</font>
</table>
# Отображаем список посетителей.
<h5 align=center><font color="000080">Кто в онлайне.</font></h5>
<HTML>
# Здесь я предусмотрел очистку файла online.txt через 3 минуты после бездействия чата.
# Ни к чему хранить давние сообщения. Системный журнал и файл с сообщениями также очищаются
# после 3 минут бездействия, как вы увидите дальше.
# Сравниваем время модификации файла с текущим временем.
$cur_time=time;
$stat3=(stat ([$online]))[9];
$diff3=$cur_time-$stat3; # Вычисляем разность
# Если разность более 180 секунд, перезаписываем файл пустым значением.
if ($diff3>180) {
open (NET,">$online");
print NET "";
close (NET);}
# Дальше выводим собственно список.
open (NET,"$online");
@lines=<NET>;
$count=@lines;
if ($count!=0) {
print [<table bgcolor=]e6e8fa" align=center width=80 cellspacing=0
border=1 bordercolor="000000"><tr><td>n";
foreach $line (@lines) {
print [<font face=]serif" size=2 color="0000ff">[,$line,]</font>
[;
}
}
close (NET);
print <<<HTML>;
</table><p> <center><a href=]chat.cgi?action=login" target="second">Войти в чат</a></center>
<HTML>

Вывод системного журнала

В системный журнал пишутся сообщения о входе в чат и выходе из него. Он постоянно динамически обновляется. Для вывода его на экран читаем файл syslog.txt

##############Вывод системного журнала###############
($action eq [log]) && do {
# Здесь,в принципе все просто. Открываем файл, читаем и выводим на экран.
print [Content-type:text/htmlnn];
print <<<HTML>;
<html><meta http-equiv="Refresh" content="10">
<body bgcolor="0000ff" text="ffffff">
<HTML>
# Снова проверяем время модификации файла, и если оно больше 180 секунд очищаем его.
$cur_time=time;
$stat2=(stat ([$syslog]))[9];
$diff2=$cur_time-$stat2;
if ($diff2>180) {
open (LOG,">$syslog");
print LOG "";
close (LOG);
}
# Выводим сообщения на экран,начиная с последнего.
open (LOG,"$syslog");
@lines=<LOG>;
@strings=reverse @lines;
foreach $string (@strings) {
print $string,"
[;
}
close (LOG);
};


Вывод сообщений

Здесь тоже ничего особенного. Просто выводим сообщения на экран, каждые 10 секунд обновляя его.


###################Чтение cообщений########################
($action eq „read“) && do {
print „Content-type:text/htmlnn“;
print <<<HTML>;
<html><meta http-equiv=]Refresh" content="10">
<style>
BODY
{background-color:#e6e8fa;font-family:arial;font-size:10pt;}
</style>
<body>
<HTML>
# Файл с сообщениями также очищается после 180 секунд бездействия.
$cur_time=time;
$stat1=(stat ([$file]))[9];
$diff1=$cur_time-$stat1;
if ($diff1>180) {
open (FILE,">$file");
print FILE "";
close (FILE);
}
# Читаем сообщения и выводим на экран, начиная с последнего.
open (FILE,"$file");
@lines=<FILE>;
@items=reverse (@lines);
foreach $item (@items) {
@string=split (/&/,$item);
$time=localtime ($string[1]);
print <<<HTML>;
<font color="$string[2]">$string[0]</font> $time

<font color="$string[2]">$string[3]</font>
<center><hr width=80% noshade size=1></center>
<HTML>
}
close (FILE);


Главная страница

Вот мы и добрались до главной страницы, на которой, собственно, и происходит все это. Она представляет собой набор фреймов, в каждом из которых производятся совершенно независимые действия.


########################Главная страница#########################
if ($query eq "") {
print [Content-type:text/htmlnn];
print <<<HTML>;
<html><head></head>
<style>
A:link {text-decoration:none;font-family:arial;font-size:10pt;color:#000080; }
A:hover {text-decoration:none;font-family:arial;font-size:10pt;color:#ff0000; }
A:visited {text-decoration:none;font-family:arial;font-size:10pt;color:#000080; }
</style>
<frameset cols=20%,*>
<frame name="left" src="chat.cgi?action=online">
<frameset rows=50%,10%,*>
<frame name="first" src="chat.cgi?action=read">
<frame name="2" src="chat.cgi?action=log">
<frame name="second" src="chat.cgi?action=login">
</frameset>
</frameset>
<HTML>
}

К началу статьи





Добавил: MadvEXДата публикации: 2005-05-31 16:57:28
Рейтинг статьи:3.00 [Голосов 5]Кол-во просмотров: 26339

Комментарии читателей

Всего комментариев: 298

2017-07-23 19:53:57
Patrickmut
Всё отлично, хорошая программа реабилитации. Отдельное спасибо персоналу клиники. Вышел пару недель назад – тяги к наркоте нет!

См. подробнее тут - [url=https://krasnodar-deystvie.ru/uslugi-narkologa/vrach-narkolog]Врач нарколог в Краснодаре[/url]

2017-02-08 14:03:09
Charleship
<a href=https://www.youtube.com/watch?v=AE6K84UgQP4>speed чит на варфейс</a>

Наш сайт: <a href=http://cheater24.ru/forum/index.php?forums/warface.6/>Читы на варфейс</a>

2017-01-15 14:50:53
plitki.com
Perl есть практически на любом юниксе у любого хостера. Да питон тоже, но там может быть двойка, тройка и непонятно какие библиотеки.

2016-08-29 20:14:22
Michaelpa
Эта неопределенность ужасна. Подольше бы она не кончалась.


------
http://www.auto2000.su/

2016-08-29 19:52:51
Dustinpl
Жизни не надо смотреть в лицо, достаточно ощущать ее.


------
http://www.univeravto.ru/

2016-08-29 19:24:09
Ignaciohab
До чего красивые жены у моих приятелей!


------
http://www.znakdor.ru/

2016-08-29 13:47:28
SamuelTuh
Мало на свете пороков, которые больше мешают человеку обрести многочисленных друзей, чем слишком большие достоинства.


------
http://www.belzovmebel.ru/

2016-08-29 13:24:27
ThomaslinI
В высших должностях, так же как и на слишком возвышенных местностях, люди подвергаются головокружениям.


------
http://asavto.ru

2016-08-29 13:00:46
ErnestoCon
Тот, кто падет из любви к Богу, взойдет, подобно звезде.


------
http://www.rusgayk.ru/

2016-08-29 12:31:54
Jeffreyroto
Глупость, опирающаяся на опыт простого здравого смысла, стоит выше ума, увлеченного плодами собственного воображения


-----
http://www.jadeite-rus.ru/
Ваше имя: *
Текст записи: *
Имя:

Пароль:



Регистрация

Что для вас важнее в ПО
Его размер
7% (9)
Его цена
7% (8)
Его простота и доступность
17% (20)
Его функциональность
64% (77)
Наличие дополнительных фич
0% (0)
Наличие русского языка
5% (6)
Графицеский интерфейс
1% (1)
Изготовитель
0% (0)

Проголосовало: 121
Shift влево, Shift вправо считается Escape-ом и карается Reboot-ом!
Рейтинг: 4/10 (2)
Посмотреть все анекдоты