aleesa-bot/aleesa-telegram
0
Fork 0
Code Pull Requests Projects Releases Activity

Refactor some parts of bot

Browse Source 
- Move most modules to subdirs
- Rename functions according perlcritic guidelines
- Fix and add some bugs
This commit is contained in:
eleksir
2021-04-21 14:07:20 +03:00
parent 729489236f
commit 8665a6ddda
23 changed files with 262 additions and 309 deletions
Download Patch File Download Diff File Expand all files Collapse all files

6
bin/aleesa-telegram-bot
View File

@@ -32,8 +32,8 @@ use File::Path qw (make_path);
use Log::Any::Adapter; use Log::Any::Adapter;
use Log::Any::For::Std; use Log::Any::For::Std;
use POSIX qw (setgid setuid setsid); use POSIX qw (setgid setuid setsid);
use conf qw (loadConf); use BotLib::Conf qw (LoadConf);
use telegrambot qw (run_telegrambot); use TelegramBot qw (RunTelegramBot);
sub daemonize; sub daemonize;
sub __fork; sub __fork;
@@ -43,7 +43,7 @@ local $OUTPUT_AUTOFLUSH = 1;
my $runAsUid = $UID; my $runAsUid = $UID;
my $piddir = '/var/run/' . basename (abs_path ($PROGRAM_NAME)); my $piddir = '/var/run/' . basename (abs_path ($PROGRAM_NAME));
my $C = loadConf (); my $C = LoadConf ();
my $logfile; my $logfile;
if (defined $C->{'log'}) { if (defined $C->{'log'}) {

4
bin/flickr_init.pl
View File

@@ -20,9 +20,9 @@ BEGIN {
} }
use lib ("$workdir/lib", "$workdir/vendor_perl", "$workdir/vendor_perl/lib/perl5"); 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; exit 0;
} else { } else {
exit 1; exit 1;

4
bin/flickr_test.pl
View File

@@ -20,9 +20,9 @@ BEGIN {
} }
use lib ("$workdir/lib", "$workdir/vendor_perl", "$workdir/vendor_perl/lib/perl5"); 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; exit 0;
} else { } else {
exit 1; exit 1;

4
bin/friday_seed.pl
View File

@@ -20,7 +20,7 @@ BEGIN {
} }
use lib ("$workdir/lib", "$workdir/vendor_perl", "$workdir/vendor_perl/lib/perl5"); 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; exit 0;

111
lib/botlib.pm → lib/BotLib.pm
View File

@@ -1,4 +1,4 @@
package botlib; package BotLib;
# store here utility functions that are not protocol-specified # store here utility functions that are not protocol-specified
use 5.018; use 5.018;
@@ -10,30 +10,31 @@ use English qw ( -no_match_vars );
use Carp qw (carp); use Carp qw (carp);
use Math::Random::Secure qw (irand); use Math::Random::Secure qw (irand);
use conf qw (loadConf); use BotLib::Conf qw (LoadConf);
use admin qw (@forbiddenMessageTypes getForbiddenTypes addForbiddenType delForbiddenType listForbidden fortune_toggle fortune_status plugin_toggle plugin_status pluginEnabled); use BotLib::Admin qw (@forbiddenMessageTypes GetForbiddenTypes AddForbiddenType DelForbiddenType ListForbidden
use archeologist qw (dig); FortuneToggle FortuneStatus PluginToggle PluginStatus PluginEnabled);
use buni qw (buni); use BotLib::Archeologist qw (Dig);
use drink qw (drink); use BotLib::Buni qw (Buni);
use fisher qw (fish); use BotLib::Drink qw (Drink);
use fortune qw (fortune); use BotLib::Fisher qw (Fish);
use friday qw (friday); use BotLib::Fortune qw (Fortune);
use image qw (kitty fox oboobs obutts rabbit owl); use BotLib::Friday qw (Friday);
use karma qw (karmaSet karmaGet); use BotLib::Image qw (Kitty Fox Oboobs Obutts Rabbit Owl);
use lat qw (latAnswer); use BotLib::Karma qw (KarmaSet KarmaGet);
use monkeyuser qw (monkeyuse); use BotLib::Lat qw (Lat);
use util qw (trim); use BotLib::Monkeyuser qw (Monkeyuser);
use weather qw (weather); use BotLib::Util qw (trim);
use xkcd qw (xkcd); use BotLib::Weather qw (Weather);
use BotLib::Xkcd qw (Xkcd);
use version; our $VERSION = qw (1.0); use version; our $VERSION = qw (1.0);
use Exporter qw (import); 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}; my $csign = $c->{telegrambot}->{csign};
sub randomCommonPhrase { sub RandomCommonPhrase {
my @myphrase = ( my @myphrase = (
'Так, блядь...', 'Так, блядь...',
'*Закатывает рукава* И ради этого ты меня позвал?', '*Закатывает рукава* И ради этого ты меня позвал?',
@@ -51,13 +52,13 @@ sub randomCommonPhrase {
return $myphrase[irand ($#myphrase + 1)]; return $myphrase[irand ($#myphrase + 1)];
} }
sub command { sub Command {
my $self = shift; my $self = shift;
my $msg = shift; my $msg = shift;
my $text = shift; my $text = shift;
my $chatid = shift; my $chatid = shift;
my $reply; my $reply;
my ($userid, $username, $fullname, $highlight, $visavi) = highlight ($msg); my ($userid, $username, $fullname, $highlight, $visavi) = Highlight ($msg);
if (substr ($text, 1) eq 'ping') { if (substr ($text, 1) eq 'ping') {
$reply = 'Pong.'; $reply = 'Pong.';
@@ -71,27 +72,27 @@ sub command {
$reply = 'Версия: Нуль.Чего-то_там.Чего-то_там'; $reply = 'Версия: Нуль.Чего-то_там.Чего-то_там';
} elsif (length ($text) >= 2 && (substr ($text, 1, 2) eq 'w ' || substr ($text, 1, 2) eq 'п ')) { } elsif (length ($text) >= 2 && (substr ($text, 1, 2) eq 'w ' || substr ($text, 1, 2) eq 'п ')) {
my $city = substr $text, 3; my $city = substr $text, 3;
$reply = weather $city; $reply = Weather $city;
} elsif (substr ($text, 1) eq 'buni') { } elsif (substr ($text, 1) eq 'buni') {
$msg->typing (); $msg->typing ();
$reply = buni (); $reply = Buni ();
sleep (irand (2) + 1); sleep (irand (2) + 1);
$msg->replyMd ($reply); $msg->replyMd ($reply);
return; return;
} elsif (substr ($text, 1) eq 'monkeyuser') { } elsif (substr ($text, 1) eq 'monkeyuser') {
$msg->typing (); $msg->typing ();
$reply = monkeyuser (); $reply = Monkeyuser ();
sleep (irand (2) + 1); sleep (irand (2) + 1);
$msg->replyMd ($reply); $msg->replyMd ($reply);
return; return;
} elsif (substr ($text, 1) eq 'cat' || substr ($text, 1) eq 'кис') { } elsif (substr ($text, 1) eq 'cat' || substr ($text, 1) eq 'кис') {
$msg->typing (); $msg->typing ();
$reply = kitty (); $reply = Kitty ();
sleep (irand (2) + 1); sleep (irand (2) + 1);
$msg->replyMd ($reply); $msg->replyMd ($reply);
return; return;
} elsif (substr ($text, 1) eq 'lat' || substr ($text, 1) eq 'лат') { } elsif (substr ($text, 1) eq 'lat' || substr ($text, 1) eq 'лат') {
$reply = latAnswer (); $reply = Lat ();
} elsif ( } elsif (
(length ($text) >= 6 && (substr ($text, 1, 6) eq 'karma ' || substr ($text, 1, 6) eq 'карма ')) || (length ($text) >= 6 && (substr ($text, 1, 6) eq 'karma ' || substr ($text, 1, 6) eq 'карма ')) ||
substr ($text, 1) eq 'karma' || substr ($text, 1) eq 'карма' substr ($text, 1) eq 'karma' || substr ($text, 1) eq 'карма'
@@ -106,27 +107,27 @@ sub command {
$mytext = ''; $mytext = '';
} }
$reply = karmaGet ($chatid, $mytext); $reply = KarmaGet ($chatid, $mytext);
} elsif (substr ($text, 1) eq 'xkcd') { } elsif (substr ($text, 1) eq 'xkcd') {
$msg->typing (); $msg->typing ();
$reply = xkcd (); $reply = Xkcd ();
sleep (irand (2) + 1); sleep (irand (2) + 1);
$msg->replyMd ($reply); $msg->replyMd ($reply);
return; return;
} elsif (substr ($text, 1) eq 'fox' || substr ($text, 1) eq 'лис') { } elsif (substr ($text, 1) eq 'fox' || substr ($text, 1) eq 'лис') {
$msg->typing (); $msg->typing ();
$reply = fox (); $reply = Fox ();
sleep (irand (2) + 1); sleep (irand (2) + 1);
$msg->replyMd ($reply); $msg->replyMd ($reply);
return; return;
} elsif (substr ($text, 1) eq 'rabbit' || substr ($text, 1) eq 'bunny' || substr ($text, 1) eq 'кролик') { } elsif (substr ($text, 1) eq 'rabbit' || substr ($text, 1) eq 'bunny' || substr ($text, 1) eq 'кролик') {
$msg->typing (); $msg->typing ();
$reply = rabbit (); $reply = Rabbit ();
$msg->replyMd ($reply); $msg->replyMd ($reply);
return; return;
} elsif (substr ($text, 1) eq 'owl' || substr ($text, 1) eq 'сова') { } elsif (substr ($text, 1) eq 'owl' || substr ($text, 1) eq 'сова') {
$msg->typing (); $msg->typing ();
$reply = owl (); $reply = Owl ();
$msg->replyMd ($reply); $msg->replyMd ($reply);
return; return;
} elsif ( } elsif (
@@ -139,7 +140,7 @@ sub command {
) { ) {
if (pluginEnabled $chatid, 'oboobs') { if (pluginEnabled $chatid, 'oboobs') {
$msg->typing (); $msg->typing ();
$reply = oboobs (); $reply = Oboobs ();
sleep (irand (2) + 1); sleep (irand (2) + 1);
$msg->replyMd ($reply); $msg->replyMd ($reply);
} }
@@ -154,31 +155,31 @@ sub command {
) { ) {
if (pluginEnabled $chatid, 'obutts') { if (pluginEnabled $chatid, 'obutts') {
$msg->typing (); $msg->typing ();
$reply = obutts (); $reply = Obutts ();
sleep (irand (2) + 1); sleep (irand (2) + 1);
$msg->replyMd ($reply); $msg->replyMd ($reply);
} }
return; return;
} elsif (substr ($text, 1) eq 'friday' || substr ($text, 1) eq 'пятница') { } 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 'ф') { } 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); $msg->replyMd ($reply);
return; return;
} elsif (substr ($text, 1) eq 'drink' || substr ($text, 1) eq 'праздник') { } elsif (substr ($text, 1) eq 'drink' || substr ($text, 1) eq 'праздник') {
$msg->typing (); $msg->typing ();
$reply = drink (); $reply = Drink ();
sleep (irand (2) + 1); sleep (irand (2) + 1);
} elsif (substr ($text, 1) eq 'dig' || substr ($text, 1) eq 'копать') { } elsif (substr ($text, 1) eq 'dig' || substr ($text, 1) eq 'копать') {
$msg->typing (); $msg->typing ();
$reply = dig $highlight; $reply = Dig $highlight;
sleep (irand (2) + 1); sleep (irand (2) + 1);
$msg->replyMd ($reply); $msg->replyMd ($reply);
return; return;
} elsif (substr ($text, 1) eq 'fish' || substr ($text, 1) eq 'fishing' || substr ($text, 1) eq 'рыба' || substr ($text, 1) eq 'рыбка' || substr ($text, 1) eq 'рыбалка' ) { } 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 (); $msg->typing ();
$reply = fish $highlight; $reply = Fish $highlight;
sleep (irand (2) + 1); sleep (irand (2) + 1);
$msg->replyMd ($reply); $msg->replyMd ($reply);
return; return;
@@ -255,50 +256,50 @@ MYADMIN
my ($msgType, $toggle) = split /\s/, $args, 2; my ($msgType, $toggle) = split /\s/, $args, 2;
if (defined $toggle) { if (defined $toggle) {
foreach (@forbiddenMessageTypes) { foreach (@ForbiddenMessageTypes) {
if ($msgType eq $_) { if ($msgType eq $_) {
if ($toggle == 1) { if ($toggle == 1) {
addForbiddenType ($chatid, $msgType); AddForbiddenType ($chatid, $msgType);
$reply = "Теперь сообщения с $msgType будут автоматически удаляться"; $reply = "Теперь сообщения с $msgType будут автоматически удаляться";
} elsif ($toggle == 0) { } elsif ($toggle == 0) {
delForbiddenType ($chatid, $msgType); DelForbiddenType ($chatid, $msgType);
$reply = "Теперь сообщения с $msgType будут оставаться"; $reply = "Теперь сообщения с $msgType будут оставаться";
} }
} }
} }
} }
} else { } else {
$reply = listForbidden ($chatid); $reply = ListForbidden ($chatid);
} }
} elsif ($cmd eq 'fortune' || $cmd eq 'фортунка') { } elsif ($cmd eq 'fortune' || $cmd eq 'фортунка') {
if (defined $args) { if (defined $args) {
if ($args == 1) { if ($args == 1) {
$reply = fortune_toggle ($chatid, 1); $reply = FortuneToggle ($chatid, 1);
} elsif ($args == 0) { } elsif ($args == 0) {
$reply = fortune_toggle ($chatid, 0); $reply = FortuneToggle ($chatid, 0);
} }
} else { } else {
$reply = fortune_status ($chatid); $reply = FortuneStatus ($chatid);
} }
} elsif ($cmd eq 'oboobs') { } elsif ($cmd eq 'oboobs') {
if (defined $args) { if (defined $args) {
if ($args == 1) { if ($args == 1) {
$reply = plugin_toggle ($chatid, 'oboobs', 1); $reply = PluginToggle ($chatid, 'oboobs', 1);
} elsif ($args == 0) { } elsif ($args == 0) {
$reply = plugin_toggle ($chatid, 'oboobs', 0); $reply = PluginToggle ($chatid, 'oboobs', 0);
} }
} else { } else {
$reply = plugin_status ($chatid, 'oboobs'); $reply = PluginStatus ($chatid, 'oboobs');
} }
} elsif ($cmd eq 'obutts') { } elsif ($cmd eq 'obutts') {
if (defined $args) { if (defined $args) {
if ($args == 1) { if ($args == 1) {
$reply = plugin_toggle ($chatid, 'obutts', 1); $reply = PluginToggle ($chatid, 'obutts', 1);
} elsif ($args == 0) { } elsif ($args == 0) {
$reply = plugin_toggle ($chatid, 'obutts', 0); $reply = PluginToggle ($chatid, 'obutts', 0);
} }
} else { } else {
$reply = plugin_status ($chatid, 'obutts'); $reply = PluginStatus ($chatid, 'obutts');
} }
} }
} }
@@ -307,7 +308,7 @@ MYADMIN
return $reply; return $reply;
} }
sub highlight { sub Highlight {
my $msg = shift; my $msg = shift;
my $fullname; my $fullname;
@@ -349,7 +350,7 @@ sub highlight {
return ($userid, $username, $fullname, $highlight, $visavi); return ($userid, $username, $fullname, $highlight, $visavi);
} }
sub botsleep { sub BotSleep {
# TODO: Parametrise this with fuzzy sleep time in seconds # TODO: Parametrise this with fuzzy sleep time in seconds
my $msg = shift; my $msg = shift;
# let's emulate real human and delay answer # let's emulate real human and delay answer
@@ -365,10 +366,10 @@ sub botsleep {
return; return;
} }
sub isCensored { sub IsCensored {
my $msg = shift; my $msg = shift;
my $forbidden = getForbiddenTypes ($msg->chat->id); my $forbidden = GetForbiddenTypes ($msg->chat->id);
# voice messages are special # voice messages are special
if (defined ($msg->voice) && defined ($msg->voice->duration) && ($msg->voice->duration > 0)) { if (defined ($msg->voice) && defined ($msg->voice->duration) && ($msg->voice->duration > 0)) {

51
lib/admin.pm → lib/BotLib/Admin.pm
View File

@@ -1,4 +1,4 @@
package admin; package BotLib::Admin;
use 5.018; use 5.018;
use strict; use strict;
@@ -9,31 +9,25 @@ use English qw ( -no_match_vars );
use Carp qw (cluck croak); use Carp qw (cluck croak);
use CHI; use CHI;
use CHI::Driver::BerkeleyDB; use CHI::Driver::BerkeleyDB;
use conf qw (loadConf); use BotLib::Conf qw (LoadConf);
use util qw (utf2sha1); use BotLib::Util qw (utf2sha1);
use version; our $VERSION = qw (1.0); use version; our $VERSION = qw (1.0);
use Exporter qw (import); use Exporter qw (import);
# to export array we need @ISA here # to export array we need @ISA here
our @ISA = qw / Exporter /; ## no critic (ClassHierarchies::ProhibitExplicitISA) 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}; my $cachedir = $c->{cachedir};
# this list is not yet used # this list is not yet used
our @pluginList = qw (oboobs obutts); ## 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) 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; my $chatid = shift;
unless (-d $dir) {
unless (make_path $dir) {
cluck "Unable to create $dir: $OS_ERROR";
return;
}
}
my $messageTypes; my $messageTypes;
my $cache = CHI->new ( my $cache = CHI->new (
@@ -42,7 +36,7 @@ sub getForbiddenTypes {
namespace => __PACKAGE__ . '_' . 'censor' . '_' . utf2sha1 ($chatid) namespace => __PACKAGE__ . '_' . 'censor' . '_' . utf2sha1 ($chatid)
); );
foreach (@forbiddenMessageTypes) { foreach (@ForbiddenMessageTypes) {
my $type = $c->get ($_); my $type = $c->get ($_);
if ($type) { if ($type) {
@@ -60,7 +54,7 @@ sub getForbiddenTypes {
return $messageTypes; return $messageTypes;
} }
sub addForbiddenType { sub AddForbiddenType {
my $chatid = shift; my $chatid = shift;
my $type = shift; my $type = shift;
@@ -74,7 +68,7 @@ sub addForbiddenType {
return; return;
} }
sub delForbiddenType { sub DelForbiddenType {
my $chatid = shift; my $chatid = shift;
my $type = shift; my $type = shift;
@@ -88,7 +82,7 @@ sub delForbiddenType {
return; return;
} }
sub listForbidden { sub ListForbidden {
my $chatid = shift; my $chatid = shift;
my @list; my @list;
@@ -98,7 +92,7 @@ sub listForbidden {
namespace => __PACKAGE__ . '_' . 'censor' . '_' . utf2sha1 ($chatid) namespace => __PACKAGE__ . '_' . 'censor' . '_' . utf2sha1 ($chatid)
); );
foreach (@forbiddenMessageTypes) { foreach (@ForbiddenMessageTypes) {
my $type = $c->get ($_); my $type = $c->get ($_);
if ($type) { if ($type) {
@@ -116,7 +110,7 @@ sub listForbidden {
return join "\n", @list; return join "\n", @list;
} }
sub fortune_toggle (@) { sub FortuneToggle (@) {
my $chatid = shift; my $chatid = shift;
my $action = shift // undef; my $action = shift // undef;
my $phrase = 'Фортунка с утра '; my $phrase = 'Фортунка с утра ';
@@ -153,7 +147,7 @@ sub fortune_toggle (@) {
return $phrase; return $phrase;
} }
sub fortune_status ($) { sub FortuneStatus ($) {
my $chatid = shift; my $chatid = shift;
my $phrase = 'Фортунка с утра '; my $phrase = 'Фортунка с утра ';
@@ -174,18 +168,17 @@ sub fortune_status ($) {
return $phrase; return $phrase;
} }
sub fortune_toggle_list () { sub FortuneToggleList () {
my $cache = CHI->new ( my $cache = CHI->new (
driver => 'BerkeleyDB', driver => 'BerkeleyDB',
root_dir => $cachedir, root_dir => $cachedir,
namespace => __PACKAGE__ . '_' . 'fortune' namespace => __PACKAGE__ . '_' . 'fortune'
); );
my @list = $cache->get_keys(); return $cache->get_keys ();
return @list;
} }
sub plugin_status (@) { sub PluginStatus (@) {
my $chatid = shift; my $chatid = shift;
my $plugin = shift; my $plugin = shift;
my $phrase = "Плагин $plugin "; my $phrase = "Плагин $plugin ";
@@ -207,7 +200,7 @@ sub plugin_status (@) {
return $phrase; return $phrase;
} }
sub pluginEnabled (@) { sub PluginEnabled (@) {
my $chatid = shift; my $chatid = shift;
my $plugin = shift; my $plugin = shift;
@@ -226,7 +219,7 @@ sub pluginEnabled (@) {
} }
} }
sub plugin_toggle (@) { sub PluginToggle (@) {
my $chatid = shift; my $chatid = shift;
my $plugin = shift; my $plugin = shift;
my $action = shift // undef; my $action = shift // undef;

6
lib/archeologist.pm → lib/BotLib/Archeologist.pm
View File

@@ -1,4 +1,4 @@
package archeologist; package BotLib::Archeologist;
use 5.018; use 5.018;
use strict; use strict;
@@ -10,9 +10,9 @@ use Math::Random::Secure qw (irand);
use version; our $VERSION = qw (1.0); use version; our $VERSION = qw (1.0);
use Exporter qw (import); use Exporter qw (import);
our @EXPORT_OK = qw (dig); our @EXPORT_OK = qw (Dig);
sub dig { sub Dig {
my $name = shift; my $name = shift;
my @artifact = ( my @artifact = (

6
lib/buni.pm → lib/BotLib/Buni.pm
View File

@@ -1,4 +1,4 @@
package buni; package BotLib::Buni;
use 5.018; use 5.018;
use strict; use strict;
@@ -12,9 +12,9 @@ use Mojo::UserAgent;
use version; our $VERSION = qw (1.0); use version; our $VERSION = qw (1.0);
use Exporter qw (import); use Exporter qw (import);
our @EXPORT_OK = qw (buni); our @EXPORT_OK = qw (Buni);
sub buni { sub Buni {
my $r; my $r;
my $ret = 'Нету Buni'; my $ret = 'Нету Buni';

6
lib/conf.pm → lib/BotLib/Conf.pm
View File

@@ -1,4 +1,4 @@
package conf; package BotLib::Conf;
# loads config # loads config
use 5.018; use 5.018;
@@ -11,9 +11,9 @@ use JSON::XS;
use version; our $VERSION = qw (1.0); use version; our $VERSION = qw (1.0);
use Exporter qw (import); use Exporter qw (import);
our @EXPORT_OK = qw (loadConf); our @EXPORT_OK = qw (LoadConf);
sub loadConf { sub LoadConf {
my $c = 'data/config.json'; my $c = 'data/config.json';
open my $CH, '<', $c or die "[FATAL] No conf at $c: $OS_ERROR\n"; open my $CH, '<', $c or die "[FATAL] No conf at $c: $OS_ERROR\n";
my $len = (stat $c) [7]; my $len = (stat $c) [7];

10
lib/drink.pm → lib/BotLib/Drink.pm
View File

@@ -1,4 +1,4 @@
package drink; package BotLib::Drink;
use 5.018; use 5.018;
use strict; use strict;
@@ -15,17 +15,17 @@ use HTML::TokeParser;
use Mojo::Log; use Mojo::Log;
use Mojo::UserAgent::Cached; use Mojo::UserAgent::Cached;
use POSIX qw (strftime); use POSIX qw (strftime);
use conf qw (loadConf); use BotLib::Conf qw (LoadConf);
use version; our $VERSION = qw (1.0); use version; our $VERSION = qw (1.0);
use Exporter qw (import); 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 @MONTH = qw (yanvar fevral mart aprel may iyun iyul avgust sentyabr oktyabr noyabr dekabr);
my $c = loadConf (); my $c = LoadConf ();
my $cachedir = $c->{cachedir}; my $cachedir = $c->{cachedir};
sub drink { sub Drink {
my $r; my $r;
my $ret = 'Не знаю праздников - вджобываю весь день на шахтах, как проклятая.'; my $ret = 'Не знаю праздников - вджобываю весь день на шахтах, как проклятая.';
my ($dayNum, $monthNum) = (localtime ())[3, 4]; my ($dayNum, $monthNum) = (localtime ())[3, 4];

6
lib/fisher.pm → lib/BotLib/Fisher.pm
View File

@@ -1,4 +1,4 @@
package fisher; package BotLib::Fisher;
use 5.018; use 5.018;
use strict; use strict;
@@ -10,10 +10,10 @@ use Math::Random::Secure qw (irand);
use version; our $VERSION = qw (1.0); use version; our $VERSION = qw (1.0);
use Exporter qw (import); use Exporter qw (import);
our @EXPORT_OK = qw (fish); our @EXPORT_OK = qw (Fish);
sub fish { sub Fish {
my $name = shift; my $name = shift;
my @artifact = ( my @artifact = (

12
lib/fortune.pm → lib/BotLib/Fortune.pm
View File

@@ -1,4 +1,4 @@
package fortune; package BotLib::Fortune;
# Any fortune_mod sources are suitable. Text file with "\n%\n" sentence delimeter. # Any fortune_mod sources are suitable. Text file with "\n%\n" sentence delimeter.
use 5.018; use 5.018;
@@ -11,17 +11,17 @@ use Carp qw (cluck croak);
use File::Path qw (make_path); use File::Path qw (make_path);
use Math::Random::Secure qw (irand); use Math::Random::Secure qw (irand);
use SQLite_File; use SQLite_File;
use conf qw (loadConf); use BotLib::Conf qw (LoadConf);
use version; our $VERSION = qw (1.0); use version; our $VERSION = qw (1.0);
use Exporter qw (import); 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 $dir = $c->{fortune}->{dir};
my $srcdir = $c->{fortune}->{srcdir}; my $srcdir = $c->{fortune}->{srcdir};
sub seed () { sub Seed () {
unless (-d $dir) { unless (-d $dir) {
make_path ($dir) || croak "Unable to create $dir: $OS_ERROR"; make_path ($dir) || croak "Unable to create $dir: $OS_ERROR";
} }
@@ -65,7 +65,7 @@ sub seed () {
} }
# just return answer # just return answer
sub fortune () { sub Fortune () {
my $backingfile = sprintf '%s/fortune.sqlite', $dir; my $backingfile = sprintf '%s/fortune.sqlite', $dir;
tie my @array, 'SQLite_File', $backingfile || do { tie my @array, 'SQLite_File', $backingfile || do {

10
lib/friday.pm → lib/BotLib/Friday.pm
View File

@@ -1,4 +1,4 @@
package friday; package BotLib::Friday;
# for friday data stolen from https://raw.githubusercontent.com/isida/vi/master/data/friday.txt # for friday data stolen from https://raw.githubusercontent.com/isida/vi/master/data/friday.txt
use 5.018; use 5.018;
@@ -11,18 +11,18 @@ use Carp qw (cluck croak);
use File::Path qw (make_path); use File::Path qw (make_path);
use Math::Random::Secure qw (irand); use Math::Random::Secure qw (irand);
use SQLite_File; use SQLite_File;
use conf qw (loadConf); use BotLib::Conf qw (LoadConf);
use version; our $VERSION = qw (1.0); use version; our $VERSION = qw (1.0);
use Exporter qw (import); use Exporter qw (import);
our @EXPORT_OK = qw (seed friday); our @EXPORT_OK = qw (seed friday);
my $c = loadConf (); my $c = LoadConf ();
my $dir = $c->{friday}->{dir}; my $dir = $c->{friday}->{dir};
my $srcfile = $c->{friday}->{src}; my $srcfile = $c->{friday}->{src};
my @dow = qw (monday tuesday wednesday thursday friday saturday sunday); my @dow = qw (monday tuesday wednesday thursday friday saturday sunday);
sub seed () { sub Seed () {
unless (-d $dir) { unless (-d $dir) {
make_path ($dir) || croak "Unable to create $dir: $OS_ERROR"; make_path ($dir) || croak "Unable to create $dir: $OS_ERROR";
} }
@@ -75,7 +75,7 @@ sub seed () {
} }
# just return answer # just return answer
sub friday () { sub Friday () {
my $today = (localtime (time))[6] - 1; my $today = (localtime (time))[6] - 1;
my $backingfile = sprintf '%s/%s.sqlite', $dir, $dow[$today]; my $backingfile = sprintf '%s/%s.sqlite', $dir, $dow[$today];

22
lib/image.pm → lib/BotLib/Image.pm
View File

@@ -1,4 +1,4 @@
package image; package BotLib::Image;
use 5.018; use 5.018;
use strict; use strict;
@@ -7,21 +7,15 @@ use utf8;
use open qw (:std :utf8); use open qw (:std :utf8);
use English qw ( -no_match_vars ); use English qw ( -no_match_vars );
use Carp qw (cluck); use Carp qw (cluck);
use File::Path qw (make_path);
use Math::Random::Secure qw (irand); use Math::Random::Secure qw (irand);
use Mojo::UserAgent; use Mojo::UserAgent;
use SQLite_File; use BotLIb::Image::Flickr qw (FlickrByTags);
use conf qw (loadConf); use BotLib::Image::Imgur qw (Imgur);
use flickr qw (flickr_by_tags); use BotLib::Util qw (urlencode);
use imgur qw (imgur);
use util qw (urlencode);
use version; our $VERSION = qw (1.0); use version; our $VERSION = qw (1.0);
use Exporter qw (import); use Exporter qw (import);
our @EXPORT_OK = qw (kitty fox oboobs obutts rabbit owl); our @EXPORT_OK = qw (Kitty Fox Oboobs Obutts Rabbit Owl);
my $c = loadConf ();
my $dir = $c->{image}->{dir};
sub kitty { sub kitty {
my $r; 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', 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) # return just large thumbnail instead of real photo (that can be really huge)
$rabbit = sprintf '%sl%s', substr ($rabbit, 0, -4), substr ($rabbit, -4); $rabbit = sprintf '%sl%s', substr ($rabbit, 0, -4), substr ($rabbit, -4);
@@ -187,7 +181,7 @@ sub rabbit_imgur {
sub rabbit { sub rabbit {
# rabbit, but bunny # rabbit, but bunny
my $url = flickr_by_tags ('animal,bunny'); my $url = FlickrByTags ('animal,bunny');
if (defined $url) { if (defined $url) {
return sprintf '[(\_/)](%s)', $url; return sprintf '[(\_/)](%s)', $url;
@@ -197,7 +191,7 @@ sub rabbit {
} }
sub owl { sub owl {
my $url = flickr_by_tags ('bird,owl'); my $url = FlickrByTags ('bird,owl');
if (defined $url) { if (defined $url) {
return sprintf '[{ O v O }](%s)', $url; return sprintf '[{ O v O }](%s)', $url;

134
lib/flickr.pm → lib/BotLib/Image/Flickr.pm
View File

@@ -1,4 +1,4 @@
package flickr; package BotLib::Image::Flickr;
use 5.018; use 5.018;
use strict; use strict;
@@ -7,25 +7,25 @@ use utf8;
use open qw (:std :utf8); use open qw (:std :utf8);
use English qw ( -no_match_vars ); use English qw ( -no_match_vars );
use Carp qw (cluck); use Carp qw (cluck);
use CHI;
use CHI::Driver::BerkeleyDB;
use Digest::HMAC_SHA1 qw (hmac_sha1); use Digest::HMAC_SHA1 qw (hmac_sha1);
use File::Path qw (make_path);
use Math::Random::Secure qw (irand); use Math::Random::Secure qw (irand);
use MIME::Base64; use MIME::Base64;
use Mojo::UserAgent; use Mojo::UserAgent;
use SQLite_File;
use URI::Encode::XS qw (uri_encode); use URI::Encode::XS qw (uri_encode);
use conf qw (loadConf); use BotLib::Conf qw (LoadConf);
use util qw (urlencode); use BotLib::Util qw (urlencode);
use Data::Dumper; use Data::Dumper;
use version; our $VERSION = qw (1.0); use version; our $VERSION = qw (1.0);
use Exporter qw (import); 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 $c = LoadConf ();
my $dir = $c->{image}->{dir}; my $cachedir = $c->{cachedir};
my $flickr_consumer_key = $c->{image}->{flickr}->{consumer_key}; my $flickr_consumer_key = $c->{image}->{flickr}->{consumer_key};
my $flickr_consumer_secret = $c->{image}->{flickr}->{consumer_secret}; my $flickr_consumer_secret = $c->{image}->{flickr}->{consumer_secret};
@@ -459,88 +459,68 @@ sub flickrSearchByTags {
} }
} }
sub flickr_init { sub FlickrInit {
my $backingfile = sprintf '%s/secrets.sqlite', $dir; my $cache = CHI->new (
driver => 'BerkeleyDB',
unless (-d $dir) { root_dir => $cachedir,
make_path ($dir) or do { namespace => __PACKAGE__
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;
};
if (defined $flickr_verifier && $flickr_verifier) { if (defined $flickr_verifier && $flickr_verifier) {
my $flickr_request_token = $secret{flickr_request_token}; my $flickr_request_token = $cache->get ('flickr_request_token');
my $flickr_request_token_secret = $secret{flickr_request_token_secret}; my $flickr_request_token_secret = $cache->get ('flickr_request_token_secret');
unless (defined $flickr_request_token || defined $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 "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) say 'Please remove verifier settings from config.json and run this script again.'; ## no critic (InputOutput::RequireCheckedSyscalls)
untie %secret;
return 0; return 0;
} }
my %accessToken = flickrAccessToken ($flickr_request_token, $flickr_request_token_secret, $flickr_verifier); my %accessToken = flickrAccessToken ($flickr_request_token, $flickr_request_token_secret, $flickr_verifier);
if (defined ($accessToken{oauth_token}) && defined ($accessToken{oauth_token_secret})) { if (defined ($accessToken{oauth_token}) && defined ($accessToken{oauth_token_secret})) {
$secret{flickr_access_token} = $accessToken{oauth_token}; # TODO: check set
$secret{flickr_access_token_secret} = $accessToken{oauth_token_secret}; $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) 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},
$accessToken{oauth_token_secret}, $accessToken{oauth_token_secret},
$backingfile
); );
untie %secret;
return 1; return 1;
} }
} else { } else {
my %req = flickrRequestToken (); my %req = flickrRequestToken ();
if (defined ($req{oauth_token}) && defined ($req{oauth_token_secret}) && defined ($req{oauth_token})) { if (defined ($req{oauth_token}) && defined ($req{oauth_token_secret}) && defined ($req{oauth_token})) {
$secret{flickr_request_token} = $req{oauth_token}; # TODO: check set
$secret{flickr_request_token_secret} = $req{oauth_token_secret}; $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}); my $confirm_url = flickrAuthorization ($req{oauth_token});
if (defined $confirm_url) { 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 "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 '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) say 'Note that you should be logged off from flickr account.'; ## no critic (InputOutput::RequireCheckedSyscalls)
untie %secret;
return 1; return 1;
} }
} }
} }
untie %secret;
return 0; return 0;
} }
sub flickr_test_login { sub FlickrTestLogin {
my $text = shift; my $text = shift;
my $backingfile = sprintf '%s/secrets.sqlite', $dir; my $cache = CHI->new (
driver => 'BerkeleyDB',
root_dir => $cachedir,
namespace => __PACKAGE__
);
unless (-d $dir) { my $flickr_access_token = $cache->get ('flickr_access_token');
make_path ($dir) or do { my $flickr_access_token_secret = $cache->get ('flickr_access_token_secret');
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;
if (flickrTestLogin ($flickr_access_token, $flickr_access_token_secret)) { if (flickrTestLogin ($flickr_access_token, $flickr_access_token_secret)) {
return 1; return 1;
@@ -549,25 +529,17 @@ sub flickr_test_login {
} }
} }
sub flickr_by_tags { sub FlickrByTags {
my $text = shift; my $text = shift;
my $backingfile = sprintf '%s/secrets.sqlite', $dir;
unless (-d $dir) { my $cache = CHI->new (
make_path ($dir) or do { driver => 'BerkeleyDB',
say "Unable to create $dir: $OS_ERROR"; ## no critic (InputOutput::RequireCheckedSyscalls) root_dir => $cachedir,
return 0; namespace => __PACKAGE__
}; );
}
tie my %secret, 'SQLite_File', $backingfile || do { my $flickr_access_token = $cache->get ('flickr_access_token');
say "[ERROR] Unable to tie to $backingfile: $OS_ERROR"; ## no critic (InputOutput::RequireCheckedSyscalls) my $flickr_access_token_secret = $cache->get ('flickr_access_token_secret');
return 0;
};
my $flickr_access_token = $secret{flickr_access_token};
my $flickr_access_token_secret = $secret{flickr_access_token_secret};
untie %secret;
# NB: I honestly query random page (among number of pages) of results from api, but always got first page, # 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 # 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 $text = shift;
my $backingfile = sprintf '%s/secrets.sqlite', $dir;
unless (-d $dir) { my $cache = CHI->new (
make_path ($dir) or do { driver => 'BerkeleyDB',
say "Unable to create $dir: $OS_ERROR"; ## no critic (InputOutput::RequireCheckedSyscalls) root_dir => $cachedir,
return 0; namespace => __PACKAGE__
}; );
}
tie my %secret, 'SQLite_File', $backingfile || do { my $flickr_access_token = $cache->get ('flickr_access_token');
say "[ERROR] Unable to tie to $backingfile: $OS_ERROR"; ## no critic (InputOutput::RequireCheckedSyscalls) my $flickr_access_token_secret = $cache->get ('flickr_access_token_secret');
return 0;
};
my $flickr_access_token = $secret{flickr_access_token};
my $flickr_access_token_secret = $secret{flickr_access_token_secret};
untie %secret;
# NB: I honestly query random page (among number of pages) of results from api, but always got first page, # 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 # no matter what is shown in response' "page" parameter. Looks like bug in API. Try to little bit mitigate

75
lib/imgur.pm → lib/BotLib/Image/Imgur.pm
View File

@@ -1,4 +1,4 @@
package imgur; package Botlib::Image::Imgur;
use 5.018; use 5.018;
use strict; use strict;
@@ -7,56 +7,61 @@ use utf8;
use open qw (:std :utf8); use open qw (:std :utf8);
use English qw ( -no_match_vars ); use English qw ( -no_match_vars );
use Carp qw (cluck); use Carp qw (cluck);
use File::Path qw (make_path); use CHI;
use CHI::Driver::BerkeleyDB;
use Math::Random::Secure qw (irand); use Math::Random::Secure qw (irand);
use Mojo::UserAgent; use Mojo::UserAgent;
use SQLite_File;
use conf qw (loadConf); use BotLib::Conf qw (LoadConf);
use version; our $VERSION = qw (1.0); use version; our $VERSION = qw (1.0);
use Exporter qw (import); use Exporter qw (import);
our @EXPORT_OK = qw (imgur); our @EXPORT_OK = qw (Imgur);
my $c = loadConf (); 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};
sub imgur { sub Imgur {
my $tag = shift; my $tag = shift;
my $refresh_url = 'https://api.imgur.com/oauth2/token'; my $refresh_url = 'https://api.imgur.com/oauth2/token';
my $search_url = 'https://api.imgur.com/3/gallery/search/'; my $search_url = 'https://api.imgur.com/3/gallery/search/';
# load all tokens from api secrets db my $imgur_client_id = $c->{image}->{imgur}->{client_id} // do {
my $backingfile = sprintf '%s/secrets.sqlite', $dir; cluck "No client_id specified in config for imgur module";
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";
return undef; return undef;
}; };
my $imgur_client_secret = $c->{image}->{imgur}->{client_secret} // do {
# if there is no access_token in db - put there one from config cluck "No client_secret specified in config for imgur module";
if (defined $secret{imgur_access_token}) { return undef;
$imgur_access_token = $secret{imgur_access_token}; };
} else { my $imgur_access_token = $c->{image}->{imgur}->{access_token} // do {
$secret{imgur_access_token} = $imgur_access_token; 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 there is no refresh_token in db - put there one from config
if (defined $secret{imgur_refresh_token}) { unless (defined $imgur_refresh_token) {
$imgur_refresh_token = $secret{imgur_refresh_token}; $cache->set ('imgur_refresh_token', $c->{image}->{imgur}->{refresh_token}, 'never');
} else {
$secret{imgur_refresh_token} = $imgur_refresh_token;
} }
# query api # query api
@@ -97,8 +102,6 @@ sub imgur {
$r = $ua->get ($search_url . $tag => {Authorization => "Bearer $imgur_access_token"})->result; $r = $ua->get ($search_url . $tag => {Authorization => "Bearer $imgur_access_token"})->result;
} }
untie %secret;
if ($r->is_success) { if ($r->is_success) {
my $searchResult = eval { return $r->json; }; my $searchResult = eval { return $r->json; };
my @urls; my @urls;

12
lib/karma.pm → lib/BotLib/Karma.pm
View File

@@ -1,4 +1,4 @@
package karma; package BotLib::Karma;
use 5.018; use 5.018;
use strict; use strict;
@@ -9,18 +9,18 @@ use English qw ( -no_match_vars );
use Carp qw (cluck); use Carp qw (cluck);
use CHI; use CHI;
use CHI::Driver::BerkeleyDB; use CHI::Driver::BerkeleyDB;
use conf qw (loadConf); use BotLib::Conf qw (LoadConf);
use version; our $VERSION = qw (1.0); use version; our $VERSION = qw (1.0);
use Exporter qw (import); 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 $cachedir = $c->{cachedir};
my $max = 5; my $max = 5;
# swallow phrase and return answer # swallow phrase and return answer
sub karmaSet (@) { sub KarmaSet (@) {
my $chatid = shift; my $chatid = shift;
my $phrase = shift; my $phrase = shift;
my $action = shift; my $action = shift;
@@ -71,7 +71,7 @@ sub karmaSet (@) {
} }
# just return answer # just return answer
sub karmaGet (@) { sub KarmaGet (@) {
my $chatid = shift; my $chatid = shift;
my $phrase = shift; my $phrase = shift;

12
lib/lat.pm → lib/BotLib/Lat.pm
View File

@@ -1,4 +1,4 @@
package lat; package BotLib::Lat;
# famous latin phases taken from https://ru.wikipedia.org/wiki/Список_крылатых_латинских_выражений # famous latin phases taken from https://ru.wikipedia.org/wiki/Список_крылатых_латинских_выражений
use 5.018; use 5.018;
@@ -11,17 +11,17 @@ use Carp qw (cluck);
use File::Basename qw (dirname); use File::Basename qw (dirname);
use File::Path qw (make_path); use File::Path qw (make_path);
use Hailo; use Hailo;
use conf qw (loadConf); use BotLib::Conf qw (loadConf);
use version; our $VERSION = qw (1.0); use version; our $VERSION = qw (1.0);
use Exporter qw (import); 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 $brain = $c->{lat}->{brain};
my $srcfile = $c->{lat}->{src}; my $srcfile = $c->{lat}->{src};
sub train () { sub Train () {
my $braindir = dirname $brain; my $braindir = dirname $brain;
unless (-d $braindir) { unless (-d $braindir) {
@@ -45,7 +45,7 @@ sub train () {
} }
# just return answer # just return answer
sub latAnswer () { sub Lat () {
my $braindir = dirname $brain; my $braindir = dirname $brain;
unless (-d $braindir) { unless (-d $braindir) {

6
lib/monkeyuser.pm → lib/BotLib/Monkeyuser.pm
View File

@@ -1,4 +1,4 @@
package monkeyuser; package BotLib::Monkeyuser;
use 5.018; use 5.018;
use strict; use strict;
@@ -13,9 +13,9 @@ use Mojo::UserAgent;
use version; our $VERSION = qw (1.0); use version; our $VERSION = qw (1.0);
use Exporter qw (import); use Exporter qw (import);
our @EXPORT_OK = qw (monkeyuser); our @EXPORT_OK = qw (Monkeyuser);
sub monkeyuser { sub Monkeyuser {
my $r; my $r;
my $ret = 'Нету Monkey User-ов, они все спрятались.'; my $ret = 'Нету Monkey User-ов, они все спрятались.';
my @link; my @link;

3
lib/util.pm → lib/BotLib/Util.pm
View File

@@ -1,4 +1,4 @@
package util; package BotLib::Util;
use 5.018; use 5.018;
use strict; use strict;
@@ -77,7 +77,6 @@ sub utf2sha1 {
return sha1_base64 $bytes; return sha1_base64 $bytes;
} }
1; 1;
# vim: set ft=perl noet ai ts=4 sw=4 sts=4: # vim: set ft=perl noet ai ts=4 sw=4 sts=4:

11
lib/weather.pm → lib/BotLib/Weather.pm
View File

@@ -1,4 +1,4 @@
package weather; package BotLib::Weather;
use 5.018; use 5.018;
use strict; use strict;
@@ -9,19 +9,16 @@ use English qw ( -no_match_vars );
use Carp qw (carp cluck); use Carp qw (carp cluck);
use CHI; use CHI;
use CHI::Driver::BerkeleyDB; use CHI::Driver::BerkeleyDB;
use DB_File;
use Digest::MD5 qw (md5_base64);
use File::Path qw (make_path);
use Mojo::Log; use Mojo::Log;
use Mojo::UserAgent::Cached; use Mojo::UserAgent::Cached;
use conf qw (loadConf); use BotLib::Conf qw (LoadConf);
use util qw (trim urlencode); use BotLib::Util qw (trim urlencode);
use version; our $VERSION = qw (1.0); use version; our $VERSION = qw (1.0);
use Exporter qw (import); use Exporter qw (import);
our @EXPORT_OK = qw (weather); our @EXPORT_OK = qw (weather);
my $c = loadConf (); my $c = LoadConf ();
my $cachedir = $c->{cachedir}; my $cachedir = $c->{cachedir};
sub weather { sub weather {

6
lib/xkcd.pm → lib/BotLib/Xkcd.pm
View File

@@ -1,4 +1,4 @@
package xkcd; package BotLib::Xkcd;
use 5.018; use 5.018;
use strict; use strict;
@@ -9,9 +9,9 @@ use Mojo::UserAgent;
use version; our $VERSION = qw (1.0); use version; our $VERSION = qw (1.0);
use Exporter qw (import); 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 $ua = Mojo::UserAgent->new->connect_timeout (5)->max_redirects (0);
my $r = $ua->get ('https://xkcd.ru/random/')->result; my $r = $ua->get ('https://xkcd.ru/random/')->result;

52
lib/telegrambot.pm → lib/TelegramBot.pm
View File

@@ -1,4 +1,4 @@
package telegrambot; package TelegramBot;
# main bot gears are here # main bot gears are here
use 5.018; use 5.018;
@@ -13,18 +13,19 @@ use File::Path qw (make_path);
use Hailo; use Hailo;
use Math::Random::Secure qw (irand); use Math::Random::Secure qw (irand);
use Mojo::Base 'Teapot::Bot::Brain'; use Mojo::Base 'Teapot::Bot::Brain';
use admin qw (fortune_toggle_list);
use botlib qw (randomCommonPhrase command highlight botsleep isCensored); use BotLib::Admin qw (FortuneToggleList);
use conf qw (loadConf); use BotLib qw (RandomCommonPhrase Command Highlight BotSleep IsCensored);
use fortune qw (fortune); use BotLib::Conf qw (LoadConf);
use karma qw (karmaSet); use BotLib::Fortune qw (Fortune);
use util qw (trim fmatch); use BotLib::Karma qw (KarmaSet);
use BotLib::Util qw (trim fmatch);
use version; our $VERSION = qw (1.0); use version; our $VERSION = qw (1.0);
use Exporter qw (import); use Exporter qw (import);
our @EXPORT_OK = qw (run_telegrambot); our @EXPORT_OK = qw (RunTelegramBot);
my $c = loadConf (); my $c = LoadConf ();
my $hailo; my $hailo;
my $myid; my $myid;
my $myusername; my $myusername;
@@ -47,10 +48,10 @@ sub __cron {
my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime (time); my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime (time);
if ($hour == 8 && ($min >= 0 && $min <= 14)) { if ($hour == 8 && ($min >= 0 && $min <= 14)) {
foreach my $enabledfortunechat (fortune_toggle_list ()) { foreach my $enabledFortuneChat (FortuneToggleList ()) {
my $send_args; my $send_args;
$send_args->{text} = sprintf "%s\n```\n%s\n```\n", $intro[irand ($#intro + 1)], trim (fortune ()); $send_args->{text} = sprintf "%s\n```\n%s\n```\n", $intro[irand ($#intro + 1)], trim (Fortune ());
$send_args->{chat_id} = $enabledfortunechat; $send_args->{chat_id} = $enabledFortuneChat;
$send_args->{parse_mode} = 'Markdown'; $send_args->{parse_mode} = 'Markdown';
$self->sendMessage ($send_args); $self->sendMessage ($send_args);
} }
@@ -65,7 +66,7 @@ sub __on_msg {
my $chatid; my $chatid;
my $chatname = 'Noname chat'; my $chatname = 'Noname chat';
# user sending message info # 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}; my $csign = $c->{telegrambot}->{csign};
unless ($myid) { unless ($myid) {
@@ -142,18 +143,18 @@ sub __on_msg {
$phrase = sprintf 'Дратути, %s. Представьтес, пожалуйста, и расскажите, что вас сюда привело.', $members[0]; $phrase = sprintf 'Дратути, %s. Представьтес, пожалуйста, и расскажите, что вас сюда привело.', $members[0];
} }
botsleep $msg; BotSleep $msg;
$msg->replyMd ($phrase); $msg->replyMd ($phrase);
return; return;
} }
# lazy init chat-bot brains # lazy init chat-bot brains
unless (defined $hailo->{$chatid}) { 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 ( $hailo->{$chatid} = Hailo->new (
# we'll got file like this: data/telegrambot-brains/-1001332512695.brain.sqlite # we'll got file like this: data/telegrambot-brains/-1001332512695.brain.sqlite
brain => $brainname, brain => $brainName,
order => 3 order => 3
); );
@@ -167,6 +168,7 @@ sub __on_msg {
# is this a 1-on-1 ? # is this a 1-on-1 ?
if ($msg->chat->type eq 'private') { if ($msg->chat->type eq 'private') {
unless (defined $msg->text) { unless (defined $msg->text) {
# TODO: it can be sticker, image, voice, video, etc. Maybe, i'll handle it once? :)
return; return;
} }
@@ -175,7 +177,7 @@ sub __on_msg {
my $reply = 'Давайте ещё пообщаемся, а то я ещё не научилась от вас плохому.'; my $reply = 'Давайте ещё пообщаемся, а то я ещё не научилась от вас плохому.';
if (substr ($text, 0, 1) eq $csign) { if (substr ($text, 0, 1) eq $csign) {
$reply = command ($self, $msg, $text, $userid); $reply = Command ($self, $msg, $text, $userid);
} else { } else {
my $just_message_in_chat = 0; my $just_message_in_chat = 0;
@@ -184,7 +186,7 @@ sub __on_msg {
my @arr = split /\n/, $text; my @arr = split /\n/, $text;
if ($#arr < 1) { 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 { } else {
$just_message_in_chat = 1; $just_message_in_chat = 1;
} }
@@ -204,7 +206,7 @@ sub __on_msg {
$phrase = lc $phrase; $phrase = lc $phrase;
if (fmatch (lc ($reply), $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')) { } elsif (($msg->chat->type eq 'supergroup') or ($msg->chat->type eq 'group')) {
my $reply; 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; 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}}); $self->deleteMessage ({chat_id => $chatid, message_id => $msg->{message_id}});
} }
@@ -259,7 +261,7 @@ sub __on_msg {
} }
# simple commands # simple commands
} elsif (substr ($text, 0, 1) eq $csign) { } elsif (substr ($text, 0, 1) eq $csign) {
$reply = command ($self, $msg, $text, $chatid); $reply = Command ($self, $msg, $text, $chatid);
} elsif ( } elsif (
($text eq $myusername) or ($text eq $myusername) or
($text eq '@' . $myusername) or ($text eq '@' . $myusername) or
@@ -279,7 +281,7 @@ sub __on_msg {
# bot mention by name # bot mention by name
} elsif ((lc ($text) =~ /.+ ${qname}[\,|\!|\?|\.| ]/) or (lc ($text) =~ / $qname$/)) { } elsif ((lc ($text) =~ /.+ ${qname}[\,|\!|\?|\.| ]/) or (lc ($text) =~ / $qname$/)) {
$phrase = $text; $phrase = $text;
$reply = $hailo->{$msg->chat->id}->reply($phrase); $reply = $hailo->{$msg->chat->id}->reply ($phrase);
# bot mention by telegram name # bot mention by telegram name
} elsif ((lc ($text) =~ /.+ ${qtname}[\,|\!|\?|\.| ]/) or (lc ($text) =~ / $qtname$/)) { } elsif ((lc ($text) =~ /.+ ${qtname}[\,|\!|\?|\.| ]/) or (lc ($text) =~ / $qtname$/)) {
$phrase = $text; $phrase = $text;
@@ -289,7 +291,7 @@ sub __on_msg {
my @arr = split /\n/, $text; my @arr = split /\n/, $text;
if ($#arr < 1) { 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 { } else {
# just message in chat # just message in chat
$hailo->{$msg->chat->id}->learn ($text); $hailo->{$msg->chat->id}->learn ($text);
@@ -311,7 +313,7 @@ sub __on_msg {
$phrase = lc $phrase; $phrase = lc $phrase;
if (fmatch (lc ($reply), $phrase)) { if (fmatch (lc ($reply), $phrase)) {
$reply = randomCommonPhrase (); $reply = RandomCommonPhrase ();
} }
$msg->typing (); $msg->typing ();
@@ -347,7 +349,7 @@ sub init {
return; return;
} }
sub run_telegrambot { sub RunTelegramBot {
while (sleep 3) { while (sleep 3) {
eval { ## no critic (ErrorHandling::RequireCheckingReturnValueOfEval) eval { ## no critic (ErrorHandling::RequireCheckingReturnValueOfEval)
telegrambot->new->think; telegrambot->new->think;