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

Implement logging via Log::Any, cleanup, remove logger()

Browse Source
This commit is contained in:
eleksir
2020-12-13 15:51:24 +03:00
parent a9193faf12
commit e861f5420b
13 changed files with 146 additions and 173 deletions
Download Patch File Download Diff File Expand all files Collapse all files

54
bin/aleesa-telegram-bot
View File

@@ -26,18 +26,23 @@ use Cwd::utf8 qw(chdir abs_path);
use POSIX qw(setgid setuid setsid);
use File::Path qw(make_path);
use File::Basename qw(basename dirname);
use Log::Any::Adapter;
use Log::Any::For::Std;
use conf qw(loadConf);
use botlib qw(logger);
use telegrambot qw(run_telegrambot);
sub daemonize;
sub __fork;
sub __signal_handler;
local $OUTPUT_AUTOFLUSH = 1;
my $runAsUid = $UID;
my $piddir = '/var/run/' . basename (abs_path ($PROGRAM_NAME));
my $C = loadConf ();
my $logfile;
if (defined $C->{'log'}) { $logfile = $C->{'log'}; }
elsif (defined $C->{'debug_log'}) {$logfile = $C->{'debug_log'}; }
# if we run under root, create pid dir and set correct owner for it, same for debug log if it is defined
if ($UID == 0) {
@@ -58,15 +63,19 @@ if ($UID == 0) {
);
}
if ($C->{'debug_log'}) {
unless (-d dirname ($C->{'debug_log'})) {
if (defined $logfile) {
my $logdir = dirname ($logfile);
unless (-d $logdir) {
make_path (
dirname ($C->{'debug_log'}), {
uid => $uid,
group => $gid
}
$logdir, {
uid => $uid,
group => $gid
}
);
}
die "Unable to create $logdir" unless (-d $logdir); ## no critic (ErrorHandling::RequireCarping)
}
# drop privs
@@ -76,6 +85,12 @@ if ($UID == 0) {
$piddir = $workdir;
}
if (defined $logfile) {
Log::Any::Adapter->set ('File', $logfile);
} else {
Log::Any::Adapter->set ('File', '/dev/null');
}
# double fork attach to /dev/null all stdio and go background
daemonize ();
@@ -83,17 +98,19 @@ daemonize ();
my $apath = abs_path $PROGRAM_NAME;
unless (defined $apath) {
logger "Unable to get abs_path: $OS_ERROR";
die "Unable to get abs_path: $OS_ERROR\n";
die "[FATAL] 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 my $MYPID, '>', $pidfile or die "Error opening $pidfile: $OS_ERROR\n";
print {$MYPID} $PID or die "Error writing to $pidfile: $OS_ERROR\n";
warn "[INFO] Creating pidfile at $pidfile\n";
open my $MYPID, '>', $pidfile or die "[FATAL] Error opening $pidfile: $OS_ERROR\n";
print {$MYPID} $PID or die "[FATAL] Error writing to $pidfile: $OS_ERROR\n";
close $MYPID; ## no critic (InputOutput::RequireCheckedSyscalls
local $SIG{INT} = \&__signal_handler;
local $SIG{TERM} = \&__signal_handler;
# set correct proctitle
$PROGRAM_NAME = abs_path $PROGRAM_NAME; ## no critic (Variables::RequireLocalizedPunctuationVars)
@@ -110,8 +127,9 @@ 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)
# we handle STDOUT && STDERR via Log::Any::For::Std, so do not close them explicitly
#open STDOUT, '>', '/dev/null'; ## no critic (InputOutput::RequireCheckedSyscalls, InputOutput::RequireCheckedOpen)
#open STDERR, '>', '/dev/null'; ## no critic (InputOutput::RequireCheckedSyscalls, InputOutput::RequireCheckedOpen)
__fork ();
umask 0;
return;
@@ -119,10 +137,16 @@ sub daemonize {
sub __fork {
my $pid = fork;
unless (defined $pid) { die "Can't fork: $OS_ERROR\n"; }
unless (defined $pid) { die "[FATAL] Can't fork: $OS_ERROR\n"; }
exit if ($pid != 0);
return;
}
sub __signal_handler {
warn "[INFO] Caught a signal $OS_ERROR\n";
unlink $pidfile if (-f $pidfile);
exit 0;
}
__END__
# vim: set ft=perl noet ai ts=4 sw=4 sts=4:

3
bin/fortune_seed.pl
View File

@@ -23,8 +23,7 @@ BEGIN {
use lib ("$workdir/lib", "$workdir/vendor_perl", "$workdir/vendor_perl/lib/perl5");
use fortune qw(seed fortune);
use Carp;
$SIG{__DIE__} = sub { Carp::confess @_ };
local $SIG{__DIE__} = sub { Carp::confess @_ };
seed ();
exit 0;

1
bin/friday_seed.pl
View File

@@ -24,5 +24,4 @@ use lib ("$workdir/lib", "$workdir/vendor_perl", "$workdir/vendor_perl/lib/perl5
use friday qw(seed);
seed ();
exit 0;

2
confcheck.pl
View File

@@ -12,7 +12,7 @@ use JSON::XS;
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)
open (my $C, '<', $c) or die "No conf at $c: $OS_ERROR\n";
my $len = (stat ($c)) [7];
my $json;
my $readlen = read ($C, $json, $len);

2
cpanfile
View File

@@ -15,6 +15,8 @@ requires 'JSON::XS';
requires 'List::Util';
requires 'local::lib';
requires 'Log::Any';
requires 'Log::Any::Adapter';
requires 'Log::Any::For::Std';
requires 'Mojo::Base';
requires 'Mojo::IOLoop';
requires 'Mojo::UserAgent';

33
lib/botlib.pm
View File

@@ -7,13 +7,12 @@ use warnings;
use utf8;
use open qw(:std :utf8);
use English qw( -no_match_vars );
use Carp qw(carp);
use HTTP::Tiny;
use URI::URL;
use JSON::XS qw(decode_json encode_json);
use Digest::MD5 qw(md5_base64);
use DB_File;
use conf qw(loadConf);
use lat qw(latAnswer);
use karma qw(karmaSet karmaGet);
@@ -21,10 +20,8 @@ use friday qw(friday);
use fortune qw(fortune fortune_toggle fortune_status);
use vars qw/$VERSION/;
use Exporter qw(import);
our @EXPORT_OK = qw(weather logger trim randomCommonPhrase command);
our @EXPORT_OK = qw(weather trim randomCommonPhrase command);
$VERSION = '1.0';
my $c = loadConf();
@@ -37,26 +34,6 @@ sub __urlencode {
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;
@@ -130,12 +107,12 @@ sub __weather {
# attach to cache data
tie my %cachetime, 'DB_File', $c->{openweathermap}->{cachetime} or do {
logger "Something nasty happen when cachetime ties to its data: $OS_ERROR";
carp "[ERROR] Something nasty happen when cachetime ties to its data: $OS_ERROR";
return undef;
};
tie my %cachedata, 'DB_File', $c->{openweathermap}->{cachedata} or do {
logger "Something nasty happen when cachedata ties to its data: $OS_ERROR";
carp "[ERROR] Something nasty happen when cachedata ties to its data: $OS_ERROR";
return undef;
};
@@ -158,7 +135,7 @@ sub __weather {
$fc = eval { decode_json ($r->{content}) };
if ($EVAL_ERROR) {
logger "[WARN] openweathermap returns corrupted json: $EVAL_ERROR";
carp "[WARN] openweathermap returns corrupted json: $EVAL_ERROR";
untie %cachetime;
untie %cachedata;
return undef;

10
lib/conf.pm
View File

@@ -7,30 +7,28 @@ use warnings;
use utf8;
use open qw(:std :utf8);
use English qw( -no_match_vars );
use vars qw/$VERSION/;
use JSON::XS;
use vars qw/$VERSION/;
use Exporter qw(import);
our @EXPORT_OK = qw(loadConf);
$VERSION = '1.0';
sub loadConf {
my $c = 'data/config.json';
open my $CH, '<', $c or die "[FATA] 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 $json;
my $readlen = read $CH, $json, $len;
unless ($readlen) {
close $CH; ## no critic (InputOutput::RequireCheckedSyscalls
die "[FATA] Unable to read $c: $OS_ERROR\n";
die "[FATAL] Unable to read $c: $OS_ERROR\n";
}
if ($readlen != $len) {
close $CH; ## no critic (InputOutput::RequireCheckedSyscalls
die "[FATA] File $c is $len bytes on disk, but we read only $readlen bytes\n";
die "[FATAL] File $c is $len bytes on disk, but we read only $readlen bytes\n";
}
close $CH; ## no critic (InputOutput::RequireCheckedSyscalls

36
lib/fortune.pm
View File

@@ -8,18 +8,16 @@ use utf8;
use open qw(:std :utf8);
use English qw( -no_match_vars );
use Carp qw(cluck croak);
use vars qw/$VERSION/;
use Exporter qw(import);
our @EXPORT_OK = qw(seed fortune fortune_toggle fortune_toggle_list fortune_status);
$VERSION = '1.0';
use SQLite_File;
use MIME::Base64;
use File::Path qw(mkpath);
use conf qw(loadConf);
use vars qw/$VERSION/;
use Exporter qw(import);
our @EXPORT_OK = qw(seed fortune fortune_toggle fortune_toggle_list fortune_status);
$VERSION = '1.0';
my $c = loadConf();
my $dir = $c->{fortune}->{dir};
my $srcdir = $c->{fortune}->{srcdir};
@@ -32,10 +30,10 @@ sub seed () {
my $backingfile = sprintf '%s/fortune.sqlite', $dir;
if (-f $backingfile) {
unlink $backingfile || croak "Unable to remove $backingfile: $OS_ERROR\n";
unlink $backingfile || croak "Unable to remove $backingfile: $OS_ERROR";
}
tie my @fortune, 'SQLite_File', $backingfile || croak "Unable to tie to $backingfile: $OS_ERROR\n";
tie my @fortune, 'SQLite_File', $backingfile || croak "Unable to tie to $backingfile: $OS_ERROR";
opendir (my $srcdirhandle, $srcdir) || croak "Unable to open $srcdir: $OS_ERROR";
@@ -43,7 +41,7 @@ sub seed () {
my $srcfile = sprintf '%s/%s', $srcdir, $fortunefile;
next unless (-f $srcfile);
next if ($fortunefile =~ m/\./);
open (my $fh, '<', $srcfile) || croak "Unable to open $srcfile, $OS_ERROR\n";
open (my $fh, '<', $srcfile) || croak "Unable to open $srcfile, $OS_ERROR";
# set correct phrase delimiter
local $INPUT_RECORD_SEPARATOR = "\n%\n";
@@ -65,7 +63,7 @@ sub fortune () {
my $backingfile = sprintf '%s/fortune.sqlite', $dir;
tie my @array, 'SQLite_File', $backingfile || do {
cluck "Unable to tie to $backingfile: $OS_ERROR\n";
cluck "[ERROR] Unable to tie to $backingfile: $OS_ERROR";
return '';
};
@@ -83,7 +81,7 @@ sub fortune_toggle (@) {
unless (-d $dir) {
mkpath ($dir) || do {
cluck "Unable to create $dir: $OS_ERROR";
cluck "[ERROR] Unable to create $dir: $OS_ERROR";
return;
};
}
@@ -91,7 +89,7 @@ sub fortune_toggle (@) {
my $backingfile = sprintf '%s/chats.sqlite', $dir;
tie my %toggle, 'SQLite_File', $backingfile || do {
cluck "Unable to tie to $backingfile: $OS_ERROR\n";
cluck "[ERROR] Unable to tie to $backingfile: $OS_ERROR";
return;
};
@@ -128,7 +126,7 @@ sub fortune_status ($) {
unless (-d $dir) {
mkpath ($dir) || do {
cluck "Unable to create $dir: $OS_ERROR";
cluck "[ERROR] Unable to create $dir: $OS_ERROR";
return;
};
}
@@ -136,7 +134,7 @@ sub fortune_status ($) {
my $backingfile = sprintf '%s/chats.sqlite', $dir;
tie my %toggle, 'SQLite_File', $backingfile || do {
cluck "Unable to tie to $backingfile: $OS_ERROR\n";
cluck "[ERROR] Unable to tie to $backingfile: $OS_ERROR\n";
return;
};
@@ -154,13 +152,17 @@ sub fortune_status ($) {
sub fortune_toggle_list () {
unless (-d $dir) {
mkpath ($dir) || croak "Unable to create $dir: $OS_ERROR";
mkpath ($dir) || do {
cluck "[ERROR] Unable to create $dir: $OS_ERROR";
my @empty = ();
return @empty;
}
}
my $backingfile = sprintf '%s/chats.sqlite', $dir;
tie my %toggle, 'SQLite_File', $backingfile || do {
cluck "Unable to tie to $backingfile: $OS_ERROR\n";
cluck "[ERROR] Unable to tie to $backingfile: $OS_ERROR";
my @empty = ();
return @empty;
};

14
lib/friday.pm
View File

@@ -8,18 +8,16 @@ use utf8;
use open qw(:std :utf8);
use English qw( -no_match_vars );
use Carp qw(cluck croak);
use vars qw/$VERSION/;
use Exporter qw(import);
our @EXPORT_OK = qw(seed friday);
$VERSION = '1.0';
use SQLite_File;
use MIME::Base64;
use File::Path qw(mkpath);
use conf qw(loadConf);
use vars qw/$VERSION/;
use Exporter qw(import);
our @EXPORT_OK = qw(seed friday);
$VERSION = '1.0';
my $c = loadConf();
my $dir = $c->{friday}->{dir};
my $srcfile = $c->{friday}->{src};
@@ -69,7 +67,7 @@ sub friday () {
my $backingfile = sprintf '%s/%s.sqlite', $dir, $dow[$today];
tie my @array, 'SQLite_File', $backingfile || do {
cluck "Unable to tie to $backingfile: $OS_ERROR\n";
cluck "[ERROR] Unable to tie to $backingfile: $OS_ERROR\n";
return '';
};

8
lib/karma.pm
View File

@@ -9,15 +9,13 @@ use English qw( -no_match_vars );
use Digest::SHA qw(sha1_base64);
use DB_File;
use Carp qw(cluck);
use conf qw(loadConf);
use vars qw/$VERSION/;
use Exporter qw(import);
our @EXPORT_OK = qw(karmaSet karmaGet);
$VERSION = '1.0';
use conf qw(loadConf);
my $c = loadConf();
my $karmadir = $c->{karma}->{dir};
my $max = 5;
@@ -41,7 +39,7 @@ sub karmaSet (@) {
# init hash, store phrase and score
tie my %karma, 'DB_File', $karmafile || do {
cluck "Something nasty happen when cachedata ties to its data: $OS_ERROR";
cluck "[ERROR] Something nasty happen when cachedata ties to its data: $OS_ERROR";
return sprintf 'Карма %s составляет 0', $phrase;
};
@@ -100,7 +98,7 @@ sub karmaGet (@) {
# init hash, store phrase and score
tie my %karma, 'DB_File', $karmafile || do {
cluck "Something nasty happen when karma ties to its data: $OS_ERROR";
cluck "[ERROR] Something nasty happen when karma ties to its data: $OS_ERROR";
return sprintf 'Карма %s составляет 0', $phrase;
};

19
lib/lat.pm
View File

@@ -8,18 +8,15 @@ use utf8;
use open qw(:std :utf8);
use English qw( -no_match_vars );
use Carp qw(cluck);
use vars qw/$VERSION/;
use Exporter qw(import);
our @EXPORT_OK = qw(train latAnswer);
$VERSION = '1.0';
use Hailo;
use File::Basename qw(dirname);
use File::Path qw(mkpath);
use conf qw(loadConf);
use botlib qw(logger);
use vars qw/$VERSION/;
use Exporter qw(import);
our @EXPORT_OK = qw(train latAnswer);
$VERSION = '1.0';
my $c = loadConf();
my $brain = $c->{lat}->{brain};
@@ -44,7 +41,7 @@ sub train () {
$lat->train($srcfile);
my ($tokens, $expressions) = ($lat->stats())[0,1];
printf "Total tokens: %s\nTotal expressins: %s\n", $tokens, $expressions;
$lat->save();
$lat->save ();
return;
}
@@ -53,12 +50,12 @@ sub latAnswer () {
my $braindir = dirname ($brain);
unless (-d $braindir) {
cluck "No lat module data: $braindir is absent! Train lat first.";
cluck "[ERROR] No lat module data: $braindir is absent! Train lat first.";
return '';
}
unless (-f $brain) {
cluck "No lat module data: $brain is absent! Train lat first.";
cluck "[ERROR] No lat module data: $brain is absent! Train lat first.";
return '';
}

100
lib/telegrambot.pm
View File

@@ -4,23 +4,21 @@ package telegrambot;
use 5.018;
use strict;
use warnings;
use vars qw/$VERSION/;
use utf8;
use Data::Dumper;
use open qw(:std :utf8);
use Carp qw(carp);
use File::Path qw(mkpath);
use Hailo;
use Mojo::Base 'Teapot::Bot::Brain';
use conf qw(loadConf);
use botlib qw(weather logger trim randomCommonPhrase command);
use telegramlib qw(visavi);
use botlib qw(weather trim randomCommonPhrase command);
use karma qw(karmaSet);
use fortune qw(fortune fortune_toggle_list);
use vars qw/$VERSION/;
use Exporter qw(import);
our @EXPORT_OK = qw(run_telegrambot);
$VERSION = '1.0';
my $c = loadConf();
@@ -42,9 +40,9 @@ sub __cron {
my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime (time);
if ($hour == 8 && ($min >= 0 && $min <= 14)) {
foreach my $enabledfortunechat (fortune_toggle_list()) {
foreach my $enabledfortunechat (fortune_toggle_list ()) {
my $send_args;
$send_args->{text} = sprintf "Сегодняшний день пройдёт под эгидой фразы:\n%s", fortune();
$send_args->{text} = sprintf "Сегодняшний день пройдёт под эгидой фразы:\n%s", fortune ();
$send_args->{chat_id} = $enabledfortunechat;
Teapot::Bot::Brain::sendMessage ($self, $send_args);
}
@@ -134,20 +132,23 @@ sub __on_msg {
}
if ($me->{'status'} eq 'administrator') {
logger "I can talk in group chat $chatname ($chatid)";
carp "[DEBUG] I can talk in group chat $chatname ($chatid)" if $c->{debug};
$can_talk = 1;
} else {
logger "I can talk in group chat $chatname ($chatid)" if ($group_talk);
logger "I can not talk in group chat $chatname ($chatid)" unless ($group_talk);
if ($c->{debug}) {
carp "[DEBUG] I can talk in group chat $chatname ($chatid)" if ($group_talk);
carp "[DEBUG] I can not talk in group chat $chatname ($chatid)" unless ($group_talk);
}
$can_talk = $group_talk;
}
} else {
# private chat, so definely bot can talk
logger "I can talk in private chat $chatname ($chatid)";
carp "[DEBUG] I can talk in private chat $chatname ($chatid)" if $c->{debug};
$can_talk = 1;
}
} else {
logger 'Unable to get chatid';
carp '[INFO] Unable to get chatid';
}
# according api user must have username and/or first_name and/or last_name at least one of these fields
@@ -158,7 +159,7 @@ sub __on_msg {
if ($msg->from->can ('first_name') && defined ($msg->from->first_name)) {
$fullname = $msg->from->first_name;
if ($msg->from->can('last_name') && defined ($msg->from->last_name)) {
if ($msg->from->can ('last_name') && defined ($msg->from->last_name)) {
$fullname .= ' ' . $msg->from->last_name;
}
} elsif ($msg->from->can ('last_name') && defined ($msg->from->last_name)) {
@@ -178,14 +179,14 @@ sub __on_msg {
if (defined ($username)) {
if (defined ($fullname)) {
logger "Newcommer in $chatname ($chatid): \@$username, $fullname ($userid)";
carp "[DEBUG] Newcommer in $chatname ($chatid): \@$username, $fullname ($userid)" if $c->{debug};
$send_args->{text} = "Дратути, [$fullname](tg://user?id=$userid). Представьтес, пожалуйста, и расскажите, что вас сюда привело.";
} else {
logger "Newcommer in $chatname ($chatid): \@$username ($userid)";
carp "[DEBUG] Newcommer in $chatname ($chatid): \@$username ($userid)" if $c->{debug};
$send_args->{text} = "Дратути, [$username](tg://user?id=$userid). Представьтес, пожалуйста, и расскажите, что вас сюда привело.";
}
} else {
logger "Newcommer in $chatname ($chatid): $fullname ($userid)";
carp "[DEBUG] Newcommer in $chatname ($chatid): $fullname ($userid)" if $c->{debug};
$send_args->{text} = "Дратути, [$fullname](tg://user?id=$userid). Представьтес, пожалуйста, и расскажите, что вас сюда привело.";
}
@@ -193,7 +194,7 @@ sub __on_msg {
sleep (int ( rand (2) + 1));
for (0..(4 + int (rand (3)))) {
$msg->typing();
$msg->typing ();
sleep(3);
sleep 3 unless ($_);
}
@@ -215,9 +216,9 @@ sub __on_msg {
);
if ($chatid < 0) {
logger "Initialized brain for public chat $chatname ($chatid): $brainname";
carp "[INFO] Initialized brain for public chat $chatname ($chatid): $brainname";
} else {
logger "Initialized for private chat $chatname ($chatid): $brainname";
carp "[INFO] Initialized for private chat $chatname ($chatid): $brainname";
}
}
@@ -227,7 +228,7 @@ 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);
carp sprintf ('[DEBUG] Private chat %s say to bot: %s', $vis_a_vi, $text) if $c->{debug};
my $csign = quotemeta ($c->{telegrambot}->{csign});
my $reply = 'Давайте ещё пообщаемся, а то я ещё не научилась от вас плохому.';
@@ -259,7 +260,7 @@ MYHELP
Teapot::Bot::Brain::sendMessage ($self, $send_args);
return;
} else {
$reply = command($text, $userid);
$reply = command ($text, $userid);
}
} else {
my $just_message_in_chat = 0;
@@ -289,21 +290,21 @@ MYHELP
$phrase = lc ($phrase);
if (lc ($reply) eq $phrase) {
$reply = randomCommonPhrase();
$reply = randomCommonPhrase ();
} elsif (lc ($reply) eq substr ($phrase, 0, -1)) {
# in case of trailing dot
$reply = randomCommonPhrase();
$reply = randomCommonPhrase ();
} elsif (substr (lc ($reply), 0, -1) eq $phrase) {
$reply = randomCommonPhrase();
$reply = randomCommonPhrase ();
}
}
}
}
if (defined $reply) {
$msg->typing();
$msg->typing ();
sleep 1;
logger sprintf ("Private chat bot reply to $vis_a_vi: %s", $reply);
carp sprintf ("[DEBUG] Private chat bot reply to $vis_a_vi: %s", $reply) if $c->{debug};
$msg->reply ($reply);
}
# group chat
@@ -312,7 +313,7 @@ MYHELP
# detect and log messages without text, noop here
unless (defined ($msg->text)) {
logger sprintf('No text in message from %s', $vis_a_vi);
carp sprintf ('[INFO] No text in message from %s', $vis_a_vi);
if ($msg->can ('document') && defined ($msg->document)) {
if (defined ($msg->document->{'file_name'})) {
@@ -320,21 +321,21 @@ MYHELP
$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);
carp sprintf ('[DEBUG] 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) if $c->{debug};
} else {
logger sprintf ('In public chat %s (%s) %s send unknown document', $chatname, $chatid, $vis_a_vi);
carp sprintf ('In public chat %s (%s) %s send unknown document', $chatname, $chatid, $vis_a_vi) if $c->{debug};
}
} 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);
carp sprintf ('[DEBUG] In public chat %s (%s) %s reacted with sticker %s from pack %s', $chatname, $chatid, $vis_a_vi, $emoji, $set_name) if $c->{debug};
} 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);
carp sprintf ('[DEBUG] In public chat %s (%s) %s send photo', $chatname, $chatid, $vis_a_vi) if $c->{debug};
} else {
logger Dumper ($msg);
carp Dumper ($msg) if $c->{debug};
}
return;
@@ -342,7 +343,7 @@ MYHELP
# 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);
carp sprintf ('[DEBUG] In public chat %s (%s) %s say: %s', $chatname, $chatid, $vis_a_vi, $text) if $c->{debug};
my $qname = quotemeta ($c->{telegrambot}->{name});
my $qtname = quotemeta ($c->{telegrambot}->{tname});
my $csign = quotemeta ($c->{telegrambot}->{csign});
@@ -352,7 +353,7 @@ MYHELP
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);
carp sprintf ('[DEBUG] 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);
@@ -440,23 +441,23 @@ MYHELP
$phrase = lc ($phrase);
if (lc ($reply) eq $phrase) {
$reply = randomCommonPhrase();
$reply = randomCommonPhrase ();
} elsif (lc ($reply) eq substr ($phrase, 0, -1)) {
# in case of trailing dot
$reply = randomCommonPhrase();
$reply = randomCommonPhrase ();
} elsif (substr(lc ($reply), 0, -1) eq $phrase) {
$reply = randomCommonPhrase();
$reply = randomCommonPhrase ();
}
$msg->typing();
$msg->typing ();
sleep (int (rand (2)));
logger sprintf ('In public chat %s (%s) bot reply to %s: %s', $chatname, $chatid, $vis_a_vi, $reply);
carp sprintf ('[DEBUG] In public chat %s (%s) bot reply to %s: %s', $chatname, $chatid, $vis_a_vi, $reply) if $c->{debug};
$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);
carp sprintf ('[DEBUG] In public chat %s (%s) bot is not required to reply to %s', $chatname, $chatid, $vis_a_vi) if $c->{debug};
} else {
logger sprintf ('In public chat %s (%s) bot can\'t talk, but reply to %s is: %s', $chatname, $chatid, $vis_a_vi, $reply);
carp sprintf ('[DEBUG] In public chat %s (%s) bot can\'t talk, but reply to %s is: %s', $chatname, $chatid, $vis_a_vi, $reply) if $c->{debug};
}
}
@@ -476,7 +477,7 @@ sub init {
my $self = shift;
$self->add_listener (\&__on_msg);
$self->add_repeating_task(900, \&__cron);
$self->add_repeating_task (900, \&__cron);
return;
}
@@ -490,6 +491,21 @@ sub run_telegrambot {
return;
}
sub visavi {
my ($userid, $username, $fullname) = @_;
my $name = '';
if (defined ($username)) {
$name .= '@' . $username;
$name .= ', ' . $fullname if (defined ($fullname));
} else {
$name .= $fullname;
}
$name .= " ($userid)";
return $name;
}
1;
# vim: ft=perl noet ai ts=4 sw=4 sts=4:

37
lib/telegramlib.pm
View File

@@ -1,37 +0,0 @@
package telegramlib;
# store here functions that are not implemented in Teapot::Bot
use 5.018;
use strict;
use warnings;
use utf8;
use open qw(:std :utf8);
use botlib qw(trim);
use Teapot::Bot::Brain;
# module shit
use vars qw/$VERSION/;
use Exporter qw(import);
our @EXPORT_OK = qw(visavi);
$VERSION = '1.0';
sub visavi {
my ($userid, $username, $fullname) = @_;
my $name = '';
if (defined ($username)) {
$name .= '@' . $username;
$name .= ', ' . $fullname if (defined ($fullname));
} else {
$name .= $fullname;
}
$name .= " ($userid)";
return $name;
}
1;
# vim: ft=perl noet ai ts=4 sw=4 sts=4: