diff --git a/.percriticrc b/.percriticrc new file mode 100644 index 0000000..3eca9f0 --- /dev/null +++ b/.percriticrc @@ -0,0 +1,80 @@ +#!/usr/bin/env perlcritic +severity = 5 +verbose = 8 + +# minorify some of warnings that are not really critical +[-InputOutput::RequireCheckedClose] +# what can we handle in case of error? + +[-Modules::ProhibitExcessMainComplexity] +# noone cares + +[-Subroutines::ProhibitExcessComplexity] +# noone cares + +[-Subroutines::ProhibitExplicitReturnUndef] +# but it's very handy sometimes! + +[-ValuesAndExpressions::ProhibitMagicNumbers] +# this policy makes too much false positives + +[-RegularExpressions::RequireLineBoundaryMatching] +# we use /m as needed + +[-RegularExpressions::RequireExtendedFormatting] +# we do not use extended formatting of regex, they still not THAT complex + +[-RegularExpressions::RequireDotMatchAnything] +# huh? + +[-RegularExpressions::ProhibitEscapedMetacharacters] +# looks like it pointless + +[-ControlStructures::ProhibitCascadingIfElse] +# I like long ifelse chains + +[-ControlStructures::ProhibitPostfixControls] +# in short lines we can afford ourselves to use postfix controls +# but ofcorse we shoul avoid such constructions in long lines + +[-Subroutines::ProhibitSubroutinePrototypes] +# Contrary to Perl::Critic we consider prototypes as useful, even if +# the compile-time checks of Perl are not perfect, Perl may give some +# hints. + +[-CodeLayout::RequireTidyCode] +# impossible to complete, because of on higher linting levels ## no critic +# require be per-case on same line where critique is, but tidy align them +# one line down + +[-CodeLayout::ProhibitParensWithBuiltins] +# duh... + +[-ValuesAndExpressions::ProhibitEmptyQuotes] +# cause we consider following correct and useful: my $var = ''; +# the recomended use of q{} looks too complex: my $var = q{}; + +[-ValuesAndExpressions::ProhibitNoisyQuotes] +# other people, other opinions: "," is better readable than qw(,) + +[-BuiltinFunctions::ProhibitSleepViaSelect] +# We do not wish to use too much external modules. +# select undef, undef, undef, 0.25; # actually is okay if you add comment that +# it is sleep for 0.25 seconds + +[-NamingConventions::Capitalization] +# duh... +# Noone care, really + +[-ControlStructures::ProhibitUnlessBlocks] +# they should not be too complex - only one condition should be checked, +# that's all + +[-Miscellanea::ProhibitTies] +# Just allow it. It's very handy stuff and extremely simple and safe enugh to use. + +[-ValuesAndExpressions::RequireNumberSeparators] +# not really + +[-InputOutput::RequireBracedFileHandleWithPrint] +# we prefer not to use braced file handles diff --git a/bin/aleesa-telegram-bot b/bin/aleesa-telegram-bot index be3e6e2..6f4da51 100755 --- a/bin/aleesa-telegram-bot +++ b/bin/aleesa-telegram-bot @@ -2,19 +2,22 @@ use 5.018; use strict; -use warnings "all"; +use warnings; use utf8; use open qw(:std :utf8); +use English qw( -no_match_vars ); + +use version; our $VERSION = qw(1.0); my $workdir; # before we run, change working dir BEGIN { use Cwd qw(chdir abs_path); - my @CWD = split (/\//, abs_path ($0)); + my @CWD = split /\//xms, abs_path ($PROGRAM_NAME); if ($#CWD > 1) { $#CWD = $#CWD - 2; } - $workdir = join ('/', @CWD); - chdir ($workdir); + $workdir = join '/', @CWD; + chdir $workdir; } use lib ("$workdir/lib", "$workdir/vendor_perl", "$workdir/vendor_perl/lib/perl5"); @@ -27,20 +30,24 @@ use conf qw(loadConf); use botlib qw(logger); use telegrambot qw(run_telegrambot); -sub daemonize (); -sub __fork (); +sub daemonize; +sub __fork; -$| = 1; -my $runAsUid = $<; +local $OUTPUT_AUTOFLUSH = 1; +my $runAsUid = $UID; -my $piddir = "/var/run/" . basename (abs_path ($0)); +my $piddir = '/var/run/' . basename (abs_path ($PROGRAM_NAME)); my $C = loadConf (); # if we run under root, create pid dir and set correct owner for it, same for debug log if it is defined -if ($< == 0) { +if ($UID == 0) { my $user = $C->{user}; - die "Unable to run as root, please define unprivileged user in config.json\n" unless (defined ($user)); - my ($uid, $gid) = (getpwnam ($user))[2,3]; + + unless (defined $user) { + die "Unable to run as root, please define unprivileged user in config.json\n"; + } + + my ($uid, $gid) = (getpwnam $user)[2,3]; unless (-d $piddir) { make_path ( @@ -52,9 +59,9 @@ if ($< == 0) { } if ($C->{'debug_log'}) { - unless (-d dirname($C->{'debug_log'})) { + unless (-d dirname ($C->{'debug_log'})) { make_path ( - dirname($C->{'debug_log'}), { + dirname ($C->{'debug_log'}), { uid => $uid, group => $gid } @@ -63,8 +70,8 @@ if ($< == 0) { } # drop privs - setgid ($gid) or die "Unable to switch to group of $user($!)\n"; - setuid ($uid) or die "Unable to switch to account $user($!)\n"; + setgid ($gid) or die "Unable to switch to group of $user($OS_ERROR)\n"; + setuid ($uid) or die "Unable to switch to account $user($OS_ERROR)\n"; } else { $piddir = $workdir; } @@ -73,42 +80,48 @@ if ($< == 0) { daemonize (); # write pidfile -my $apath = abs_path ($0); +my $apath = abs_path $PROGRAM_NAME; -unless (defined($apath)) { - logger ("Unable to get abs_path: $!"); - die "Unable to get abs_path: $!\n"; +unless (defined $apath) { + logger "Unable to get abs_path: $OS_ERROR"; + die "Unable to get abs_path: $OS_ERROR\n"; }; # write pidfile -my $pidfile = sprintf ("%s/%s.pid", $piddir, basename ($apath)); -logger ("Creating pidfile at $pidfile"); -open (PID, ">", $pidfile) or die "Error opening $pidfile: $!\n"; -print PID $$ or die "Error writing to $pidfile: $!\n"; -close PID; +my $pidfile = sprintf '%s/%s.pid', $piddir, basename $apath; +logger "Creating pidfile at $pidfile"; +open my $MYPID, '>', $pidfile or die "Error opening $pidfile: $OS_ERROR\n"; +print {$MYPID} $PID or die "Error writing to $pidfile: $OS_ERROR\n"; +close $MYPID; ## no critic (InputOutput::RequireCheckedSyscalls # set correct proctitle -$0 = abs_path ($0); +$PROGRAM_NAME = abs_path $PROGRAM_NAME; ## no critic (Variables::RequireLocalizedPunctuationVars) # run bot, at last run_telegrambot (); -unlink ($pidfile) if (-f $pidfile); -exit 0; -sub daemonize () { - __fork (); - POSIX::setsid (); - open (STDIN, "<", "/dev/null"); - open (STDOUT, ">", "/dev/null"); - open (STDERR, ">", "/dev/null"); - __fork (); - umask 0; +if (-f $pidfile) { + unlink $pidfile; } -sub __fork () { +exit 0; + +sub daemonize { + __fork (); + POSIX::setsid (); + open STDIN, '<', '/dev/null'; ## no critic (InputOutput::RequireCheckedSyscalls, InputOutput::RequireCheckedOpen) + open STDOUT, '>', '/dev/null'; ## no critic (InputOutput::RequireCheckedSyscalls, InputOutput::RequireCheckedOpen) + open STDERR, '>', '/dev/null'; ## no critic (InputOutput::RequireCheckedSyscalls, InputOutput::RequireCheckedOpen) + __fork (); + umask 0; + return; +} + +sub __fork { my $pid = fork; - die "Can't fork: $!\n" unless (defined ($pid)); + unless (defined $pid) { die "Can't fork: $OS_ERROR\n"; } exit if ($pid != 0); + return; } __END__ diff --git a/bootstrap.sh b/bootstrap.sh index 697f373..fe78a4f 100644 --- a/bootstrap.sh +++ b/bootstrap.sh @@ -2,4 +2,4 @@ cpanm -l vendor_perl --self-contained --force --update --installdeps . -# vim: set ft=perl noet ai ts=4 sw=4 sts=4: +# vim: set ft=sh noet ai ts=4 sw=4 sts=4: diff --git a/confcheck.pl b/confcheck.pl index 6eba9a2..34bfdfd 100755 --- a/confcheck.pl +++ b/confcheck.pl @@ -2,34 +2,35 @@ use 5.018; use strict; -use warnings "all"; +use warnings; use utf8; use open qw(:std :utf8); - -use lib ("./lib", "./vendor_perl", "./vendor_perl/lib/perl5"); - +use English qw( -no_match_vars ); +use lib qw(./lib ./vendor_perl ./vendor_perl/lib/perl5); use JSON::PP; -my $c = "data/config.json"; -open (C, "<", $c) or die "No conf at $c: $!\n"; +use version; our $VERSION = qv(1.0); + +my $c = 'data/config.json'; +open (my $C, '<', $c) or die "No conf at $c: $OS_ERROR\n"; ## no critic (InputOutput::RequireBriefOpen) my $len = (stat ($c)) [7]; my $json; -my $readlen = read (C, $json, $len); +my $readlen = read ($C, $json, $len); unless ($readlen) { - close C; - die "Unable to read $c: $!\n"; + close C; ## no critic (InputOutput::RequireCheckedSyscalls) + die "Unable to read $c: $OS_ERROR\n"; } if ($readlen != $len) { - close C; + close C; ## no critic (InputOutput::RequireCheckedSyscalls) die "File $c is $len bytes on disk, but we read only $readlen bytes\n"; } -close C; +close C; ## no critic (InputOutput::RequireCheckedSyscalls) $c = decode_json ($json); -my $j = JSON::PP->new->pretty->canonical->indent_length (4); -print $j->encode ($c); +my $j = JSON::PP->new->pretty->canonical->indent_length (4); ## no critic (ValuesAndExpressions::ProhibitLongChainsOfMethodCalls) +print $j->encode ($c); ## no critic (InputOutput::RequireCheckedSyscalls) # vim: set ft=perl noet ai ts=4 sw=4 sts=4: diff --git a/lib/botlib.pm b/lib/botlib.pm index f555dfe..0d32824 100644 --- a/lib/botlib.pm +++ b/lib/botlib.pm @@ -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; diff --git a/lib/conf.pm b/lib/conf.pm index 6bb87e3..0460fdf 100644 --- a/lib/conf.pm +++ b/lib/conf.pm @@ -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: diff --git a/lib/telegrambot.pm b/lib/telegrambot.pm index ce48785..79992ce 100644 --- a/lib/telegrambot.pm +++ b/lib/telegrambot.pm @@ -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; diff --git a/lib/telegramlib.pm b/lib/telegramlib.pm index e1cc501..5279304 100644 --- a/lib/telegramlib.pm +++ b/lib/telegramlib.pm @@ -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: