From 2972e73adbddde80454d0c3124f8df0827b2264a Mon Sep 17 00:00:00 2001 From: eleksir Date: Sat, 19 Sep 2020 14:38:20 +0300 Subject: [PATCH] Initial commit. Split bot from myapi as separate application. --- .gitignore | 4 + LICENSE | 127 +++++++++++++++++++++ README.md | 31 ++++++ bin/aleesa-jabber-bot | 114 +++++++++++++++++++ bootstrap.sh | 5 + confcheck.pl | 35 ++++++ cpanfile | 14 +++ data/sample_config.json | 24 ++++ lib/botlib.pm | 238 ++++++++++++++++++++++++++++++++++++++++ lib/conf.pm | 69 ++++++++++++ lib/jabberbot.pm | 172 +++++++++++++++++++++++++++++ 11 files changed, 833 insertions(+) create mode 100644 .gitignore create mode 100644 LICENSE create mode 100644 README.md create mode 100755 bin/aleesa-jabber-bot create mode 100644 bootstrap.sh create mode 100755 confcheck.pl create mode 100644 cpanfile create mode 100644 data/sample_config.json create mode 100644 lib/botlib.pm create mode 100644 lib/conf.pm create mode 100644 lib/jabberbot.pm diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..27cbfec --- /dev/null +++ b/.gitignore @@ -0,0 +1,4 @@ +vendor_perl/** +data/config.json +data/*.sqlite +data/cache diff --git a/LICENSE b/LICENSE new file mode 100644 index 0000000..4ff3f42 --- /dev/null +++ b/LICENSE @@ -0,0 +1,127 @@ + The "Artistic License" + + Preamble + +The intent of this document is to state the conditions under which a +Package may be copied, such that the Copyright Holder maintains some +semblance of artistic control over the development of the package, +while giving the users of the package the right to use and distribute +the Package in a more-or-less customary fashion, plus the right to make +reasonable modifications. + +Definitions: + + "Package" refers to the collection of files distributed by the + Copyright Holder, and derivatives of that collection of files + created through textual modification. + + "Standard Version" refers to such a Package if it has not been + modified, or has been modified in accordance with the wishes + of the Copyright Holder as specified below. + + "Copyright Holder" is whoever is named in the copyright or + copyrights for the package. + + "You" is you, if you're thinking about copying or distributing + this Package. + + "Reasonable copying fee" is whatever you can justify on the + basis of media cost, duplication charges, time of people involved, + and so on. (You will not be required to justify it to the + Copyright Holder, but only to the computing community at large + as a market that must bear the fee.) + + "Freely Available" means that no fee is charged for the item + itself, though there may be fees involved in handling the item. + It also means that recipients of the item may redistribute it + under the same conditions they received it. + +1. You may make and give away verbatim copies of the source form of the +Standard Version of this Package without restriction, provided that you +duplicate all of the original copyright notices and associated disclaimers. + +2. You may apply bug fixes, portability fixes and other modifications +derived from the Public Domain or from the Copyright Holder. A Package +modified in such a way shall still be considered the Standard Version. + +3. You may otherwise modify your copy of this Package in any way, provided +that you insert a prominent notice in each changed file stating how and +when you changed that file, and provided that you do at least ONE of the +following: + + a) place your modifications in the Public Domain or otherwise make them + Freely Available, such as by posting said modifications to Usenet or + an equivalent medium, or placing the modifications on a major archive + site such as uunet.uu.net, or by allowing the Copyright Holder to include + your modifications in the Standard Version of the Package. + + b) use the modified Package only within your corporation or organization. + + c) rename any non-standard executables so the names do not conflict + with standard executables, which must also be provided, and provide + a separate manual page for each non-standard executable that clearly + documents how it differs from the Standard Version. + + d) make other distribution arrangements with the Copyright Holder. + +4. You may distribute the programs of this Package in object code or +executable form, provided that you do at least ONE of the following: + + a) distribute a Standard Version of the executables and library files, + together with instructions (in the manual page or equivalent) on where + to get the Standard Version. + + b) accompany the distribution with the machine-readable source of + the Package with your modifications. + + c) give non-standard executables non-standard names, and clearly + document the differences in manual pages (or equivalent), together + with instructions on where to get the Standard Version. + + d) make other distribution arrangements with the Copyright Holder. + +5. You may charge a reasonable copying fee for any distribution of this +Package. You may charge any fee you choose for support of this +Package. You may not charge a fee for this Package itself. However, +you may distribute this Package in aggregate with other (possibly +commercial) programs as part of a larger (possibly commercial) software +distribution provided that you do not advertise this Package as a +product of your own. You may embed this Package's interpreter within +an executable of yours (by linking); this shall be construed as a mere +form of aggregation, provided that the complete Standard Version of the +interpreter is so embedded. + +6. The scripts and library files supplied as input to or produced as +output from the programs of this Package do not automatically fall +under the copyright of this Package, but belong to whoever generated +them, and may be sold commercially, and may be aggregated with this +Package. If such scripts or library files are aggregated with this +Package via the so-called "undump" or "unexec" methods of producing a +binary executable image, then distribution of such an image shall +neither be construed as a distribution of this Package nor shall it +fall under the restrictions of Paragraphs 3 and 4, provided that you do +not represent such an executable image as a Standard Version of this +Package. + +7. C subroutines (or comparably compiled subroutines in other +languages) supplied by you and linked into this Package in order to +emulate subroutines and variables of the language defined by this +Package shall not be considered part of this Package, but are the +equivalent of input as in Paragraph 6, provided these subroutines do +not change the language in any way that would cause it to fail the +regression tests for the language. + +8. Aggregation of this Package with a commercial distribution is always +permitted provided that the use of this Package is embedded; that is, +when no overt attempt is made to make this Package's interfaces visible +to the end user of the commercial distribution. Such use shall not be +construed as a distribution of this Package. + +9. The name of the Copyright Holder may not be used to endorse or promote +products derived from this software without specific prior written permission. + +10. THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR +IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED +WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. + + The End diff --git a/README.md b/README.md new file mode 100644 index 0000000..e0e3fa1 --- /dev/null +++ b/README.md @@ -0,0 +1,31 @@ +# Aleesa-Jabber-bot - Simple Jabber chatty bot + +## About + +It is based on Perl modules [Net::Jabber::Bot][1] and [Hailo][2] as +conversation generator. + +Config located in **data/config.json**, sample config provided as +**data/sample_config.json**. + +Bot can be run via **bin/aleesa-jabber-bot** and acts as daemon. + +## Installation + +In order to run this application, you need to "bootstrap" it - download and +install all dependencies and libraries. + +You'll need "Development Tools" or similar group of packages, perl, perl-devel, +perl-local-lib, perl-app-cpanm, sqlite-devel, zlib-devel, openssl-devel, +libdb4-devel (Berkeley DB devel), make. + +After installng required dependencies it is possible to run: + +```bash +bash bootstrap.sh +``` + +and all libraries should be downloaded, built, tested and installed. + +[1]: https://metacpan.org/pod/Net::Jabber::Bot +[2]: https://metacpan.org/pod/Hailo diff --git a/bin/aleesa-jabber-bot b/bin/aleesa-jabber-bot new file mode 100755 index 0000000..4d10e3c --- /dev/null +++ b/bin/aleesa-jabber-bot @@ -0,0 +1,114 @@ +#!/usr/bin/perl + +use 5.018; +use strict; +use warnings "all"; +use utf8; +use open qw(:std :utf8); + +my $workdir; + +# before we run, change working dir +BEGIN { + use Cwd qw(chdir abs_path); + my @CWD = split (/\//, abs_path ($0)); + if ($#CWD > 1) { $#CWD = $#CWD - 2; } + $workdir = join ('/', @CWD); + chdir ($workdir); +} + +use lib ("$workdir/lib", "$workdir/vendor_perl", "$workdir/vendor_perl/lib/perl5"); +no Cwd; +use Cwd::utf8 qw(chdir abs_path); +use POSIX qw(setgid setuid setsid); +use File::Path qw(make_path); +use File::Basename qw(basename dirname); +use conf qw(loadConf); +use botlib qw(logger); +use jabberbot qw(run_jabberbot); + +sub daemonize (); +sub __fork (); + +$| = 1; +my $runAsUid = $<; + +my $piddir = "/var/run/" . basename (abs_path ($0)); +my $C = loadConf (); + +# if we run under root, create pid dir and set correct owner for it, same for debug log if it is defined +if ($< == 0) { + 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 ( + $piddir, { + uid => $uid, + group => $gid + } + ); + } + + if ($C->{'debug_log'}) { + unless (-d dirname($C->{'debug_log'})) { + make_path ( + dirname($C->{'debug_log'}), { + uid => $uid, + group => $gid + } + ); + } + } + +# drop privs + setgid ($gid) or die "Unable to switch to group of $user($!)\n"; + setuid ($uid) or die "Unable to switch to account $user($!)\n"; +} else { + $piddir = $workdir; +} + +# double fork attach to /dev/null all stdio and go background +daemonize (); + +# write pidfile +my $apath = abs_path ($0); + +unless (defined($apath)) { + logger ("Unable to get abs_path: $!"); + die "Unable to get abs_path: $!\n"; +}; + +my $pidfile = sprintf ("%s/%s.pid", $piddir, basename ($apath)); +logger ("Creating pidfile at $pidfile"); +open (PID, ">", $pidfile) or die "Error opening $pidfile: $!\n"; +print PID $$ or die "Error writing to $pidfile: $!\n"; +close PID; + +# set correct proctitle +$0 = abs_path ($0); + +# run bot, at last +run_jabberbot (); +unlink ($pidfile) if (-f $pidfile); +exit 0; + +sub daemonize () { + __fork (); + POSIX::setsid (); + open (STDIN, "<", "/dev/null"); + open (STDOUT, ">", "/dev/null"); + open (STDERR, ">", "/dev/null"); + __fork (); + umask 0; +} + +sub __fork () { + my $pid = fork; + die "Can't fork: $!\n" unless (defined ($pid)); + exit if ($pid != 0); +} + +__END__ +# vim: set ft=perl noet ai ts=4 sw=4 sts=4: diff --git a/bootstrap.sh b/bootstrap.sh new file mode 100644 index 0000000..697f373 --- /dev/null +++ b/bootstrap.sh @@ -0,0 +1,5 @@ +#!/bin/bash + +cpanm -l vendor_perl --self-contained --force --update --installdeps . + +# vim: set ft=perl noet ai ts=4 sw=4 sts=4: diff --git a/confcheck.pl b/confcheck.pl new file mode 100755 index 0000000..6eba9a2 --- /dev/null +++ b/confcheck.pl @@ -0,0 +1,35 @@ +#!/usr/bin/perl + +use 5.018; +use strict; +use warnings "all"; +use utf8; +use open qw(:std :utf8); + +use lib ("./lib", "./vendor_perl", "./vendor_perl/lib/perl5"); + +use JSON::PP; + +my $c = "data/config.json"; +open (C, "<", $c) or die "No conf at $c: $!\n"; +my $len = (stat ($c)) [7]; +my $json; +my $readlen = read (C, $json, $len); + +unless ($readlen) { + close C; + die "Unable to read $c: $!\n"; +} + +if ($readlen != $len) { + close C; + die "File $c is $len bytes on disk, but we read only $readlen bytes\n"; +} + +close C; +$c = decode_json ($json); + +my $j = JSON::PP->new->pretty->canonical->indent_length (4); +print $j->encode ($c); + +# vim: set ft=perl noet ai ts=4 sw=4 sts=4: diff --git a/cpanfile b/cpanfile new file mode 100644 index 0000000..838946a --- /dev/null +++ b/cpanfile @@ -0,0 +1,14 @@ +requires 'Cwd::utf8'; +requires 'DB_File'; +requires 'Digest::MD5'; +requires 'File::Basename'; +requires 'File::Path'; +requires 'HTTP::Tiny'; +requires 'Hailo'; +requires 'JSON'; +requires 'JSON::XS'; +requires 'JSON::PP'; +requires 'Net::Jabber::Bot'; +requires 'POSIX'; +requires 'URI::URL'; +requires 'local::lib'; diff --git a/data/sample_config.json b/data/sample_config.json new file mode 100644 index 0000000..f5803b2 --- /dev/null +++ b/data/sample_config.json @@ -0,0 +1,24 @@ +{ + "user" : "nobody", + "jabberbot": { +# maybe onece it will be multi-instance of bot + "aleesa" : { + "state" : "enabled", + "host" : "jabber.ru", + "confsrv": "conference.jabber.ru", +# sadly, but for now we can serve only one room + "room" : "mychatroom", + "authname" : "mybot", + "mucname" : "mybot", + "password": "mypassword", + "brain": "data/aleesa.jabber.sqlite", + "csign": "!" + }, + }, + "openweathermap" : { + "cachetime": "data/cache/openweathermap.Id-Timestamp.db", + "cachedata": "data/cache/openweathermap.Id-Data.db", + "appid": "get_it_on_openweathermap.org" + }, + "debug_log" : "/var/log/aleesa-telegram-bot/debug.log" +} diff --git a/lib/botlib.pm b/lib/botlib.pm new file mode 100644 index 0000000..f4806f5 --- /dev/null +++ b/lib/botlib.pm @@ -0,0 +1,238 @@ +package botlib; + +use 5.018; +use strict; +use warnings "all"; +use utf8; +use open qw(:std :utf8); + +use HTTP::Tiny; +use URI::URL; +use JSON::XS qw(decode_json encode_json); +use Digest::MD5 qw(md5_base64); +use DB_File; + +use conf qw(loadConf); + +use vars qw/$VERSION/; + +use Exporter qw(import); +our @EXPORT = qw(weather logger trim randomCommonPhrase); + +$VERSION = "1.0"; + +my $c = loadConf(); + +sub weather($) { + my $city = shift; + $city = trim($city); + + return "Мне нужно ИМЯ города." if ($city eq ''); + return "Длинновато для названия города." if (length($city) > 80); + + $city = ucfirst($city); + my $w = __weather($city); + my $reply; + + if ($w) { + if ($w->{temperature_min} == $w->{temperature_max}) { + $reply = sprintf ("Погода в городе %s, %s:\n%s, ветер %s %s м/c, температура %s°C, ощущается как %s°C, относительная влажность %s%%, давление %s мм.рт.ст", + $w->{name}, + $w->{country}, + ucfirst($w->{description}), + $w->{wind_direction}, + $w->{wind_speed}, + $w->{temperature_min}, + $w->{temperature_feelslike}, + $w->{humidity}, + $w->{pressure} + ); + } else { + $reply = sprintf ("Погода в городе %s, %s:\n%s, ветер %s %s м/c, температура %s-%s°C, ощущается как %s°C, относительная влажность %s%%, давление %s мм.рт.ст", + $w->{name}, + $w->{country}, + ucfirst($w->{description}), + $w->{wind_direction}, + $w->{wind_speed}, + $w->{temperature_min}, + $w->{temperature_max}, + $w->{temperature_feelslike}, + $w->{humidity}, + $w->{pressure} + ); + } + } else { + $reply = "Я не знаю, какая погода в $city"; + } + + return $reply; +} + +sub __weather($) { + my $city = shift; + $city = __urlencode($city); + my $id = md5_base64($city); + my $appid = $c->{openweathermap}->{appid}; + my $now = time(); + my $fc; + my $w; + +# attach to cache data + tie my %cachetime, 'DB_File', $c->{openweathermap}->{cachetime} or do { + warn "Something nasty happen when cachetime ties to its data: $!"; + return undef; + }; + + tie my %cachedata, 'DB_File', $c->{openweathermap}->{cachedata} or do { + warn "Something nasty happen when cachedata ties to its data: $!"; + return undef; + }; + +# lookup cache + if (defined ($cachetime{$id}) && ($now - $cachetime{$id}) < 10800) { + $fc = decode_json($cachedata{$id}); + } else { + my $r; + +# try 3 times and giveup + for (my $counter = 0; $counter < 3; $counter++) { + next if ($r->{success}); + my $http = HTTP::Tiny->new(timeout => 3); + $r = $http->get(sprintf("http://api.openweathermap.org/data/2.5/weather?q=%s&lang=ru&APPID=%s", $city, $appid)); + sleep 2; + } + +# all 3 times can give error, so check it here + if ($r->{success}) { + $fc = eval { decode_json($r->{content}) }; + + if ($@) { + warn "[WARN] openweathermap returns corrupted json: $@"; + untie %cachetime; + untie %cachedata; + return undef; + }; + + $cachetime{$id} = $now; + $cachedata{$id} = encode_json($fc); + } else { + untie %cachetime; + untie %cachedata; + return undef; + } + } + + untie %cachetime; + untie %cachedata; + +# TODO: check all of this for existance + $w->{'name'} = $fc->{name}; + $w->{'state'} = $fc->{state}; + $w->{'country'} = $fc->{sys}->{country}; + $w->{'longitude'} = $fc->{coord}->{lon}; + $w->{'latitude'} = $fc->{coord}->{lat}; + $w->{'temperature_min'} = int($fc->{main}->{temp_min} - 273.15); + $w->{'temperature_max'} = int($fc->{main}->{temp_max} - 273.15); + $w->{'temperature_feelslike'} = int($fc->{main}->{feels_like} - 273.15); + $w->{'humidity'} = $fc->{main}->{humidity}; + $w->{'pressure'} = int($fc->{main}->{pressure} * 0.75006375541921); + $w->{'description'} = $fc->{weather}->[0]->{description}; + $w->{'wind_speed'} = $fc->{wind}->{speed}; + $w->{'wind_direction'} = 'разный'; + my $dir = int($fc->{wind}->{deg} + 0); + + if ($dir == 0) { + $w->{'wind_direction'} = 'северный'; + } elsif ($dir > 0 && $dir <= 30) { + $w->{'wind_direction'} = 'северо-северо-восточный'; + } elsif ($dir > 30 && $dir <= 60) { + $w->{'wind_direction'} = 'северо-восточный'; + } elsif ($dir > 60 && $dir < 90) { + $w->{'wind_direction'} = 'восточно-северо-восточный'; + } elsif ($dir == 90) { + $w->{'wind_direction'} = 'восточный'; + } elsif ($dir > 90 && $dir <= 120) { + $w->{'wind_direction'} = 'восточно-юго-восточный'; + } elsif ($dir > 120 && $dir <= 150) { + $w->{'wind_direction'} = 'юговосточный'; + } elsif ($dir > 150 && $dir < 180) { + $w->{'wind_direction'} = 'юго-юго-восточный'; + } elsif ($dir == 180) { + $w->{'wind_direction'} = 'южный'; + } elsif ($dir > 180 && $dir <= 210) { + $w->{'wind_direction'} = 'юго-юго-западный'; + } elsif ($dir > 210 && $dir <= 240) { + $w->{'wind_direction'} = 'юго-западный'; + } elsif ($dir > 240 && $dir < 270) { + $w->{'wind_direction'} = 'западно-юго-западный'; + } elsif ($dir == 270) { + $w->{'wind_direction'} = 'западный'; + } elsif ($dir > 270 && $dir <= 300) { + $w->{'wind_direction'} = 'западно-северо-западный'; + } elsif ($dir > 300 && $dir <= 330) { + $w->{'wind_direction'} = 'северо-западный'; + } elsif ($dir > 330 && $dir < 360) { + $w->{'wind_direction'} = 'северо-северо-западный'; + } elsif ($dir == 360) { + $w->{'wind_direction'} = 'северный'; + } + + return $w; +} + +sub __urlencode($) { + my $str = shift; + my $urlobj = url $str; + $str = $urlobj->as_string; + $urlobj = undef; undef $urlobj; + return $str; +} + +sub logger { + my $msg = shift; + + if ($c->{debug_log}) { + my $mode = '>'; + $mode = '>>' if (-f $c->{debug_log}); + + if (open (LOG, $mode, $c->{debug_log})) { + print LOG $msg . "\n"; + close LOG; + } + } +} + +sub trim($) { + my $str = shift; + + while (substr ($str, 0, 1) =~ /^\s$/) { + $str = substr($str, 1); + } + + while (substr ($str, -1, 1) =~ /^\s$/) { + chop ($str); + } + + return $str; +} + +sub randomCommonPhrase() { + my @myphrase = ( + "Так, блядь...", + "*Закатывает рукава* И ради этого ты меня позвал?", + "Ну чего ты начинаешь, нормально же общались", + "Повтори свой вопрос, не поняла", + "Выйди и зайди нормально", + "Я подумаю", + "Даже не знаю что на это ответить", + "Ты упал такие вопросы девочке задавать?", + "Можно и так, но не уверена", + "А как ты думаешь?" + ); + + return ($myphrase[rand($#myphrase -1)]); +} + +1; + +# vim: set ft=perl noet ai ts=4 sw=4 sts=4: diff --git a/lib/conf.pm b/lib/conf.pm new file mode 100644 index 0000000..6bb87e3 --- /dev/null +++ b/lib/conf.pm @@ -0,0 +1,69 @@ +package conf; + +use 5.018; +use strict; +use warnings "all"; +use utf8; +use open qw(:std :utf8); + +use vars qw/$VERSION/; +use Fcntl qw(O_WRONLY O_CREAT O_TRUNC); +use JSON::XS qw(decode_json encode_json); + +use Exporter qw(import); +our @EXPORT = qw(loadConf saveConf); + +$VERSION = "1.0"; +sub loadConf (); +sub saveConf ($); + +sub loadConf () { + my $c = "data/config.json"; + open (C, "<", $c) or die "[FATA] No conf at $c: $!\n"; + my $len = (stat ($c)) [7]; + my $json; + my $readlen = read (C, $json, $len); + + unless ($readlen) { + close C; + die "[FATA] Unable to read $c: $!\n"; + } + + if ($readlen != $len) { + close C; + die "[FATA] File $c is $len bytes on disk, but we read only $readlen bytes\n"; + } + + close C; + my $j = JSON::XS->new->utf8->relaxed; + return $j->decode ($json); +} + +sub saveConf($) { + my $c = shift; + my $file = "data/myapi.json"; + my $j = JSON::XS->new->pretty->canonical->indent (1); + my $json = $j->encode ($c); + $j = undef; undef $j; + use bytes; + my $len = length ($json); + no bytes; + # TODO: make it transactional + sysopen (C, $file, O_WRONLY|O_CREAT|O_TRUNC) or die "[FATA] Unable to open $file: $!\n"; + + my $written = syswrite (C, $json, $len); + + unless (defined ($written)) { + die "[FATA] Unable to write to $file: $!"; + } + + unless ($written != $len) { + die "[FATA] We wrote $written bytes to $file, bu buffer length id $len bytes\n"; + } + + close C; +} + +1; + +# vim: set ft=perl noet ai ts=4 sw=4 sts=4: diff --git a/lib/jabberbot.pm b/lib/jabberbot.pm new file mode 100644 index 0000000..d2ec27b --- /dev/null +++ b/lib/jabberbot.pm @@ -0,0 +1,172 @@ +# 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 "all"; +use utf8; +use open qw(:std :utf8); + +use Net::Jabber::Bot; +use Hailo; + +use conf; +use botlib; + +use Exporter qw(import); +use vars qw/$VERSION/; +$VERSION = "1.0"; +our @EXPORT = qw(run_jabberbot); + +my $c = loadConf(); +my $hailo; +my $imonline = 0; + +sub __background_checks { + my $bot = shift; + + unless ($imonline) { + $bot->ChangeStatus('Chat', 'I\'m here'); + $imonline = 1; + } + + return; +} + +sub __new_bot_message { + my %hash = @_; + my $bot = $hash{bot_object}; +# my $text = encode('utf-8', $hash{body}); + my $text = $hash{body}; + + if ($hash{'type'} eq "groupchat") { + # ignore self messages + return if ($hash{'from_full'} eq $bot->{'from_full'}); + # parse messages + my $qname = quotemeta($c->{jabberbot}->{aleesa}->{mucname}); + if ($text =~ /^$qname$/) { + $bot->SendGroupMessage($hash{'reply_to'}, "Чего тебе?"); + } elsif ($text =~ /^$qname[\,|\:]? (.+)/) { +# $bot->SendGroupMessage($hash{'reply_to'}, $hailo->learn_reply(decode('utf-8', $1))); + $bot->SendGroupMessage($hash{'reply_to'}, $hailo->learn_reply($1)); + } elsif ($text eq "$c->{jabberbot}->{aleesa}->{csign}пинг") { + $bot->SendGroupMessage($hash{'reply_to'}, "Понг."); + } elsif ($text eq "$c->{jabberbot}->{aleesa}->{csign}ping") { + $bot->SendGroupMessage($hash{'reply_to'}, "Pong."); + } elsif (substr($text, 0, 1) eq $c->{jabberbot}->{aleesa}->{csign}) { +# $text = decode('utf-8', $text); + + if (substr($text, 1, 3) eq "rum") { + eval { + $bot->SendGroupMessage( + $hash{'reply_to'}, + "/me притаскивает на подносе стопку рома для ". (split(/\//,$hash{from_full}))[1] . ", края стопки искрятся кристаллами соли." + ); + }; + } elsif (substr($text, 1, 5) eq "vodka") { + eval { + $bot->SendGroupMessage( + $hash{'reply_to'}, + "/me подаёт водку с маринованным огурчиком для " . (split(/\//,$hash{from_full}))[1] + ); + }; + } elsif (substr($text, 1, 4) eq "beer") { + eval { + $bot->SendGroupMessage( + $hash{'reply_to'}, + "/me бахает об стол перед " . (split(/\//,$hash{from_full}))[1] . " кружкой холодного пива, часть пенной шапки сползает по запотевшей спенке кружки." + ); + }; + } elsif (substr($text, 1, 7) eq "tequila") { + eval { + $bot->SendGroupMessage( + $hash{'reply_to'}, + "/me ставит рядом с " . (split(/\//,$hash{from_full}))[1] . " шот текилы, аккуратно на ребро стопки насаживает дольку лайма и ставит кофейное блюдце с горочкой соли." + ); + }; + } elsif (substr($text, 1, 6) eq "whisky") { + eval { + $bot->SendGroupMessage( + $hash{'reply_to'}, + "/me демонстративно достаёт из морозилки пару кубических камушков, бросает их в толстодонный стакан и аккуратно наливает Jack Daniels. Запускает стакан вдоль барной стойки, он останавливается около " . (split(/\//,$hash{from_full}))[1] . "." + ); + }; + } elsif (substr($text, 1, 8) eq "absinthe") { + eval { + $bot->SendGroupMessage( + $hash{'reply_to'}, + "/me наливает абсент в стопку. Смочив кубик сахара в абсенте кладёт его на дырявую ложечку и пожигает. Как только пламя потухнет, $c->{jabberbot}->{aleesa}->{mucname} размешивает оплавившийся кубик в абсенте и подносит стопку " .(split(/\//,$hash{from_full}))[1] . "." + ); + }; + } elsif ((substr($text, 1, 2) eq "w ") || (substr($text, 1, 2) eq "п ")) { + my $city = substr($text, 2); + + eval { + $bot->SendGroupMessage( + $hash{'reply_to'}, + weather($city) =~ tr/\n/ /r + ); + }; + } else { + #$hailo->learn($text); + return; + } + } else { + #$hailo->learn($text); + return; + } + } elsif ($hash{'type'} eq "chat") { + $bot->SendPersonalMessage($hash{'reply_to'}, "Я вас не знаю, идите нахуй."); + return; + } + + return; +} + + +sub run_jabberbot { + $hailo = Hailo->new( + brain => $c->{jabberbot}->{aleesa}->{brain}, + order => 3 + ); + + 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 => 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(); + }; + } +} + +1; + +# vim: set ft=perl noet ai ts=4 sw=4 sts=4: