Финансы Сайт на котором знают все про финансы

Пишем простое клиент-серверное приложение на Perl

В этой статье я рассмотрю создание простого чата на Perl. Чат будет состоять из консольного сервера и клиента с GUI на основе Tk. Для начала реализуем серверную часть.
В серверной части мы не будем использовать процессы или потоки, а вместо этого воспользуемся мультиплексированием. Мультиплексирование довольно просто реализуется с помощью модуля IO::Select, который является классом-оболочкой над системной функцией select.
Функция select позволяет определить готовность дескриптора к записи/чтению. Также стоит отметить, что при использовании select следует избегать использования блокирующих вызовов, как, например, print, read, вместо них необходимо использовать syswrite, sysread.

Итак, начнем писать сервер:

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, что является нежелательным событием).

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, который содержит дескриптор сокета.
Теперь рассмотрим основной цикл обработки входящих соединений:

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.

sub handle_request
{
	my ($user_input, $handle) = @_;
	
	if($user_input eq 'LOG')
	{
		if(-e LOGFILE)
		{
			open F, '<', LOGFILE or warn $!;
			while()
			{
				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 и возвращаются в форматированном виде из функции, далее они будут отправлены всем подключенным клиентам.

Теперь рассмотрим графический клиент чата. Выглядеть он будет следующим образом:

Как обычно, начнем с прагм и инклюдов.

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*).

BEGIN
{
	if($^O eq 'MSWin32') 
	{
		require Win32::Console;
		Win32::Console::Free();
	}
}

Далее идет специальный блок BEGIN, который выполняется во время компиляции как можно раньше. В нем происходит проверка системы и, если скрипт запущен под ОС семейства Windows, то подключается модуль Win32::Console и вызывается метод Free, который консоль «освобождает». То есть при запуске двойным кликом, окно консоли не будет висеть на фоне.
Теперь определим несколько глобальных переменных и создадим интерфейс чата:

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('' => \&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 завершает графическую часть клиента. Теперь рассмотрим методы, которые использует клиент:

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, и, наконец, помещает в окно чата сообщение «Вы отключились».
Рассмотрим метод отправки сообщений на сервер:

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, проверяется размер данных и если он ненулевой, то они отправляются на сервер, а поле для ввода очищается.
И, наконец, последняя функция:

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.