aleesa-jabber-bot/lib/jabberbot.pm

# note http://www.gentoo.ru/node/21449
# необходимо закомменировать строку $response{authzid} = $authzid;
# в vendor_perl/5.24.3/Authen/SASL/Perl/DIGEST_MD5.pm
package jabberbot;

use 5.018;
use strict;
use warnings;
use utf8;
use open qw (:std :utf8);
use English qw ( -no_match_vars );
use Carp qw(carp);
use File::Path qw (make_path);
use Hailo;
use Net::Jabber::Bot;
use botlib qw (command randomCommonPhrase realjid);
use conf qw (loadConf);
use karma qw (karmaSet);
use util qw (trim utf2sha1);

use Exporter qw (import);
use vars qw/$VERSION/;
$VERSION = '1.0';
our @EXPORT_OK = qw (run_jabberbot);

my $c = loadConf ();
my $hailo;
my $imonline = 0;

sub __background_checks {
	my $bot = shift;

	unless ($imonline) {
		$bot->ChangeStatus ('Available', 'I\'m here');
		$imonline = 1;
	}

	return;
}

sub __new_bot_message {
	my %hash = @_;
	my $bot = $hash{bot_object};

	# ignore self messages
	if ($hash{'from_full'} eq $bot->{'from_full'}) {
		return;
	}

	my $text = $hash{body};

	my %jid = realjid (%hash);
	my $chattername = $jid{'name'};
	my $chatid;

	if ($hash{'type'} eq 'groupchat') {
		$chatid = utf2sha1 $hash{'reply_to'};
	} else {
		$chatid = utf2sha1 $jid{'name'};
	}

	$chatid =~ s/\//-/xmsg;

	my $reply;

	# lazy init chat-bot brains
	unless (defined ($hailo->{$chatid})) {
		my $braindir = $c->{jabberbot}->{braindir};
		my $brainname = sprintf '%s/%s.sqlite', $braindir, $chatid;

		unless (-d $braindir) {
			make_path ($braindir) or do {
				carp "[ERROR] Unable to create $braindir: $OS_ERROR";
				return;
			};
		}

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

		if ($hash{'type'} eq 'groupchat') {
			carp "[INFO] Initialized brain for chat $hash{'reply_to'}: $brainname";
		} else {
			carp "[INFO] Initialized brain for chat $jid{'jid'}: $brainname";
		}
	}

	# parse messages
	my $qname = quotemeta ($bot->{'alias'});

	if ($text =~ /^$qname\,?\s*$/) {
		$reply = 'Чего тебе?';
	} elsif (($text =~ /^$qname[\,|\:]? (.+)/) && ($hash{'type'} eq 'groupchat')) {
		$reply = $hailo->{$chatid}->learn_reply ($1);
	} elsif (substr ($text, 0, 1) eq $c->{jabberbot}->{aleesa}->{csign}) {
		$reply = command (%hash);
	# karma agjustment
	} elsif (substr ($text, -2) eq '++'  ||  substr ($text, -2) eq '--') {
		my @arr = split(/\n/, $text);

		if ($#arr < 1) {
			$reply = karmaSet ($chatid, trim (substr ($text, 0, -2)), substr ($text, -2));
		} else {
			# just message in chat
			# in groupchat we answer only to phrases that mention us
			if ($hash{'type'} eq 'groupchat') {
				$hailo->{$chatid}->learn ($text);
			# in tet-a-tet chat we must always answer, if possible
			} elsif ($hash{'type'} eq 'chat') {
				$reply = $hailo->{$chatid}->learn_reply ($text);
			}
		}
	# just message in chat
	} else {
		# in groupchat we answer only to phrases that mention us
		if ($hash{'type'} eq 'groupchat') {
			$hailo->{$chatid}->learn ($text);
		# in tet-a-tet chat we must always answer, if possible
		} elsif ($hash{'type'} eq 'chat') {
			$reply = $hailo->{$chatid}->learn_reply ($text);
		}
	}

	if (defined $reply && ($reply ne '')) {
		if ($hash{'type'} eq 'groupchat') {
			$bot->SendGroupMessage ($hash{'reply_to'}, $reply);
		} elsif ($hash{'type'} eq 'chat') {
			$bot->SendPersonalMessage ($hash{'reply_to'}, $reply);
		}
	}

	return;
}


sub run_jabberbot {
	my %conflist = ();
	$conflist{$c->{jabberbot}->{aleesa}->{room}} = [];
	my $qname = quotemeta ($c->{jabberbot}->{aleesa}->{mucname});

	my $bot = Net::Jabber::Bot->new (
		server => $c->{jabberbot}->{aleesa}->{host},
		server_host => $c->{jabberbot}->{aleesa}->{host},
		conference_server => $c->{jabberbot}->{aleesa}->{confsrv},
		tls => 1,
		ssl_verify => 0,
		username => $c->{jabberbot}->{aleesa}->{authname},
# threre is some nasty bug in module, so we have to set from_full explicitly
		from_full => sprintf (
			"%s@%s/%s",
			$c->{jabberbot}->{aleesa}->{room},
			$c->{jabberbot}->{aleesa}->{confsrv},
			$c->{jabberbot}->{aleesa}->{authname}
		),
		password => $c->{jabberbot}->{aleesa}->{password},
		alias => $c->{jabberbot}->{aleesa}->{mucname}, # name on confs
		resource => 'bot',
		safety_mode => 1,
		message_function => \&__new_bot_message,
		background_function => \&__background_checks,
		loop_sleep_time => 60,
		forums_and_responses => \%conflist,
	);

	while (sleep 3) {
		eval {
			$imonline = 0;
			$bot->Start ();
		};
	}

	return;
}

1;

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