Add logging via Log::Any, fork() to daemonize, fix misc bugs

.perlcriticrc

@@ -101,3 +101,6 @@ lib_sections    = NAME | VERSION | DESCRIPTION | AUTHOR | LICENSE AND COPYRIGHT
 
 [-BuiltinFunctions::ProhibitComplexMappings]
 # so how I suppose to chomp() every damn string in array?
+
+[-ValuesAndExpressions::ProhibitEscapedCharacters]
+# lets follow example of AnyEvent::IRC::Client, and do not complicate this stuff

bin/aleesa-irc-bot

@@ -25,23 +25,39 @@ BEGIN {
 
 use lib ("$workdir/lib", "$workdir/vendor_perl", "$workdir/vendor_perl/lib/perl5");
 no Cwd;
-use Cwd::utf8 qw (abs_path);
+use Cwd::utf8 qw (chdir abs_path);
-use POSIX qw (setgid setuid);
+use POSIX qw (setgid setuid setsid);
 use File::Path qw (make_path);
-use File::Basename qw (dirname);
+use File::Basename qw (basename dirname);
+use Log::Any qw ($log);
+use Log::Any::Adapter;
+use Log::Any::For::Std;
 use BotLib::Conf qw (LoadConf);
-use IRCBot2 qw (RunIRCBot);
+use IRCBot qw (RunIRCBot);
+
+sub daemonize ();
+sub __fork ();
+sub __signal_handler;
+
+local $OUTPUT_AUTOFLUSH = 1;
+my $runAsUid = $UID;
+
+my $piddir = '/var/run/' . basename (abs_path $PROGRAM_NAME);
+my $C = LoadConf ();
+my $loglevel = $C->{'loglevel'} // 'notice';
+my $logfile;
+
+if (defined $C->{'log'}) {
+	$logfile = $C->{'log'};
+} elsif (defined $C->{'debug_log'}) {
+	$logfile = $C->{'debug_log'};
+}
 
 # if we run under root, create pid dir and set correct owner for it, same for debug log if it is defined
 if ($UID == 0) {
-	my $C = LoadConf ();
+	my $user = $C->{user};
-
+	die "Unable to run as root, please define unprivileged user in config.json\n" unless (defined ($user));
-	unless (defined $C->{user}) {
+	my ($uid, $gid) = (getpwnam $user)[2,3];
-		die "Unable to run as root, please define unprivileged user in config.json\n";
-	}
-
-	my ($uid, $gid) = (getpwnam $C->{user})[2,3];
-	my $piddir = dirname $C->{pid};
 
 	unless (-d $piddir) {
 		make_path (
@@ -52,14 +68,6 @@ if ($UID == 0) {
 		) or die "Unable to create $piddir: $OS_ERROR\n";
 	}
 
-	my $logfile;
-
-	if (defined $C->{'log'}) {
-		$logfile = $C->{'log'};
-	} elsif (defined $C->{'debug_log'}) {
-		$logfile = $C->{'debug_log'};
-	}
-
 	if (defined $logfile) {
 		my $logdir = dirname $logfile;
 
@@ -74,16 +82,108 @@ if ($UID == 0) {
 	}
 
 # drop privs
-	setgid ($gid) or die "Unable to switch to group of $C->{user}: $OS_ERROR\n";
+	setgid ($gid) or die "Unable to switch to group of $user: $OS_ERROR\n";
-	setuid ($uid) or die "Unable to switch to account $C->{user}: $OS_ERROR\n";
+	setuid ($uid) or die "Unable to switch to account $user: $OS_ERROR\n";
+} else {
+	$piddir = $workdir;
 }
 
+if (defined $logfile) {
+	# loglevel warning suppresses logging from CHI.
+	Log::Any::Adapter->set ('File', $logfile, log_level => $loglevel);
+
+	# Some annoying CHI logging events come with category set to CHI::Driver and log_level set to debug.
+	# Until we use start using Log::Any native features and set whole loglevel accordingly, lets lower
+	# verbosity paticulary for CHI.
+	Log::Any::Adapter->set (
+		{
+			category => 'CHI::Driver'
+		},
+		'File',
+		$logfile,
+		log_level => 'warn'
+	);
+} else {
+	# no log defined so set loglevel to the least verbose
+	Log::Any::Adapter->set ('File', '/dev/null', 'log_level'=>'emergency');
+}
+
+# double fork attach to /dev/null all stdio and go background
+daemonize ();
+
+# write pidfile
+my $apath = abs_path $PROGRAM_NAME;
+
+unless (defined $apath) {
+	$log->fatal ("[FATAL] Unable to get abs_path: $OS_ERROR");
+	exit 1;
+}
+
+my $pidfile = sprintf '%s/%s.pid', $piddir, basename $apath;
+$log->info ("[INFO] Creating pidfile at $pidfile");
+
+open (my $pid, '>', $pidfile) or do {
+	$log->fatal ("[FATAL] Error opening $pidfile: $OS_ERROR");
+	exit 1;
+};
+
+print $pid $PID or do {
+	$log->fatal ("[FATAL] Error writing to $pidfile: $OS_ERROR");
+	exit 1;
+};
+
+close $pid;                              ## no critic (InputOutput::RequireCheckedSyscalls)
+
+local $SIG{INT}  = \&__signal_handler;
+local $SIG{TERM} = \&__signal_handler;
+
 # set correct proctitle
 $PROGRAM_NAME = abs_path $PROGRAM_NAME;  ## no critic (Variables::RequireLocalizedPunctuationVars)
 
 RunIRCBot ();
 
+if (-f $pidfile) {
+	unlink $pidfile;
+}
+
 exit 0;
 
+sub daemonize () {
+	__fork ();
+	POSIX::setsid ();
+	open (STDIN, '<', '/dev/null');   ## 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)
+	__fork ();
+	umask 0;
+	return;
+}
+
+sub __fork () {
+	my $pid = fork;
+
+	unless (defined $pid) {
+		$log->fatal ("[FATAL] Can't fork: $OS_ERROR");
+		exit 1;
+	}
+
+	if ($pid != 0) {
+		exit 0;
+	}
+
+	return;
+}
+
+sub __signal_handler ($) {
+	$log->info ("[INFO] Caught a signal $OS_ERROR");
+
+	if (-f $pidfile) {
+		unlink $pidfile;
+	}
+
+	exit 0;
+}
+
 __END__
 # vim: set ft=perl noet ai ts=4 sw=4 sts=4:

cpanfile

@@ -17,6 +17,9 @@ requires "HTML::TokeParser";
 requires "HTTP::Tiny";
 requires "JSON::XS";
 requires "JSON::PP";
+requires "Log::Any";
+requires "Log::Any::Adapter";
+requires "Log::Any::For::Std";
 requires "Math::Random::Secure";
 requires "MIME::Base64";
 requires "POSIX";

data/sample_config.json

@@ -26,10 +26,9 @@
     # bot commands will begin with this symbol
     "csign": "!",
 
-    # stderr
+    # log settings
-    "log" : "/var/log/aleesa-irc-bot/error.log",
+    "log" : "/var/log/aleesa-irc-bot/aleesa-irc-bot.log",
-    # stdout
+    "loglevel" : "notice";
-    "debug_log" : "/dev/null",
 
     # ditto
     "pid" : "/var/run/aleesa-irc-bot/aleesa-irc-bot.pid",

lib/BotLib.pm

@@ -51,20 +51,147 @@ sub RandomCommonPhrase () {
 }
 
 sub Command {
+	my $bot = shift;
 	my $chatid = shift;
 	my $chattername = shift;
 	my $text = shift;
 
 	my $reply;
 
-	if (substr ($text, 1, 2) eq 'w '  ||  substr ($text, 1, 2) eq 'п ') {
+	if (substr ($text, 1, 3) eq 'rum' || substr ($text, 1, 3) eq 'ром') {
+		my $target;
+
+		if ((length ($text) > 5)) {
+			$target = trim (substr $text, 5);
+		}
+
+		if (! defined $target || ($target eq '')) {
+			$target = $chattername;
+		}
+
+		$reply = 'притаскивает на подносе стопку рома для ' . $target . ', края стопки искрятся кристаллами соли.';
+		$bot->send_long_message ('utf8', 0, "PRIVMSG\001ACTION", $chatid, $reply);
+		return;
+	} elsif (substr ($text, 1, 5) eq 'vodka' || substr ($text, 1, 5) eq 'водка') {
+		my $target;
+
+		if ((length ($text) > 7)) {
+			$target = trim (substr $text, 7);
+		}
+
+		if (! defined $target || ($target eq '')) {
+			$target = $chattername;
+		}
+
+		$reply = 'подаёт шот водки с небольшим маринованным огурчиком на блюдце для ' . $target . '. Из огурчика торчит небольшая вилочка.';
+		$bot->send_long_message ('utf8', 0, "PRIVMSG\001ACTION", $chatid, $reply);
+		return;
+	} elsif (substr ($text, 1, 4) eq 'beer' || substr ($text, 1, 4) eq 'пиво') {
+		my $target;
+
+		if ((length ($text) > 6)) {
+			$target = trim (substr $text, 6);
+		}
+
+		if (! defined $target || ($target eq '')) {
+			$target = $chattername;
+		}
+
+		$reply = 'бахает об стол перед ' . $target . ' кружкой холодного пива, часть пенной шапки сползает по запотевшей стенке кружки.';
+		$bot->send_long_message ('utf8', 0, "PRIVMSG\001ACTION", $chatid, $reply);
+		return;
+	} elsif (substr ($text, 1, 7) eq 'tequila') {
+		my $target;
+
+		if ((length ($text) > 9)) {
+			$target = trim (substr $text, 9);
+		}
+
+		if (! defined $target || ($target eq '')) {
+			$target = $chattername;
+		}
+
+		$reply = 'ставит рядом с ' . $target . ' шот текилы, аккуратно на ребро стопки насаживает дольку лайма и ставит кофейное блюдце с горочкой соли.';
+		$bot->send_long_message ('utf8', 0, "PRIVMSG\001ACTION", $chatid, $reply);
+		return;
+	} elsif (substr ($text, 1, 6) eq 'текила') {
+		my $target;
+
+		if ((length ($text) > 8)) {
+			$target = trim (substr $text, 8);
+		}
+
+		if (! defined $target || ($target eq '')) {
+			$target = $chattername;
+		}
+
+		$reply = 'ставит рядом с ' . $target . ' шот текилы, аккуратно на ребро стопки насаживает дольку лайма и ставит кофейное блюдце с горочкой соли.';
+		$bot->send_long_message ('utf8', 0, "PRIVMSG\001ACTION", $chatid, $reply);
+		return;
+	} elsif (substr ($text, 1, 6) eq 'whisky') {
+		my $target;
+
+		if ((length ($text) > 8)) {
+			$target = trim (substr $text, 8);
+		}
+
+		if (! defined $target || ($target eq '')) {
+			$target = $chattername;
+		}
+
+		$reply = 'демонстративно достаёт из морозилки пару кубических камушков, бросает их в толстодонный стакан и аккуратно наливает Jack Daniels. Запускает стакан вдоль барной стойки, он останавливается около ' . $target . '.';
+		$bot->send_long_message ('utf8', 0, "PRIVMSG\001ACTION", $chatid, $reply);
+		return;
+	} elsif (substr ($text, 1, 5) eq 'виски') {
+		my $target;
+
+		if ((length ($text) > 7)) {
+			$target = trim (substr $text, 7);
+		}
+
+		if (! defined $target || ($target eq '')) {
+			$target = $chattername;
+		}
+
+		$reply = 'демонстративно достаёт из морозилки пару кубических камушков, бросает их в толстодонный стакан и аккуратно наливает Jack Daniels. Запускает стакан вдоль барной стойки, он останавливается около ' . $target . '.';
+		$bot->send_long_message ('utf8', 0, "PRIVMSG\001ACTION", $chatid, $reply);
+		return;
+	} elsif (substr ($text, 1, 8) eq 'absinthe') {
+		my $target;
+
+		if ((length ($text) > 10)) {
+			$target = trim (substr $text, 10);
+		}
+
+		if (! defined $target || ($target eq '')) {
+			$target = $chattername;
+		}
+
+		$reply = 'наливает абсент в стопку. Смочив кубик сахара в абсенте кладёт его на дырявую ложечку и пожигает. Как только пламя потухнет, ' . $c->{nick} . ' размешивает оплавившийся кубик в абсенте и подносит стопку ' . $target . '.';
+		$bot->send_long_message ('utf8', 0, "PRIVMSG\001ACTION", $chatid, $reply);
+		return;
+	} elsif (substr ($text, 1, 6) eq 'абсент') {
+		my $target;
+
+		if ((length ($text) > 8)) {
+			$target = trim (substr $text, 8);
+		}
+
+		if (! defined $target || ($target eq '')) {
+			$target = $chattername;
+		}
+
+		$reply = 'наливает абсент в стопку. Смочив кубик сахара в абсенте кладёт его на дырявую ложечку и пожигает. Как только пламя потухнет, ' . $c->{nick} . ' размешивает оплавившийся кубик в абсенте и подносит стопку ' . $target . '.';
+		$bot->send_long_message ('utf8', 0, "PRIVMSG\001ACTION", $chatid, $reply);
+		return;
+	} elsif (substr ($text, 1, 2) eq 'w '  ||  substr ($text, 1, 2) eq 'п ') {
 		my $city = substr $text, 2;
 		$reply = Weather ($city) =~ tr/\n/ /r;
 	} elsif (substr ($text, 1) eq 'anek'  ||  substr ($text, 1) eq 'анек' || substr ($text, 1) eq 'анекдот' ) {
 		$reply = Anek ();
 	} elsif (substr ($text, 1) eq 'coin' || substr ($text, 1) eq 'монетка') {
 		if (rand (101) < 0.016) {
-			$reply = "ребро";
+			$reply = 'ребро';
 		} else {
 			if (irand (2) == 0) {
 				if (irand (2) == 0) {
@@ -81,11 +208,9 @@ sub Command {
 			}
 		}
 	} elsif (substr ($text, 1) eq 'roll' || substr ($text, 1) eq 'dice' || substr ($text, 1) eq 'кости') {
-		$reply = sprintf "На первой кости выпало %d, а на второй — %d.", irand (6) + 1, irand (6) + 1;
+		$reply = sprintf 'На первой кости выпало %d, а на второй — %d.', irand (6) + 1, irand (6) + 1;
 	} elsif (substr ($text, 1) eq 'version'  ||  substr ($text, 1) eq 'ver') {
 		$reply = 'Версия нуль.чего-то_там.чего-то_там';
-	} elsif (substr ($text, 1) eq 'help'  ||  substr ($text, 1) eq 'помощь') {
-		$reply = "Попробуй '$c->{nick}, help' без кавычек, должно помочь.";
 	} elsif (substr ($text, 1) eq 'lat'  ||  substr ($text, 1) eq 'лат') {
 		$reply = Lat ();
 	} elsif (substr ($text, 1) eq 'cat'  ||  substr ($text, 1) eq 'кис') {

lib/BotLib/Anek.pm

@@ -6,11 +6,11 @@ use warnings;
 use utf8;
 use open qw (:std :utf8);
 use English qw ( -no_match_vars );
-use Carp qw (carp);
 use Encode;
 use HTML::TokeParser;
 use HTTP::Tiny;
 use JSON::XS;
+use Log::Any qw ($log);
 
 use version; our $VERSION = qw (1.0);
 use Exporter qw (import);
@@ -58,14 +58,14 @@ sub Anek {
 				my @anek = split (/<br>/, $anek);
 				$ret = join ("\n", @anek);
 			} else {
-				carp (sprintf "[WARN] anekdot.ru server returns incorrect json, full response text message: %s\n", $response_text);
+				$log->warn (sprintf '[WARN] anekdot.ru server returns incorrect json, full response text message: %s', $response_text);
 			}
 		} else {
-			carp (sprintf "[WARN] anekdot.ru server returns unexpected response text: %s\n", $response_text);
+			$log->warn (sprintf '[WARN] anekdot.ru server returns unexpected response text: %s', $response_text);
 		}
 
 	} else {
-		carp (sprintf "[WARN] anekdot.ru server return status %s with message: %s\n", $r->code, $r->message);
+		$log->warn (sprintf '[WARN] anekdot.ru server return status %s with message: %s', $r->code, $r->message);
 	}
 
 	return $ret;

lib/BotLib/Buni.pm

@@ -6,9 +6,9 @@ use warnings;
 use utf8;
 use open qw (:std :utf8);
 use English qw ( -no_match_vars );
-use Carp qw (carp);
 use HTTP::Tiny;
 use HTML::TokeParser;
+use Log::Any qw ($log);
 
 use version; our $VERSION = qw (1.0);
 use Exporter qw (import);
@@ -47,7 +47,7 @@ sub Buni {
 			} while ($#{$a[0]} > 1);
 		}
 	} else {
-		carp (sprintf "[WARN] Server return status %s with message: %s\n", $r->{status}, $r->{reason});
+		$log->warn (sprintf '[WARN] Server return status %s with message: %s', $r->{status}, $r->{reason});
 	}
 
 	return $ret;

lib/BotLib/Conf.pm

@@ -7,8 +7,8 @@ use warnings;
 use utf8;
 use open qw (:std :utf8);
 use English qw ( -no_match_vars );
-use Carp qw (carp);
 use JSON::XS;
+use Log::Any qw ($log);
 
 use version; our $VERSION = qw (1.0);
 use Exporter qw (import);
@@ -23,12 +23,12 @@ sub LoadConf {
 
 	unless ($readlen) {
 		close $CH;                                   ## no critic (InputOutput::RequireCheckedSyscalls
-		carp ("[FATA] Unable to read $c: $OS_ERROR\n");
+		$log->fata ("[FATA] Unable to read $c: $OS_ERROR");
 	}
 
 	if ($readlen != $len) {
 		close $CH;                                   ## no critic (InputOutput::RequireCheckedSyscalls
-		carp ("[FATA] File $c is $len bytes on disk, but we read only $readlen bytes\n");
+		$log->fata ("[FATA] File $c is $len bytes on disk, but we read only $readlen bytes");
 	}
 
 	close $CH;                                       ## no critic (InputOutput::RequireCheckedSyscalls

lib/BotLib/Drink.pm

@@ -6,13 +6,13 @@ use warnings;
 use utf8;
 use open qw (:std :utf8);
 use English qw ( -no_match_vars );
-use Carp qw (carp);
 use Encode;
 use CHI;
 use CHI::Driver::BerkeleyDB;
 use DateTime;
 use HTTP::Tiny;
 use HTML::TokeParser;
+use Log::Any qw ($log);
 use POSIX qw (strftime);
 use BotLib::Conf qw (LoadConf);
 
@@ -66,7 +66,7 @@ sub Drink {
 				$ret = join "\n", @holiday;
 			}
 		} else {
-			carp (sprintf "[WARN] Server return status %s with message: %s\n", $r->{status}, $r->{reason});
+			$log->warn (sprintf '[WARN] Server return status %s with message: %s', $r->{status}, $r->{reason});
 			return undef;
 		}
 

lib/BotLib/Fortune.pm

@@ -7,8 +7,9 @@ use warnings;
 use utf8;
 use open qw (:std :utf8);
 use English qw ( -no_match_vars );
-use Carp qw (croak carp);
+use Carp qw (croak);
 use File::Path qw (make_path);
+use Log::Any qw ($log);
 use Math::Random::Secure qw (irand);
 use MIME::Base64;
 use SQLite_File;
@@ -69,7 +70,7 @@ sub Fortune () {
 	my $backingfile = sprintf '%s/fortune.sqlite', $dir;
 
 	tie my @array, 'SQLite_File', $backingfile  ||  do {
-		carp ("[ERROR] Unable to tie to $backingfile: $OS_ERROR\n");
+		$log->error ("[ERROR] Unable to tie to $backingfile: $OS_ERROR");
 		return '';
 	};
 

lib/BotLib/Fox.pm

@@ -6,9 +6,9 @@ use warnings;
 use utf8;
 use open qw (:std :utf8);
 use English qw ( -no_match_vars );
-use Carp qw (carp);
 use JSON::XS;
 use HTTP::Tiny;
+use Log::Any qw ($log);
 
 use version; our $VERSION = qw (1.0);
 use Exporter qw (import);
@@ -35,7 +35,7 @@ sub Fox {
 		};
 
 		unless (defined $jfox) {
-			carp ("[WARN] Unable to decode JSON: $EVAL_ERROR\n");
+			$log->warn ("[WARN] Unable to decode JSON: $EVAL_ERROR");
 		} else {
 			if ($jfox->{image}) {
 				$jfox->{image} =~ s/\\//xmsg;
@@ -43,7 +43,7 @@ sub Fox {
 			}
 		}
 	} else {
-		carp (sprintf "[WARN] Server return status %s with message: %s\n", $r->{status}, $r->{reason});
+		$log->warn (sprintf '[WARN] Server return status %s with message: %s', $r->{status}, $r->{reason});
 	}
 
 	return $ret;

lib/BotLib/Friday.pm

@@ -7,8 +7,9 @@ use warnings;
 use utf8;
 use open qw (:std :utf8);
 use English qw ( -no_match_vars );
-use Carp qw (croak carp);
+use Carp qw (croak);
 use File::Path qw (make_path);
+use Log::Any qw ($log);
 use Math::Random::Secure qw (irand);
 use SQLite_File;
 use BotLib::Conf qw (LoadConf);
@@ -80,7 +81,7 @@ sub Friday () {
 	my $backingfile = sprintf '%s/%s.sqlite', $dir, $dow[$today];
 
 	tie my @array, 'SQLite_File', $backingfile  ||  do {
-		carp ("[ERROR] Unable to tie to $backingfile: $OS_ERROR\n");
+		$log->error ("[ERROR] Unable to tie to $backingfile: $OS_ERROR");
 		return '';
 	};
 

lib/BotLib/Image/Flickr.pm

@@ -6,11 +6,11 @@ use warnings;
 use utf8;
 use open qw (:std :utf8);
 use English qw ( -no_match_vars );
-use Carp qw (carp);
 use Digest::HMAC_SHA1 qw (hmac_sha1);
 use File::Path qw (make_path);
 use JSON::XS;
 use HTTP::Tiny;
+use Log::Any qw ($log);
 use Math::Random::Secure qw (irand);
 use MIME::Base64;
 use SQLite_File;
@@ -338,19 +338,19 @@ sub flickrSearchByText {
 				if (defined $response) {
 					return $response;
 				} else {
-					carp ("[WARN] Flickr api returns incorrect json: $r->{content}\n");
+					$log->warn ("[WARN] Flickr api returns incorrect json: $r->{content}");
 					return undef;
 				}
 			} else {
-				carp ("[WARN] Flickr api returns incorrect json: $r->{content}\n");
+				$log->warn ("[WARN] Flickr api returns incorrect json: $r->{content}");
 				return undef;
 			}
 		} else {
-			carp ("[WARN] Flickr api returns incorrect json: $r->{content}\n");
+			$log->warn ("[WARN] Flickr api returns incorrect json: $r->{content}");
 			return undef;
 		}
 	} else {
-		carp ("[WARN] HTTP status code not 200: $r->{status}, $r->{content}\n");
+		$log->warn ("[WARN] HTTP status code not 200: $r->{status}, $r->{content}");
 		return undef;
 	}
 }
@@ -447,19 +447,19 @@ sub flickrSearchByTags {
 				if (defined $response) {
 					return $response;
 				} else {
-					carp ("[WARN] Flickr api returns incorrect json: $r->{content}\n");
+					$log->warn ("[WARN] Flickr api returns incorrect json: $r->{content}");
 					return undef;
 				}
 			} else {
-				carp ("[WARN] Flickr api returns incorrect json: $r->{content}\n");
+				$log->warn ("[WARN] Flickr api returns incorrect json: $r->{content}");
 				return undef;
 			}
 		} else {
-			carp ("[WARN] Flickr api returns incorrect json: $r->{content}\n");
+			$log->warn ("[WARN] Flickr api returns incorrect json: $r->{content}");
 			return undef;
 		}
 	} else {
-		carp ("[WARN] HTTP status code not 200: $r->{status}, $r>{content}\n");
+		$log->warn ("[WARN] HTTP status code not 200: $r->{status}, $r>{content}");
 		return undef;
 	}
 }
@@ -560,13 +560,13 @@ sub FlickrByTags {
 
 	unless (-d $dir) {
 		make_path ($dir) or do {
-			carp ("[ERROR] Unable to create $dir: $OS_ERROR\n");
+			$log->error ("[ERROR] Unable to create $dir: $OS_ERROR");
 			return 0;
 		};
 	}
 
 	tie my %secret, 'SQLite_File', $backingfile  ||  do {
-		carp ("[ERROR] Unable to tie to $backingfile: $OS_ERROR\n");
+		$log->error ("[ERROR] Unable to tie to $backingfile: $OS_ERROR");
 		return 0;
 	};
 
@@ -587,7 +587,7 @@ sub FlickrByTags {
 			$item = sprintf 'https://live.staticflickr.com/%s/%s_%s_z.jpg', $item->{server}, $item->{id}, $item->{secret};
 			return $item;
 		} else {
-			carp ("[NOTICE] Flickr api returns empty search result list\n");
+			$log->notice ('[NOTICE] Flickr api returns empty search result list');
 			return;
 		}
 	} else {
@@ -601,13 +601,13 @@ sub FlickrByText {
 
 	unless (-d $dir) {
 		make_path ($dir) or do {
-			carp ("[ERROR] Unable to create $dir: $OS_ERROR\n");
+			$log->error ("[ERROR] Unable to create $dir: $OS_ERROR");
 			return 0;
 		};
 	}
 
 	tie my %secret, 'SQLite_File', $backingfile  ||  do {
-		carp ("[ERROR] Unable to tie to $backingfile: $OS_ERROR\n");
+		$log->error ("[ERROR] Unable to tie to $backingfile: $OS_ERROR");
 		return 0;
 	};
 
@@ -628,7 +628,7 @@ sub FlickrByText {
 			$item = sprintf 'https://live.staticflickr.com/%s/%s_%s_z.jpg', $item->{server}, $item->{id}, $item->{secret};
 			return $item;
 		} else {
-			carp ("[NOTICE] Flickr api returns empty search result list\n");
+			$log->notice ('[NOTICE] Flickr api returns empty search result list');
 			return;
 		}
 	} else {

lib/BotLib/Karma.pm

@@ -6,9 +6,9 @@ use warnings;
 use utf8;
 use open qw (:std :utf8);
 use English qw ( -no_match_vars );
-use Carp qw (carp);
 use DB_File;
 use File::Path qw (make_path);
+use Log::Any qw ($log);
 use BotLib::Conf qw (LoadConf);
 use BotLib::Util qw (utf2sha1 trim);
 
@@ -34,14 +34,14 @@ sub KarmaSet (@) {
 
 	unless (-d $karmadir) {
 		make_path ($karmadir) or do {
-			carp ("[ERROR] Unable to create $karmadir: $OS_ERROR\n");
+			$log->error ("[ERROR] Unable to create $karmadir: $OS_ERROR");
 			return sprintf 'Карма %s составляет 0', $phrase;
 		};
 	}
 
 	# init hash, store phrase and score
 	tie my %karma, 'DB_File', $karmafile || do {
-		carp ("[ERROR] Something nasty happen when karma ties to its data: $OS_ERROR\n");
+		$log->error ("[ERROR] Something nasty happen when karma ties to its data: $OS_ERROR");
 		return sprintf 'Карма %s составляет 0', $phrase;
 	};
 
@@ -94,14 +94,14 @@ sub KarmaGet (@) {
 
 	unless (-d $karmadir) {
 		make_path ($karmadir) or do {
-			carp ("Unable to create $karmadir: $OS_ERROR\n");
+			$log->error ("Unable to create $karmadir: $OS_ERROR");
 			return sprintf 'Карма %s составляет 0', $phrase;
 		};
 	}
 
 	# init hash, store phrase and score
 	tie my %karma, 'DB_File', $karmafile || do {
-		carp ("[ERROR] Something nasty happen when karma ties to its data: $OS_ERROR\n");
+		$log->error ("[ERROR] Something nasty happen when karma ties to its data: $OS_ERROR");
 		return sprintf 'Карма %s составляет 0', $phrase;
 	};
 

lib/BotLib/Kitty.pm

@@ -6,9 +6,9 @@ use warnings;
 use utf8;
 use open qw (:std :utf8);
 use English qw ( -no_match_vars );
-use Carp qw (carp);
 use JSON::XS;
 use HTTP::Tiny;
+use Log::Any qw ($log);
 
 use version; our $VERSION = qw (1.0);
 use Exporter qw (import);
@@ -35,14 +35,14 @@ sub Kitty {
 		};
 
 		unless (defined $jcat) {
-			carp ("[ERROR] Unable to decode JSON: $EVAL_ERROR\n");
+			$log->error ("[ERROR] Unable to decode JSON: $EVAL_ERROR");
 		} else {
 			if ($jcat->[0]->{url}) {
 				$ret = $jcat->[0]->{url};
 			}
 		}
 	} else {
-		carp (sprintf "Server return status %s with message: %s\n", $r->{status}, $r->{reason});
+		$log->error (sprintf 'Server return status %s with message: %s', $r->{status}, $r->{reason});
 	}
 
 	return $ret;

lib/BotLib/Lat.pm

@@ -11,6 +11,7 @@ use Carp qw (carp);
 use File::Basename qw (dirname);
 use File::Path qw (make_path);
 use Hailo;
+use Log::Any qw ($log);
 use BotLib::Conf qw (LoadConf);
 
 use version; our $VERSION = qw (1.0);
@@ -49,12 +50,12 @@ sub Lat () {
 	my $braindir = dirname $brain;
 
 	unless (-d $braindir) {
-		carp ("[ERROR] No lat module data: $braindir is absent! Train lat first.\n");
+		$log->error ("[ERROR] No lat module data: $braindir is absent! Train lat first.");
 		return '';
 	}
 
 	unless (-f $brain) {
-		carp ("[ERROR] No lat module data: $brain is absent! Train lat first.\n");
+		$log->error ("[ERROR] No lat module data: $brain is absent! Train lat first.");
 		return '';
 	}
 

lib/BotLib/Monkeyuser.pm

@@ -6,9 +6,9 @@ use warnings;
 use utf8;
 use open qw (:std :utf8);
 use English qw ( -no_match_vars );
-use Carp qw (carp);
 use HTTP::Tiny;
 use HTML::TokeParser;
+use Log::Any qw ($log);
 use Math::Random::Secure qw (irand);
 
 use version; our $VERSION = qw (1.0);
@@ -51,7 +51,7 @@ sub Monkeyuser {
 			$ret = sprintf 'https://www.monkeyuser.com%s', $link[irand (1 + $#link)];
 		}
 	} else {
-		carp (sprintf "[WARN] Monkeyuser server return status %s with message: %s\n", $r->{status}, $r->{reason});
+		$log->warn (sprintf '[WARN] Monkeyuser server return status %s with message: %s', $r->{status}, $r->{reason});
 	}
 
 	return $ret;

lib/BotLib/Weather.pm

@@ -6,11 +6,11 @@ use warnings;
 use utf8;
 use open qw (:std :utf8);
 use English qw ( -no_match_vars );
-use Carp qw (carp cluck);
 use CHI;
 use CHI::Driver::BerkeleyDB;
 use HTTP::Tiny;
 use JSON::XS;
+use Log::Any qw ($log);
 use BotLib::Conf qw (LoadConf);
 use BotLib::Util qw (trim urlencode);
 
@@ -33,7 +33,7 @@ sub Weather {
 		my $appid = $c->{openweathermap}->{appid};
 
 		unless (defined $appid) {
-			carp ("[WARN] No appid specified for openweathermap\n");
+			$log->warn ('[WARN] No appid specified for openweathermap');
 			return undef;
 		}
 
@@ -60,11 +60,11 @@ sub Weather {
 			};
 
 			unless (defined $fc) {
-				carp ("[WARN] openweathermap returns corrupted json: $EVAL_ERROR\n");
+				$log->warn ("[WARN] openweathermap returns corrupted json: $EVAL_ERROR");
 				return undef;
 			};
 		} else {
-			carp (sprintf "Server return status %s with message: %s\n", $r->{status}, $r->{reason});
+			$log->warn (sprintf 'Server return status %s with message: %s', $r->{status}, $r->{reason});
 			return undef;
 		}
 

lib/IRCBot.pm

@@ -1,4 +1,4 @@
-package IRCBot2;
+package IRCBot;
 
 use 5.018;
 use strict;
@@ -9,13 +9,16 @@ use English qw ( -no_match_vars );
 use AnyEvent;
 use AnyEvent::IRC;
 use AnyEvent::IRC::Client;
+use AnyEvent::IRC::Util qw (prefix_nick);
 use Date::Format::ISO8601 qw (gmtime_to_iso8601_datetime);
-use Encode qw (_utf8_on _utf8_off decode encode);
+use Encode qw (decode);
 use Hailo;
+use Log::Any qw ($log);
 use BotLib qw (Command RandomCommonPhrase);
 use BotLib::Conf qw (LoadConf);
 use BotLib::Karma qw (KarmaSet);
 use BotLib::Util qw (trim utf2sha1);
+use Data::Dumper;
 
 use version; our $VERSION = qw (1.0);
 use Exporter qw (import);
@@ -26,15 +29,15 @@ sub RunIRCBot {
 	my $c = LoadConf ();
 	my $hailo;
 	my $cv = AnyEvent->condvar;
-	my $irc = new AnyEvent::IRC::Client;
+	my $irc = AnyEvent::IRC::Client->new(send_initial_whois => 1);
 
 	$irc->reg_cb (
 		irc_privmsg => sub {
 			my ($self, $msg) = @_;
 			my $botnick = $irc->nick ();
 			my $chatid = $msg->{params}->[0];
-			my $text = decode('utf8', $msg->{params}->[-1]);
+			my $text = decode ('utf8', $msg->{params}->[-1]);
-			my $nick = (split /!/, $msg->{prefix})[0];
+			my $nick = prefix_nick ($msg->{prefix});
 			my $answer;
 
 			unless (defined $text) { return; }
@@ -63,7 +66,7 @@ sub RunIRCBot {
 					};
 
 					unless (defined $hailo->{$chatid}) {
-						warn ($EVAL_ERROR);
+						$log->warn ($EVAL_ERROR);
 						return;
 					}
 				}
@@ -73,7 +76,7 @@ sub RunIRCBot {
 				};
 
 				unless (defined $answer) {
-					warn ($EVAL_ERROR);
+					$log->warn ($EVAL_ERROR);
 					$answer = sprintf '%s, %s', $nick, RandomCommonPhrase ();
 				}
 			} elsif (substr ($text, -2) eq '++'  ||  substr ($text, -2) eq '--') {
@@ -81,7 +84,7 @@ sub RunIRCBot {
 				my @arr = split /\n/, $text;
 
 				if ($#arr < 1) {
-					my $answer = eval {
+					$answer = eval {
 						KarmaSet (
 							$chatid,
 							trim ( substr ($text, 0, -2) ),
@@ -90,12 +93,56 @@ sub RunIRCBot {
 					};
 
 					unless (defined $answer) {
-						warn ($EVAL_ERROR);
+						$log->warn ($EVAL_ERROR);
 						return;
 					}
 				}
 			} elsif (substr ($text, 0, 1) eq $c->{csign}) {
-				$answer = Command ($chatid, $nick, $text);
+				if (substr ($text, 1) eq 'help' || substr ($text, 1) eq 'помощь') {
+					my $csign = $c->{csign};
+					$answer = << "EOA";
+${csign}help | ${csign}помощь             - это сообщение
+${csign}anek | ${csign}анек | ${csign}анекдот    - рандомный анекдот с anekdot.ru
+${csign}buni                       - комикс-стрип hapi buni
+${csign}bunny                      - кролик
+${csign}rabbit | ${csign}кролик           - кролик
+${csign}cat | ${csign}кис                 - кошечка
+${csign}dice | ${csign}roll | ${csign}кости      - бросить кости
+${csign}dig | ${csign}копать              - заняться археологией
+${csign}drink | ${csign}праздник          - какой сегодня праздник?
+${csign}fish | ${csign}fisher             - порыбачить
+${csign}рыба | ${csign}рыбка | ${csign}рыбалка   - порыбачить
+${csign}f | ${csign}ф                     - рандомная фраза из сборника цитат fortune_mod
+${csign}fortune | ${csign}фортунка        - рандомная фраза из сборника цитат fortune_mod
+${csign}fox | ${csign}лис                 - лисичка
+${csign}friday | ${csign}пятница          - а не пятница ли сегодня?
+${csign}frog | ${csign}лягушка            - лягушка
+${csign}horse | ${csign}лошадь | ${csign}лошадка - лошадка
+${csign}karma фраза                - посмотреть карму фразы
+${csign}карма фраза                - посмотреть карму фразы
+фраза++ | фраза--           - повысить или понизить карму фразы
+${csign}lat | ${csign}лат                 - сгенерировать фразу из крылатого латинского выражения
+${csign}monkeyuser                 - комикс-стрип MonkeyUser
+${csign}owl | ${csign}сова                - сова
+${csign}ping | ${csign}пинг               - попинговать бота
+${csign}proverb | ${csign}пословица       - рандомная русская пословица
+${csign}snail | ${csign}улитк а           - улитка
+${csign}some_brew                  - выдать соответствующий напиток, бармен может налить rum, ром, vodka, водку, beer, пиво, tequila, текила, whisky, виски, absinthe, абсент
+${csign}ver | ${csign}version             - написать что-то про версию ПО
+${csign}версия                     - написать что-то про версию ПО
+${csign}w город | ${csign}п город         - погода в городе
+${csign}xkcd                       - комикс-стрип с xkcb.ru
+EOA
+					foreach my $string (split /\n/, $answer) {
+						if ($string ne '') {
+							$irc->send_long_message ('utf8', 0, "PRIVMSG\001ACTION", $nick, $string);
+						}
+					}
+
+					return;
+				}
+
+				$answer = Command ($self, $chatid, $nick, $text);
 
 				unless (defined $answer && $answer ne '') {
 					return;
@@ -113,7 +160,7 @@ sub RunIRCBot {
 					);
 
 					unless (defined $hailo->{$chatid}) {
-						warn ($EVAL_ERROR);
+						$log->warn ($EVAL_ERROR);
 						return;
 					}
 				}
@@ -124,8 +171,13 @@ sub RunIRCBot {
 			if (defined $answer) {
 					foreach my $string (split /\n/, $answer) {
 						if ($string ne '') {
-							_utf8_off ($string);
+							if ($irc->is_my_nick ($chatid)) {
-							$irc->send_chan ($chatid, "PRIVMSG", $chatid, $string);
+								# private chat
+								$irc->send_long_message ('utf8', 0, 'PRIVMSG', $nick, $string);
+							} else {
+								# chat in channel
+								$irc->send_long_message ('utf8', 0, 'PRIVMSG', $chatid, $string);
+							}
 						}
 					}
 			}
@@ -136,7 +188,7 @@ sub RunIRCBot {
 		connect => sub {
 			my ($pc, $err) = @_;
 			if (defined $err) {
-				warn "Couldn't connect to server: $err\n";
+				$log->err ("Couldn't connect to server: $err\n");
 			}
 
 			if (defined ($c->{identify}) && $c->{identify} ne '') {
@@ -148,14 +200,14 @@ sub RunIRCBot {
 			}
 
 			for my $chan (@{$c->{channels}}) {
-				$irc->send_srv ("JOIN", $chan);
+				$irc->send_srv ('JOIN', $chan);
 			}
 
 			return;
 		},
 
 		connfail => sub {
-			warn "Connection failed, trying again";
+			$log->err ('Connection failed, trying again');
 			sleep 5;
 
 			$irc->connect(
@@ -171,13 +223,13 @@ sub RunIRCBot {
 
 		registered => sub {
 			my ($self) = @_;
-			print "registered!\n";
+			$log->info ('Registered on server');
 			$irc->enable_ping (60);
 			return;
 		},
 
 		disconnect => sub {
-			print "disconnected: $_[1]!\n";
+			$log->err ("Disconnected: $_[1]");
 			sleep 5;
 
 			$irc->connect(
@@ -197,9 +249,9 @@ sub RunIRCBot {
 			my ($self, $kicked_nick, $channel, $is_myself, $msg, $kicker_nick) = @_;
 
 			if ($is_myself) {
-				warn sprintf ('%s kicked me from %s with reason: %s', $kicker_nick, $channel, decode('utf8', $msg));
+				$log->warn (sprintf '%s kicked me from %s with reason: %s', $kicker_nick, $channel, decode ('utf8', $msg));
 				sleep 3;
-				$irc->send_srv ("JOIN", $channel);
+				$irc->send_srv ('JOIN', $channel);
 			}
 
 			return;
@@ -209,7 +261,7 @@ sub RunIRCBot {
 			my ($self, $old_nick, $new_nick, $is_myself) = @_;
 
 			if ($is_myself) {
-				warn sprintf ('my nick have been changed from %s to %s', $old_nick, $new_nick);
+				$log->warn (sprintf 'My nick have been changed from %s to %s', $old_nick, $new_nick);
 			}
 
 			return;
@@ -219,7 +271,7 @@ sub RunIRCBot {
 			my ($self, $nick, $channel, $is_myself, $msg) = @_;
 
 			if ($is_myself) {
-				warn sprintf ('I left %s channel', $channel);
+				$log->warn (sprintf 'I left %s channel', $channel);
 			}
 
 			return;
@@ -229,7 +281,7 @@ sub RunIRCBot {
 			my ($self, $nick, $channel, $is_myself) = @_;
 
 			if ($is_myself) {
-				warn sprintf ('I joined to %s channel', $channel);
+				$log->info (sprintf 'I joined to %s channel', $channel);
 			}
 
 			return;
@@ -276,7 +328,6 @@ sub RunIRCBot {
 	return;
 }
 
-
 1;
 
 # vim: set ft=perl noet ai ts=4 sw=4 sts=4: