[ главная ]   [ рейтинг статей ]   [ справочник радиолюбителя ]   [ новости мира ИТ ]



Ответов: 0
25-02-12 07:01







   Web - программирование
PHP


ASP






XML



CSS

SSI





   Программирование под ОС











   Web - технологии








   Базы Данных









   Графика






Данные




Web - программирование / PERL /

Делаем чат на Perl/Cgi

Дятченко Николай http://ufoxfiles.h1.ru/


В интернете существует много сервисов, предоставляющих бесплатные чаты, многие из которых имеют ограничения, для снятие которых нужно выкладывать некую сумму. Нас не интересуют подобные сервисы, мы хотим создать нечто своё, где не будет никакой навязчивой рекламы и т.д.
Для создания чата нам нужно определиться с языком написания чата. Чат можно сделать на PHP, ASP, но мы, как ясно из заголовка будем использовать Perl, который очень хорошо подходит для написания как простых, так и продвинутых чатов.
В этой статье я расскажу как создать обыкновенный чат на Perl, который в последствии можно довести "до ума".

Для начала создадим фреймовую структуру чата. В вверху будет находится фрейм с логотипом чата или какой-нибудь информацией. Среднюю часть страницы поделим на две части: в одной будут появляться сообщения, в другой будут располагаться новости чата. В нижней части окна будет расположена форма для введения ника, а после поле для ввода сообщения. Вот что у нас получилось:

<html>
<head>;
<title>Чат</title>
</head>
<frameset rows="15%,*,12%" border=1>
<frame name='top' scrolling='no' noresize target='namechat' src='../title.htm'>
<frameset cols="67%,*" border=0>\n";
<frame name="chat" noresize src="left.cgi">
<frame name='news' src='../news.htm' scrolling='auto'></frameset>
<frame name="message" scrolling='no' src="../nik.htm">
<noframes>
<body>
К сожалению, ваш браузер не поддерживает фреймы, необходимые для общения.
</body></noframes>
</frameset>
</html>

Содержание nik.htm:

<html>
<body>
<form method="post" action="cgi-bin/down.cgi">
<table wigth=100% border=0>
<tr><td width=15%>
Ник:</td>
<td width=85%>
<input type=text name=login>  <input type=submit value="Войти">
</td></tr></table>
</form>
</body>
</html>

Информация из nik.htm передаётся скрипту down.cgi, для её преобразования в скалярную переменную $login со значением ника пользователя нужно распознать метод передачи данных (в нашем случае это Post) и декодировать данные:

if($ENV{'REQUEST_METHOD'} eq 'GET'){
$query=$ENV{'QUERY_STRING'};
}
elsif($ENV{'REQUEST_METHOD'} eq 'POST'){
sysread STDIN,$query,$ENV{'CONTENT_LENGTH'};
}

# Распознали метод

@formfields=split /&/,$query;
foreach(@formfields){
if(/^login=(.*)/){$login=urldecode();}
}

sub urldecode{ 
local($val)=@_; 
$val=~s/+/ /g;
$val=~s/%([0-9A-H]{2})/pack('C',hex())/ge;
return $val;
}

# Декодировали данные и занесли значение ника в скалярную переменную $login.

Для того, чтобы появлялись сообщения о выходе пользователя через некоторое время, когда он просто закрыл окно с чатом нам нужно занести информацию о пользователе с последним временем обращения к чату (обновления окна). Мы будем использовать в чате два файла log.txt в котором содержится информация о присутствующих в чате и chat.txt с сообщениями пользователей:

$time = time;
{
($sec,$min,$hour,$mday,$mon,$year,$wday) = localtime(time);
$year+=1900;
$pdata="($hour:$min:$sec)";
}

#Установили время

open(LOG,">>log.txt");
print LOG "||$login||$time||\n";
close(LOG);
open(CHAT,"chat.txt");
@chat = <CHAT>;
close(CHAT);
$str = "||$pdata||К нам пришёл $login.||slug||\n";
push(@chat,$str);
$chat_many = @chat;
if ($chat_many > 99) {$chat[0] = "";}

open(CHAT,">chat.txt");
print CHAT @chat;
close(CHAT);

Заносим данные о пользователе в log.txt и извещаем всех посетителей в чате, что у них пополнения, занося в chat.txt строчку об этом и помечая, что эта строчка служебная (..||slug||..).

Выводим форму для ввода сообщения:

print "Content-Type: text/html; charset=windows-1251\n\n";
my $texts = qq~
<html>
<head>
<title>Чат</title>
<SCRIPT language="javascript"><!--
function send()
{
window.open ("left.cgi?out="+document.form1.out.value+"&login=$login", "message");
document.form1.out.value = '';
}
//--></script>
</head>
<body>
<form name="form1" method="post" action="../news.htm" target="news" onSubmit="send()">
<input type="text" style="width: 450px"> 
<input type="button" value="Ok" class="ok" onClick="send()" style="width: 30px; height: 18px; cursor: hand;">
</form></body></html>
~;
print "$texts";

Мы используем помощь JavaScript, чтобы нижнее окно не обновлялось.

Теперь напишем скрипт left.cgi для приема сообщений и вывода сообщений на экран:

 #!/usr/bin/perl

if($ENV{'REQUEST_METHOD'} eq 'GET'){
$query=$ENV{'QUERY_STRING'};
}
elsif($ENV{'REQUEST_METHOD'} eq 'POST'){
sysread STDIN,$query,$ENV{'CONTENT_LENGTH'};
}

@formfields=split /&/,$query;
foreach(@formfields){
if(/^out=(.*)/){$out=urldecode();}
if(/^login=(.*)/){$login=urldecode();}
}

sub urldecode{ 
local($val)=@_; 
$val=~s/+/ /g;
$val=~s/%([0-9A-H]{2})/pack('C',hex())/ge;
return $val;
}

{
($sec,$min,$hour,$mday,$mon,$year,$wday) = localtime(time);
$year+=1900;
$pdata="($hour:$min:$sec)";
}


$timeout = time;

open (LOG,"+<log.txt");
@log = <LOG>;

foreach $log (@log) {
@log_params = split(/||/,$log);
$timelog = $timeout - $log_params[2];
if ($timelog > 40) {
$log = "";
open(CHAT,"chat.txt");
@chat = <CHAT>;
close(CHAT);
$str = "||$pdata||$log_params[1] покидает чат.||slug||\n"; #сверяем время, если пользователь не присутствует в чате 
push(@chat,$str);                                                            #более 40 сек, то он покидает чат.
$chat_many = @chat;
if ($chat_many > 99) {$chat[0] = "";}

open(CHAT,">chat.txt");
print CHAT @chat;
close(CHAT);
}
$a++;
}

seek (LOG, 0, 0);
truncate (LOG,0);
print LOG @log;
close (LOG);

{
($sec,$min,$hour,$mday,$mon,$year,$wday) = localtime(time);
$year+=1900;
$pdata="($hour:$min:$sec)";
}

if ($login eq ""){loginno}else{
if ($out ne ""){&message;}else{&loginyes;} #определяем послал ли сообщение пользователь и в чате он или нет.
}

sub loginno {      # пользователь не в чате.
open(CHAT,"chat.txt");
@chat = <CHAT>;
close(CHAT);

@chat = reverse @chat; # инвертируем сообщения прочитанные из файла chat.txt

$end = 30 - 1;
$end = @chat - 1 if scalar(@chat) < 30; # берём 30 последних сообщений.

foreach $chat (@chat[0..$end]) {
@chat_params = split(/||/,$chat);
if ($chat_params[3] eq "slug"){
$str = "<b>$chat_params[1]: $chat_params[2]</b><br>"; # преобразуем их в html-код
}else{

$str = "<b>$chat_params[1]</b> $chat_params[2]<br>";
}
push(@text_chat,$str);
}

print "Content-Type: text/html; charset=windows-1251\n\n";
print "<html>\n";
print "<head><META HTTP-EQUIV="Expires" CONTENT="Tue, 04 Dec 1996 21:29:02 GMT">\n";
print "<meta http-equiv="Refresh" CONTENT="5; URL=left.cgi">\n";
print "<META HTTP-EQUIV = "CACHE-CONTROL" CONTENT = "NO-CACHE">\n<META HTTP-EQUIV = "PRAGMA" CONTENT = "NO-CACHE">\n";
print "</head>\n";
print "<body>\n";
foreach $str (@text_chat) { # выводим сообщения на экран.
print "$str\n";
}
print "</body>\n";
print "</html>\n";

exit;
}

sub message { # запись сообщения в фаил.
$out =~ s/</</g; # маленькая предосторожность - вырезам теги.
$out =~ s/>/>/g;

open(CHAT,"chat.txt");
@chat = <CHAT>;
close(CHAT);
$str = "||$login||$out||login||\n"; # записываем сообщение в фаил
push(@chat,$str);
$chat_many = @chat;
if ($chat_many > 99) {$chat[0] = "";}

open(CHAT,">chat.txt");
printf CHAT $line;
print CHAT @chat;
close(CHAT);
$out="";
&loginyes;
}

sub loginyes { # пользователь в чате

open(CHAT,"data/sl/chat.txt");
@chat = <CHAT>;
close(CHAT);

@chat = reverse @chat;

$end = 30 - 1;
$end = @chat - 1 if scalar(@chat) < 30;

foreach $chat (@chat[0..$end]) {
@chat_params = split(/||/,$chat);
if ($chat_params[3] eq "slug"){
$str = "<b>$chat_params[1]: $chat_params[2]</b><br>";
}else{

$str = "<b>$chat_params[1]</b> $chat_params[2]<br>";
}
push(@text_chat,$str);
}

print "Content-Type: text/html; charset=windows-1251\n\n";
print "<html>\n";
print "<head><META HTTP-EQUIV="Expires" CONTENT="Tue, 04 Dec 1996 21:29:02 GMT">\n";
print "<meta http-equiv="Refresh" CONTENT="5; URL=left.cgi?login=$login">\n";
print "<META HTTP-EQUIV = "CACHE-CONTROL" CONTENT = "NO-CACHE">\n<META HTTP-EQUIV = "PRAGMA" CONTENT = "NO-CACHE">\n";
print "</head>\n";
print "<body>\n";
foreach $str (@text_chat) {
print "$str\n";
}
print "</body>\n";
print "</html>\n";

open (LOG,"+<log.txt");
@log = <LOG>;

$a=0;
foreach (@log) {
@log_params = split(/||/,$log[$a]);
if ($log_params[1] eq $login) {
$log_params[2] = time;         # добавляем время, чтобы присутствующий пользователь не покинул чат.
$log[$a] = join("||",@log_params);
}
$a++;
}

seek (LOG, 0, 0);
truncate (LOG,0);
print LOG @log;
close (LOG);

exit;
}

exit;

Вот у нас получился простой чат, который можно доделать, добавить функций и т.д.




Комментарии

 Ваш комментарий к данному материалу будет интересен нам и нашим читателям!



Последние статьи: Web - программирование / PERL /

CGI интерфейс
24-10-2009   

Большое количество World Wide Web приложений основано на использовании внешних программ, управляемых Web сервером... подробнее

Кол. просмотров: общее - 4128 сегодня - 0

Upload File
24-10-2009   
Кол. просмотров: общее - 3236 сегодня - 2

Программирование для Веб: Загрузка файлов на сервер и посылка e-mail с вложениями
24-10-2009   

Одним из популярнейших вопросов во всевозможных форумах является вопрос «Как загрузить файл на сервер?». А ведь на самом деле это не так сложно, как кажется на первый взгляд. И чтобы не было совсем легко – пусть скрипт, который приведен ниже еще и посылает этот файл по почте, в виде вложения... подробнее

Кол. просмотров: общее - 3455 сегодня - 0

Защита WWW-сценариев от несанкционированного копирования и модификации
24-10-2009   

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

Кол. просмотров: общее - 3278 сегодня - 0

Как защитить мою программу, чтобы никто не смог её прочитать?
20-10-2009   

Disclaimer: все приведённые примеры предназначены для демонстрации принципов, а вовсе не являются готовыми к использованию решениями... подробнее

Кол. просмотров: общее - 3291 сегодня - 0



  WWW.COMPROG.RU - 2009-2012 | Designed and Powered by Zaipov Renat | Projects