aleesa-irc-bot/lib/IRCBot2.pm

package IRCBot2;

use 5.018;
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 Date::Format::ISO8601 qw (gmtime_to_iso8601_datetime);
use Encode qw (_utf8_on _utf8_off decode encode);
use Hailo;
use BotLib qw (Command RandomCommonPhrase);
use BotLib::Conf qw (LoadConf);
use BotLib::Karma qw (KarmaSet);
use BotLib::Util qw (trim utf2sha1);

use version; our $VERSION = qw (1.0);
use Exporter qw (import);
our @EXPORT_OK = qw (RunIRCBot);


sub RunIRCBot {
	my $c = LoadConf ();
	my $hailo;
	my $cv = AnyEvent->condvar;
	my $irc = new AnyEvent::IRC::Client;

	$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 $answer;

			unless (defined $text) { return; }

			# The main idea is to find out if message contains command.
			# I know that this framework contains nifty way to guess commands
			# but it detects command when bot mentiond, but'd like to send
			# commands via command sign (say, exclamation mark).
			if ($text =~ qr/^\s*\Q$botnick\E[\,|\:]?\s*$/i) {
				# Someone call bot, but says only name, nothing more
				$answer = sprintf '%s, чего тебе?', $nick;
			} elsif ($text =~ /^\Q$botnick\E[\,|\:]?\s+(.+)/i) {
				# Someone wants to chit-chat with bot, lets use our brain to make an answer.
				my $phrase = trim ($1);

				unless (defined $hailo->{$chatid}) {
					my $cid = utf2sha1 ($chatid);
					$cid =~ s/\//-/xmsg;
					my $brainname = sprintf '%s/%s.sqlite', $c->{braindir}, $cid;

					$hailo->{$chatid} = eval {
						Hailo->new (
							brain => $brainname,
							order => 3
						);
					};

					unless (defined $hailo->{$chatid}) {
						warn ($EVAL_ERROR);
						return;
					}
				}

				$answer = eval {
					sprintf '%s, %s', $nick, lcfirst ($hailo->{$chatid}->learn_reply ($phrase));
				};

				unless (defined $answer) {
					warn ($EVAL_ERROR);
					$answer = sprintf '%s, %s', $nick, RandomCommonPhrase ();
				}
			} elsif (substr ($text, -2) eq '++'  ||  substr ($text, -2) eq '--') {
				# Looks like someone wants to adjust karma of the phrase
				my @arr = split /\n/, $text;

				if ($#arr < 1) {
					my $answer = eval {
						KarmaSet (
							$chatid,
							trim ( substr ($text, 0, -2) ),
							substr ($text, -2)
						);
					};

					unless (defined $answer) {
						warn ($EVAL_ERROR);
						return;
					}
				}
			} elsif (substr ($text, 0, 1) eq $c->{csign}) {
				$answer = Command ($chatid, $nick, $text);

				unless (defined $answer && $answer ne '') {
					return;
				}
			} else {
				# Default action - add phrase to brain reactor as is
				unless (defined $hailo->{$chatid}) {
					my $cid = utf2sha1 ($chatid);
					$cid =~ s/\//-/xmsg;
					my $brainname = sprintf '%s/%s.sqlite', $c->{braindir}, $cid;

					$hailo->{$chatid} = Hailo->new (
						brain => $brainname,
						order => 3
					);

					unless (defined $hailo->{$chatid}) {
						warn ($EVAL_ERROR);
						return;
					}
				}

				$hailo->{$chatid}->learn ($text);
			}

			if (defined $answer) {
					foreach my $string (split /\n/, $answer) {
						if ($string ne '') {
							_utf8_off ($string);
							$irc->send_chan ($chatid, "PRIVMSG", $chatid, $string);
						}
					}
			}

			return;
		},

		connect => sub {
			my ($pc, $err) = @_;
			if (defined $err) {
				warn "Couldn't connect to server: $err\n";
			}

			if (defined ($c->{identify}) && $c->{identify} ne '') {
				# freenode/libera.chat identification style
				$irc->send_srv (
				PRIVMSG => 'NickServ',
				sprintf ('identify %s %s', $c->{nick}, $c->{identify})
				);
			}

			for my $chan (@{$c->{channels}}) {
				$irc->send_srv ("JOIN", $chan);
			}

			return;
		},

		connfail => sub {
			warn "Connection failed, trying again";
			sleep 5;

			$irc->connect(
				$c->{server},
				$c->{port},
				{
					nick => $c->{nick},
					user => $c->{nick},
					real => $c->{nick}
				}
			);
		},

		registered => sub {
			my ($self) = @_;
			print "registered!\n";
			$irc->enable_ping (60);
			return;
		},

		disconnect => sub {
			print "disconnected: $_[1]!\n";
			sleep 5;

			$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) {
				warn sprintf ('%s kicked me from %s with reason: %s', $kicker_nick, $channel, decode('utf8', $msg));
				sleep 3;
				$irc->send_srv ("JOIN", $channel);
			}

			return;
		},

		nick_change => sub {
			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);
			}

			return;
		},

		part => sub {
			my ($self, $nick, $channel, $is_myself, $msg) = @_;

			if ($is_myself) {
				warn sprintf ('I left %s channel', $channel);
			}

			return;
		},

		join => sub {
			my ($self, $nick, $channel, $is_myself) = @_;

			if ($is_myself) {
				warn sprintf ('I joined to %s channel', $channel);
			}

			return;
		},
	);

	# these commands will queue until the connection
	# is completly registered and has a valid nick etc.
	$irc->ctcp_auto_reply ('CLIENTINFO', ['CLIENTINFO', 'CLIENTINFO ACTION FINGER PING SOURCE TIME USERINFO VERSION']);
	$irc->ctcp_auto_reply ('ACTION',
		sub {
			my ($cl, $src, $target, $tag, $msg, $type) = @_;
			return ['ACTION', $msg];
		}
	);
	$irc->ctcp_auto_reply ('FINGER', ['FINGER', $c->{nick}]);
	$irc->ctcp_auto_reply ('PING',
		sub {
			my ($cl, $src, $target, $tag, $msg, $type) = @_;
			return ['PING', $msg];
		}
	);
	$irc->ctcp_auto_reply ('SOURCE', ['SOURCE', 'https://github.com/eleksir/aleesa-irc-bot']);
	$irc->ctcp_auto_reply ('USERINFO', ['USERINFO', $c->{nick}]);
	$irc->ctcp_auto_reply ('VERSION', ['VERSION', 'Aleesa IRC Bot/1.0']);
	$irc->ctcp_auto_reply ('TIME', ['TIME', gmtime_to_iso8601_datetime (time ()) ]);

	if ($c->{ssl}) {
		$irc->enable_ssl ();
	}

	$irc->connect (
		$c->{server},
		$c->{port},
		{
			nick => $c->{nick},
			user => $c->{nick},
			real => $c->{nick}
		}
	);

	$cv->wait;
	$irc->disconnect;
	return;
}


1;

# vim: set ft=perl noet ai ts=4 sw=4 sts=4: