В общем, есть, конечно isida, но по моему скромному мнению, когда нужен бот с пятью функциями, надо использовать бота с пятью функциями, а не пять функций из этого монстроузного проекта. Хотелось получить лёгкое решение, поэтому, как обычно, был расчехлён perl.
В первую очередь, откажемся от написания велосипедов -- поставим модуль для работы с Jabber (если ещё не стоит) и модуль jabber-бота для perl из cpan:
cpan Net::Jabber
cpan Net::Jabber::Bot
Во время компиляции модулей, если пять звёзд встанут в линию, а луна будет находиться в третьей фазе (т.е. у вас perl 5.18) можно наступить на известный баг в тестах, связанный с рандомным возвратом ключей хэшей в perl. Мне помогло просто запустить команды сборки ещё раз.
И дальше всё было чрезвычайно просто, если бы модуль не изобиловал комментариями вида "#TODO:" и не выводил в STDERR пару warning-ов при запуске.
Кроме того, современные MUC комнаты зачастую защищены паролем, а Net::Jabber::Bot такого не умеет.
Поэтому я написал небольшой патч, который вносит необходимые мне изменения в модуль.
Патч можно разделить на три части. В первой (строки 52-56 исходного файла) я добавляю workaround к использованию неинициализированных переменных. Во второй (строки 62-451) -- поддержку пароля для конференций и в третьей (со строки 652) -- отказываюсь от механизма разделения сообщений, предлагаемого разработчиком, в пользу обработки всех сообщений в коде бота. Текст патча ниже.
52c52
< $self->username .
---
> (defined $self->username ? $self->username : "username") .
54c54
< $self->server .
---
> (defined $self->server ? $self->server : "server") .
56c56
< $self->alias});
---
> ($self->alias ? $self->alias : "alias")});
62a63
> has 'forums_passwords' => (isa => HashRef[Str], is => 'rw'); # List of forums passwords.
425c426
< $self->JoinForum($forum);
---
> $self->JoinForum($forum, $self->forums_passwords->{$forum});
445a447
> my $forum_pass = shift;
451a454
> password => $forum_pass,
652c655,656
< my @aliases_to_respond_to = $self->get_responses($from);
---
> ## Parse messages from any alias.
> #my @aliases_to_respond_to = $self->get_responses($from);
654,666c658,670
< if($#aliases_to_respond_to >= 0 and $type eq 'groupchat') {
< my $request;
< foreach my $address_type (@aliases_to_respond_to) {
< my $qm_address_type = quotemeta($address_type);
< next if($body !~ m/^\s*$qm_address_type\s*(\S.*)$/ms);
< $request = $1;
< $bot_address_from = $address_type;
< last; # do not need to loop any more.
< }
< DEBUG("Message not relevant to bot");
< return if(!defined $request);
< $body = $request;
< }
---
> #if($#aliases_to_respond_to >= 0 and $type eq 'groupchat') {
> # my $request;
> # foreach my $address_type (@aliases_to_respond_to) {
> # my $qm_address_type = quotemeta($address_type);
> # next if($body !~ m/^\s*$qm_address_type\s*(\S.*)$/ms);
> # $request = $1;
> # $bot_address_from = $address_type;
> # last; # do not need to loop any more.
> # }
> # DEBUG("Message not relevant to bot");
> # return if(!defined $request);
> # $body = $request;
> #}
Файл Bot.pm на FreeBSD можно найти тут: /usr/local/lib/perl5/site_perl/Net/Jabber.
Далее сначала приведу исходный текст самого бота и затем прокомментирую важные части.
#!/usr/local/bin/perl
# made by: KorG
use strict;
use warnings;
use v5.18;
use utf8;
no warnings 'experimental';
use Net::Jabber::Bot;
use Storable;
my $name = 'AimBot';
my $karmafile = '/tmp/karma';
my $qname = quotemeta($name);
store {}, $karmafile unless -r $karmafile;
my %karma = %{retrieve($karmafile)};
$SIG{INT} = \&shutdown;
$SIG{TERM} = \&shutdown;
sub shutdown {
store \%karma, $karmafile and say "Karma saved to: $karmafile";
exit 0;
}
sub background_checks {
my $bot = shift;
store \%karma, $karmafile;
}
sub new_bot_message {
my %msg = @_;
my $bot = $msg{'bot_object'};
my $from = $msg{'from_full'};
$from =~ s{^.+/([^/]+)$}{$1};
my $to_me = ($msg{'body'} =~ s{^$qname: }{});
given ($msg{'body'}) {
when (/^time\s*$/i) {
$bot->SendGroupMessage($msg{'reply_to'},
"$from: " . time);
}
when (/^help\s*$/i) {
$bot->SendGroupMessage($msg{'reply_to'},
"$from: пробуй так: fortune karma time");
}
when (/^fortune\s*$/i) {
my $fortune = `/usr/games/fortune -s`;
chomp $fortune;
$fortune =~ s/[\n\t]+/ /g;
$bot->SendGroupMessage($msg{'reply_to'},
"$from: $fortune");
sleep 1;
}
when (/^karma\s*$/i) {
$bot->SendGroupMessage($msg{'reply_to'},
"$from: твоя карма: " . ($karma{lc($from)}||0));
}
when (/^karma\s*(\w+)$/i) {
$bot->SendGroupMessage($msg{'reply_to'},
"$from: карма $1: " . ($karma{lc($1)}||0));
}
when (/^(\w+):\s*\+[+1]\s*$/) {
return if $1 eq $from;
$karma{lc($1)}++;
$bot->SendGroupMessage($msg{'reply_to'},
"$from: поднял карму $1 до " . $karma{lc($1)});
}
when (/^(\w+):\s*\-[-1]\s*$/) {
return if $1 eq $from;
$karma{lc($1)}--;
$bot->SendGroupMessage($msg{'reply_to'},
"$from: опустил карму $1 до " . $karma{lc($1)});
}
default {
$bot->SendGroupMessage($msg{'reply_to'},
"$from: how about no, братиша?") if $to_me;
}
}
}
my %forum_list = ('ubuntulinux' => []); # [] due to Bot.pm.patch
my %forum_passwords = ('ubuntulinux' => 'ubuntu');
my $bot = Net::Jabber::Bot->new(
server => 'zhmylove.ru',
conference_server => 'conference.jabber.ru',
port => 5222,
username => 'aimbot',
password => 'password',
alias => $name,
resource => $name,
safety_mode => 1,
message_function => \&new_bot_message,
background_function => \&background_checks,
loop_sleep_time => 60,
forums_and_responses => \%forum_list,
forums_passwords => \%forum_passwords,
);
$bot->Start();
К функционалу данного бота относятся следующие команды:
time -- показать время.
help -- вывести краткую справку.
karma [user] -- показать карму указанного пользователя или свою.
user: ++ -- увеличить или уменьшить карму указанного пользователя.
user: +1
user: -1
user: --
fortune -- показать случайную фразу из fortune(6).
Собственно, интерес для настроек представляют две переменные в начале скрипта: $name и $karmafile. В них указаны ник (и ресурс), путь к файлу, в котором сохранять информацию о карме. Информация о карме будет сохраняться при завершении бота сигналами SIGINT и SIGTERM, а также каждые 60 ($bot->loop_sleep_time) секунд при выполнении функции background_checks. Вообще, эта функция предназначена для мониторинга внешних ресурсов и вызывается с заданной частотой. Фактически, бот занимается вызовом этой функции и асинхронно обрабатывает приходящие сообщения. Рассмотрим сразу хэш с настройками в конце скрипта. В принципе, всё интуитивно понятно. username и password -- это логин и пароль для авторизации на порту port сервера server; conference_server -- это сервер конференций, к комнатам которого будет подключаться бот; alias и resourse, как было сказано, -- это ник и ресурс бота; safety_mode -- флаг включения некоторых фич безопасности (и его рекомендуется не выключать), остальное -- указатели на соответствующие функции и хэши. Ключи хэша forum_list используются для задания комнат, к которым подключается бот. Значения ключей изначально задают фразы, на которые должен реагировать бот, но он не реагирует на ряд фраз, поэтому в коде бота просто указатель на пустой хэш. В хэше forum_passwords значатся соответствия форум-пароль.
Теперь немного пройдёмся по коду. Старался написать не загромождённый и легко масштабируемый код.
Сначала указываем общеизвестные модули, выключаем experimental warning-и (т.к. я хочу использовать given) и подключаем модули Net::Jabber::Bot и Storable (для сохранения объектов в файл). Далее подготавливается файл для кармы и устанавливаются обработчики сигналов. Функция shutdown выполняется когда завершают работу бота; background_checks -- вызывается с определённой частотой; и самая большая функция -- обработчик новых сообщений. В нём мы видим получения информации о сообщении из аргументов, выделение ника отправителя из MUC JID, и удаление из тела сообщения нашего имени, если оно там присутствует. Большую часть кода занимает "switch" по телу. Фактически, на каждое действие вызывается функция SendGroupMessage, которая отправляет сообщение в MUC, в зависимости от распознанной команды. Последняя строка скрипта -- указание боту запустить свой вечный цикл.
Код довольно понятный и легко масштабируем, а по отзывам пользователей, бот работает весьма быстро. Исходный код, по просьбам трудящихся, был также размещён на https://github.com/tune-it/jplbot. Засим, пожалуй, всё.