package IRCBot; use 5.030; ## no critic (ProhibitImplicitImport) use strict; use warnings; use utf8; use open qw (:std :utf8); 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 (decode); use JSON::XS qw (decode_json encode_json); use Log::Any qw ($log); use BotLib qw (Command SigIntHandler SigTermHandler SigQuitHandler); use BotLib::Conf qw (LoadConf); use BotLib::Util qw (rakedata storedata PrintMsg); use version; our $VERSION = qw (1.0); use Exporter qw (import); our @EXPORT_OK = qw (RunIRCBot); local $OUTPUT_AUTOFLUSH = 1; # Основная функция # undef RunIRCBot() sub RunIRCBot { my $c = LoadConf (); my $cv = AnyEvent->condvar; # Пытаемся ловить сигналы асинхронно my $sigint = AnyEvent->signal (signal => 'INT', cb => \&SigIntHandler); my $sigterm = AnyEvent->signal (signal => 'TERM', cb => \&SigTermHandler); my $sigquit = AnyEvent->signal (signal => 'QUIT', cb => \&SigQuitHandler); # Looks butt-ugly, but we have to make global var calls... err calls to MAIN namespace var $MAIN::IRC = AnyEvent::IRC::Client->new (send_initial_whois => 1); ## no critic (Modules::RequireExplicitInclusion) $MAIN::IRC->reg_cb ( ## no critic (Modules::RequireExplicitInclusion) irc_privmsg => sub { my ($self, $msg) = @_; my $botnick = $MAIN::IRC->nick (); ## no critic (Modules::RequireExplicitInclusion) my $chatid = $msg->{params}->[0]; my $text = decode ('utf8', $msg->{params}->[-1]); my $nick = prefix_nick ($msg->{prefix}); my $answer; # Ивенты без текста нам не интересны unless (defined $text) {return;} # Команды, как правило, начинаются с csign, это обычно . (точка) if (substr($text, 0, length $c->{csign}) eq $c->{csign}) { $answer = Command ($self, $chatid, $nick, $text); unless (defined $answer && $answer ne '') { return; } } # То, что не команды мы игнорируем. if (defined $answer) { foreach my $string (split /\n/, $answer) { if ($string ne '') { if ($MAIN::IRC->is_my_nick ($chatid)) { ## no critic (Modules::RequireExplicitInclusion) # private chat PrintMsg ($nick, $string); } else { # chat in channel PrintMsg ($chatid, $string); } } } } return; }, connect => sub { my ($pc, $err) = @_; if (defined $err) { $log->err ("[ERROR] Couldn't connect to server: $err\n"); } if (defined($c->{identify}) && $c->{identify} ne '') { # freenode/libera.chat identification style $MAIN::IRC->send_srv ( ## no critic (Modules::RequireExplicitInclusion) PRIVMSG => 'NickServ', sprintf ('identify %s %s', $c->{nick}, $c->{identify}), ); } # Джойнимся ко всем каналам, кроме assist-а for my $chan (sort (keys %{$c->{channels}})) { next if $chan eq 'assist'; if ($chan eq 'notify') { next unless ($c->{notifications}->{enabled}); } $MAIN::IRC->send_srv ('JOIN', $c->{channels}->{$chan}); ## no critic (Modules::RequireExplicitInclusion) } # К assist-у джойнимся в последнюю очередь, чтобы быть уже приджойненным ко всему остальному $MAIN::IRC->send_srv ('JOIN', $c->{channels}->{assist}); return; }, connfail => sub { $log->err ('[ERROR] Connection failed, trying again'); sleep 5; $MAIN::IRC->connect ( $c->{server}, $c->{port}, { nick => $c->{nick}, user => $c->{nick}, real => $c->{nick}, }, ); }, registered => sub { my ($self) = @_; $log->info('[INFO] Registered on server'); $MAIN::IRC->enable_ping (60); return; }, disconnect => sub { # TODO: Data::Dump here and debug $_[1], it's undef! $log->err("[ERROR] Disconnected: $_[1]"); sleep 5; $log->info ("[INFO] Re-connecting to $c->{server}:$c->{port}"); $MAIN::IRC->connect( $c->{server}, $c->{port}, { nick => $c->{nick}, user => $c->{nick}, real => $c->{nick}, }, ); return; }, kick => sub { my ($self, $kicked_nick, $channel, $is_myself, $msg, $kicker_nick) = @_; if ($is_myself) { if (defined $msg && $msg ne '') { $log->warn ( sprintf '[WARN] %s kicked me from %s with reason: %s', $kicker_nick, $channel, decode('utf8', $msg), ); } else { $log->warn (sprintf '[WARN] %s kicked me from %s with no reason', $kicker_nick, $channel); } sleep 3; $log->info ("[INFO] Re-joining to $channel"); $MAIN::IRC->send_srv ('JOIN', $channel); } return; }, nick_change => sub { my ($self, $old_nick, $new_nick, $is_myself) = @_; if ($is_myself) { $log->warn(sprintf '[WARN] My nick have been changed from %s to %s', $old_nick, $new_nick); } return; }, part => sub { my ($self, $nick, $channel, $is_myself, $msg) = @_; if ($is_myself) { if (defined $msg && $msg ne '') { $log->warn(sprintf '[WARN] I left %s channel: %s', $channel, $msg); } else { $log->warn(sprintf '[WARN] I left %s channel', $channel); } } else { if (defined $msg && $msg ne '') { $log->warn(sprintf '[INFO] %s left %s channel: %s', $nick, $channel, $msg); } else { $log->warn(sprintf '[INFO] %s left %s channel', $nick, $channel); } } return; }, join => sub { my ($self, $nick, $channel, $is_myself) = @_; if ($is_myself) { $log->info (sprintf '[INFO] I joined to %s channel', $channel); } else { $log->info( sprintf '[INFO] %s joined to %s channel', $nick, $channel); } return; }, ); # these commands will queue until the connection # is completly registered and has a valid nick etc. $MAIN::IRC->ctcp_auto_reply ('ACTION', ## no critic (Modules::RequireExplicitInclusion) sub { my ($cl, $src, $target, $tag, $msg, $type) = @_; return ['ACTION', $msg]; }, ); $MAIN::IRC->ctcp_auto_reply ('CLIENTINFO', ## no critic (Modules::RequireExplicitInclusion) [ 'CLIENTINFO', 'CLIENTINFO ACTION FINGER PING SOURCE TIME USERINFO VERSION', ], ); $MAIN::IRC->ctcp_auto_reply ('FINGER', ## no critic (Modules::RequireExplicitInclusion) [ 'FINGER', $c->{nick}, ], ); $MAIN::IRC->ctcp_auto_reply ('PING', ## no critic (Modules::RequireExplicitInclusion) sub { my ($cl, $src, $target, $tag, $msg, $type) = @_; return ['PING', $msg]; }, ); $MAIN::IRC->ctcp_auto_reply ('SOURCE', ## no critic (Modules::RequireExplicitInclusion) [ 'SOURCE', 'https://github.com/eleksir/meow-irc-bot', ], ); $MAIN::IRC->ctcp_auto_reply ('TIME', ## no critic (Modules::RequireExplicitInclusion) [ 'TIME', gmtime_to_iso8601_datetime (time ()), ], ); $MAIN::IRC->ctcp_auto_reply ('USERINFO', ## no critic (Modules::RequireExplicitInclusion) [ 'USERINFO', $c->{nick}, ], ); $MAIN::IRC->ctcp_auto_reply ('VERSION', ## no critic (Modules::RequireExplicitInclusion) [ 'VERSION', 'Meow IRC Bot/1.0', ], ); if ($c->{ssl}) { $MAIN::IRC->enable_ssl (); ## no critic (Modules::RequireExplicitInclusion) } $MAIN::IRC->connect ( ## no critic (Modules::RequireExplicitInclusion) $c->{server}, $c->{port}, { nick => $c->{nick}, user => $c->{nick}, real => $c->{nick}, }, ); $cv->wait; $MAIN::IRC->disconnect; ## no critic (Modules::RequireExplicitInclusion) return; } 1; # vim: set ft=perl noet ai ts=4 sw=4 sts=4: