Bump Mojolicious version 9.22 -> 9.24, minor changes

* Update Mojolicious version 9.22 -> 9.24 in cpanfile
* Remove Protocol::Redis::XS from cpanfile and Games.pm, it has buggy xs
* More carefull tidy incoming json
* Fix handling non existing forward_max in config
* Install signal async handlers separately
* Calculate csign length dynamically
* Refer in README to aleesa-misc-go, fix formatting

.perlcriticrc

@@ -1,3 +1,18 @@
+#!/usr/bin/env perlcritic
+# Задействованные модули критика:
+#
+# Perl::Critic::More
+# Perl::Critic::Pulp
+# Perl::Critic::TooMuchCode
+# Perl::Critic::Lax
+# Perl::Critic::CognitiveComplexity
+# Perl::Critic::Policy::CompileTime
+# Perl::Critic::Policy::ProhibitImplicitImport
+# Perl::Critic::Policy::Dynamic::NoIndirect
+# Perl::Critic::StricterSubs
+# Perl::Critic::Policy::ProhibitImplicitImport
+# Perl::Critic::Policy::CodeLayout::RequireUseUTF8
+
 [-CodeLayout::RequireTidyCode]
 [-ValuesAndExpressions::ProhibitMagicNumbers]
 [-ControlStructures::ProhibitUnlessBlocks]
@@ -14,4 +29,14 @@
 [-Subroutines::ProhibitExplicitReturnUndef]
 [-RegularExpressions::ProhibitEscapedMetacharacters]
 [-InputOutput::RequireBriefOpen]
-[-Modules::ProhibitExcessMainComplexity]
+[-Modules::ProhibitExcessMainComplexity]
+[-Editor::RequireEmacsFileVariables]
+[-TooMuchCode::ProhibitUnnecessaryUTF8Pragma]
+[-ValuesAndExpressions::RequireConstantOnLeftSideOfEquality]
+[-Lax::RequireConstantOnLeftSideOfEquality::ExceptEq]
+[-Lax::ProhibitEmptyQuotes::ExceptAsFallback]
+[-TooMuchCode::ProhibitDuplicateLiteral]
+[-CodeLayout::RequireASCII]
+[-ErrorHandling::RequireUseOfExceptions]
+[-Miscellanea::ProhibitUnrestrictedNoCritic]
+[-ValuesAndExpressions::RestrictLongStrings]

README

@@ -13,7 +13,7 @@ aleesa-games
 
 Ответ направляется в redis-канал, указанный в поле plugin входящего сообщения.
 
-Формат протокола - см README от aleesa-misc.
+Формат протокола - см README от aleesa-misc-go.
 
 
 Как это запустить?
@@ -33,5 +33,6 @@ development tools - gcc, gcc-g++, perl-devel, make, cmake и так далее.
 В каталоге contrib находится скрипт для alpine linux, системы инициализации openrc. Этот скрипт достаточно положить В
 /etc/init.d/aleesa-games сконфигурить сервис по инструкции выше и после этого сервис запускается командой:
 service aleesa-games start
-в автозагрузку его можно прописать через команду
+
+в автозагрузку его можно прописать через команду:
 rc-update add aleesa-games default

bin/aleesa-games

@@ -1,6 +1,6 @@
 #!/usr/bin/perl
 
-use 5.018;
+use 5.018; ## no critic (ProhibitImplicitImport)
 use strict;
 use warnings;
 use utf8;
@@ -29,9 +29,10 @@ no Cwd;
 use Cwd::utf8 qw (chdir abs_path);
 use File::Basename qw (basename dirname);
 use File::Path qw (make_path);
+use File::Spec ();
 use Log::Any qw ($log);
-use Log::Any::Adapter;
-use Log::Any::For::Std;
+use Log::Any::Adapter ();
+use Log::Any::For::Std ();
 use POSIX qw (setgid setuid setsid);
 
 use Conf qw (LoadConf);
@@ -70,8 +71,8 @@ if ($UID == 0) {
 		make_path (
 			$piddir, {
 				uid   => $uid,
-				group => $gid
-			}
+				group => $gid,
+			},
 		);
 	}
 
@@ -82,8 +83,8 @@ if ($UID == 0) {
 			make_path (
 					$logdir, {
 							uid   => $uid,
-							group => $gid
-					}
+							group => $gid,
+					},
 			) or die "Unable to create $logdir: $OS_ERROR\n";
 		}
 	}
@@ -103,14 +104,14 @@ if (defined $logfile) {
 	# verbosity paticulary for CHI.
 	Log::Any::Adapter->set (
 		{
-			category => 'CHI::Driver'
+			category => 'CHI::Driver',
 		},
 		'File',
 		$logfile,
-		log_level => 'warn'
+		log_level => 'warn',
 	);
 } else {
-	Log::Any::Adapter->set ('File', '/dev/null');
+	Log::Any::Adapter->set ('File', File::Spec->devnull);
 }
 
 # По-умолчанию, демонизируемся, если явно не указано, что этого делать не надо
@@ -126,7 +127,7 @@ my $apath = abs_path $PROGRAM_NAME;
 unless (defined $apath) {
 	$log->fatal ("[FATAL] Unable to get abs_path: $OS_ERROR\n");
 	exit 1;
-};
+}
 
 my $pidfile = sprintf '%s/%s.pid', $piddir, basename $apath;
 $log->info ("[INFO] Creating pidfile at $pidfile");
@@ -152,7 +153,7 @@ $PROGRAM_NAME = abs_path $PROGRAM_NAME;              ## no critic (Variables::Re
 # И запустим уже наш сервис
 RunGames ();
 
-if (-f $pidfile) {
+if (-e $pidfile) {
 	unlink $pidfile;
 }
 
@@ -160,11 +161,11 @@ exit 0;
 
 sub daemonize {
 	__fork ();
-	POSIX::setsid ();
-	open STDIN, '<', '/dev/null';                    ## no critic (InputOutput::RequireCheckedSyscalls, InputOutput::RequireCheckedOpen)
+	setsid ();
+	open STDIN, '<', File::Spec->devnull;                    ## no critic (InputOutput::RequireCheckedSyscalls, InputOutput::RequireCheckedOpen)
 	# we handle STDOUT && STDERR via Log::Any::For::Std, so do not close them explicitly
-	#open STDOUT, '>', '/dev/null';                   ## no critic (InputOutput::RequireCheckedSyscalls, InputOutput::RequireCheckedOpen)
-	#open STDERR, '>', '/dev/null';                   ## no critic (InputOutput::RequireCheckedSyscalls, InputOutput::RequireCheckedOpen)
+	#open STDOUT, '>', File::Spec->devnull;                   ## no critic (InputOutput::RequireCheckedSyscalls, InputOutput::RequireCheckedOpen)
+	#open STDERR, '>', File::Spec->devnull;                   ## no critic (InputOutput::RequireCheckedSyscalls, InputOutput::RequireCheckedOpen)
 	__fork ();
 	umask 0;
 	return;
@@ -188,7 +189,7 @@ sub __fork {
 sub __signal_handler {
 	$log->info ("[INFO] Caught a signal $OS_ERROR");
 
-	if (-f $pidfile) {
+	if (-e $pidfile) {
 		unlink $pidfile;
 	}
 

bin/gamedata_seed.pl

@@ -1,6 +1,6 @@
 #!/usr/bin/perl
 
-use 5.018;
+use 5.018; ## no critic (ProhibitImplicitImport)
 use strict;
 use warnings;
 use utf8;

cpanfile

@@ -1,3 +1,4 @@
+## no critic
 requires 'Carp',                  '==1.50';
 requires 'Clone',                 '==0.45';
 requires 'Cwd::utf8',             '==0.011';
@@ -10,18 +11,18 @@ requires 'English',               '0';
 requires 'Exporter',              '==5.74';
 requires 'File::Basename',        '0';
 requires 'File::Path',            '==2.18';
+requires 'File::Spec',            '==3.75';
 requires 'JSON::XS',              '==4.03';
 requires 'Log::Any',              '==1.710';
 requires 'Log::Any::Adapter',     '==1.710';
 requires 'Log::Any::For::Std',    '==0.05';
 requires 'Math::Random::Secure',  '==0.080001';
-requires 'Mojolicious',           '==9.22';
+requires 'Mojolicious',           '==9.24';
 requires 'Mojo::IOLoop',          '0';
 requires 'Mojo::IOLoop::Signal',  '==0.003';
 requires 'Mojo::Redis',           '==3.27';
 requires 'Mojo::Util',            '0';
 requires 'POSIX',                 '0';
-requires 'Protocol::Redis::XS',   '0';
 requires 'String::Random',        '==0.32';
 requires 'open',                  '0';
 requires 'utf8',                  '0';

lib/Conf.pm

@@ -1,14 +1,14 @@
 package Conf;
 # loads config
 
-use 5.018;
+use 5.018; ## no critic (ProhibitImplicitImport)
 use strict;
 use warnings;
 use utf8;
 use open qw (:std :utf8);
 use English qw ( -no_match_vars );
 use Encode qw (encode);
-use JSON::XS;
+use JSON::XS ();
 
 use version; our $VERSION = qw (1.0);
 use Exporter qw (import);

lib/Games.pm

@@ -1,7 +1,7 @@
 package Games;
 
 # Общие модули - синтаксис, кодировки итд
-use 5.018;
+use 5.018; ## no critic (ProhibitImplicitImport)
 use strict;
 use warnings;
 use utf8;
@@ -9,14 +9,11 @@ use open qw (:std :utf8);
 
 # Модули для работы приложения
 use Clone qw (clone);
-use Data::Dumper;
+use Data::Dumper qw (Dumper);
 use Log::Any qw ($log);
-use Math::Random::Secure qw (irand);
-# Чтобы "уж точно" использовать hiredis-биндинги, загрузим этот модуль перед Mojo::Redis
-use Protocol::Redis::XS;
-use Mojo::Redis;
-use Mojo::IOLoop;
-use Mojo::IOLoop::Signal;
+use Mojo::Redis ();
+use Mojo::IOLoop ();
+use Mojo::IOLoop::Signal ();
 
 use Conf qw (LoadConf);
 use Games::Archeologist qw (Dig);
@@ -27,7 +24,11 @@ use Exporter qw (import);
 our @EXPORT_OK = qw (RunGames);
 
 my $c = LoadConf ();
-my $fwd_cnt = $c->{'forward_max'} // 5;
+my $fwd_cnt = 5;
+
+if (defined $c->{'forward_max'}) {
+	$fwd_cnt = $c->{'forward_max'};
+}
 
 # Основной парсер
 my $parse_message = sub {
@@ -38,6 +39,18 @@ my $parse_message = sub {
 	$answer->{message} = undef;
 
 	if (defined $answer->{misc}) {
+		unless (defined $answer->{misc}->{answer}) {
+			$answer->{misc}->{answer} = 1;
+		}
+
+		unless (defined $answer->{misc}->{bot_nick}) {
+			$answer->{misc}->{bot_nick} = '';
+		}
+
+		unless (defined $answer->{misc}->{csign}) {
+			$answer->{misc}->{csign} = $c->{csign};
+		}
+
 		unless (defined $answer->{misc}->{fwd_cnt}) {
 			$answer->{misc}->{fwd_cnt} = 1;
 		} else {
@@ -50,17 +63,25 @@ my $parse_message = sub {
 			}
 		}
 
-		unless (defined $answer->{misc}->{answer}) {
-			$answer->{misc}->{answer} = 1;
+		unless (defined $answer->{misc}->{good_morning}) {
+			$answer->{misc}->{good_morning} = 0;
 		}
 
-		unless (defined $answer->{misc}->{csign}) {
-			$answer->{misc}->{csign} = '!';
+		unless (defined $answer->{misc}->{msg_format}) {
+			$answer->{misc}->{msg_format} = 0;
+		}
+
+		unless (defined $answer->{misc}->{username}) {
+			$answer->{misc}->{username} = '';
 		}
 	} else {
-		$answer->{misc}->{answer} = 1;
-		$answer->{misc}->{csign} = '!';
-		$answer->{misc}->{msg_format} = 0;
+		$answer->{misc}->{answer}       = 1;
+		$answer->{misc}->{bot_nick}     = '';
+		$answer->{misc}->{csign}        = $c->{csign};
+		$answer->{misc}->{fwd_cnt}      = 1;
+		$answer->{misc}->{good_morning} = 0;
+		$answer->{misc}->{msg_format}   = 0;
+		$answer->{misc}->{username}     = '';
 	}
 
 	my $send_to = $m->{plugin};
@@ -68,8 +89,8 @@ my $parse_message = sub {
 	$log->debug ('[DEBUG] Incoming message ' . Dumper ($m));
 
 	# Пробуем найти команды. Сообщения, начинающиеся с $answer->{misc}->{csign}
-	if (substr ($m->{message}, 0, 1) eq $answer->{misc}->{csign}) {
-		my $cmd = substr $m->{message}, 1;
+	if (substr ($m->{message}, 0, length ($answer->{misc}->{csign})) eq $answer->{misc}->{csign}) {
+		my $cmd = substr $m->{message}, length ($answer->{misc}->{csign});
 		my @cmds = qw (fish fishing рыба рыбка рыбалка);
 		my $bingo = 0;
 
@@ -99,7 +120,7 @@ my $parse_message = sub {
 
 	if (defined $answer->{message}) {
 		$self->json ($send_to)->notify (
-			$send_to => $answer
+			$send_to => $answer,
 		);
 	}
 
@@ -110,7 +131,7 @@ my $__signal_handler = sub {
 	my ($self, $name) = @_;
 	$log->info ("[INFO] Caught a signal $name");
 
-	if (defined $main::pidfile && -f $main::pidfile) {
+	if (defined $main::pidfile && -e $main::pidfile) {
 		unlink $main::pidfile;
 	}
 
@@ -123,7 +144,7 @@ sub RunGames {
 	$log->info ("[INFO] Connecting to $c->{server}, $c->{port}");
 
 	my $redis = Mojo::Redis->new (
-		sprintf 'redis://%s:%s/1', $c->{server}, $c->{port}
+		sprintf 'redis://%s:%s/1', $c->{server}, $c->{port},
 	);
 
 	$log->info ('[INFO] Registering connection-event callback');
@@ -140,11 +161,11 @@ sub RunGames {
 					my ($conn, $error) = @_;
 					$log->error ("[ERROR] Redis connection error: $error");
 					return;
-				}
+				},
 			);
 
 			return;
-		}
+		},
 	);
 
 	my $pubsub = $redis->pubsub;
@@ -155,14 +176,12 @@ sub RunGames {
 		$log->debug ("[DEBUG] Subscribing to $channel");
 
 		$sub->{$channel} = $pubsub->json ($channel)->listen (
-			$channel => sub { $parse_message->(@_); }
+			$channel => sub { $parse_message->(@_); },
 		);
 	}
 
-	Mojo::IOLoop::Signal->on (
-		TERM => $__signal_handler,
-		INT  => $__signal_handler
-	);
+	Mojo::IOLoop::Signal->on (TERM => $__signal_handler);
+	Mojo::IOLoop::Signal->on (INT  => $__signal_handler);
 
 	do { Mojo::IOLoop->start } until Mojo::IOLoop->is_running;
 	return;

lib/Games/Archeologist.pm

@@ -1,12 +1,12 @@
 package Games::Archeologist;
 
-use 5.018;
+use 5.018; ## no critic (ProhibitImplicitImport)
 use strict;
 use warnings;
 use utf8;
 use open qw (:std :utf8);
 use English qw ( -no_match_vars );
-use DBI;
+use DBI ();
 use Log::Any qw ($log);
 use Math::Random::Secure qw (irand);
 

lib/Games/Fisher.pm

@@ -1,12 +1,12 @@
 package Games::Fisher;
 
-use 5.018;
+use 5.018; ## no critic (ProhibitImplicitImport)
 use strict;
 use warnings;
 use utf8;
 use open qw (:std :utf8);
 use English qw ( -no_match_vars );
-use DBI;
+use DBI ();
 use Log::Any qw ($log);
 use Math::Random::Secure qw (irand);
 

lib/Games/Gamestat.pm

@@ -1,12 +1,12 @@
 package Games::Gamestat;
 # Stores and calculates player stats for games
 
-use 5.018;
+use 5.018; ## no critic (ProhibitImplicitImport)
 use strict;
 use warnings;
 use utf8;
 use open qw (:std :utf8);
-use DBI;
+use DBI ();
 use English qw ( -no_match_vars );
 use File::Path qw (make_path);
 use Mojo::Util qw (trim);

lib/Util.pm

@@ -1,6 +1,6 @@
 package Util;
 
-use 5.018;
+use 5.018; ## no critic (ProhibitImplicitImport)
 use strict;
 use warnings;
 use utf8;
@@ -8,7 +8,7 @@ use open qw (:std :utf8);
 use English qw ( -no_match_vars );
 
 use Digest::SHA qw (sha1_base64);
-use Encode;
+use Encode qw (encode_utf8);
 
 use version; our $VERSION = qw (1.0);
 use Exporter qw (import);