diff --git a/.perlcriticrc b/.perlcriticrc index 4ead187..000641b 100644 --- a/.perlcriticrc +++ b/.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 \ No newline at end of file diff --git a/bin/aleesa-irc-bot b/bin/aleesa-irc-bot index b2635df..962bea9 100755 --- a/bin/aleesa-irc-bot +++ b/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 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: diff --git a/cpanfile b/cpanfile index 7e0d8c6..ca4745c 100644 --- a/cpanfile +++ b/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"; diff --git a/data/sample_config.json b/data/sample_config.json index 858ef7a..eb38e94 100644 --- a/data/sample_config.json +++ b/data/sample_config.json @@ -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", diff --git a/lib/BotLib.pm b/lib/BotLib.pm index 4e714c4..90cd45e 100644 --- a/lib/BotLib.pm +++ b/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 'кис') { diff --git a/lib/BotLib/Anek.pm b/lib/BotLib/Anek.pm index 5e7fdc7..4143141 100644 --- a/lib/BotLib/Anek.pm +++ b/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 (/
/, $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; diff --git a/lib/BotLib/Buni.pm b/lib/BotLib/Buni.pm index 9bcf07a..4c5ab41 100644 --- a/lib/BotLib/Buni.pm +++ b/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; diff --git a/lib/BotLib/Conf.pm b/lib/BotLib/Conf.pm index e222b2a..0624101 100644 --- a/lib/BotLib/Conf.pm +++ b/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 diff --git a/lib/BotLib/Drink.pm b/lib/BotLib/Drink.pm index c027b6f..65c91c2 100644 --- a/lib/BotLib/Drink.pm +++ b/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; } diff --git a/lib/BotLib/Fortune.pm b/lib/BotLib/Fortune.pm index ae6dbb7..4e5de18 100644 --- a/lib/BotLib/Fortune.pm +++ b/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 ''; }; diff --git a/lib/BotLib/Fox.pm b/lib/BotLib/Fox.pm index 246d0dd..7f6b2d7 100644 --- a/lib/BotLib/Fox.pm +++ b/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; diff --git a/lib/BotLib/Friday.pm b/lib/BotLib/Friday.pm index b4c4b36..8fa4ac9 100644 --- a/lib/BotLib/Friday.pm +++ b/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 ''; }; diff --git a/lib/BotLib/Image/Flickr.pm b/lib/BotLib/Image/Flickr.pm index 5421a8c..dca19ce 100644 --- a/lib/BotLib/Image/Flickr.pm +++ b/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 { diff --git a/lib/BotLib/Karma.pm b/lib/BotLib/Karma.pm index bd2032e..8f2790b 100644 --- a/lib/BotLib/Karma.pm +++ b/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; }; diff --git a/lib/BotLib/Kitty.pm b/lib/BotLib/Kitty.pm index 09b1801..3825e2b 100644 --- a/lib/BotLib/Kitty.pm +++ b/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; diff --git a/lib/BotLib/Lat.pm b/lib/BotLib/Lat.pm index d1d34ed..f8ef84f 100644 --- a/lib/BotLib/Lat.pm +++ b/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 ''; } diff --git a/lib/BotLib/Monkeyuser.pm b/lib/BotLib/Monkeyuser.pm index d2878bf..1ec70ac 100644 --- a/lib/BotLib/Monkeyuser.pm +++ b/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; diff --git a/lib/BotLib/Weather.pm b/lib/BotLib/Weather.pm index a92edf8..691a5b8 100644 --- a/lib/BotLib/Weather.pm +++ b/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; } diff --git a/lib/IRCBot2.pm b/lib/IRCBot.pm similarity index 54% rename from lib/IRCBot2.pm rename to lib/IRCBot.pm index c5ec9a5..0d3c5b2 100644 --- a/lib/IRCBot2.pm +++ b/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 $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: