eleksir/aleesa-jabber-bot
1
Fork 0
Code Activity

Fix logging, update sample config, implement !horse !лошадка !frog !лягушка !snail !улитка commands

Browse Source 
* Make logging use features of Log::Any and log as it should be done via this module
+ Add loglevel parameter to sample config
+ Implement !horse !лошадка !frog !лягушка !snail !улитка commands
This commit is contained in:
eleksir
2021-05-07 12:49:40 +03:00
parent 2cfede2769
commit e821356a64
17 changed files with 159 additions and 85 deletions
Download Patch File Download Diff File Expand all files Collapse all files

61
lib/BotLib.pm
View File

@@ -16,7 +16,7 @@ use BotLib::Fisher qw (Fish);
use BotLib::Fortune qw (Fortune);
use BotLib::Fox qw (Fox);
use BotLib::Friday qw (Friday);
use BotLib::Image qw (Rabbit Owl);
use BotLib::Image qw (Rabbit Owl Frog Horse Snail);
use BotLib::Karma qw (KarmaGet);
use BotLib::Kitty qw (Kitty);
use BotLib::Lat qw (Lat);
@@ -184,31 +184,34 @@ sub Command {
} elsif (substr ($text, 1) eq 'help' || substr ($text, 1) eq 'помощь') {
$reply = <<"EOL";
${csign}help | ${csign}помощь - это сообщение
${csign}buni - комикс-стрип hapi buni
${csign}bunny - кролик
${csign}rabbit | ${csign}кролик - кролик
${csign}cat | ${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}karma фраза - посмотреть карму фразы
${csign}карма фраза - посмотреть карму фразы
фраза++ | фраза-- - повысить или понизить карму фразы
${csign}lat | ${csign}лат - сгенерировать фразу из крылатого латинского выражения
${csign}monkeyuser - комикс-стрип MonkeyUser
${csign}owl | ${csign}сова - сова
${csign}ping | ${csign}пинг - попинговать бота
${csign}some_brew - выдать соответствующий напиток, бармен может налить rum, ром, vodka, водку, beer, пиво, tequila, текила, whisky, виски, absinthe, абсент
${csign}ver | ${csign}version - написать что-то про версию ПО
${csign}версия - написать что-то про версию ПО
${csign}w город | ${csign}п город - погода в городе
${csign}xkcd - комикс-стрип с xkcb.ru
${csign}help | ${csign}помощь - это сообщение
${csign}buni - комикс-стрип hapi buni
${csign}bunny - кролик
${csign}rabbit | ${csign}кролик - кролик
${csign}cat | ${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}snail | ${csign}улитк а - улитка
${csign}some_brew - выдать соответствующий напиток, бармен может налить rum, ром, vodka, водку, beer, пиво, tequila, текила, whisky, виски, absinthe, абсент
${csign}ver | ${csign}version - написать что-то про версию ПО
${csign}версия - написать что-то про версию ПО
${csign}w город | ${csign}п город - погода в городе
${csign}xkcd - комикс-стрип с xkcb.ru
EOL
} elsif (substr ($text, 1) eq 'lat' || substr ($text, 1) eq 'лат') {
@@ -217,6 +220,12 @@ EOL
$reply = Kitty ();
} elsif (substr ($text, 1) eq 'fox' || substr ($text, 1) eq 'лис') {
$reply = Fox ();
} elsif (substr ($text, 1) eq 'frog' || substr ($text, 1) eq 'лягушка') {
$reply = Frog ();
} elsif (substr ($text, 1) eq 'horse' || substr ($text, 1) eq 'лошадь' || substr ($text, 1) eq 'лошадка') {
$reply = Horse ();
} elsif (substr ($text, 1) eq 'snail' || substr ($text, 1) eq 'улитка') {
$reply = Snail ();
} elsif (substr ($text, 1) eq 'dig' || substr ($text, 1) eq 'копать') {
$reply = Dig ($chattername);
} elsif (substr ($text, 1) eq 'fish' || substr ($text, 1) eq 'fisher' || substr ($text, 1) eq 'рыба' || substr ($text, 1) eq 'рыбка' || substr ($text, 1) eq 'рыбалка') {

4
lib/BotLib/Buni.pm
View File

@@ -6,9 +6,9 @@ use warnings;
use utf8;
use open qw (:std :utf8);
use English qw ( -no_match_vars );
use Carp qw (cluck);
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 {
cluck sprintf 'Server return status %s with message: %s', $r->{status}, $r->{reason};
$log->warn (sprintf '[WARN] Server return status %s with message: %s', $r->{status}, $r->{reason});
}
return $ret;

5
lib/BotLib/Conf.pm
View File

@@ -8,6 +8,7 @@ use utf8;
use open qw (:std :utf8);
use English qw ( -no_match_vars );
use JSON::XS;
use Log::Any qw ($log);
use version; our $VERSION = qw (1.0);
use Exporter qw (import);
@@ -22,12 +23,12 @@ sub LoadConf {
unless ($readlen) {
close $CH; ## no critic (InputOutput::RequireCheckedSyscalls
die "[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
die "[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

4
lib/BotLib/Drink.pm
View File

@@ -7,12 +7,12 @@ use utf8;
use open qw (:std :utf8);
use English qw ( -no_match_vars );
use Encode;
use Carp qw (cluck);
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 {
cluck sprintf 'Server return status %s with message: %s', $r->{status}, $r->{reason};
$log->warn (sprintf '[WARN] Server return status %s with message: %s', $r->{status}, $r->{reason});
return undef;
}

9
lib/BotLib/Fortune.pm
View File

@@ -7,11 +7,12 @@ use warnings;
use utf8;
use open qw (:std :utf8);
use English qw ( -no_match_vars );
use Carp qw (croak carp);
use SQLite_File;
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 File::Path qw (make_path);
use SQLite_File;
use BotLib::Conf qw (LoadConf);
use version; our $VERSION = qw (1.0);
@@ -69,7 +70,7 @@ sub Fortune () {
my $backingfile = sprintf '%s/fortune.sqlite', $dir;
tie my @array, 'SQLite_File', $backingfile || do {
carp "Unable to tie to $backingfile: $OS_ERROR\n";
$log->error ("[ERROR] Unable to tie to $backingfile: $OS_ERROR");
return '';
};

6
lib/BotLib/Fox.pm
View File

@@ -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 "[ERROR] Unable to decode JSON: $EVAL_ERROR";
$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 'Server return status %s with message: %s', $r->{status}, $r->{reason};
$log->warn (sprintf '[WARN] Server return status %s with message: %s', $r->{status}, $r->{reason});
}
return $ret;

5
lib/BotLib/Friday.pm
View File

@@ -7,8 +7,9 @@ use warnings;
use utf8;
use open qw (:std :utf8);
use English qw ( -no_match_vars );
use Carp qw (carp croak);
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 '';
};

35
lib/BotLib/Image.pm
View File

@@ -9,7 +9,7 @@ use BotLib::Image::Flickr qw (FlickrByTags);
use version; our $VERSION = qw (1.0);
use Exporter qw (import);
our @EXPORT_OK = qw (Rabbit Owl);
our @EXPORT_OK = qw (Rabbit Owl Frog Horse Snail);
sub Rabbit {
# rabbit, but bunny
@@ -32,6 +32,39 @@ sub Owl {
}
}
sub Frog {
# unable to find any one-line ascii art for frog :(
my $url = FlickrByTags ('frog,toad,amphibian');
if (defined $url) {
return $url;
} else {
return 'Нету лягушек, все свалили.';
}
}
sub Horse {
# unable to find any one-line ascii art for frog :(
my $url = FlickrByTags ('horse,equine,mammal');
if (defined $url) {
return $url;
} else {
return 'Нету коняшек, все разбежались.';
}
}
sub Snail {
# unable to find any one-line ascii art for frog :(
my $url = FlickrByTags ('snail,slug');
if (defined $url) {
return $url;
} else {
return 'Нету улиток, все расползлись.';
}
}
1;
# vim: set ft=perl noet ai ts=4 sw=4 sts=4:

31
lib/BotLib/Image/Flickr.pm
View File

@@ -11,6 +11,7 @@ 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 +339,19 @@ sub flickrSearchByText {
if (defined $response) {
return $response;
} else {
cluck "Flickr api returns incorrect json: $r->{content}";
$log->warn ("[WARN] Flickr api returns incorrect json: $r->{content}");
return undef;
}
} else {
cluck "Flickr api returns incorrect json: $r->{content}";
$log->warn ("[WARN] Flickr api returns incorrect json: $r->{content}");
return undef;
}
} else {
cluck "Flickr api returns incorrect json: $r->{content}";
$log->warn ("[WARN] Flickr api returns incorrect json: $r->{content}");
return undef;
}
} else {
cluck "HTTP status code not 200: $r->{status}, $r->{content}";
$log->warn ("[WARN] HTTP status code not 200: $r->{status}, $r->{content}");
return undef;
}
}
@@ -447,19 +448,19 @@ sub flickrSearchByTags {
if (defined $response) {
return $response;
} else {
cluck "Flickr api returns incorrect json: $r->{content}";
$log->warn ("[WARN] Flickr api returns incorrect json: $r->{content}");
return undef;
}
} else {
cluck "Flickr api returns incorrect json: $r->{content}";
$log->warn ("[WARN] Flickr api returns incorrect json: $r->{content}");
return undef;
}
} else {
cluck "Flickr api returns incorrect json: $r->{content}";
$log->warn ("[WARN] Flickr api returns incorrect json: $r->{content}");
return undef;
}
} else {
cluck "HTTP status code not 200: $r->{status}, $r>{contenr}";
$log->warn ("[WARN] HTTP status code not 200: $r->{status}, $r>{content}");
return undef;
}
}
@@ -539,7 +540,7 @@ sub FlickrTestLogin {
}
tie my %secret, 'SQLite_File', $backingfile || do {
say "[ERROR] Unable to tie to $backingfile: $OS_ERROR"; ## no critic (InputOutput::RequireCheckedSyscalls)
say "Unable to tie to $backingfile: $OS_ERROR"; ## no critic (InputOutput::RequireCheckedSyscalls)
return 0;
};
@@ -560,13 +561,13 @@ sub FlickrByTags {
unless (-d $dir) {
make_path ($dir) or do {
say "Unable to create $dir: $OS_ERROR"; ## no critic (InputOutput::RequireCheckedSyscalls)
$log->error ("[ERROR] Unable to create $dir: $OS_ERROR");
return 0;
};
}
tie my %secret, 'SQLite_File', $backingfile || do {
say "[ERROR] Unable to tie to $backingfile: $OS_ERROR"; ## no critic (InputOutput::RequireCheckedSyscalls)
$log->error ("[ERROR] Unable to tie to $backingfile: $OS_ERROR");
return 0;
};
@@ -587,7 +588,7 @@ sub FlickrByTags {
$item = sprintf 'https://live.staticflickr.com/%s/%s_%s_z.jpg', $item->{server}, $item->{id}, $item->{secret};
return $item;
} else {
cluck 'Flickr api returns empty search result list';
$log->notice ('[NOTICE] Flickr api returns empty search result list');
return;
}
} else {
@@ -601,13 +602,13 @@ sub FlickrByText {
unless (-d $dir) {
make_path ($dir) or do {
say "Unable to create $dir: $OS_ERROR"; ## no critic (InputOutput::RequireCheckedSyscalls)
$log->error ("[ERROR] Unable to create $dir: $OS_ERROR");
return 0;
};
}
tie my %secret, 'SQLite_File', $backingfile || do {
say "[ERROR] Unable to tie to $backingfile: $OS_ERROR"; ## no critic (InputOutput::RequireCheckedSyscalls)
$log->error ("[ERROR] Unable to tie to $backingfile: $OS_ERROR");
return 0;
};
@@ -628,7 +629,7 @@ sub FlickrByText {
$item = sprintf 'https://live.staticflickr.com/%s/%s_%s_z.jpg', $item->{server}, $item->{id}, $item->{secret};
return $item;
} else {
cluck 'Flickr api returns empty search result list';
$log->notice ('[NOTICE] Flickr api returns empty search result list');
return;
}
} else {

10
lib/BotLib/Karma.pm
View File

@@ -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 "Unable to create $karmadir: $OS_ERROR";
$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";
$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";
$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";
$log->error ("[ERROR] Something nasty happen when karma ties to its data: $OS_ERROR");
return sprintf 'Карма %s составляет 0', $phrase;
};

6
lib/BotLib/Kitty.pm
View File

@@ -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";
$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', $r->{status}, $r->{reason};
$log->error (sprintf 'Server return status %s with message: %s', $r->{status}, $r->{reason});
}
return $ret;

5
lib/BotLib/Lat.pm
View File

@@ -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.";
$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.";
$log->error ("[ERROR] No lat module data: $brain is absent! Train lat first.");
return '';
}

4
lib/BotLib/Monkeyuser.pm
View File

@@ -6,9 +6,9 @@ use warnings;
use utf8;
use open qw (:std :utf8);
use English qw ( -no_match_vars );
use Carp qw (cluck);
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 {
cluck sprintf 'Server return status %s with message: %s', $r->{status}, $r->{reason};
$log->warn (sprintf '[WARN] Monkeyuser server return status %s with message: %s', $r->{status}, $r->{reason});
}
return $ret;

7
lib/BotLib/Weather.pm
View File

@@ -11,6 +11,7 @@ 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 +34,7 @@ sub Weather {
my $appid = $c->{openweathermap}->{appid};
unless (defined $appid) {
carp 'No appid specified for openweathermap';
$log->warn ('[WARN] No appid specified for openweathermap');
return undef;
}
@@ -60,11 +61,11 @@ sub Weather {
};
unless (defined $fc) {
carp "[WARN] openweathermap returns corrupted json: $EVAL_ERROR";
$log->warn ("[WARN] openweathermap returns corrupted json: $EVAL_ERROR");
return undef;
};
} else {
carp sprintf 'Server return status %s with message: %s', $r->{status}, $r->{reason};
$log->warn (sprintf 'Server return status %s with message: %s', $r->{status}, $r->{reason});
return undef;
}

8
lib/JabberBot.pm
View File

@@ -9,9 +9,9 @@ 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 Log::Any qw ($log);
use Net::Jabber::Bot;
use BotLib qw (Command RandomCommonPhrase RealJID);
use BotLib::Conf qw (LoadConf);
@@ -68,7 +68,7 @@ sub __new_bot_message {
unless (-d $braindir) {
make_path ($braindir) or do {
carp "[ERROR] Unable to create $braindir: $OS_ERROR";
$log->error ("[ERROR] Unable to create $braindir: $OS_ERROR");
return;
};
}
@@ -79,9 +79,9 @@ sub __new_bot_message {
);
if ($hash{'type'} eq 'groupchat') {
carp "[INFO] Initialized brain for chat $hash{'reply_to'}: $brainname";
$log->info ("[INFO] Initialized brain for chat $hash{'reply_to'}: $brainname");
} else {
carp "[INFO] Initialized brain for chat $jid{'jid'}: $brainname";
$log->info ("[INFO] Initialized brain for chat $jid{'jid'}: $brainname");
}
}