From e861f5420bd3f8e595ffbf128cf01fd0a6e8484b Mon Sep 17 00:00:00 2001 From: eleksir Date: Sun, 13 Dec 2020 15:51:24 +0300 Subject: [PATCH] Implement logging via Log::Any, cleanup, remove logger() --- bin/aleesa-telegram-bot | 54 ++++++++++++++++------ bin/fortune_seed.pl | 3 +- bin/friday_seed.pl | 1 - confcheck.pl | 2 +- cpanfile | 2 + lib/botlib.pm | 33 ++----------- lib/conf.pm | 10 ++-- lib/fortune.pm | 36 ++++++++------- lib/friday.pm | 14 +++--- lib/karma.pm | 8 ++-- lib/lat.pm | 19 ++++---- lib/telegrambot.pm | 100 +++++++++++++++++++++++----------------- lib/telegramlib.pm | 37 --------------- 13 files changed, 146 insertions(+), 173 deletions(-) delete mode 100644 lib/telegramlib.pm diff --git a/bin/aleesa-telegram-bot b/bin/aleesa-telegram-bot index 6f4da51..23a2698 100755 --- a/bin/aleesa-telegram-bot +++ b/bin/aleesa-telegram-bot @@ -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: diff --git a/bin/fortune_seed.pl b/bin/fortune_seed.pl index 83ebae3..2989b7c 100644 --- a/bin/fortune_seed.pl +++ b/bin/fortune_seed.pl @@ -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; diff --git a/bin/friday_seed.pl b/bin/friday_seed.pl index 5c6acfe..fdf4cbf 100644 --- a/bin/friday_seed.pl +++ b/bin/friday_seed.pl @@ -24,5 +24,4 @@ use lib ("$workdir/lib", "$workdir/vendor_perl", "$workdir/vendor_perl/lib/perl5 use friday qw(seed); seed (); - exit 0; diff --git a/confcheck.pl b/confcheck.pl index 90b3784..acb45d8 100755 --- a/confcheck.pl +++ b/confcheck.pl @@ -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); diff --git a/cpanfile b/cpanfile index a921d97..bce7dd5 100644 --- a/cpanfile +++ b/cpanfile @@ -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'; diff --git a/lib/botlib.pm b/lib/botlib.pm index ec23b79..f3a121d 100644 --- a/lib/botlib.pm +++ b/lib/botlib.pm @@ -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; diff --git a/lib/conf.pm b/lib/conf.pm index 0460fdf..2a008b3 100644 --- a/lib/conf.pm +++ b/lib/conf.pm @@ -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 diff --git a/lib/fortune.pm b/lib/fortune.pm index eb95fc9..4f543a3 100644 --- a/lib/fortune.pm +++ b/lib/fortune.pm @@ -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; }; diff --git a/lib/friday.pm b/lib/friday.pm index c1d8009..8d6fbda 100644 --- a/lib/friday.pm +++ b/lib/friday.pm @@ -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 ''; }; diff --git a/lib/karma.pm b/lib/karma.pm index 37d3ebe..1e855a3 100644 --- a/lib/karma.pm +++ b/lib/karma.pm @@ -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; }; diff --git a/lib/lat.pm b/lib/lat.pm index 4c50f59..4432fba 100644 --- a/lib/lat.pm +++ b/lib/lat.pm @@ -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 ''; } diff --git a/lib/telegrambot.pm b/lib/telegrambot.pm index 19c1152..3e35c15 100644 --- a/lib/telegrambot.pm +++ b/lib/telegrambot.pm @@ -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: diff --git a/lib/telegramlib.pm b/lib/telegramlib.pm deleted file mode 100644 index ce5fcce..0000000 --- a/lib/telegramlib.pm +++ /dev/null @@ -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: