aleesa-cli/aleesa-cli

#!/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->{bot_nick}) {
	$redismsg->{misc}->{bot_nick} = "$c->{bot_nick}";
} else {
	$redismsg->{misc}->{bot_nick} = '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->{bot_nick}, $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->{bot_nick}\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: