From 8665a6dddab966fb47c50ccbf8e7dc93b63937b6 Mon Sep 17 00:00:00 2001 From: eleksir Date: Wed, 21 Apr 2021 14:07:20 +0300 Subject: [PATCH] Refactor some parts of bot - Move most modules to subdirs - Rename functions according perlcritic guidelines - Fix and add some bugs --- bin/aleesa-telegram-bot | 6 +- bin/flickr_init.pl | 4 +- bin/flickr_test.pl | 4 +- bin/friday_seed.pl | 4 +- lib/{botlib.pm => BotLib.pm} | 111 ++++++++------- lib/{admin.pm => BotLib/Admin.pm} | 51 +++---- .../Archeologist.pm} | 6 +- lib/{buni.pm => BotLib/Buni.pm} | 6 +- lib/{conf.pm => BotLib/Conf.pm} | 6 +- lib/{drink.pm => BotLib/Drink.pm} | 10 +- lib/{fisher.pm => BotLib/Fisher.pm} | 6 +- lib/{fortune.pm => BotLib/Fortune.pm} | 12 +- lib/{friday.pm => BotLib/Friday.pm} | 10 +- lib/{image.pm => BotLib/Image.pm} | 22 ++- lib/{flickr.pm => BotLib/Image/Flickr.pm} | 134 +++++++----------- lib/{imgur.pm => BotLib/Image/Imgur.pm} | 77 +++++----- lib/{karma.pm => BotLib/Karma.pm} | 12 +- lib/{lat.pm => BotLib/Lat.pm} | 12 +- lib/{monkeyuser.pm => BotLib/Monkeyuser.pm} | 6 +- lib/{util.pm => BotLib/Util.pm} | 3 +- lib/{weather.pm => BotLib/Weather.pm} | 11 +- lib/{xkcd.pm => BotLib/Xkcd.pm} | 6 +- lib/{telegrambot.pm => TelegramBot.pm} | 52 +++---- 23 files changed, 262 insertions(+), 309 deletions(-) rename lib/{botlib.pm => BotLib.pm} (85%) rename lib/{admin.pm => BotLib/Admin.pm} (84%) rename lib/{archeologist.pm => BotLib/Archeologist.pm} (98%) rename lib/{buni.pm => BotLib/Buni.pm} (94%) rename lib/{conf.pm => BotLib/Conf.pm} (93%) rename lib/{drink.pm => BotLib/Drink.pm} (95%) rename lib/{fisher.pm => BotLib/Fisher.pm} (98%) rename lib/{fortune.pm => BotLib/Fortune.pm} (92%) rename lib/{friday.pm => BotLib/Friday.pm} (94%) rename lib/{image.pm => BotLib/Image.pm} (91%) rename lib/{flickr.pm => BotLib/Image/Flickr.pm} (84%) rename lib/{imgur.pm => BotLib/Image/Imgur.pm} (67%) rename lib/{karma.pm => BotLib/Karma.pm} (92%) rename lib/{lat.pm => BotLib/Lat.pm} (91%) rename lib/{monkeyuser.pm => BotLib/Monkeyuser.pm} (94%) rename lib/{util.pm => BotLib/Util.pm} (98%) rename lib/{weather.pm => BotLib/Weather.pm} (96%) rename lib/{xkcd.pm => BotLib/Xkcd.pm} (91%) rename lib/{telegrambot.pm => TelegramBot.pm} (89%) diff --git a/bin/aleesa-telegram-bot b/bin/aleesa-telegram-bot index 0a116b9..8d1f555 100755 --- a/bin/aleesa-telegram-bot +++ b/bin/aleesa-telegram-bot @@ -32,8 +32,8 @@ use File::Path qw (make_path); use Log::Any::Adapter; use Log::Any::For::Std; use POSIX qw (setgid setuid setsid); -use conf qw (loadConf); -use telegrambot qw (run_telegrambot); +use BotLib::Conf qw (LoadConf); +use TelegramBot qw (RunTelegramBot); sub daemonize; sub __fork; @@ -43,7 +43,7 @@ local $OUTPUT_AUTOFLUSH = 1; my $runAsUid = $UID; my $piddir = '/var/run/' . basename (abs_path ($PROGRAM_NAME)); -my $C = loadConf (); +my $C = LoadConf (); my $logfile; if (defined $C->{'log'}) { diff --git a/bin/flickr_init.pl b/bin/flickr_init.pl index 9b50657..0d58b19 100644 --- a/bin/flickr_init.pl +++ b/bin/flickr_init.pl @@ -20,9 +20,9 @@ BEGIN { } use lib ("$workdir/lib", "$workdir/vendor_perl", "$workdir/vendor_perl/lib/perl5"); -use flickr qw (flickr_init); +use BotLib::Image::Flickr qw (FlickrInit); -if (flickr_init ()) { +if (FlickrInit ()) { exit 0; } else { exit 1; diff --git a/bin/flickr_test.pl b/bin/flickr_test.pl index 908bc20..7d9b0bf 100644 --- a/bin/flickr_test.pl +++ b/bin/flickr_test.pl @@ -20,9 +20,9 @@ BEGIN { } use lib ("$workdir/lib", "$workdir/vendor_perl", "$workdir/vendor_perl/lib/perl5"); -use flickr qw (flickr_test_login); +use BotLib::Image::Flickr qw (FlickrTestLogin); -if (flickr_test_login ()) { +if (FlickrTestLogin ()) { exit 0; } else { exit 1; diff --git a/bin/friday_seed.pl b/bin/friday_seed.pl index 2c61905..3cf3e51 100644 --- a/bin/friday_seed.pl +++ b/bin/friday_seed.pl @@ -20,7 +20,7 @@ BEGIN { } use lib ("$workdir/lib", "$workdir/vendor_perl", "$workdir/vendor_perl/lib/perl5"); -use friday qw (seed); +use BotLib::Friday qw (Seed); -seed (); +Seed (); exit 0; diff --git a/lib/botlib.pm b/lib/BotLib.pm similarity index 85% rename from lib/botlib.pm rename to lib/BotLib.pm index ccfca2a..f06ea96 100644 --- a/lib/botlib.pm +++ b/lib/BotLib.pm @@ -1,4 +1,4 @@ -package botlib; +package BotLib; # store here utility functions that are not protocol-specified use 5.018; @@ -10,30 +10,31 @@ use English qw ( -no_match_vars ); use Carp qw (carp); use Math::Random::Secure qw (irand); -use conf qw (loadConf); -use admin qw (@forbiddenMessageTypes getForbiddenTypes addForbiddenType delForbiddenType listForbidden fortune_toggle fortune_status plugin_toggle plugin_status pluginEnabled); -use archeologist qw (dig); -use buni qw (buni); -use drink qw (drink); -use fisher qw (fish); -use fortune qw (fortune); -use friday qw (friday); -use image qw (kitty fox oboobs obutts rabbit owl); -use karma qw (karmaSet karmaGet); -use lat qw (latAnswer); -use monkeyuser qw (monkeyuse); -use util qw (trim); -use weather qw (weather); -use xkcd qw (xkcd); +use BotLib::Conf qw (LoadConf); +use BotLib::Admin qw (@forbiddenMessageTypes GetForbiddenTypes AddForbiddenType DelForbiddenType ListForbidden + FortuneToggle FortuneStatus PluginToggle PluginStatus PluginEnabled); +use BotLib::Archeologist qw (Dig); +use BotLib::Buni qw (Buni); +use BotLib::Drink qw (Drink); +use BotLib::Fisher qw (Fish); +use BotLib::Fortune qw (Fortune); +use BotLib::Friday qw (Friday); +use BotLib::Image qw (Kitty Fox Oboobs Obutts Rabbit Owl); +use BotLib::Karma qw (KarmaSet KarmaGet); +use BotLib::Lat qw (Lat); +use BotLib::Monkeyuser qw (Monkeyuser); +use BotLib::Util qw (trim); +use BotLib::Weather qw (Weather); +use BotLib::Xkcd qw (Xkcd); use version; our $VERSION = qw (1.0); use Exporter qw (import); -our @EXPORT_OK = qw (randomCommonPhrase command highlight botsleep isCensored); +our @EXPORT_OK = qw (RandomCommonPhrase Command Highlight BotSleep IsCensored); -my $c = loadConf (); +my $c = LoadConf (); my $csign = $c->{telegrambot}->{csign}; -sub randomCommonPhrase { +sub RandomCommonPhrase { my @myphrase = ( 'Так, блядь...', '*Закатывает рукава* И ради этого ты меня позвал?', @@ -51,13 +52,13 @@ sub randomCommonPhrase { return $myphrase[irand ($#myphrase + 1)]; } -sub command { +sub Command { my $self = shift; my $msg = shift; my $text = shift; my $chatid = shift; my $reply; - my ($userid, $username, $fullname, $highlight, $visavi) = highlight ($msg); + my ($userid, $username, $fullname, $highlight, $visavi) = Highlight ($msg); if (substr ($text, 1) eq 'ping') { $reply = 'Pong.'; @@ -71,27 +72,27 @@ sub command { $reply = 'Версия: Нуль.Чего-то_там.Чего-то_там'; } elsif (length ($text) >= 2 && (substr ($text, 1, 2) eq 'w ' || substr ($text, 1, 2) eq 'п ')) { my $city = substr $text, 3; - $reply = weather $city; + $reply = Weather $city; } elsif (substr ($text, 1) eq 'buni') { $msg->typing (); - $reply = buni (); + $reply = Buni (); sleep (irand (2) + 1); $msg->replyMd ($reply); return; } elsif (substr ($text, 1) eq 'monkeyuser') { $msg->typing (); - $reply = monkeyuser (); + $reply = Monkeyuser (); sleep (irand (2) + 1); $msg->replyMd ($reply); return; } elsif (substr ($text, 1) eq 'cat' || substr ($text, 1) eq 'кис') { $msg->typing (); - $reply = kitty (); + $reply = Kitty (); sleep (irand (2) + 1); $msg->replyMd ($reply); return; } elsif (substr ($text, 1) eq 'lat' || substr ($text, 1) eq 'лат') { - $reply = latAnswer (); + $reply = Lat (); } elsif ( (length ($text) >= 6 && (substr ($text, 1, 6) eq 'karma ' || substr ($text, 1, 6) eq 'карма ')) || substr ($text, 1) eq 'karma' || substr ($text, 1) eq 'карма' @@ -106,27 +107,27 @@ sub command { $mytext = ''; } - $reply = karmaGet ($chatid, $mytext); + $reply = KarmaGet ($chatid, $mytext); } elsif (substr ($text, 1) eq 'xkcd') { $msg->typing (); - $reply = xkcd (); + $reply = Xkcd (); sleep (irand (2) + 1); $msg->replyMd ($reply); return; } elsif (substr ($text, 1) eq 'fox' || substr ($text, 1) eq 'лис') { $msg->typing (); - $reply = fox (); + $reply = Fox (); sleep (irand (2) + 1); $msg->replyMd ($reply); return; } elsif (substr ($text, 1) eq 'rabbit' || substr ($text, 1) eq 'bunny' || substr ($text, 1) eq 'кролик') { $msg->typing (); - $reply = rabbit (); + $reply = Rabbit (); $msg->replyMd ($reply); return; } elsif (substr ($text, 1) eq 'owl' || substr ($text, 1) eq 'сова') { $msg->typing (); - $reply = owl (); + $reply = Owl (); $msg->replyMd ($reply); return; } elsif ( @@ -139,7 +140,7 @@ sub command { ) { if (pluginEnabled $chatid, 'oboobs') { $msg->typing (); - $reply = oboobs (); + $reply = Oboobs (); sleep (irand (2) + 1); $msg->replyMd ($reply); } @@ -154,31 +155,31 @@ sub command { ) { if (pluginEnabled $chatid, 'obutts') { $msg->typing (); - $reply = obutts (); + $reply = Obutts (); sleep (irand (2) + 1); $msg->replyMd ($reply); } return; } elsif (substr ($text, 1) eq 'friday' || substr ($text, 1) eq 'пятница') { - $reply = friday (); + $reply = Friday (); } elsif (substr ($text, 1) eq 'fortune' || substr ($text, 1) eq 'фортунка' || substr ($text, 1) eq 'f' || substr ($text, 1) eq 'ф') { - $reply = sprintf "```\n%s\n```\n", trim (fortune ()); + $reply = sprintf "```\n%s\n```\n", trim (Fortune ()); $msg->replyMd ($reply); return; } elsif (substr ($text, 1) eq 'drink' || substr ($text, 1) eq 'праздник') { $msg->typing (); - $reply = drink (); + $reply = Drink (); sleep (irand (2) + 1); } elsif (substr ($text, 1) eq 'dig' || substr ($text, 1) eq 'копать') { $msg->typing (); - $reply = dig $highlight; + $reply = Dig $highlight; sleep (irand (2) + 1); $msg->replyMd ($reply); return; } elsif (substr ($text, 1) eq 'fish' || substr ($text, 1) eq 'fishing' || substr ($text, 1) eq 'рыба' || substr ($text, 1) eq 'рыбка' || substr ($text, 1) eq 'рыбалка' ) { $msg->typing (); - $reply = fish $highlight; + $reply = Fish $highlight; sleep (irand (2) + 1); $msg->replyMd ($reply); return; @@ -255,50 +256,50 @@ MYADMIN my ($msgType, $toggle) = split /\s/, $args, 2; if (defined $toggle) { - foreach (@forbiddenMessageTypes) { + foreach (@ForbiddenMessageTypes) { if ($msgType eq $_) { if ($toggle == 1) { - addForbiddenType ($chatid, $msgType); + AddForbiddenType ($chatid, $msgType); $reply = "Теперь сообщения с $msgType будут автоматически удаляться"; } elsif ($toggle == 0) { - delForbiddenType ($chatid, $msgType); + DelForbiddenType ($chatid, $msgType); $reply = "Теперь сообщения с $msgType будут оставаться"; } } } } } else { - $reply = listForbidden ($chatid); + $reply = ListForbidden ($chatid); } } elsif ($cmd eq 'fortune' || $cmd eq 'фортунка') { if (defined $args) { if ($args == 1) { - $reply = fortune_toggle ($chatid, 1); + $reply = FortuneToggle ($chatid, 1); } elsif ($args == 0) { - $reply = fortune_toggle ($chatid, 0); + $reply = FortuneToggle ($chatid, 0); } } else { - $reply = fortune_status ($chatid); + $reply = FortuneStatus ($chatid); } } elsif ($cmd eq 'oboobs') { if (defined $args) { if ($args == 1) { - $reply = plugin_toggle ($chatid, 'oboobs', 1); + $reply = PluginToggle ($chatid, 'oboobs', 1); } elsif ($args == 0) { - $reply = plugin_toggle ($chatid, 'oboobs', 0); + $reply = PluginToggle ($chatid, 'oboobs', 0); } } else { - $reply = plugin_status ($chatid, 'oboobs'); + $reply = PluginStatus ($chatid, 'oboobs'); } } elsif ($cmd eq 'obutts') { if (defined $args) { if ($args == 1) { - $reply = plugin_toggle ($chatid, 'obutts', 1); + $reply = PluginToggle ($chatid, 'obutts', 1); } elsif ($args == 0) { - $reply = plugin_toggle ($chatid, 'obutts', 0); + $reply = PluginToggle ($chatid, 'obutts', 0); } } else { - $reply = plugin_status ($chatid, 'obutts'); + $reply = PluginStatus ($chatid, 'obutts'); } } } @@ -307,7 +308,7 @@ MYADMIN return $reply; } -sub highlight { +sub Highlight { my $msg = shift; my $fullname; @@ -349,7 +350,7 @@ sub highlight { return ($userid, $username, $fullname, $highlight, $visavi); } -sub botsleep { +sub BotSleep { # TODO: Parametrise this with fuzzy sleep time in seconds my $msg = shift; # let's emulate real human and delay answer @@ -365,10 +366,10 @@ sub botsleep { return; } -sub isCensored { +sub IsCensored { my $msg = shift; - my $forbidden = getForbiddenTypes ($msg->chat->id); + my $forbidden = GetForbiddenTypes ($msg->chat->id); # voice messages are special if (defined ($msg->voice) && defined ($msg->voice->duration) && ($msg->voice->duration > 0)) { diff --git a/lib/admin.pm b/lib/BotLib/Admin.pm similarity index 84% rename from lib/admin.pm rename to lib/BotLib/Admin.pm index 679f785..271a756 100644 --- a/lib/admin.pm +++ b/lib/BotLib/Admin.pm @@ -1,4 +1,4 @@ -package admin; +package BotLib::Admin; use 5.018; use strict; @@ -9,31 +9,25 @@ use English qw ( -no_match_vars ); use Carp qw (cluck croak); use CHI; use CHI::Driver::BerkeleyDB; -use conf qw (loadConf); -use util qw (utf2sha1); +use BotLib::Conf qw (LoadConf); +use BotLib::Util qw (utf2sha1); use version; our $VERSION = qw (1.0); use Exporter qw (import); # to export array we need @ISA here our @ISA = qw / Exporter /; ## no critic (ClassHierarchies::ProhibitExplicitISA) -our @EXPORT_OK = qw (@forbiddenMessageTypes @pluginList getForbiddenTypes addForbiddenType delForbiddenType listForbidden fortune_toggle fortune_toggle_list fortune_status plugin_toggle plugin_status pluginEnabled); +our @EXPORT_OK = qw (@ForbiddenMessageTypes @PluginList GetForbiddenTypes AddForbiddenType DelForbiddenType + ListForbidden FortuneToggle FortuneToggleList FortuneStatus PluginToggle PluginStatus + PluginEnabled); -my $c = loadConf (); +my $c = LoadConf (); my $cachedir = $c->{cachedir}; # this list is not yet used -our @pluginList = qw (oboobs obutts); ## no critic (Variables::ProhibitPackageVars) -our @forbiddenMessageTypes = qw (audio voice photo video video_note animation sticker dice game poll document); ## no critic (Variables::ProhibitPackageVars) +our @PluginList = qw (oboobs obutts); ## no critic (Variables::ProhibitPackageVars) +our @ForbiddenMessageTypes = qw (audio voice photo video video_note animation sticker dice game poll document); ## no critic (Variables::ProhibitPackageVars) -sub getForbiddenTypes { +sub GetForbiddenTypes { my $chatid = shift; - - unless (-d $dir) { - unless (make_path $dir) { - cluck "Unable to create $dir: $OS_ERROR"; - return; - } - } - my $messageTypes; my $cache = CHI->new ( @@ -42,7 +36,7 @@ sub getForbiddenTypes { namespace => __PACKAGE__ . '_' . 'censor' . '_' . utf2sha1 ($chatid) ); - foreach (@forbiddenMessageTypes) { + foreach (@ForbiddenMessageTypes) { my $type = $c->get ($_); if ($type) { @@ -60,7 +54,7 @@ sub getForbiddenTypes { return $messageTypes; } -sub addForbiddenType { +sub AddForbiddenType { my $chatid = shift; my $type = shift; @@ -74,7 +68,7 @@ sub addForbiddenType { return; } -sub delForbiddenType { +sub DelForbiddenType { my $chatid = shift; my $type = shift; @@ -88,7 +82,7 @@ sub delForbiddenType { return; } -sub listForbidden { +sub ListForbidden { my $chatid = shift; my @list; @@ -98,7 +92,7 @@ sub listForbidden { namespace => __PACKAGE__ . '_' . 'censor' . '_' . utf2sha1 ($chatid) ); - foreach (@forbiddenMessageTypes) { + foreach (@ForbiddenMessageTypes) { my $type = $c->get ($_); if ($type) { @@ -116,7 +110,7 @@ sub listForbidden { return join "\n", @list; } -sub fortune_toggle (@) { +sub FortuneToggle (@) { my $chatid = shift; my $action = shift // undef; my $phrase = 'Фортунка с утра '; @@ -153,7 +147,7 @@ sub fortune_toggle (@) { return $phrase; } -sub fortune_status ($) { +sub FortuneStatus ($) { my $chatid = shift; my $phrase = 'Фортунка с утра '; @@ -174,18 +168,17 @@ sub fortune_status ($) { return $phrase; } -sub fortune_toggle_list () { +sub FortuneToggleList () { my $cache = CHI->new ( driver => 'BerkeleyDB', root_dir => $cachedir, namespace => __PACKAGE__ . '_' . 'fortune' ); - my @list = $cache->get_keys(); - return @list; + return $cache->get_keys (); } -sub plugin_status (@) { +sub PluginStatus (@) { my $chatid = shift; my $plugin = shift; my $phrase = "Плагин $plugin "; @@ -207,7 +200,7 @@ sub plugin_status (@) { return $phrase; } -sub pluginEnabled (@) { +sub PluginEnabled (@) { my $chatid = shift; my $plugin = shift; @@ -226,7 +219,7 @@ sub pluginEnabled (@) { } } -sub plugin_toggle (@) { +sub PluginToggle (@) { my $chatid = shift; my $plugin = shift; my $action = shift // undef; diff --git a/lib/archeologist.pm b/lib/BotLib/Archeologist.pm similarity index 98% rename from lib/archeologist.pm rename to lib/BotLib/Archeologist.pm index f7c257b..3afb0ba 100644 --- a/lib/archeologist.pm +++ b/lib/BotLib/Archeologist.pm @@ -1,4 +1,4 @@ -package archeologist; +package BotLib::Archeologist; use 5.018; use strict; @@ -10,9 +10,9 @@ use Math::Random::Secure qw (irand); use version; our $VERSION = qw (1.0); use Exporter qw (import); -our @EXPORT_OK = qw (dig); +our @EXPORT_OK = qw (Dig); -sub dig { +sub Dig { my $name = shift; my @artifact = ( diff --git a/lib/buni.pm b/lib/BotLib/Buni.pm similarity index 94% rename from lib/buni.pm rename to lib/BotLib/Buni.pm index 37352af..1290571 100644 --- a/lib/buni.pm +++ b/lib/BotLib/Buni.pm @@ -1,4 +1,4 @@ -package buni; +package BotLib::Buni; use 5.018; use strict; @@ -12,9 +12,9 @@ use Mojo::UserAgent; use version; our $VERSION = qw (1.0); use Exporter qw (import); -our @EXPORT_OK = qw (buni); +our @EXPORT_OK = qw (Buni); -sub buni { +sub Buni { my $r; my $ret = 'Нету Buni'; diff --git a/lib/conf.pm b/lib/BotLib/Conf.pm similarity index 93% rename from lib/conf.pm rename to lib/BotLib/Conf.pm index b864e2b..3706bf2 100644 --- a/lib/conf.pm +++ b/lib/BotLib/Conf.pm @@ -1,4 +1,4 @@ -package conf; +package BotLib::Conf; # loads config use 5.018; @@ -11,9 +11,9 @@ use JSON::XS; use version; our $VERSION = qw (1.0); use Exporter qw (import); -our @EXPORT_OK = qw (loadConf); +our @EXPORT_OK = qw (LoadConf); -sub loadConf { +sub LoadConf { my $c = 'data/config.json'; open my $CH, '<', $c or die "[FATAL] No conf at $c: $OS_ERROR\n"; my $len = (stat $c) [7]; diff --git a/lib/drink.pm b/lib/BotLib/Drink.pm similarity index 95% rename from lib/drink.pm rename to lib/BotLib/Drink.pm index 1aefc97..377c62a 100644 --- a/lib/drink.pm +++ b/lib/BotLib/Drink.pm @@ -1,4 +1,4 @@ -package drink; +package BotLib::Drink; use 5.018; use strict; @@ -15,17 +15,17 @@ use HTML::TokeParser; use Mojo::Log; use Mojo::UserAgent::Cached; use POSIX qw (strftime); -use conf qw (loadConf); +use BotLib::Conf qw (LoadConf); use version; our $VERSION = qw (1.0); use Exporter qw (import); -our @EXPORT_OK = qw (drink); +our @EXPORT_OK = qw (Drink); my @MONTH = qw (yanvar fevral mart aprel may iyun iyul avgust sentyabr oktyabr noyabr dekabr); -my $c = loadConf (); +my $c = LoadConf (); my $cachedir = $c->{cachedir}; -sub drink { +sub Drink { my $r; my $ret = 'Не знаю праздников - вджобываю весь день на шахтах, как проклятая.'; my ($dayNum, $monthNum) = (localtime ())[3, 4]; diff --git a/lib/fisher.pm b/lib/BotLib/Fisher.pm similarity index 98% rename from lib/fisher.pm rename to lib/BotLib/Fisher.pm index 3684501..9264475 100644 --- a/lib/fisher.pm +++ b/lib/BotLib/Fisher.pm @@ -1,4 +1,4 @@ -package fisher; +package BotLib::Fisher; use 5.018; use strict; @@ -10,10 +10,10 @@ use Math::Random::Secure qw (irand); use version; our $VERSION = qw (1.0); use Exporter qw (import); -our @EXPORT_OK = qw (fish); +our @EXPORT_OK = qw (Fish); -sub fish { +sub Fish { my $name = shift; my @artifact = ( diff --git a/lib/fortune.pm b/lib/BotLib/Fortune.pm similarity index 92% rename from lib/fortune.pm rename to lib/BotLib/Fortune.pm index da667d2..e44615c 100644 --- a/lib/fortune.pm +++ b/lib/BotLib/Fortune.pm @@ -1,4 +1,4 @@ -package fortune; +package BotLib::Fortune; # Any fortune_mod sources are suitable. Text file with "\n%\n" sentence delimeter. use 5.018; @@ -11,17 +11,17 @@ use Carp qw (cluck croak); use File::Path qw (make_path); use Math::Random::Secure qw (irand); use SQLite_File; -use conf qw (loadConf); +use BotLib::Conf qw (LoadConf); use version; our $VERSION = qw (1.0); use Exporter qw (import); -our @EXPORT_OK = qw (seed fortune); +our @EXPORT_OK = qw (Seed Fortune); -my $c = loadConf (); +my $c = LoadConf (); my $dir = $c->{fortune}->{dir}; my $srcdir = $c->{fortune}->{srcdir}; -sub seed () { +sub Seed () { unless (-d $dir) { make_path ($dir) || croak "Unable to create $dir: $OS_ERROR"; } @@ -65,7 +65,7 @@ sub seed () { } # just return answer -sub fortune () { +sub Fortune () { my $backingfile = sprintf '%s/fortune.sqlite', $dir; tie my @array, 'SQLite_File', $backingfile || do { diff --git a/lib/friday.pm b/lib/BotLib/Friday.pm similarity index 94% rename from lib/friday.pm rename to lib/BotLib/Friday.pm index 0b6505d..d06639a 100644 --- a/lib/friday.pm +++ b/lib/BotLib/Friday.pm @@ -1,4 +1,4 @@ -package friday; +package BotLib::Friday; # for friday data stolen from https://raw.githubusercontent.com/isida/vi/master/data/friday.txt use 5.018; @@ -11,18 +11,18 @@ use Carp qw (cluck croak); use File::Path qw (make_path); use Math::Random::Secure qw (irand); use SQLite_File; -use conf qw (loadConf); +use BotLib::Conf qw (LoadConf); use version; our $VERSION = qw (1.0); use Exporter qw (import); our @EXPORT_OK = qw (seed friday); -my $c = loadConf (); +my $c = LoadConf (); my $dir = $c->{friday}->{dir}; my $srcfile = $c->{friday}->{src}; my @dow = qw (monday tuesday wednesday thursday friday saturday sunday); -sub seed () { +sub Seed () { unless (-d $dir) { make_path ($dir) || croak "Unable to create $dir: $OS_ERROR"; } @@ -75,7 +75,7 @@ sub seed () { } # just return answer -sub friday () { +sub Friday () { my $today = (localtime (time))[6] - 1; my $backingfile = sprintf '%s/%s.sqlite', $dir, $dow[$today]; diff --git a/lib/image.pm b/lib/BotLib/Image.pm similarity index 91% rename from lib/image.pm rename to lib/BotLib/Image.pm index 56fcdd1..d333968 100644 --- a/lib/image.pm +++ b/lib/BotLib/Image.pm @@ -1,4 +1,4 @@ -package image; +package BotLib::Image; use 5.018; use strict; @@ -7,21 +7,15 @@ use utf8; use open qw (:std :utf8); use English qw ( -no_match_vars ); use Carp qw (cluck); -use File::Path qw (make_path); use Math::Random::Secure qw (irand); use Mojo::UserAgent; -use SQLite_File; -use conf qw (loadConf); -use flickr qw (flickr_by_tags); -use imgur qw (imgur); -use util qw (urlencode); +use BotLIb::Image::Flickr qw (FlickrByTags); +use BotLib::Image::Imgur qw (Imgur); +use BotLib::Util qw (urlencode); use version; our $VERSION = qw (1.0); use Exporter qw (import); -our @EXPORT_OK = qw (kitty fox oboobs obutts rabbit owl); - -my $c = loadConf (); -my $dir = $c->{image}->{dir}; +our @EXPORT_OK = qw (Kitty Fox Oboobs Obutts Rabbit Owl); sub kitty { my $r; @@ -174,7 +168,7 @@ sub rabbit_imgur { urlencode 'score?q_not=cat OR kitten OR kittens OR dog OR cats OR dogs OR puppy OR puppies&q_tags=bunnies,bunny,rabbits,rabbit', ); - my $rabbit = imgur ($terms[irand ($#terms + 1)]); + my $rabbit = Imgur ($terms[irand ($#terms + 1)]); # return just large thumbnail instead of real photo (that can be really huge) $rabbit = sprintf '%sl%s', substr ($rabbit, 0, -4), substr ($rabbit, -4); @@ -187,7 +181,7 @@ sub rabbit_imgur { sub rabbit { # rabbit, but bunny - my $url = flickr_by_tags ('animal,bunny'); + my $url = FlickrByTags ('animal,bunny'); if (defined $url) { return sprintf '[(\_/)](%s)', $url; @@ -197,7 +191,7 @@ sub rabbit { } sub owl { - my $url = flickr_by_tags ('bird,owl'); + my $url = FlickrByTags ('bird,owl'); if (defined $url) { return sprintf '[{ O v O }](%s)', $url; diff --git a/lib/flickr.pm b/lib/BotLib/Image/Flickr.pm similarity index 84% rename from lib/flickr.pm rename to lib/BotLib/Image/Flickr.pm index 9212a17..8b385ac 100644 --- a/lib/flickr.pm +++ b/lib/BotLib/Image/Flickr.pm @@ -1,4 +1,4 @@ -package flickr; +package BotLib::Image::Flickr; use 5.018; use strict; @@ -7,25 +7,25 @@ use utf8; use open qw (:std :utf8); use English qw ( -no_match_vars ); use Carp qw (cluck); +use CHI; +use CHI::Driver::BerkeleyDB; use Digest::HMAC_SHA1 qw (hmac_sha1); -use File::Path qw (make_path); use Math::Random::Secure qw (irand); use MIME::Base64; use Mojo::UserAgent; -use SQLite_File; use URI::Encode::XS qw (uri_encode); -use conf qw (loadConf); -use util qw (urlencode); +use BotLib::Conf qw (LoadConf); +use BotLib::Util qw (urlencode); use Data::Dumper; use version; our $VERSION = qw (1.0); use Exporter qw (import); -our @EXPORT_OK = qw (flickr_init flickr_by_tags flickr_by_text flickr_test_login); +our @EXPORT_OK = qw (FlickrInit FlickrByTags FlickrByText FlickrTestLogin); -my $c = loadConf (); -my $dir = $c->{image}->{dir}; +my $c = LoadConf (); +my $cachedir = $c->{cachedir}; my $flickr_consumer_key = $c->{image}->{flickr}->{consumer_key}; my $flickr_consumer_secret = $c->{image}->{flickr}->{consumer_secret}; @@ -459,88 +459,68 @@ sub flickrSearchByTags { } } -sub flickr_init { - my $backingfile = sprintf '%s/secrets.sqlite', $dir; - - unless (-d $dir) { - make_path ($dir) or do { - say "Unable to create $dir: $OS_ERROR"; ## no critic (InputOutput::RequireCheckedSyscalls) - return 0; - }; - } - - tie my %secret, 'SQLite_File', $backingfile || do { - say "[ERROR] Unable to tie to $backingfile: $OS_ERROR"; ## no critic (InputOutput::RequireCheckedSyscalls) - return 0; - }; +sub FlickrInit { + my $cache = CHI->new ( + driver => 'BerkeleyDB', + root_dir => $cachedir, + namespace => __PACKAGE__ + ); if (defined $flickr_verifier && $flickr_verifier) { - my $flickr_request_token = $secret{flickr_request_token}; - my $flickr_request_token_secret = $secret{flickr_request_token_secret}; + my $flickr_request_token = $cache->get ('flickr_request_token'); + my $flickr_request_token_secret = $cache->get ('flickr_request_token_secret'); unless (defined $flickr_request_token || defined $flickr_request_token_secret) { - say "Looks like there is no request token or request token secret in $backingfile"; ## no critic (InputOutput::RequireCheckedSyscalls) - say 'Please remove verifier settings from config.json and run this script again'; ## no critic (InputOutput::RequireCheckedSyscalls) - untie %secret; + say "Looks like there is no request token or request token secret in config db."; ## no critic (InputOutput::RequireCheckedSyscalls) + say 'Please remove verifier settings from config.json and run this script again.'; ## no critic (InputOutput::RequireCheckedSyscalls) return 0; } my %accessToken = flickrAccessToken ($flickr_request_token, $flickr_request_token_secret, $flickr_verifier); if (defined ($accessToken{oauth_token}) && defined ($accessToken{oauth_token_secret})) { - $secret{flickr_access_token} = $accessToken{oauth_token}; - $secret{flickr_access_token_secret} = $accessToken{oauth_token_secret}; + # TODO: check set + $cache->set ('flickr_access_token', $accessToken{oauth_token}, 'never'); + $cache->set ('flickr_access_token_secret', $accessToken{oauth_token_secret}, 'never'); say sprintf ( ## no critic (InputOutput::RequireCheckedSyscalls) - 'Access token (%s) and access token secret (%s) are in %s', + 'Access token (%s) and access token secret (%s) are config db', $accessToken{oauth_token}, $accessToken{oauth_token_secret}, - $backingfile ); - untie %secret; return 1; } } else { my %req = flickrRequestToken (); if (defined ($req{oauth_token}) && defined ($req{oauth_token_secret}) && defined ($req{oauth_token})) { - $secret{flickr_request_token} = $req{oauth_token}; - $secret{flickr_request_token_secret} = $req{oauth_token_secret}; + # TODO: check set + $cache->set ('flickr_request_token', $req{oauth_token}, 'never'); + $cache->set ('flickr_request_token_secret', $req{oauth_token_secret}, 'never'); my $confirm_url = flickrAuthorization ($req{oauth_token}); if (defined $confirm_url) { say "Please open this url in your browser and grant access for this app:\n$confirm_url"; ## no critic (InputOutput::RequireCheckedSyscalls) say 'Do not forget to put oauth_verifier to config.json file and re-run this script to get access token'; ## no critic (InputOutput::RequireCheckedSyscalls) say 'Note that you should be logged off from flickr account.'; ## no critic (InputOutput::RequireCheckedSyscalls) - untie %secret; return 1; } } } - untie %secret; return 0; } -sub flickr_test_login { +sub FlickrTestLogin { my $text = shift; - my $backingfile = sprintf '%s/secrets.sqlite', $dir; + my $cache = CHI->new ( + driver => 'BerkeleyDB', + root_dir => $cachedir, + namespace => __PACKAGE__ + ); - unless (-d $dir) { - make_path ($dir) or do { - say "Unable to create $dir: $OS_ERROR"; ## no critic (InputOutput::RequireCheckedSyscalls) - return 0; - }; - } - - tie my %secret, 'SQLite_File', $backingfile || do { - say "[ERROR] Unable to tie to $backingfile: $OS_ERROR"; ## no critic (InputOutput::RequireCheckedSyscalls) - return 0; - }; - - my $flickr_access_token = $secret{flickr_access_token}; - my $flickr_access_token_secret = $secret{flickr_access_token_secret}; - untie %secret; + my $flickr_access_token = $cache->get ('flickr_access_token'); + my $flickr_access_token_secret = $cache->get ('flickr_access_token_secret'); if (flickrTestLogin ($flickr_access_token, $flickr_access_token_secret)) { return 1; @@ -549,25 +529,17 @@ sub flickr_test_login { } } -sub flickr_by_tags { +sub FlickrByTags { my $text = shift; - my $backingfile = sprintf '%s/secrets.sqlite', $dir; - unless (-d $dir) { - make_path ($dir) or do { - say "Unable to create $dir: $OS_ERROR"; ## no critic (InputOutput::RequireCheckedSyscalls) - return 0; - }; - } + my $cache = CHI->new ( + driver => 'BerkeleyDB', + root_dir => $cachedir, + namespace => __PACKAGE__ + ); - tie my %secret, 'SQLite_File', $backingfile || do { - say "[ERROR] Unable to tie to $backingfile: $OS_ERROR"; ## no critic (InputOutput::RequireCheckedSyscalls) - return 0; - }; - - my $flickr_access_token = $secret{flickr_access_token}; - my $flickr_access_token_secret = $secret{flickr_access_token_secret}; - untie %secret; + my $flickr_access_token = $cache->get ('flickr_access_token'); + my $flickr_access_token_secret = $cache->get ('flickr_access_token_secret'); # NB: I honestly query random page (among number of pages) of results from api, but always got first page, # no matter what is shown in response' "page" parameter. Looks like bug in API. Try to little bit mitigate @@ -590,25 +562,17 @@ sub flickr_by_tags { } } -sub flickr_by_text { +sub FlickrByText { my $text = shift; - my $backingfile = sprintf '%s/secrets.sqlite', $dir; - unless (-d $dir) { - make_path ($dir) or do { - say "Unable to create $dir: $OS_ERROR"; ## no critic (InputOutput::RequireCheckedSyscalls) - return 0; - }; - } + my $cache = CHI->new ( + driver => 'BerkeleyDB', + root_dir => $cachedir, + namespace => __PACKAGE__ + ); - tie my %secret, 'SQLite_File', $backingfile || do { - say "[ERROR] Unable to tie to $backingfile: $OS_ERROR"; ## no critic (InputOutput::RequireCheckedSyscalls) - return 0; - }; - - my $flickr_access_token = $secret{flickr_access_token}; - my $flickr_access_token_secret = $secret{flickr_access_token_secret}; - untie %secret; + my $flickr_access_token = $cache->get ('flickr_access_token'); + my $flickr_access_token_secret = $cache->get ('flickr_access_token_secret'); # NB: I honestly query random page (among number of pages) of results from api, but always got first page, # no matter what is shown in response' "page" parameter. Looks like bug in API. Try to little bit mitigate diff --git a/lib/imgur.pm b/lib/BotLib/Image/Imgur.pm similarity index 67% rename from lib/imgur.pm rename to lib/BotLib/Image/Imgur.pm index 929639f..9b317c4 100644 --- a/lib/imgur.pm +++ b/lib/BotLib/Image/Imgur.pm @@ -1,4 +1,4 @@ -package imgur; +package Botlib::Image::Imgur; use 5.018; use strict; @@ -7,56 +7,61 @@ use utf8; use open qw (:std :utf8); use English qw ( -no_match_vars ); use Carp qw (cluck); -use File::Path qw (make_path); +use CHI; +use CHI::Driver::BerkeleyDB; use Math::Random::Secure qw (irand); use Mojo::UserAgent; -use SQLite_File; -use conf qw (loadConf); + +use BotLib::Conf qw (LoadConf); use version; our $VERSION = qw (1.0); use Exporter qw (import); -our @EXPORT_OK = qw (imgur); +our @EXPORT_OK = qw (Imgur); -my $c = loadConf (); -my $dir = $c->{image}->{dir}; -my $imgur_client_id = $c->{image}->{imgur}->{client_id}; -my $imgur_client_secret = $c->{image}->{imgur}->{client_secret}; -my $imgur_access_token = $c->{image}->{imgur}->{access_token};; -my $imgur_refresh_token = $c->{image}->{imgur}->{refresh_token}; +my $c = LoadConf (); -sub imgur { +sub Imgur { my $tag = shift; my $refresh_url = 'https://api.imgur.com/oauth2/token'; my $search_url = 'https://api.imgur.com/3/gallery/search/'; - # load all tokens from api secrets db - my $backingfile = sprintf '%s/secrets.sqlite', $dir; - - unless (-d $dir) { - make_path ($dir) or do { - cluck "Unable to create $dir: $OS_ERROR"; - return undef; - }; - } - - tie my %secret, 'SQLite_File', $backingfile || do { - cluck "[ERROR] Unable to tie to $backingfile: $OS_ERROR"; + my $imgur_client_id = $c->{image}->{imgur}->{client_id} // do { + cluck "No client_id specified in config for imgur module"; return undef; }; - - # if there is no access_token in db - put there one from config - if (defined $secret{imgur_access_token}) { - $imgur_access_token = $secret{imgur_access_token}; - } else { - $secret{imgur_access_token} = $imgur_access_token; + my $imgur_client_secret = $c->{image}->{imgur}->{client_secret} // do { + cluck "No client_secret specified in config for imgur module"; + return undef; + }; + my $imgur_access_token = $c->{image}->{imgur}->{access_token} // do { + cluck "No access_token specified in config for imgur module"; + return undef; + }; + my $imgur_refresh_token = $c->{image}->{imgur}->{refresh_token} // do { + cluck "No refresh_token specified in config for imgur module"; } + # N.B. Both imgur_access_token and imgur_refresh_token time to time can change, so we need + # some place where we can store new values + my $cache = CHI->new ( + driver => 'BerkeleyDB', + root_dir => $cachedir, + namespace => __PACKAGE__ + ); + + $imgur_access_token = $cache->get ('imgur_access_token'); + + # if there is no access_token in db - put there one from config + unless (defined $imgur_access_token) { + $cache->set ('imgur_access_token', $c->{image}->{imgur}->{access_token}, 'never'); + } + + $imgur_refresh_token = $cache->get ('imgur_refresh_token'); + # if there is no refresh_token in db - put there one from config - if (defined $secret{imgur_refresh_token}) { - $imgur_refresh_token = $secret{imgur_refresh_token}; - } else { - $secret{imgur_refresh_token} = $imgur_refresh_token; + unless (defined $imgur_refresh_token) { + $cache->set ('imgur_refresh_token', $c->{image}->{imgur}->{refresh_token}, 'never'); } # query api @@ -97,8 +102,6 @@ sub imgur { $r = $ua->get ($search_url . $tag => {Authorization => "Bearer $imgur_access_token"})->result; } - untie %secret; - if ($r->is_success) { my $searchResult = eval { return $r->json; }; my @urls; @@ -145,4 +148,4 @@ sub imgur { } } -1; \ No newline at end of file +1; diff --git a/lib/karma.pm b/lib/BotLib/Karma.pm similarity index 92% rename from lib/karma.pm rename to lib/BotLib/Karma.pm index 5957460..509db45 100644 --- a/lib/karma.pm +++ b/lib/BotLib/Karma.pm @@ -1,4 +1,4 @@ -package karma; +package BotLib::Karma; use 5.018; use strict; @@ -9,18 +9,18 @@ use English qw ( -no_match_vars ); use Carp qw (cluck); use CHI; use CHI::Driver::BerkeleyDB; -use conf qw (loadConf); +use BotLib::Conf qw (LoadConf); use version; our $VERSION = qw (1.0); use Exporter qw (import); -our @EXPORT_OK = qw (karmaSet karmaGet); +our @EXPORT_OK = qw (KarmaSet KarmaGet); -my $c = loadConf (); +my $c = LoadConf (); my $cachedir = $c->{cachedir}; my $max = 5; # swallow phrase and return answer -sub karmaSet (@) { +sub KarmaSet (@) { my $chatid = shift; my $phrase = shift; my $action = shift; @@ -71,7 +71,7 @@ sub karmaSet (@) { } # just return answer -sub karmaGet (@) { +sub KarmaGet (@) { my $chatid = shift; my $phrase = shift; diff --git a/lib/lat.pm b/lib/BotLib/Lat.pm similarity index 91% rename from lib/lat.pm rename to lib/BotLib/Lat.pm index 5daa9a3..ab67d72 100644 --- a/lib/lat.pm +++ b/lib/BotLib/Lat.pm @@ -1,4 +1,4 @@ -package lat; +package BotLib::Lat; # famous latin phases taken from https://ru.wikipedia.org/wiki/Список_крылатых_латинских_выражений use 5.018; @@ -11,17 +11,17 @@ use Carp qw (cluck); use File::Basename qw (dirname); use File::Path qw (make_path); use Hailo; -use conf qw (loadConf); +use BotLib::Conf qw (loadConf); use version; our $VERSION = qw (1.0); use Exporter qw (import); -our @EXPORT_OK = qw (train latAnswer); +our @EXPORT_OK = qw (Train Lat); -my $c = loadConf (); +my $c = LoadConf (); my $brain = $c->{lat}->{brain}; my $srcfile = $c->{lat}->{src}; -sub train () { +sub Train () { my $braindir = dirname $brain; unless (-d $braindir) { @@ -45,7 +45,7 @@ sub train () { } # just return answer -sub latAnswer () { +sub Lat () { my $braindir = dirname $brain; unless (-d $braindir) { diff --git a/lib/monkeyuser.pm b/lib/BotLib/Monkeyuser.pm similarity index 94% rename from lib/monkeyuser.pm rename to lib/BotLib/Monkeyuser.pm index 5688aac..5a39c7c 100644 --- a/lib/monkeyuser.pm +++ b/lib/BotLib/Monkeyuser.pm @@ -1,4 +1,4 @@ -package monkeyuser; +package BotLib::Monkeyuser; use 5.018; use strict; @@ -13,9 +13,9 @@ use Mojo::UserAgent; use version; our $VERSION = qw (1.0); use Exporter qw (import); -our @EXPORT_OK = qw (monkeyuser); +our @EXPORT_OK = qw (Monkeyuser); -sub monkeyuser { +sub Monkeyuser { my $r; my $ret = 'Нету Monkey User-ов, они все спрятались.'; my @link; diff --git a/lib/util.pm b/lib/BotLib/Util.pm similarity index 98% rename from lib/util.pm rename to lib/BotLib/Util.pm index 8d3e4f6..9d4bc4d 100644 --- a/lib/util.pm +++ b/lib/BotLib/Util.pm @@ -1,4 +1,4 @@ -package util; +package BotLib::Util; use 5.018; use strict; @@ -77,7 +77,6 @@ sub utf2sha1 { return sha1_base64 $bytes; } - 1; # vim: set ft=perl noet ai ts=4 sw=4 sts=4: diff --git a/lib/weather.pm b/lib/BotLib/Weather.pm similarity index 96% rename from lib/weather.pm rename to lib/BotLib/Weather.pm index 48188cb..920a1bb 100644 --- a/lib/weather.pm +++ b/lib/BotLib/Weather.pm @@ -1,4 +1,4 @@ -package weather; +package BotLib::Weather; use 5.018; use strict; @@ -9,19 +9,16 @@ use English qw ( -no_match_vars ); use Carp qw (carp cluck); use CHI; use CHI::Driver::BerkeleyDB; -use DB_File; -use Digest::MD5 qw (md5_base64); -use File::Path qw (make_path); use Mojo::Log; use Mojo::UserAgent::Cached; -use conf qw (loadConf); -use util qw (trim urlencode); +use BotLib::Conf qw (LoadConf); +use BotLib::Util qw (trim urlencode); use version; our $VERSION = qw (1.0); use Exporter qw (import); our @EXPORT_OK = qw (weather); -my $c = loadConf (); +my $c = LoadConf (); my $cachedir = $c->{cachedir}; sub weather { diff --git a/lib/xkcd.pm b/lib/BotLib/Xkcd.pm similarity index 91% rename from lib/xkcd.pm rename to lib/BotLib/Xkcd.pm index e128a8d..31b909a 100644 --- a/lib/xkcd.pm +++ b/lib/BotLib/Xkcd.pm @@ -1,4 +1,4 @@ -package xkcd; +package BotLib::Xkcd; use 5.018; use strict; @@ -9,9 +9,9 @@ use Mojo::UserAgent; use version; our $VERSION = qw (1.0); use Exporter qw (import); -our @EXPORT_OK = qw (xkcd); +our @EXPORT_OK = qw (Xkcd); -sub xkcd { +sub Xkcd { my $ua = Mojo::UserAgent->new->connect_timeout (5)->max_redirects (0); my $r = $ua->get ('https://xkcd.ru/random/')->result; diff --git a/lib/telegrambot.pm b/lib/TelegramBot.pm similarity index 89% rename from lib/telegrambot.pm rename to lib/TelegramBot.pm index 0ddfd9c..0c0c0ad 100644 --- a/lib/telegrambot.pm +++ b/lib/TelegramBot.pm @@ -1,4 +1,4 @@ -package telegrambot; +package TelegramBot; # main bot gears are here use 5.018; @@ -13,18 +13,19 @@ use File::Path qw (make_path); use Hailo; use Math::Random::Secure qw (irand); use Mojo::Base 'Teapot::Bot::Brain'; -use admin qw (fortune_toggle_list); -use botlib qw (randomCommonPhrase command highlight botsleep isCensored); -use conf qw (loadConf); -use fortune qw (fortune); -use karma qw (karmaSet); -use util qw (trim fmatch); + +use BotLib::Admin qw (FortuneToggleList); +use BotLib qw (RandomCommonPhrase Command Highlight BotSleep IsCensored); +use BotLib::Conf qw (LoadConf); +use BotLib::Fortune qw (Fortune); +use BotLib::Karma qw (KarmaSet); +use BotLib::Util qw (trim fmatch); use version; our $VERSION = qw (1.0); use Exporter qw (import); -our @EXPORT_OK = qw (run_telegrambot); +our @EXPORT_OK = qw (RunTelegramBot); -my $c = loadConf (); +my $c = LoadConf (); my $hailo; my $myid; my $myusername; @@ -47,10 +48,10 @@ sub __cron { my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime (time); if ($hour == 8 && ($min >= 0 && $min <= 14)) { - foreach my $enabledfortunechat (fortune_toggle_list ()) { + foreach my $enabledFortuneChat (FortuneToggleList ()) { my $send_args; - $send_args->{text} = sprintf "%s\n```\n%s\n```\n", $intro[irand ($#intro + 1)], trim (fortune ()); - $send_args->{chat_id} = $enabledfortunechat; + $send_args->{text} = sprintf "%s\n```\n%s\n```\n", $intro[irand ($#intro + 1)], trim (Fortune ()); + $send_args->{chat_id} = $enabledFortuneChat; $send_args->{parse_mode} = 'Markdown'; $self->sendMessage ($send_args); } @@ -65,7 +66,7 @@ sub __on_msg { my $chatid; my $chatname = 'Noname chat'; # user sending message info - my ($userid, $username, $fullname, $highlight, $vis_a_vi) = highlight $msg; + my ($userid, $username, $fullname, $highlight, $vis_a_vi) = Highlight $msg; my $csign = $c->{telegrambot}->{csign}; unless ($myid) { @@ -142,18 +143,18 @@ sub __on_msg { $phrase = sprintf 'Дратути, %s. Представьтес, пожалуйста, и расскажите, что вас сюда привело.', $members[0]; } - botsleep $msg; + BotSleep $msg; $msg->replyMd ($phrase); return; } # lazy init chat-bot brains unless (defined $hailo->{$chatid}) { - my $brainname = sprintf '%s/%s.brain.sqlite', $c->{telegrambot}->{braindir}, $chatid; + my $brainName = sprintf '%s/%s.brain.sqlite', $c->{telegrambot}->{braindir}, $chatid; $hailo->{$chatid} = Hailo->new ( # we'll got file like this: data/telegrambot-brains/-1001332512695.brain.sqlite - brain => $brainname, + brain => $brainName, order => 3 ); @@ -167,6 +168,7 @@ sub __on_msg { # is this a 1-on-1 ? if ($msg->chat->type eq 'private') { unless (defined $msg->text) { + # TODO: it can be sticker, image, voice, video, etc. Maybe, i'll handle it once? :) return; } @@ -175,7 +177,7 @@ sub __on_msg { my $reply = 'Давайте ещё пообщаемся, а то я ещё не научилась от вас плохому.'; if (substr ($text, 0, 1) eq $csign) { - $reply = command ($self, $msg, $text, $userid); + $reply = Command ($self, $msg, $text, $userid); } else { my $just_message_in_chat = 0; @@ -184,7 +186,7 @@ sub __on_msg { my @arr = split /\n/, $text; if ($#arr < 1) { - $reply = karmaSet ($chatid, trim (substr ($text, 0, -2)), substr ($text, -2)); + $reply = KarmaSet ($chatid, trim (substr ($text, 0, -2)), substr ($text, -2)); } else { $just_message_in_chat = 1; } @@ -204,7 +206,7 @@ sub __on_msg { $phrase = lc $phrase; if (fmatch (lc ($reply), $phrase)) { - $reply = randomCommonPhrase (); + $reply = RandomCommonPhrase (); } } } @@ -220,7 +222,7 @@ sub __on_msg { } elsif (($msg->chat->type eq 'supergroup') or ($msg->chat->type eq 'group')) { my $reply; - if (isCensored $msg) { + if (IsCensored $msg) { carp sprintf '[INFO] In public chat %s (%s) message from %s was censored', $chatname, $chatid, $vis_a_vi; $self->deleteMessage ({chat_id => $chatid, message_id => $msg->{message_id}}); } @@ -259,7 +261,7 @@ sub __on_msg { } # simple commands } elsif (substr ($text, 0, 1) eq $csign) { - $reply = command ($self, $msg, $text, $chatid); + $reply = Command ($self, $msg, $text, $chatid); } elsif ( ($text eq $myusername) or ($text eq '@' . $myusername) or @@ -279,7 +281,7 @@ sub __on_msg { # bot mention by name } elsif ((lc ($text) =~ /.+ ${qname}[\,|\!|\?|\.| ]/) or (lc ($text) =~ / $qname$/)) { $phrase = $text; - $reply = $hailo->{$msg->chat->id}->reply($phrase); + $reply = $hailo->{$msg->chat->id}->reply ($phrase); # bot mention by telegram name } elsif ((lc ($text) =~ /.+ ${qtname}[\,|\!|\?|\.| ]/) or (lc ($text) =~ / $qtname$/)) { $phrase = $text; @@ -289,7 +291,7 @@ sub __on_msg { my @arr = split /\n/, $text; if ($#arr < 1) { - $reply = karmaSet ($chatid, trim (substr ($text, 0, -2)), substr ($text, -2)); + $reply = KarmaSet ($chatid, trim (substr ($text, 0, -2)), substr ($text, -2)); } else { # just message in chat $hailo->{$msg->chat->id}->learn ($text); @@ -311,7 +313,7 @@ sub __on_msg { $phrase = lc $phrase; if (fmatch (lc ($reply), $phrase)) { - $reply = randomCommonPhrase (); + $reply = RandomCommonPhrase (); } $msg->typing (); @@ -347,7 +349,7 @@ sub init { return; } -sub run_telegrambot { +sub RunTelegramBot { while (sleep 3) { eval { ## no critic (ErrorHandling::RequireCheckingReturnValueOfEval) telegrambot->new->think;