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

Use perlcritic to lint the code, make it happy

Browse Source
This commit is contained in:
eleksir
2020-10-18 22:47:55 +03:00
parent 9abb221dac
commit 9c629a8dbc
8 changed files with 295 additions and 209 deletions
Download Patch File Download Diff File Expand all files Collapse all files

139
lib/botlib.pm
View File

@@ -1,10 +1,12 @@
package botlib;
# store here utility functions that are not protocol-specified
use 5.018;
use strict;
use warnings "all";
use warnings;
use utf8;
use open qw(:std :utf8);
use English qw( -no_match_vars );
use HTTP::Tiny;
use URI::URL;
@@ -17,18 +19,61 @@ use conf qw(loadConf);
use vars qw/$VERSION/;
use Exporter qw(import);
our @EXPORT = qw(weather logger trim randomCommonPhrase);
our @EXPORT_OK = qw(weather logger trim randomCommonPhrase);
$VERSION = "1.0";
$VERSION = '1.0';
my $c = loadConf();
sub weather ($) {
sub __urlencode {
my $str = shift;
my $urlobj = url $str;
$str = $urlobj->as_string;
$urlobj = undef; undef $urlobj;
return $str;
}
sub logger {
my $msg = shift;
if ($c->{debug_log}) {
my @date = localtime();
my @month = qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec);
my $t = sprintf ('%02s %02d %02d:%02d:%02d ', $month[$date[4]], $date[3], $date[2], $date[1], $date[0]);
my $mode = '>';
$mode = '>>' if (-f $c->{debug_log});
if (open my $LOG, $mode, $c->{debug_log}) {
print $LOG $t . $msg . "\n"; ## no critic (InputOutput::RequireCheckedSyscalls)
close $LOG; ## no critic (InputOutput::RequireCheckedSyscalls)
}
}
return;
}
sub trim {
my $str = shift;
while (substr ($str, 0, 1) =~ /^\s$/xms) {
$str = substr ($str, 1);
}
while (substr ($str, -1, 1) =~ /^\s$/xms) {
chop ($str);
}
return $str;
}
sub weather {
my $city = shift;
$city = trim ($city);
return "Мне нужно ИМЯ города." if ($city eq '');
return "Длинновато для названия города." if (length($city) > 80);
return 'Мне нужно ИМЯ города.' if ($city eq '');
return 'Длинновато для названия города.' if (length($city) > 80);
$city = ucfirst ($city);
my $w = __weather ($city);
@@ -36,7 +81,7 @@ sub weather ($) {
if ($w) {
if ($w->{temperature_min} == $w->{temperature_max}) {
$reply = sprintf ("Погода в городе %s, %s:\n%s, ветер %s %s м/c, температура %s°C, ощущается как %s°C, относительная влажность %s%%, давление %s мм.рт.ст",
$reply = sprintf ("Погода в городе %s, %s:\n%s, ветер %s %s м/c, температура %s°C, ощущается как %s°C, относительная влажность %s%%, давление %s мм.рт.с",
$w->{name},
$w->{country},
ucfirst ($w->{description}),
@@ -68,7 +113,7 @@ sub weather ($) {
return $reply;
}
sub __weather ($) {
sub __weather {
my $city = shift;
$city = __urlencode ($city);
my $id = md5_base64 ($city);
@@ -79,12 +124,12 @@ sub __weather ($) {
# attach to cache data
tie my %cachetime, 'DB_File', $c->{openweathermap}->{cachetime} or do {
warn "Something nasty happen when cachetime ties to its data: $!";
logger "Something nasty happen when cachetime ties to its data: $OS_ERROR";
return undef;
};
tie my %cachedata, 'DB_File', $c->{openweathermap}->{cachedata} or do {
warn "Something nasty happen when cachedata ties to its data: $!";
logger "Something nasty happen when cachedata ties to its data: $OS_ERROR";
return undef;
};
@@ -95,10 +140,10 @@ sub __weather ($) {
my $r;
# try 3 times and giveup
for (my $counter = 0; $counter < 3; $counter++) {
for (1..3) {
next if ($r->{success});
my $http = HTTP::Tiny->new (timeout => 3);
$r = $http->get (sprintf ("http://api.openweathermap.org/data/2.5/weather?q=%s&lang=ru&APPID=%s", $city, $appid));
$r = $http->get (sprintf ('http://api.openweathermap.org/data/2.5/weather?q=%s&lang=ru&APPID=%s', $city, $appid));
sleep 2;
}
@@ -106,8 +151,8 @@ sub __weather ($) {
if ($r->{success}) {
$fc = eval { decode_json ($r->{content}) };
if ($@) {
warn "[WARN] openweathermap returns corrupted json: $@";
if ($EVAL_ERROR) {
logger "[WARN] openweathermap returns corrupted json: $EVAL_ERROR";
untie %cachetime;
untie %cachedata;
return undef;
@@ -180,62 +225,22 @@ sub __weather ($) {
return $w;
}
sub __urlencode ($) {
my $str = shift;
my $urlobj = url $str;
$str = $urlobj->as_string;
$urlobj = undef; undef $urlobj;
return $str;
}
sub logger {
my $msg = shift;
if ($c->{debug_log}) {
my @date = localtime();
my @month = qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec);
my $t = sprintf ("%02s %02d %02d:%02d:%02d ", $month[$date[4]], $date[3], $date[2], $date[1], $date[0]);
my $mode = '>';
$mode = '>>' if (-f $c->{debug_log});
if (open (LOG, $mode, $c->{debug_log})) {
print LOG $t . $msg . "\n";
close LOG;
}
}
}
sub trim ($) {
my $str = shift;
while (substr ($str, 0, 1) =~ /^\s$/) {
$str = substr ($str, 1);
}
while (substr ($str, -1, 1) =~ /^\s$/) {
chop ($str);
}
return $str;
}
sub randomCommonPhrase () {
sub randomCommonPhrase {
my @myphrase = (
"Так, блядь...",
"*Закатывает рукава* И ради этого ты меня позвал?",
"Ну чего ты начинаешь, нормально же общались",
"Повтори свой вопрос, не поняла",
"Выйди и зайди нормально",
"Я подумаю",
"Даже не знаю что на это ответить",
"Ты упал такие вопросы девочке задавать?",
"Можно и так, но не уверена",
"А как ты думаешь?",
"А ви, таки, почему интересуетесь?"
'Так, блядь...',
'*Закатывает рукава* И ради этого ты меня позвал?',
'Ну чего ты начинаешь, нормально же общались',
'Повтори свой вопрос, не поняла',
'Выйди и зайди нормально',
'Я подумаю',
'Даже не знаю что на это ответить',
'Ты упал такие вопросы девочке задавать?',
'Можно и так, но не уверена',
'А как ты думаешь?',
'А ви, таки, почему интересуетесь?',
);
return ($myphrase[rand ($#myphrase -1)]);
return $myphrase[rand ($#myphrase -1)];
}
1;

54
lib/conf.pm
View File

@@ -1,69 +1,43 @@
package conf;
# loads config
use 5.018;
use strict;
use warnings "all";
use warnings;
use utf8;
use open qw(:std :utf8);
use English qw( -no_match_vars );
use vars qw/$VERSION/;
use Fcntl qw(O_WRONLY O_CREAT O_TRUNC);
use JSON::XS qw(decode_json encode_json);
use JSON::XS;
use Exporter qw(import);
our @EXPORT = qw(loadConf saveConf);
our @EXPORT_OK = qw(loadConf);
$VERSION = "1.0";
sub loadConf ();
sub saveConf ($);
$VERSION = '1.0';
sub loadConf () {
my $c = "data/config.json";
open (C, "<", $c) or die "[FATA] No conf at $c: $!\n";
sub loadConf {
my $c = 'data/config.json';
open my $CH, '<', $c or die "[FATA] No conf at $c: $OS_ERROR\n";
my $len = (stat ($c)) [7];
my $json;
my $readlen = read (C, $json, $len);
my $readlen = read $CH, $json, $len;
unless ($readlen) {
close C;
die "[FATA] Unable to read $c: $!\n";
close $CH; ## no critic (InputOutput::RequireCheckedSyscalls
die "[FATA] Unable to read $c: $OS_ERROR\n";
}
if ($readlen != $len) {
close C;
close $CH; ## no critic (InputOutput::RequireCheckedSyscalls
die "[FATA] File $c is $len bytes on disk, but we read only $readlen bytes\n";
}
close C;
close $CH; ## no critic (InputOutput::RequireCheckedSyscalls
my $j = JSON::XS->new->utf8->relaxed;
return $j->decode ($json);
}
sub saveConf($) {
my $c = shift;
my $file = "data/myapi.json";
my $j = JSON::XS->new->pretty->canonical->indent (1);
my $json = $j->encode ($c);
$j = undef; undef $j;
use bytes;
my $len = length ($json);
no bytes;
# TODO: make it transactional
sysopen (C, $file, O_WRONLY|O_CREAT|O_TRUNC) or die "[FATA] Unable to open $file: $!\n";
my $written = syswrite (C, $json, $len);
unless (defined ($written)) {
die "[FATA] Unable to write to $file: $!";
}
unless ($written != $len) {
die "[FATA] We wrote $written bytes to $file, bu buffer length id $len bytes\n";
}
close C;
}
1;
# vim: set ft=perl noet ai ts=4 sw=4 sts=4:

99
lib/telegrambot.pm
View File

@@ -1,8 +1,9 @@
package telegrambot;
# main bot gears are here
use 5.018;
use strict;
use warnings "all";
use warnings;
use vars qw/$VERSION/;
use utf8;
use Data::Dumper;
@@ -12,14 +13,14 @@ use Hailo;
use Encode;
use Mojo::Base 'Telegram::Bot::Brain';
use conf;
use botlib;
use telegramlib;
use conf qw(loadConf);
use botlib qw(weather logger trim randomCommonPhrase);
use telegramlib qw(getChat getChatMember sendChatAction visavi);
use Exporter qw(import);
our @EXPORT = qw(run_telegrambot);
our @EXPORT_OK = qw(run_telegrambot);
$VERSION = "1.0";
$VERSION = '1.0';
my $c = loadConf();
my $hailo;
@@ -33,7 +34,8 @@ my $can_talk = 0;
has token => $c->{telegrambot}->{token};
sub __cron {
# i promise, i'll make use of this sub
sub __cron { ## no critic (Subroutines::ProhibitUnusedPrivateSubroutines)
my $self = shift;
# noop
return;
@@ -116,7 +118,7 @@ sub __on_msg {
$can_talk = 1;
}
} else {
logger "Unable to get chatid";
logger 'Unable to get chatid';
}
# according api user must have username and/or first_name and/or last_name at least one of these fields
@@ -161,10 +163,10 @@ sub __on_msg {
# let's emulate real human and delay answer
sleep (int ( rand (3) + 1));
for (my $i = 0; $i <= (4 + int (rand (3))); $i++) {
for (0..(4 + int (rand (3)))) {
sendChatAction($chatid);
sleep(3);
sleep 3 unless ($i);
sleep 3 unless ($_);
}
sleep ( 3 + int ( rand (2)));
@@ -175,7 +177,7 @@ sub __on_msg {
# 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
@@ -196,21 +198,21 @@ sub __on_msg {
return unless ($msg->can ('text') && defined ($msg->text));
my $text = $msg->text;
logger sprintf ("Private chat %s say to bot: %s", $vis_a_vi, $text);
logger sprintf ('Private chat %s say to bot: %s', $vis_a_vi, $text);
my $csign = quotemeta ($c->{telegrambot}->{csign});
my $reply = "Давайте ещё пообщаемся, а то я ещё не научилась от вас плохому.";
my $reply = 'Давайте ещё пообщаемся, а то я ещё не научилась от вас плохому.';
# TODO: Process commands in separate sub, they are same for public and private chats.
if (substr ($text, 0, 1) eq $c->{telegrambot}->{csign}) {
if (substr ($text, 1) eq "ping") {
$reply = "Pong.";
} elsif (substr ($text, 1) eq "пинг") {
$reply = "Понг.";
if (substr ($text, 1) eq 'ping') {
$reply = 'Pong.';
} elsif (substr ($text, 1) eq 'пинг') {
$reply = 'Понг.';
} elsif (substr ($text, 1, 2) eq 'w ' || substr ($text, 1, 2) eq 'п ') {
my $city = substr ($text, 2);
$reply = weather ($city);
} else {
$reply = "Чего?";
$reply = 'Чего?';
}
} else {
my $str = $hailo->{$msg->chat->id}->learn_reply ($text);
@@ -245,7 +247,7 @@ sub __on_msg {
# detect and log messages without text, noop here
unless (defined ($msg->text)) {
logger sprintf("No text in message from %s", $vis_a_vi);
logger sprintf('No text in message from %s', $vis_a_vi);
if ($msg->can ('document') && defined ($msg->document)) {
if (defined ($msg->document->{'file_name'})) {
@@ -253,19 +255,19 @@ sub __on_msg {
$docsize = $msg->document->{'file_size'} if (defined ($msg->document->{'file_size'}));
my $type = 'unknown';
$type = $msg->document->{'mime_type'} if (defined ($msg->document->{'mime_type'}));
logger sprintf ("In public chat %s (%s) %s send document type %s named %s, size %s bytes", $chatname, $chatid, $vis_a_vi, $type, $msg->document->{'file_name'}, $docsize);
logger sprintf ('In public chat %s (%s) %s send document type %s named %s, size %s bytes', $chatname, $chatid, $vis_a_vi, $type, $msg->document->{'file_name'}, $docsize);
} else {
logger sprintf ("In public chat %s (%s) %s send unknown document", $chatname, $chatid, $vis_a_vi);
logger sprintf ('In public chat %s (%s) %s send unknown document', $chatname, $chatid, $vis_a_vi);
}
} elsif ($msg->can ('sticker') && defined ($msg->sticker)) {
my $set_name = 'unknown';
$set_name = $msg->sticker->set_name if ($msg->sticker->can ('set_name') && defined ($msg->sticker->set_name));
my $emoji = 'unknown';
$emoji = $msg->sticker->emoji if ($msg->sticker->can ('emoji') && defined ($msg->sticker->emoji));
logger sprintf ("In public chat %s (%s) %s reacted with sticker %s from pack %s", $chatname, $chatid, $vis_a_vi, $emoji, $set_name);
logger sprintf ('In public chat %s (%s) %s reacted with sticker %s from pack %s', $chatname, $chatid, $vis_a_vi, $emoji, $set_name);
} elsif ($msg->can ('photo') && defined ($msg->photo)) {
# actually it is an array! duh, hate arrays!
logger sprintf ("In public chat %s (%s) %s send photo", $chatname, $chatid, $vis_a_vi);
logger sprintf ('In public chat %s (%s) %s send photo', $chatname, $chatid, $vis_a_vi);
} else {
logger Dumper ($msg);
}
@@ -275,7 +277,7 @@ sub __on_msg {
# we have text here! so potentially we can chit-chat
my $text = $msg->text;
logger sprintf ("In public chat %s (%s) %s say: %s", $chatname, $chatid, $vis_a_vi, $text);
logger sprintf ('In public chat %s (%s) %s say: %s', $chatname, $chatid, $vis_a_vi, $text);
my $qname = quotemeta ($c->{telegrambot}->{name});
my $qtname = quotemeta ($c->{telegrambot}->{tname});
my $csign = quotemeta ($c->{telegrambot}->{csign});
@@ -285,7 +287,7 @@ sub __on_msg {
defined ($msg->reply_to_message->from) &&
defined ($msg->reply_to_message->from->username) &&
($msg->reply_to_message->from->username eq $myusername)) {
logger sprintf ("In public chat %s (%s) %s quote us!", $chatname, $chatid, $vis_a_vi);
logger sprintf ('In public chat %s (%s) %s quote us!', $chatname, $chatid, $vis_a_vi);
# remove our name from users reply, just in case
my $pat1 = quotemeta ('@' . $myusername);
my $pat2 = quotemeta ($myfullname);
@@ -299,40 +301,44 @@ sub __on_msg {
# TODO: Process commands in separate sub, they are same for public and private chats.
# TODO: Log commands and answers
} elsif (substr ($text, 0, 1) eq $c->{telegrambot}->{csign}) {
if (substr ($text, 1) eq "help") {
return unless ($can_talk);
if (substr ($text, 1) eq 'help') {
unless ($can_talk) {
return ;
}
my $send_args;
$send_args->{text} = '```
$send_args->{text} = << 'MYHELP';
```
!help | !помощь - список команд
!w город | !п город - погода в указанном городе
!ping | !пинг - попинговать бота
```
Но на самом деле я бот больше для общения, чем для исполнения команд.
Поговоришь со мной?
';
MYHELP
$send_args->{parse_mode} = 'Markdown';
$send_args->{chat_id} = $chatid;
Telegram::Bot::Brain::sendMessage ($self, $send_args);
return;
} elsif (substr ($text, 1) eq "ping") {
$reply = "Pong.";
} elsif (substr ($text, 1) eq "пинг") {
$reply = "Понг.";
} elsif (substr ($text, 1) eq "pong") {
$reply = "Wat?";
} elsif (substr ($text, 1) eq "понг") {
$reply = "Шта?";
} elsif (substr ($text, 1) eq 'ping') {
$reply = 'Pong.';
} elsif (substr ($text, 1) eq 'пинг') {
$reply = 'Понг.';
} elsif (substr ($text, 1) eq 'pong') {
$reply = 'Wat?';
} elsif (substr ($text, 1) eq 'понг') {
$reply = 'Шта?';
} elsif (substr ($text, 1, 2) eq 'w ' || substr ($text, 1, 2) eq 'п ') {
my $city = substr ($text, 3);
$reply = weather ($city);
}
} elsif (
($text eq $qname) or
($text eq sprintf ("%s", $qtname)) or
($text eq sprintf ('%s', $qtname)) or
($text eq sprintf ("@%s_bot", $qname)) or # :(
($text eq sprintf ("%s ", $qtname))
($text eq sprintf ('%s ', $qtname))
) {
$reply = "Чего?";
$reply = 'Чего?';
} else {
# phrase directed to bot
if ((lc ($text) =~ /^${qname}[\,|\:]? (.+)/) or (lc ($text) =~ /^${qtname}[\,|\:]? (.+)/)){
@@ -372,13 +378,13 @@ sub __on_msg {
}
sleep (int (rand (2)));
logger sprintf ("In public chat %s (%s) bot reply to %s: %s", $chatname, $chatid, $vis_a_vi, $reply);
logger sprintf ('In public chat %s (%s) bot reply to %s: %s', $chatname, $chatid, $vis_a_vi, $reply);
$msg->reply ($reply);
} else {
if ($can_talk) {
logger sprintf ("In public chat %s (%s) bot is not required to reply to %s", $chatname, $chatid, $vis_a_vi);
logger sprintf ('In public chat %s (%s) bot is not required to reply to %s', $chatname, $chatid, $vis_a_vi);
} else {
logger sprintf ("In public chat %s (%s) bot can't talk, but reply to %s is: %s", $chatname, $chatid, $vis_a_vi, $reply);
logger sprintf ('In public chat %s (%s) bot can\'t talk, but reply to %s is: %s', $chatname, $chatid, $vis_a_vi, $reply);
}
}
@@ -393,20 +399,23 @@ sub __on_msg {
# setup our bot
sub init {
unless (-d $c->{telegrambot}->{braindir}) {
mkpath ($c->{telegrambot}->{braindir}, 0, 0755);
mkpath ($c->{telegrambot}->{braindir}, 0, 0755); ## no critic (ValuesAndExpressions::ProhibitLeadingZeros)
}
my $self = shift;
$self->add_listener (\&__on_msg);
# $self->add_repeating_task(900, \&__cron);
return;
}
sub run_telegrambot {
while (sleep 3) {
eval {
eval { ## no critic (ErrorHandling::RequireCheckingReturnValueOfEval)
telegrambot->new->think;
}
}
return;
}
1;

14
lib/telegramlib.pm
View File

@@ -3,7 +3,7 @@ package telegramlib;
use 5.018;
use strict;
use warnings "all";
use warnings;
use utf8;
use open qw(:std :utf8);
@@ -13,9 +13,9 @@ use Telegram::Bot::Brain;
# module shit
use vars qw/$VERSION/;
use Exporter qw(import);
our @EXPORT = qw(getChat getChatMember sendChatAction visavi);
our @EXPORT_OK = qw(getChat getChatMember sendChatAction visavi);
$VERSION = "1.0";
$VERSION = '1.0';
# complete framework with our getChat()
sub getChat {
@@ -60,7 +60,7 @@ sub sendChatAction {
my $chatid = shift;
my $send_args = {};
$send_args->{chat_id} = $chatid;
$send_args->{action} = "typing";
$send_args->{action} = 'typing';
my $token = $self->token;
my $url = "https://api.telegram.org/bot${token}/sendChatAction";
my $api_response = $self->_post_request ($url, $send_args);
@@ -69,7 +69,7 @@ sub sendChatAction {
return;
}
sub visavi (@) {
sub visavi {
my ($userid, $username, $fullname) = @_;
my $name = '';
@@ -83,3 +83,7 @@ sub visavi (@) {
$name .= " ($userid)";
return $name;
}
1;
# vim: ft=perl noet ai ts=4 sw=4 sts=4: