Initial commit
This commit is contained in:
eleksir
6
.gitignore
vendored
Normal file
6
.gitignore
vendored
Normal file
@@ -0,0 +1,6 @@
|
||||
_Deparsed_XSubs.pm
|
||||
.idea/**
|
||||
.vscode/**
|
||||
.vstags
|
||||
vendor_perl/**
|
||||
config.json
|
||||
119
.perlcriticrc
Normal file
119
.perlcriticrc
Normal file
@@ -0,0 +1,119 @@
|
||||
#!/usr/bin/env perlcritic
|
||||
severity = 5
|
||||
verbose = 8
|
||||
|
||||
# minorify some of warnings that are not really critical
|
||||
[-InputOutput::RequireCheckedClose]
|
||||
# What can we handle in case of error?
|
||||
|
||||
[-Modules::ProhibitExcessMainComplexity]
|
||||
# Noone cares
|
||||
|
||||
[-Subroutines::ProhibitExcessComplexity]
|
||||
# Noone cares
|
||||
|
||||
[-Subroutines::ProhibitExplicitReturnUndef]
|
||||
# But it's very handy sometimes!
|
||||
|
||||
[-ValuesAndExpressions::ProhibitMagicNumbers]
|
||||
# this policy makes too much false positives
|
||||
|
||||
[-RegularExpressions::RequireLineBoundaryMatching]
|
||||
# We use /m as needed
|
||||
|
||||
[-RegularExpressions::RequireExtendedFormatting]
|
||||
# We do not use extended formatting of regex, they still not THAT complex
|
||||
|
||||
[-RegularExpressions::RequireDotMatchAnything]
|
||||
# huh?
|
||||
|
||||
[-RegularExpressions::ProhibitEscapedMetacharacters]
|
||||
# Looks like it pointless
|
||||
|
||||
[-ControlStructures::ProhibitCascadingIfElse]
|
||||
# I like long if..else chains
|
||||
|
||||
[-ControlStructures::ProhibitPostfixControls]
|
||||
# In short lines we can afford ourselves to use postfix controls
|
||||
# but ofcorse we should avoid such constructions in long lines.
|
||||
|
||||
[-Subroutines::ProhibitSubroutinePrototypes]
|
||||
# Contrary to Perl::Critic we consider prototypes as useful, even if
|
||||
# the compile-time checks of Perl are not perfect, Perl may give some
|
||||
# hints.
|
||||
|
||||
[-CodeLayout::RequireTidyCode]
|
||||
# Impossible to complete, because of on higher linting levels "## no critic..."
|
||||
# require be per-case on same line where critique is, but tidy align them
|
||||
# one line down.
|
||||
|
||||
[-CodeLayout::ProhibitParensWithBuiltins]
|
||||
# duh...
|
||||
|
||||
[-ValuesAndExpressions::ProhibitEmptyQuotes]
|
||||
# cause we consider following correct and useful: my $var = '';
|
||||
# the recomended use of q{} looks too complex: my $var = q{};
|
||||
|
||||
[-ValuesAndExpressions::ProhibitNoisyQuotes]
|
||||
# Other people, other opinions: "," is better readable than qw(,)
|
||||
|
||||
[-BuiltinFunctions::ProhibitSleepViaSelect]
|
||||
# We do not wish to use too much external modules.
|
||||
# select undef, undef, undef, 0.25; # actually is okay if you add comment that
|
||||
# it is sleep for 0.25 seconds
|
||||
|
||||
[-NamingConventions::Capitalization]
|
||||
# duh...
|
||||
# Noone care, really
|
||||
|
||||
[-ControlStructures::ProhibitUnlessBlocks]
|
||||
# They should not be too complex - only one condition should be checked,
|
||||
# that's all
|
||||
|
||||
[-Miscellanea::ProhibitTies]
|
||||
# Just allow it. It's very handy stuff and extremely simple and safe enugh to use.
|
||||
|
||||
[-ValuesAndExpressions::RequireNumberSeparators]
|
||||
# Not really
|
||||
|
||||
[-InputOutput::RequireBracedFileHandleWithPrint]
|
||||
# We prefer not to use braced file handles
|
||||
|
||||
[-Documentation::PodSpelling]
|
||||
# It doesn't help, but emits annoying errors
|
||||
|
||||
[Documentation::RequirePodSections]
|
||||
# Considering this as "soft" requirement. For modules that is (or will be)
|
||||
# stand-alone libs well formed documentation is highly desired.
|
||||
lib_sections = NAME | VERSION | DESCRIPTION | AUTHOR | LICENSE AND COPYRIGHT
|
||||
|
||||
[-InputOutput::RequireBriefOpen]
|
||||
# Yes, i do!
|
||||
|
||||
[-ControlStructures::ProhibitDeepNests]
|
||||
# Have to use it, so fuckoff
|
||||
|
||||
[-TooMuchCode::ProhibitUnnecessaryUTF8Pragma]
|
||||
|
||||
[-Editor::RequireEmacsFileVariables]
|
||||
|
||||
[-CodeLayout::RequireASCII]
|
||||
|
||||
[-ErrorHandling::RequireUseOfExceptions]
|
||||
|
||||
[-TooMuchCode::ProhibitDuplicateLiteral]
|
||||
|
||||
[-ValuesAndExpressions::RequireConstantOnLeftSideOfEquality]
|
||||
|
||||
[-InputOutput::RequireCheckedSyscalls]
|
||||
|
||||
[-ControlStructures::ProhibitUntilBlocks]
|
||||
|
||||
[-ValuesAndExpressions::ProhibitLongChainsOfMethodCalls]
|
||||
|
||||
[-ValuesAndExpressions::RestrictLongStrings]
|
||||
# You just say that 81 char long string is not okay, right? Fuck off.
|
||||
|
||||
[-Miscellanea::ProhibitUnrestrictedNoCritic]
|
||||
|
||||
[-Lax::ProhibitEmptyQuotes::ExceptAsFallback]
|
||||
127
LICENSE
Normal file
127
LICENSE
Normal file
@@ -0,0 +1,127 @@
|
||||
The "Artistic License"
|
||||
|
||||
Preamble
|
||||
|
||||
The intent of this document is to state the conditions under which a
|
||||
Package may be copied, such that the Copyright Holder maintains some
|
||||
semblance of artistic control over the development of the package,
|
||||
while giving the users of the package the right to use and distribute
|
||||
the Package in a more-or-less customary fashion, plus the right to make
|
||||
reasonable modifications.
|
||||
|
||||
Definitions:
|
||||
|
||||
"Package" refers to the collection of files distributed by the
|
||||
Copyright Holder, and derivatives of that collection of files
|
||||
created through textual modification.
|
||||
|
||||
"Standard Version" refers to such a Package if it has not been
|
||||
modified, or has been modified in accordance with the wishes
|
||||
of the Copyright Holder as specified below.
|
||||
|
||||
"Copyright Holder" is whoever is named in the copyright or
|
||||
copyrights for the package.
|
||||
|
||||
"You" is you, if you're thinking about copying or distributing
|
||||
this Package.
|
||||
|
||||
"Reasonable copying fee" is whatever you can justify on the
|
||||
basis of media cost, duplication charges, time of people involved,
|
||||
and so on. (You will not be required to justify it to the
|
||||
Copyright Holder, but only to the computing community at large
|
||||
as a market that must bear the fee.)
|
||||
|
||||
"Freely Available" means that no fee is charged for the item
|
||||
itself, though there may be fees involved in handling the item.
|
||||
It also means that recipients of the item may redistribute it
|
||||
under the same conditions they received it.
|
||||
|
||||
1. You may make and give away verbatim copies of the source form of the
|
||||
Standard Version of this Package without restriction, provided that you
|
||||
duplicate all of the original copyright notices and associated disclaimers.
|
||||
|
||||
2. You may apply bug fixes, portability fixes and other modifications
|
||||
derived from the Public Domain or from the Copyright Holder. A Package
|
||||
modified in such a way shall still be considered the Standard Version.
|
||||
|
||||
3. You may otherwise modify your copy of this Package in any way, provided
|
||||
that you insert a prominent notice in each changed file stating how and
|
||||
when you changed that file, and provided that you do at least ONE of the
|
||||
following:
|
||||
|
||||
a) place your modifications in the Public Domain or otherwise make them
|
||||
Freely Available, such as by posting said modifications to Usenet or
|
||||
an equivalent medium, or placing the modifications on a major archive
|
||||
site such as uunet.uu.net, or by allowing the Copyright Holder to include
|
||||
your modifications in the Standard Version of the Package.
|
||||
|
||||
b) use the modified Package only within your corporation or organization.
|
||||
|
||||
c) rename any non-standard executables so the names do not conflict
|
||||
with standard executables, which must also be provided, and provide
|
||||
a separate manual page for each non-standard executable that clearly
|
||||
documents how it differs from the Standard Version.
|
||||
|
||||
d) make other distribution arrangements with the Copyright Holder.
|
||||
|
||||
4. You may distribute the programs of this Package in object code or
|
||||
executable form, provided that you do at least ONE of the following:
|
||||
|
||||
a) distribute a Standard Version of the executables and library files,
|
||||
together with instructions (in the manual page or equivalent) on where
|
||||
to get the Standard Version.
|
||||
|
||||
b) accompany the distribution with the machine-readable source of
|
||||
the Package with your modifications.
|
||||
|
||||
c) give non-standard executables non-standard names, and clearly
|
||||
document the differences in manual pages (or equivalent), together
|
||||
with instructions on where to get the Standard Version.
|
||||
|
||||
d) make other distribution arrangements with the Copyright Holder.
|
||||
|
||||
5. You may charge a reasonable copying fee for any distribution of this
|
||||
Package. You may charge any fee you choose for support of this
|
||||
Package. You may not charge a fee for this Package itself. However,
|
||||
you may distribute this Package in aggregate with other (possibly
|
||||
commercial) programs as part of a larger (possibly commercial) software
|
||||
distribution provided that you do not advertise this Package as a
|
||||
product of your own. You may embed this Package's interpreter within
|
||||
an executable of yours (by linking); this shall be construed as a mere
|
||||
form of aggregation, provided that the complete Standard Version of the
|
||||
interpreter is so embedded.
|
||||
|
||||
6. The scripts and library files supplied as input to or produced as
|
||||
output from the programs of this Package do not automatically fall
|
||||
under the copyright of this Package, but belong to whoever generated
|
||||
them, and may be sold commercially, and may be aggregated with this
|
||||
Package. If such scripts or library files are aggregated with this
|
||||
Package via the so-called "undump" or "unexec" methods of producing a
|
||||
binary executable image, then distribution of such an image shall
|
||||
neither be construed as a distribution of this Package nor shall it
|
||||
fall under the restrictions of Paragraphs 3 and 4, provided that you do
|
||||
not represent such an executable image as a Standard Version of this
|
||||
Package.
|
||||
|
||||
7. C subroutines (or comparably compiled subroutines in other
|
||||
languages) supplied by you and linked into this Package in order to
|
||||
emulate subroutines and variables of the language defined by this
|
||||
Package shall not be considered part of this Package, but are the
|
||||
equivalent of input as in Paragraph 6, provided these subroutines do
|
||||
not change the language in any way that would cause it to fail the
|
||||
regression tests for the language.
|
||||
|
||||
8. Aggregation of this Package with a commercial distribution is always
|
||||
permitted provided that the use of this Package is embedded; that is,
|
||||
when no overt attempt is made to make this Package's interfaces visible
|
||||
to the end user of the commercial distribution. Such use shall not be
|
||||
construed as a distribution of this Package.
|
||||
|
||||
9. The name of the Copyright Holder may not be used to endorse or promote
|
||||
products derived from this software without specific prior written permission.
|
||||
|
||||
10. THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR
|
||||
IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
|
||||
WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
|
||||
|
||||
The End
|
||||
59
README
Normal file
59
README
Normal file
@@ -0,0 +1,59 @@
|
||||
aleesa-cli
|
||||
-----------------------------------------------------------------------------------------------------------------------
|
||||
Интерфейс командной строки для aleesa-bot-а. Способ "пообщаться" с ботом не подключаясь ни к каким сервисам.
|
||||
Cli изображает "приватный" режим чата.
|
||||
|
||||
Cli нужна в основном для упрощения процедуры отладки новых модулей бота.
|
||||
|
||||
|
||||
Механика работы
|
||||
-----------------------------------------------------------------------------------------------------------------------
|
||||
Клиент подписан на pubsub redis-канал "cli" (без кавычек) и шлёт все сообщения в канал misc (см. соответствующие
|
||||
параметры в config.json)
|
||||
|
||||
Формат протокола см. документацию к модулю aleesa-misc.
|
||||
|
||||
|
||||
Встроенные команды aleesa-cli
|
||||
-----------------------------------------------------------------------------------------------------------------------
|
||||
Встроенные в cli команды:
|
||||
help - показать help по командам
|
||||
debug - посмотреть включён ли режим отладки
|
||||
debug 1 - включить режим отладки (скорее всего оно вам не нужно)
|
||||
debug 0 - выключить режим отладки
|
||||
mode - показать текущий режим общения
|
||||
mode private - приватный режим общения
|
||||
mode public - публичный режим общения
|
||||
mode monitor - режим мониторинга сообщений в redis-каналах
|
||||
mon - список отслеживаемых redis pubsub-каналов
|
||||
mon add channel - добавить к списку отслеживаемых набор каналов channel
|
||||
mon remove channel - убрать из списка отслеживаемых набор каналов channel
|
||||
mon del channel - убрать из списка отслеживаемых набор каналов channel
|
||||
mon delete channel - убрать из списка отслеживаемых набор каналов channel
|
||||
verbose - посмотреть включён ли вербозный режим
|
||||
verbose 1 - показывать входящие и исходящие сообщения дополнительно в виде json-а
|
||||
verbose 0 - не показывать json
|
||||
exit - выйти из cli
|
||||
quit - выйти из cli
|
||||
|
||||
Пояснение про режимы общения.
|
||||
* Приватный режим изображает общение один-на-один с ботом.
|
||||
* Публичный - изображает общение в публичном чате. Поведение бота различается в этих режимах, в том числе некоторые
|
||||
команды реализованы с особенностями того или иного режима общения. Quod licet Jovi, non licet bovi.
|
||||
* Монитор - выводит все сообщения из redis-каналов, на которые подписана cli. По-умолчанию она подписана на канал cli
|
||||
(задан в конфиге). И этот канал убрать нельзя. А сам список можно менять командой mon add или mon remove, за которым
|
||||
следует набор каналов, на которые следует подписаться или от которых надо отписаться. Разделитель - регулярка
|
||||
/\s*\,?\s+/. В этом режиме общаться с ботом нельзя, работают только команды cli.
|
||||
|
||||
|
||||
Как это запустить?
|
||||
-----------------------------------------------------------------------------------------------------------------------
|
||||
Понадобится perl, cpanm и local::lib, а также несколько разных devel-пакетов для разных библиотек. Как правило, это
|
||||
находится методом тыка. Кроме того, понадобятся development tools - gcc, gcc-g++, perl-devel, make, cmake и так далее.
|
||||
|
||||
В каталоге с приложением под целевым пользователем запускаем bash bootstrap.sh и ждём с надеждой, что оно не обломится
|
||||
в пути.
|
||||
|
||||
Если всё хорошо, создём config.json из config_sample.json и можно запускать приложение.
|
||||
|
||||
Предполагается, что остальные компоненты бота сконфигурированы и запущены.
|
||||
467
aleesa-cli
Executable file
467
aleesa-cli
Executable file
@@ -0,0 +1,467 @@
|
||||
#!/usr/bin/perl
|
||||
|
||||
|
||||
use 5.018; ## no critic (ProhibitImplicitImport)
|
||||
use strict;
|
||||
use warnings;
|
||||
use utf8;
|
||||
use open qw (:std :utf8);
|
||||
use English qw ( -no_match_vars );
|
||||
|
||||
use version; our $VERSION = qw (1.0);
|
||||
|
||||
my $workdir;
|
||||
|
||||
# До фактического запуска логики программы, сменим рабочий каталог, чтобы подцепить либы
|
||||
BEGIN {
|
||||
use Cwd qw (chdir abs_path);
|
||||
my @CWD = split /\//xms, abs_path ($PROGRAM_NAME);
|
||||
|
||||
if ($#CWD > 1) {
|
||||
$#CWD = $#CWD - 1;
|
||||
}
|
||||
|
||||
$workdir = join '/', @CWD;
|
||||
chdir $workdir;
|
||||
}
|
||||
|
||||
use lib ("$workdir/lib", "$workdir/vendor_perl", "$workdir/vendor_perl/lib/perl5");
|
||||
|
||||
use Clone qw (clone);
|
||||
use JSON::XS ();
|
||||
use Mojo::IOLoop::LineReader ();
|
||||
use Mojo::Redis ();
|
||||
use Mojo::IOLoop::Signal ();
|
||||
|
||||
my $c = LoadConf ();
|
||||
|
||||
my $redis;
|
||||
my $pubsub;
|
||||
my %subchannels;
|
||||
my @monchannels;
|
||||
my $reader;
|
||||
my $mydebug = 0;
|
||||
my $myverbose = 0;
|
||||
my $public_mode = 0;
|
||||
my $monitor = 0;
|
||||
|
||||
if (defined $c->{debug}) {
|
||||
$mydebug = $c->{debug};
|
||||
}
|
||||
|
||||
if (defined $c->{verbose}) {
|
||||
$myverbose = $c->{verbose};
|
||||
}
|
||||
|
||||
my $help = << "EOH";
|
||||
debug - display debug mode status
|
||||
debug 1 - enable debug (you probably interest in verbose more)
|
||||
debug 0 - disable debug (default)
|
||||
mode - show conversation mode
|
||||
mode private - conversation in private mode (default)
|
||||
mode public - conversation in public mode
|
||||
mode monitor - sniffs subscribed channels
|
||||
mon add channel - add channel to bunch of monitored ones
|
||||
mon remove channel - remove channel from list of monitored ones, $c->{channel} is always monitored
|
||||
mon delete channel - remove channel from list of monitored ones, $c->{channel} is always monitored
|
||||
mon del channel - remove channel from list of monitored ones, $c->{channel} is always monitored
|
||||
verbose - show vebose mode status
|
||||
verbose 1 - show tx/rx messages also as json
|
||||
verbose 0 - disable verbose mode (default)
|
||||
exit - quit cli
|
||||
quit - quit cli
|
||||
EOH
|
||||
|
||||
my $redismsg->{from} = 'cli';
|
||||
$redismsg->{plugin} = 'cli';
|
||||
$redismsg->{userid} = 'cli';
|
||||
$redismsg->{chatid} = 'cli';
|
||||
$redismsg->{mode} = 'private';
|
||||
$redismsg->{misc}->{answer} = 1;
|
||||
|
||||
if (defined $c->{botnick}) {
|
||||
$redismsg->{misc}->{botnick} = "$c->{botnick}";
|
||||
} else {
|
||||
$redismsg->{misc}->{botnick} = 'aleesa';
|
||||
}
|
||||
|
||||
if (defined $c->{csign}) {
|
||||
$redismsg->{misc}->{csign} = "$c->{csign}";
|
||||
} else {
|
||||
$redismsg->{misc}->{csign} = '!';
|
||||
}
|
||||
|
||||
$redismsg->{misc}->{msg_format} = 0;
|
||||
$redismsg->{misc}->{fwd_cnt} = 1;
|
||||
$redismsg->{misc}->{good_morning} = 0;
|
||||
$redismsg->{misc}->{username} = 'user';
|
||||
|
||||
# Процедура обработки сигнала
|
||||
my $__signal_handler = sub {
|
||||
my ($self, $name) = @_;
|
||||
exit 0;
|
||||
};
|
||||
|
||||
# Процедура, реагирующая на строку, пойманную с клавиатуры
|
||||
my $__input_line_handler = sub {
|
||||
my ($self, $line) = @_;
|
||||
chomp $line;
|
||||
|
||||
if ($line =~ /^(exit|quit)$/) { ## no critic (RegularExpressions::ProhibitFixedStringMatches)
|
||||
print "Quit\n";
|
||||
$__signal_handler->($self, 'Quit');
|
||||
} elsif ($line eq 'help') {
|
||||
print "$help\n";
|
||||
} elsif ($line =~ /^mode\s+(.*)$/) {
|
||||
if ($1 eq 'public') {
|
||||
$public_mode = 1;
|
||||
|
||||
if ($monitor) {
|
||||
unsubscribe_channels (keys (%subchannels));
|
||||
subscribe_channels ($c->{channel});
|
||||
$monitor = 0;
|
||||
}
|
||||
|
||||
print "[info]: continue conversation in public mode\n";
|
||||
} elsif ($1 eq 'private') {
|
||||
$public_mode = 0;
|
||||
|
||||
if ($monitor) {
|
||||
unsubscribe_channels (keys (%subchannels));
|
||||
subscribe_channels ($c->{channel});
|
||||
$monitor = 0;
|
||||
}
|
||||
|
||||
print "[info]: continue conversation in private mode\n";
|
||||
} elsif ($1 eq 'monitor') {
|
||||
$monitor = 1;
|
||||
my @channels = keys %subchannels;
|
||||
my @sniffchannels = @monchannels;
|
||||
unsubscribe_channels (@channels);
|
||||
subscribe_channels (@sniffchannels);
|
||||
printf "[info]: switched to redis channel sniffing mode, monitoring theese pubsub channels: %s\n", join (', ',@monchannels);
|
||||
} else {
|
||||
my $message = '[info]: conversation now in ';
|
||||
|
||||
if ($monitor) {
|
||||
$message = "[info]: monitor mode is on and coversation with bot disabled\n";
|
||||
$message .= sprintf "[info]: monitoring these pubsub channels: %s\n", join (', ',@monchannels);
|
||||
} else {
|
||||
if ($public_mode) {
|
||||
$message .= "public mode\n";
|
||||
} else {
|
||||
$message .= "private mode\n";
|
||||
}
|
||||
}
|
||||
|
||||
print $message;
|
||||
}
|
||||
} elsif ($line eq 'mode') {
|
||||
my $message = '[info]: conversation now in ';
|
||||
|
||||
if ($monitor) {
|
||||
$message = "[info]: monitor mode is on and coversation with bot disabled\n";
|
||||
} else {
|
||||
if ($public_mode) {
|
||||
$message .= "public mode\n";
|
||||
} else {
|
||||
$message .= "private mode\n";
|
||||
}
|
||||
}
|
||||
|
||||
print $message;
|
||||
} elsif ($line =~ /^mon\s+(add|remove|del|delete)\s+(.+)/) {
|
||||
# Список каналов
|
||||
my $command = $1;
|
||||
my $list = $2;
|
||||
$list =~ s/^\s+//u;
|
||||
$list =~ s/\s+$//u;
|
||||
|
||||
if ($list eq '') {
|
||||
print "[info]: looks like list of channels is empty\n";
|
||||
} else {
|
||||
my @channels = split /(\s*)?\,?\s+/, $list;
|
||||
|
||||
# Команда была "добавить"
|
||||
if ($command eq 'add') {
|
||||
if ($monitor) {
|
||||
my @newchannels;
|
||||
|
||||
foreach my $channel (@channels) {
|
||||
my $subscribe = 1;
|
||||
|
||||
foreach my $subchannel (keys %subchannels) {
|
||||
if ($subchannel eq $channel) {
|
||||
$subscribe = 0;
|
||||
last;
|
||||
}
|
||||
}
|
||||
|
||||
push @newchannels, $channel if ($subscribe);
|
||||
}
|
||||
|
||||
if ($#newchannels >= 0) {
|
||||
subscribe_channels (@newchannels);
|
||||
}
|
||||
|
||||
printf "[info]: now subscribed to these channels: %s\n", join (', ', keys %subchannels);
|
||||
} else {
|
||||
my %list;
|
||||
foreach (@monchannels) {$list{$_} = 1;}
|
||||
foreach (@channels) {$list{$_} = 1;}
|
||||
$#monchannels = -1;
|
||||
@monchannels = keys %list;
|
||||
printf "[info]: list of monitored channels: %s\n", join (', ', @monchannels);
|
||||
}
|
||||
# Команда была "убрать"
|
||||
} else {
|
||||
if ($monitor) {
|
||||
my @unsub_channels;
|
||||
|
||||
foreach my $channel (@channels) {
|
||||
my $unsubscribe = 0;
|
||||
next if $channel eq $c->{channel};
|
||||
|
||||
foreach my $subchannel (keys %subchannels) {
|
||||
if ($subchannel eq $channel) {
|
||||
$unsubscribe = 1;
|
||||
last;
|
||||
}
|
||||
}
|
||||
|
||||
push @unsub_channels, $channel if ($unsubscribe);
|
||||
}
|
||||
|
||||
if ($#unsub_channels >= 0) {
|
||||
unsubscribe_channels (@unsub_channels);
|
||||
}
|
||||
|
||||
printf "[info]: now subscribed to these channels: %s\n", join (', ', keys %subchannels);
|
||||
} else {
|
||||
my %list;
|
||||
foreach (@monchannels) {$list{$_} = 1;}
|
||||
|
||||
foreach (@channels) {
|
||||
next if $_ eq $c->{channel};
|
||||
delete $list{$_} if ($list{$_});
|
||||
}
|
||||
|
||||
$#monchannels = -1;
|
||||
@monchannels = keys %list;
|
||||
printf "[info]: list of monitored channels: %s\n", join (', ', @monchannels);
|
||||
}
|
||||
}
|
||||
}
|
||||
} elsif ($line eq 'mon') {
|
||||
printf "[info]: list of monitored channels: %s\n", join (', ', @monchannels);
|
||||
} elsif ($line =~ /^debug\s+(\d)$/) {
|
||||
if ($1 eq '1') {
|
||||
$mydebug = 1;
|
||||
print "[info]: debug set to 1\n";
|
||||
} elsif ($1 eq '0') {
|
||||
$mydebug = 0;
|
||||
print "[info]: debug set to 0\n";
|
||||
}
|
||||
} elsif ($line eq 'debug') {
|
||||
print "[info]: debug is $mydebug\n";
|
||||
} elsif ($line =~ /^verbose\s+(\d)$/) {
|
||||
if ($1 eq '1') {
|
||||
$myverbose = 1;
|
||||
print "[info]: verbose set to 1\n";
|
||||
} elsif ($1 eq '0') {
|
||||
$myverbose = 0;
|
||||
print "[info]: verbose set to 0\n";
|
||||
}
|
||||
} elsif ($line eq 'verbose') {
|
||||
print "[info]: verbose is $myverbose\n";
|
||||
} else {
|
||||
# Будем дрыхнуть до того момента, пока не установится соединение к redis
|
||||
until (defined $pubsub) {
|
||||
sleep 1;
|
||||
}
|
||||
|
||||
# В режиме монитора у нас есть чем занять консоль, поэтому общаться с потрохами бота в этом инстансе мы
|
||||
# прекращаем до выхода в обычный режим - private или public
|
||||
unless ($monitor) {
|
||||
my $msg = clone $redismsg;
|
||||
$msg->{message} = $line;
|
||||
|
||||
if ($public_mode) {
|
||||
$msg->{mode} = 'public';
|
||||
} else {
|
||||
$msg->{mode} = 'private';
|
||||
}
|
||||
|
||||
if ($line ne '') {
|
||||
if ($mydebug || $myverbose) {
|
||||
my $json = JSON::XS->new ()->pretty (1)->canonical (1)->encode ($msg);
|
||||
warn "[sent]: $json\n";
|
||||
}
|
||||
|
||||
$pubsub->json ($c->{router_channel})->notify (
|
||||
$c->{router_channel} => $msg,
|
||||
);
|
||||
}
|
||||
}
|
||||
}
|
||||
};
|
||||
|
||||
# Процедура обработки входящего сообщения из redis pubsub канала
|
||||
my $parse_message = sub {
|
||||
my $self = shift;
|
||||
my $msg = shift;
|
||||
|
||||
# Что-то от модулей надо парсить, например, сообщения бармэна.
|
||||
if ($mydebug || $myverbose || $monitor) {
|
||||
my $json = JSON::XS->new ()->pretty (1)->canonical (1)->encode ($msg);
|
||||
warn "[recieved]: $json\n";
|
||||
}
|
||||
|
||||
printf "[%s]: %s\n", $c->{botnick}, $msg->{message} unless ($monitor);
|
||||
|
||||
return;
|
||||
};
|
||||
|
||||
# Создадим подключение к Redis-ке
|
||||
warn "[debug]: Connecting to $c->{server}, $c->{port}\n" if $mydebug;
|
||||
$redis = Mojo::Redis->new (
|
||||
sprintf 'redis://%s:%s/1', $c->{server}, $c->{port},
|
||||
);
|
||||
|
||||
warn "[debug]: Registering redis connection-event callback\n" if $mydebug;
|
||||
$redis->on (
|
||||
connection => sub {
|
||||
my ($r, $connection) = @_;
|
||||
|
||||
# Залоггируем ошибку, если соединение внезапно порвалось.
|
||||
# FIXME: Похоже, что $mydebug в данном случае становится локальной, а не остаётся глобальной переменной.
|
||||
warn "[debug]: Registering redis events callbacks\n" if $mydebug;
|
||||
|
||||
$connection->on (
|
||||
close => sub {
|
||||
die "[error]: Connection to redis is closed\n";
|
||||
},
|
||||
);
|
||||
|
||||
# FIXME: Похоже, что $mydebug в данном случае становится локальной, а не остаётся глобальной переменной.
|
||||
$connection->on (
|
||||
connect => sub {
|
||||
warn "[debug]: Connection to redis established\n" if $mydebug;
|
||||
},
|
||||
);
|
||||
|
||||
$connection->on (
|
||||
error => sub {
|
||||
my ($conn, $error) = @_;
|
||||
die "[error]: Redis connection error: $error\n";
|
||||
},
|
||||
);
|
||||
|
||||
return;
|
||||
},
|
||||
);
|
||||
|
||||
warn "[debug]: Registering subscribtion callback\n" if $mydebug;
|
||||
$pubsub = $redis->pubsub;
|
||||
subscribe_channels ($c->{channel});
|
||||
|
||||
# Повесим коллбэки на сигналы TERM, QUIT, HUP, INT
|
||||
warn "[debug]: Registering signal handler callbacks\n" if $mydebug;
|
||||
Mojo::IOLoop::Signal->on (TERM => $__signal_handler);
|
||||
Mojo::IOLoop::Signal->on (QUIT => $__signal_handler);
|
||||
Mojo::IOLoop::Signal->on (HUP => $__signal_handler);
|
||||
Mojo::IOLoop::Signal->on (INT => $__signal_handler);
|
||||
|
||||
# Установим читателя с терминала
|
||||
register_input_callback ();
|
||||
|
||||
# Запустим Event Loop
|
||||
warn "[debug]: Starting event loop\n" if $mydebug;
|
||||
print "\nTo show help just enter help command\n";
|
||||
print "Ready to begin conversation with $c->{botnick}\n\n";
|
||||
do { Mojo::IOLoop->start } until Mojo::IOLoop->is_running; ## no critic (Modules::RequireExplicitInclusion)
|
||||
|
||||
exit 0;
|
||||
|
||||
|
||||
sub register_input_callback {
|
||||
warn "[debug]: Registering terminal input callback\n" if $mydebug;
|
||||
my $stdin = \*STDIN;
|
||||
binmode $stdin;
|
||||
$reader = Mojo::IOLoop::LineReader->new ($stdin);
|
||||
$reader->timeout (0);
|
||||
|
||||
# Повесим коллбэк на чтение строки текста с stdin
|
||||
$reader->on (
|
||||
readln => $__input_line_handler,
|
||||
);
|
||||
|
||||
$reader->start;
|
||||
|
||||
return;
|
||||
}
|
||||
|
||||
sub subscribe_channels {
|
||||
my @channels = @_;
|
||||
|
||||
foreach my $channel (@channels) {
|
||||
warn "[debug]: Subscribing to redis pubsub channel $channel\n" if $mydebug;
|
||||
|
||||
my $cb = $pubsub->json ($channel)->listen (
|
||||
$channel => sub { $parse_message->(@_); },
|
||||
);
|
||||
|
||||
$subchannels{$channel} = $cb;
|
||||
}
|
||||
|
||||
$#monchannels = -1;
|
||||
@monchannels = keys %subchannels;
|
||||
|
||||
return;
|
||||
}
|
||||
|
||||
sub unsubscribe_channels {
|
||||
my @channels = @_;
|
||||
|
||||
foreach my $channel (@channels) {
|
||||
warn "[debug]: Unsubscribing to redis pubsub channel $channel\n" if $mydebug;
|
||||
$pubsub = $pubsub->unlisten ($channel, $subchannels{$channel});
|
||||
delete $subchannels{$channel};
|
||||
}
|
||||
|
||||
$#monchannels = -1;
|
||||
@monchannels = keys %subchannels;
|
||||
|
||||
return;
|
||||
}
|
||||
|
||||
sub LoadConf {
|
||||
my $confFile = 'config.json';
|
||||
my $CH;
|
||||
|
||||
unless (open $CH, '<', $confFile) {
|
||||
die "[error]: No conf at $confFile: $OS_ERROR\n";
|
||||
}
|
||||
|
||||
my $len = (stat $confFile) [7];
|
||||
my $json;
|
||||
use bytes;
|
||||
my $readlen = read $CH, $json, $len;
|
||||
no bytes;
|
||||
|
||||
unless ($readlen) {
|
||||
close $CH;
|
||||
die "[error]: Unable to read $confFile: $OS_ERROR\n";
|
||||
}
|
||||
|
||||
if ($readlen != $len) {
|
||||
close $CH;
|
||||
die "[error]: File $confFile is $len bytes on disk, but we read only $readlen bytes\n";
|
||||
}
|
||||
|
||||
close $CH;
|
||||
my $j = JSON::XS->new->utf8->relaxed;
|
||||
return $j->decode ($json);
|
||||
}
|
||||
|
||||
# vim: set ft=perl noet ai ts=4 sw=4 sts=4:
|
||||
5
bootstrap.sh
Normal file
5
bootstrap.sh
Normal file
@@ -0,0 +1,5 @@
|
||||
#!/bin/bash
|
||||
|
||||
cpanm -l vendor_perl --self-contained --force --installdeps .
|
||||
|
||||
# vim: set ft=sh noet ai ts=4 sw=4 sts=4:
|
||||
13
config_sample.json
Normal file
13
config_sample.json
Normal file
@@ -0,0 +1,13 @@
|
||||
{
|
||||
"server" : "redis",
|
||||
"port" : 6379,
|
||||
|
||||
"channel" : "cli",
|
||||
"router_channel": "misc",
|
||||
|
||||
# bot commands will begin with this symbol
|
||||
"csign" : "!",
|
||||
|
||||
# bot nick name
|
||||
"botnick" : "aleesa"
|
||||
}
|
||||
8
cpanfile
Normal file
8
cpanfile
Normal file
@@ -0,0 +1,8 @@
|
||||
## no critic
|
||||
requires 'Clone', '==0.45';
|
||||
requires 'Cwd', '==3.75';
|
||||
requires 'JSON::XS', '==4.03';
|
||||
requires 'local::lib', '==2.000028';
|
||||
requires 'Mojo::Redis', '==3.29';
|
||||
requires 'Mojo::IOLoop::LineReader', '==0.3';
|
||||
requires 'Mojo::IOLoop::Signal', '==0.003';
|
||||
Reference in New Issue
Block a user