В этой статье я рассмотрю создание простого чата на Perl. Чат будет состоять из консольного сервера и клиента с GUI на основе Tk. Для начала реализуем серверную часть.
В серверной части мы не будем использовать процессы или потоки, а вместо этого воспользуемся мультиплексированием. Мультиплексирование довольно просто реализуется с помощью модуля IO::Select, который является классом-оболочкой над системной функцией select.
Функция select позволяет определить готовность дескриптора к записи/чтению. Также стоит отметить, что при использовании select следует избегать использования блокирующих вызовов, как, например, print, read, вместо них необходимо использовать syswrite, sysread.
Итак, начнем писать сервер:
|
1 2 3 4 5 6 7 |
use strict; use IO::Select; use IO::Socket::INET; use constant LOGFILE => 'log.txt'; use constant SIZE => 1024; use constant EOL => "\x0D\x0A"; |
В этом фрагменте мы включаем прагму strict, которая ограничивает применение небезопасных конструкций, подключаем модули IO::Select, IO::Socket::INET и объявляем несколько констант: имя файла логов, лимит размера буфера для некоторых операций ввода/вывода в скрипте, символы конца строки (если написать \r\n, то, в зависимости от платформы, \n может превратиться, например, в \r\n, что является нежелательным событием).
|
1 2 3 4 5 6 7 8 9 |
if(scalar @ARGV < 2) { die "Usage: server.pl ip port\n"; } my ($serv_ip, $serv_port) = @ARGV; my $socket = IO::Socket::INET->new(LocalAddr => $serv_ip, LocalPort => $serv_port, Listen => 20, Proto => 'tcp', Reuse => 1) or die $!; my $select = IO::Select->new($socket) or die $!; |
Сервер будет запускаться через консоль, в качестве аргументов запуска должны быть указаны IP и Порт, на которые сервер будет биндиться. Далее создается сокет для приема входящих соединений и объект IO::Select, который содержит дескриптор сокета.
Теперь рассмотрим основной цикл обработки входящих соединений:
|
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 29 30 31 32 33 34 35 36 37 38 39 40 41 |
print "Started\n"; while(1) { my @r = $select->can_read; my @w = $select->can_write(.1); for my $handle (@r) { if($handle eq $socket) { my $connect = $socket->accept(); $select->add($connect); } else { my $user_input; while(sysread $handle, $_, SIZE) { $user_input .= $_; last if $_ =~ /\x0A/ or length $user_input >= SIZE; } $user_input =~ s/[\x00-\x08\x0A-\x1F]//g; if(length $user_input > 0) { $user_input = handle_request($user_input, $handle); if($user_input) { syswrite $_, $user_input, SIZE for @w; } } else { $select->remove($handle); close $handle; } } } } |
При каждой итерации цикла вызываются методы can_read и can_write, они возвращают список дескрипторов, готовых для чтения и записи. Следует отметить, что вызов can_read является блокирующим, а вызов can_write сбрасывается через 100 мс ожидания. Далее в цикле идет сравнение готовых к чтению дескрипторов с дескриптором слушающего сокетом. Если дескриптор к нему относится, то вызывается метод accept, который приводит к созданию нового подключенного сокета. Сокет в свою очередь добавляется к набору дескрипторов IO::Select с помощью метода add. Если дескриптор не является слушающим сокетом и готов для чтения, то из него читаются данные до тех пор, пока в них не обнаружится символ переноса строки или их размер не превысит значения константы SIZE.
Из полученных данных удаляются специальные символы (кроме табуляции). Если объем данных больше 0, то они передаются в функцию handle_request для дальнейшей обработки, а затем в обработанном виде рассылаются в дескрипторы, готовые для записи. В противном случае, запрос воспринимается как завершение сеанса работы с сервером, дескриптор удаляется из списка дескрипторов IO::Select и закрывается.
И, наконец, рассмотрим последний кусок кода сервера, а именно функцию handle_request.
|
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 |
sub handle_request { my ($user_input, $handle) = @_; if($user_input eq 'LOG') { if(-e LOGFILE) { open F, '<', LOGFILE or warn $!; while(<F>) { s/\x0D\x0A$//g; syswrite $handle, $_.EOL, SIZE; } close F; } return undef; } $user_input = substr($handle->peerhost.':'.time.':'.$user_input, 0, SIZE - 2).EOL; open F, '>>', LOGFILE or warn $!; syswrite F, $user_input, SIZE; close F; return $user_input; } |
Как видно из кода, в функцию передаются данные, поступившие от пользователя, и дескриптор клиента. Если от пользователя пришла команда LOG, то читается содержимое файла LOGFILE (если он существует) и отправляется пользователю. После этого функция возвращает undef, дабы команда не была продублирована в чат всем подключенным пользователям. Также хочу обратить внимание, что построчное чтение файла реализовано с помощью <>. В случае с мультиплексным сервером это неправильно, так как такое чтение является блокирующим, вместо него следовало бы написать собственную неблокирующую реализацию чтения или воспользоваться модулем IO::Getline.
Далее в функции пользовательские данные обрезаются и преобразуются в стандарт, установленный сервером: IP:Timestamp:Данные\r\n. После этого они записываются в LOGFILE и возвращаются в форматированном виде из функции, далее они будут отправлены всем подключенным клиентам.
Теперь рассмотрим графический клиент чата. Выглядеть он будет следующим образом:
Как обычно, начнем с прагм и инклюдов.
|
1 2 3 4 5 6 7 8 9 10 11 |
use strict; use IO::Socket::INET; use POSIX qw/strftime/; use Tk; use Tk::ROText; use Tk::EntryCheck; use encoding 'utf-8'; use constant SIZE => 1024; use constant EOL => "\x0D\x0A"; |
Чтобы не повторяться, опишу только новые фрагменты. В 3 строке мы импортируем функцию strftime их пакета POSIX. С помощью неё клиент преобразует timestamp, отправляемый сервером, в более читабельный вариант, как на картинке выше. Модули Tk, Tk::ROText и Tk::EntryCheck подключаются для создания графического интерфейса, ROText и EntryCheck - это так называемые виджеты. Прагма encoding необходима для нормального отображения русского языка в интерфейсе (по крайней мере, под win*).
|
1 2 3 4 5 6 7 8 |
BEGIN { if($^O eq 'MSWin32') { require Win32::Console; Win32::Console::Free(); } } |
Далее идет специальный блок BEGIN, который выполняется во время компиляции как можно раньше. В нем происходит проверка системы и, если скрипт запущен под ОС семейства Windows, то подключается модуль Win32::Console и вызывается метод Free, который консоль "освобождает". То есть при запуске двойным кликом, окно консоли не будет висеть на фоне.
Теперь определим несколько глобальных переменных и создадим интерфейс чата:
|
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 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 |
my ($socket, $connection_state) = (0, 0); my $main = MainWindow->new(title => 'Chat'); $main->geometry('640x420'); my $chat_box = $main->Scrolled ( 'ROText', -scrollbars => 'e' )->pack(-fill => 'both', -expand => 1, -anchor => 'n'); my $text_field = $main->EntryCheck ( -background => 'white', -width => 15, -maxlength => 100 )->pack(-fill => 'x', -after => $chat_box); $text_field->bind('<Return>' => \&send); $main->Label(-text => 'IP')->pack(-side => 'left'); my $ip_field = $main->EntryCheck ( -background => 'white', -width => 15, -maxlength => 15, -pattern => qr/[\d\.]/ )->pack(-side => 'left'); $main->Label(-text => 'Порт')->pack(-side => 'left'); my $port_field = $main->EntryCheck ( -background => 'white', -width => 5, -maxlength => 5, -pattern => qr/\d/ )->pack(-side => 'left'); my $start_btn = $main->Button ( -text => 'Подключиться', -command => \&start )->pack(-side => 'left'); my $clear_btn = $main->Button ( -text => 'Очистить чат', -command => \&clear_chat )->pack(-side => 'right'); MainLoop; |
В переменной socket будет храниться дескриптор открытого сокета, в connection_state - состояние подключения. Метод MainWindow->new создает главное окно чата, в котором будут расположены прочие элементы интерфейса, параметр title задает текст заголовка окна. Метод geometry задает размеры окна. Далее мы создаем элемент, в котором будут находиться сообщения чата. Метод Scrolled указывает на наличие полос прокрутки у виджета, аргумент ROText уточняет тип (ReadOnly Text), -scrollbars => 'e' указывает, что полоса прокрутки необходима только справа (e -> east). Местоположение виджета на форме задается строкой pack(-fill => 'both', -expand => 1, -anchor => 'n').
Рассмотрим подробнее, что такое pack. В контексте Tk существуют 3 "способа" расположения элементов на форме, так называемые geometry managers, это: pack, place и grid. Pack не позволяет элементам формы перекрывать друг друга, то есть, следующая ситуация невозможна:
Параметр fill указывает на плоскость, которую займет виджет при расположении на форме (none, x, y или both). expand делает виджет "резновым", то есть виджет стремится занять доступное пространство по измерениям, указанным в параметре fill. Параметр anchor "цепляет" виджет к определенной стороне дочернего окна.
Подробнее про всё это можно прочитать в книге "Learning Perl/Tk: Graphical User Interfaces with Perl".
Далее по коду мы создаем поле для ввода EntryCheck. EntryCheck - это расширенный вариант виджета Entry, позволяющий указывать дополнительные атрибуты у поля, как, например, предельно допустимый размер вводимого текста (параметр maxlength). Параметр background задает цвет фона виджета, по умолчанию он серый у EntryCheck.
После создания виджета поля для ввода идет вызов метода bind, он привязывает к нажатию клавиши Enter функцию send, которая отвечает за отправку сообщений. Параметр after позволяет помещать один виджет после другого, что мы и делаем.
Далее мы создаем элемент Label с текстом, он просто отображает содержимое параметра text в указанном месте. Параметр side в методе pack указывает на положение виджета в окне, допустимые значения: left, right, top, bottom.
Следующие несколько виджетов, типа EntryCheck, обладают параметром pattern, он проверяет вводимые в поле символы на соответствие регулярному выражению, что дает возможность фильтрации (в этом примере поле Порт ограничено цифрами, а поле IP цифрами и точкой).
И, наконец, создается пара кнопок, на которые вешаются методы start и clear_chat. MainLoop завершает графическую часть клиента. Теперь рассмотрим методы, которые использует клиент:
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 |
sub clear_chat { $chat_box->delete('1.0', 'end'); $chat_box->insert('end', "Чат очищен\n"); } sub set_state { $start_btn->configure(-text => $connection_state ? 'Подключиться' : 'Отключиться'); $connection_state = $connection_state ? 0 : 1; } sub disconnect { if($socket) { syswrite $socket, EOL; close $socket; } set_state(); clear_chat(); $chat_box->insert('end', "Вы отключились\n"); } |
Для начала, несколько простых методов. Метод clear_chat очищает окно сообщений и помещает туда текст "Чат очищен". Метод set_state меняет текст на кнопке $start_btn и управляет "переключателем" connection_state. Метод disconnect проверяет, открыт ли сокет, сообщает серверу, что сеанс связи завершен, закрывает сокет, вызывает методы set_state и clear_chat, и, наконец, помещает в окно чата сообщение "Вы отключились".
Рассмотрим метод отправки сообщений на сервер:
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 |
sub send { unless($connection_state && $socket) { $main->messageBox ( -message => 'Сначала подключитесь к серверу', -title => 'Ошибка', -type => 'ok' ); return; } my $text = $text_field->get; if(length $text > 0) { syswrite $socket, $text.EOL, SIZE; $text_field->delete('0', 'end'); } } |
В методе проверяется состояние сокета и переменной connection_state, и, если хотя бы одна из них является ложной, то выдается предупреждение, в противном случае, содержимое поля для ввода читается в переменную $text, проверяется размер данных и если он ненулевой, то они отправляются на сервер, а поле для ввода очищается.
И, наконец, последняя функция:
|
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 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 |
sub start { if($connection_state) { disconnect(); } else { my $serv_ip = $ip_field->get; my $serv_port = $port_field->get; if($serv_ip !~ /^(?:\d{1,3}\.){3}\d{1,3}$/ || $serv_port !~ /^\d{1,5}$/) { $main->messageBox ( -message => 'IP или порт указаны неверно', -title => 'Ошибка', -type => 'ok' ); return; } $socket = IO::Socket::INET->new(PeerAddr => $serv_ip, PeerPort => $serv_port, PeerProto => 'tcp') or { $main->messageBox ( -message => 'Не удалось подключиться к серверу', -title => 'Ошибка', -type => 'ok' ), return }; binmode $socket, ':utf8'; set_state(); if($^O eq 'MSWin32') { ioctl($socket, 0x8004667e, unpack('I', pack('P', (pack 'L', 1)))); } else { $socket->blocking(0); } syswrite $socket, 'LOG'.EOL; while($connection_state) { if(sysread($socket, $_, SIZE) > 0) { while($_ =~ /^((?:\d{1,3}\.){3}\d{1,3}):(\d+):(.+)$/mg) { $chat_box->insert('end', "$1 - ".strftime("%H:%M:%S",localtime($2))."> $3\n"); } $chat_box->see('end'); } $main->update; select undef, undef, undef, .1; } } } |
Этот метод выполняется при нажатии кнопки "Подключиться". Если соединение уже установленно, то происходит вызов метода disconnect. Если активного соединения нет, то содержимое полей IP и Порт читается в переменные, далее с помощью регулярных выражений идет проверка введенных данных. Если данные прошли проверку, то предпринимается попытка подключения к серверу, если она проходит неудачно, то выдается сообщение и выполнение метода прекращается, в противном случае, сокет переводится в бинарный режим вызовом binmode, далее происходит вызов метода set_state, перевод сокета в неблокирующий режим (в зависимости от типа ОС, метод blocking(0) не работает на win*), в сокет отправляется запрос на получение содержимого лога чата, и, наконец, запускается основной цикл. Цикл выполняется до тех пор, пока переменная connection_state является истинной, то есть подключение активно. В теле цикла идет чтение из сокета, если размер полученных данных больше 0, то с помощью регулярного выражения из них выделяются отдельные сообщения, которые заносятся в конец окна чата с помощью метода insert, далее метод see пролистывает окно чата вниз, выполняется перерисовка основного окна и с помощью select реализуется задержка в 100 мс, дабы не нагружать зря процессор.
Вот собственно и всё, реализация не идеальная, но, наверное, кому-нибудь пригодится.
Исходные коды одним архивом: скачать
P.S. Если у Вас не установлен модуль Tk, то наберите в консоли ppm install tk.
Кажется, аналогичный пример на c++ имел бы больше смысла. Там не сильно сложнее, а профита больше.
Да и перл с гуём смотрится не лучшим образом, на мой вкус.
Пример на C++ - берем и открываем примеры boost::asio и видим готовый асинхронный чат)
Я знаю, я писал клиент-серверное приложение на c++). Причём, без буста.
$user_input =~ s/[\x00-\x08\x0A-\x1F]//g;
это что, что бы вайд чарактер не выдавало?:D
Эти диапазоны захватывают только всякие спец. символы типа переноса строки, возврата каретки и т.п.
Про SIGPIPE забыли.
спасибка
Спасибо!
Очень даже познвательно.
очень много букв про рисование окна, что мне было не интересно...
а так всё гуд...
и может в следующий раз пиши комментарий сразу в коде , а то не удобно листать страницу вверх-вниз..
Никуда не годится.
Сокет нужно переводить в неблокирующий режим, коль взялись мультиплексировать.
Код возврата системных вызовов sysread/syswrite нужно проверять на ошибки.
Кому интересна эта тема лучше прочитайте книгу "Разработка сетевых программ на Perl".
В описании клиента дан пример перевода сокета в неблокирующий режим в зависимости от платформы, если хочется добавить это в сервер - вперед. Если речь идет о книге за авторством Линкольна Штайна, то там начальные примеры в общем-то не лучше в плане реализации и проверки там видимо тоже отсутствуют.
Клиент вообще через жопу похоже работает. Tk умеет ждать события на сокете, не?
Или зависший GUI для вас не беда?
А вы код читали, запускать пробовали или так, пролистали и "по фану" критикуете? Склоняюсь ко второму предположению. Лично я эту реализацию тестировал через интернет, с тремя пользователями проблем не наблюдалось, хотя на идеальность кода никто и не претендовал.