eleksir/aleesa-irc-bot
0
Fork 0
Code Activity

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

Browse Source
This commit is contained in:
eleksir
2021-08-15 12:40:41 +03:00
parent 012274b9c1
commit f7ebc1a739
19 changed files with 388 additions and 104 deletions
Download Patch File Download Diff File Expand all files Collapse all files

3
.perlcriticrc
View File

@@ -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

144
bin/aleesa-irc-bot
View File

@@ -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 POSIX qw (setgid setuid);
use Cwd::utf8 qw (chdir abs_path);
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 ();
unless (defined $C->{user}) {
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};
my $user = $C->{user};
die "Unable to run as root, please define unprivileged user in config.json\n" unless (defined ($user));
my ($uid, $gid) = (getpwnam $user)[2,3];
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";
setuid ($uid) or die "Unable to switch to account $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 $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:

3
cpanfile
View File

@@ -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";

7
data/sample_config.json
View File

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

135
lib/BotLib.pm
View File

@@ -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 'кис') {

8
lib/BotLib/Anek.pm
View File

@@ -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;

4
lib/BotLib/Buni.pm
View File

@@ -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;

6
lib/BotLib/Conf.pm
View File

@@ -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

4
lib/BotLib/Drink.pm
View File

@@ -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;
}

5
lib/BotLib/Fortune.pm
View File

@@ -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 '';
};

6
lib/BotLib/Fox.pm
View File

@@ -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;

5
lib/BotLib/Friday.pm
View File

@@ -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 '';
};

30
lib/BotLib/Image/Flickr.pm
View File

@@ -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 {

10
lib/BotLib/Karma.pm
View File

@@ -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;
};

6
lib/BotLib/Kitty.pm
View File

@@ -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;

5
lib/BotLib/Lat.pm
View File

@@ -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 '';
}

4
lib/BotLib/Monkeyuser.pm
View File

@@ -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;

8
lib/BotLib/Weather.pm
View File

@@ -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;
}

99
lib/IRCBot2.pm → lib/IRCBot.pm
View File

@@ -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 $nick = (split /!/, $msg->{prefix})[0];
my $text = decode ('utf8', $msg->{params}->[-1]);
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);
$irc->send_chan ($chatid, "PRIVMSG", $chatid, $string);
if ($irc->is_my_nick ($chatid)) {
# 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: