Compare commits
No commits in common. "406679ae2e9ca1f7c738e175c06056542f0a5e97" and "d5d58c150fa4be9340345c4d7cfd188c7653ab2f" have entirely different histories.
406679ae2e
...
d5d58c150f
285
TelegramBot.pm
285
TelegramBot.pm
@ -1,285 +0,0 @@
|
|||||||
# Important for switch feature
|
|
||||||
use v5.32;
|
|
||||||
|
|
||||||
use utf8;
|
|
||||||
use strict;
|
|
||||||
use warnings;
|
|
||||||
|
|
||||||
no warnings qw(experimental);
|
|
||||||
|
|
||||||
# core packages
|
|
||||||
use Encode;
|
|
||||||
use FindBin;
|
|
||||||
|
|
||||||
# CPAN packages
|
|
||||||
use Cache::FastMmap;
|
|
||||||
use JSON;
|
|
||||||
use Log::Log4perl;
|
|
||||||
use YAML;
|
|
||||||
|
|
||||||
# Package name
|
|
||||||
package TelegramBot;
|
|
||||||
|
|
||||||
# Constants and initalisations
|
|
||||||
Log::Log4perl->init("$FindBin::Bin/log.conf");
|
|
||||||
my $CACHE = Cache::FastMmap->new(
|
|
||||||
share_file => '/tmp/telegram_bot',
|
|
||||||
serializer => 'json',
|
|
||||||
unlink_on_exit => 0,
|
|
||||||
expire_time => 86400,
|
|
||||||
);
|
|
||||||
|
|
||||||
sub new {
|
|
||||||
my ( $Type, %Param ) = @_;
|
|
||||||
|
|
||||||
# allocate new hash for object
|
|
||||||
my $Self = {};
|
|
||||||
bless( $Self, $Type );
|
|
||||||
|
|
||||||
$Self->{LogLevel} = $Param{LogLevel} || 'info';
|
|
||||||
$Self->{LogObject} = Log::Log4perl->get_logger('TelegramBot');
|
|
||||||
$Self->{Token} = 'bot5868933096:AAE8Oe-AxU6m_yCWfpqTqwwjERqnRpBGJtE';
|
|
||||||
$Self->{URL} = {
|
|
||||||
Telegram => 'https://api.telegram.org',
|
|
||||||
};
|
|
||||||
|
|
||||||
# load remembered update ids
|
|
||||||
$Self->{MessageIDs} = YAML::LoadFile("$FindBin::Bin/message_ids.yml");
|
|
||||||
|
|
||||||
# whitelist
|
|
||||||
$Self->{Whitelist} = $Param{Whitelist};
|
|
||||||
|
|
||||||
return $Self;
|
|
||||||
}
|
|
||||||
|
|
||||||
=head1 greet
|
|
||||||
|
|
||||||
Merely a dummy routine to test the bot's functionallity. Maybe using it for easter eggs or some kind of fun later.
|
|
||||||
|
|
||||||
=cut
|
|
||||||
|
|
||||||
sub greet {
|
|
||||||
|
|
||||||
my ( $Self, %Param ) = @_;
|
|
||||||
|
|
||||||
$Self->{LogObject}->info('greet: Initiating greet routine');
|
|
||||||
|
|
||||||
if ( !defined $Param{Message} ) {
|
|
||||||
$Self->{LogObject}->error('greet: Message not defined!');
|
|
||||||
return;
|
|
||||||
}
|
|
||||||
|
|
||||||
my @Greetings =
|
|
||||||
qw(Hallo Gruezi Hello Holá Bonjour Konichiwa Shalom Godmorgen);
|
|
||||||
my $Greet = $Greetings[ int( rand(7) ) ] || '';
|
|
||||||
$Self->{LogObject}->debug( 'Random Greet is ' . $Greet );
|
|
||||||
my $ReturnContent =
|
|
||||||
$Greet . ', '
|
|
||||||
. ( $Param{Message}->{chat}->{first_name}
|
|
||||||
? $Param{Message}->{chat}->{first_name}
|
|
||||||
: $Param{Message}->{chat}->{username} )
|
|
||||||
. '!';
|
|
||||||
$Self->{LogObject}->debug( 'ReturnContent is ' . $ReturnContent );
|
|
||||||
return { text => $ReturnContent, };
|
|
||||||
}
|
|
||||||
|
|
||||||
=head1 build
|
|
||||||
|
|
||||||
Sub which is used to offer custom query building to the user by offering a decision tree of options via inline keyboard.
|
|
||||||
|
|
||||||
=cut
|
|
||||||
|
|
||||||
sub build {
|
|
||||||
|
|
||||||
my ( $Self, %Param ) = @_;
|
|
||||||
use Data::Dumper;
|
|
||||||
use JSON;
|
|
||||||
use LWP::Simple::REST qw(POST plain);
|
|
||||||
|
|
||||||
my $KeyboardData;
|
|
||||||
my $KeyboardMessage;
|
|
||||||
if ( $Param{QueryStep} ) {
|
|
||||||
if ( $Param{QueryStep} eq 'hist' ) {
|
|
||||||
# show next selection
|
|
||||||
}
|
|
||||||
else {
|
|
||||||
# for now, testing fallback
|
|
||||||
my $ResponseResult = plain POST(
|
|
||||||
join( '/', ( $Self->{URL}{Telegram}, $Self->{Token}, 'sendMessage' ) ),
|
|
||||||
{
|
|
||||||
'chat_id' => $Param{Message}->{callback_query}->{from}->{id},
|
|
||||||
'reply_to_message_id' => $Param{Message}->{callback_query}->{message}->{message_id},
|
|
||||||
'text' => "Kommando $Param{QueryStep} erkannt",
|
|
||||||
}
|
|
||||||
);
|
|
||||||
$Self->{LogObject}->info( 'build: Sending result is ' . $ResponseResult );
|
|
||||||
return {};
|
|
||||||
}
|
|
||||||
|
|
||||||
}
|
|
||||||
else {
|
|
||||||
$KeyboardData = {
|
|
||||||
'inline_keyboard' => [
|
|
||||||
[
|
|
||||||
{
|
|
||||||
'text' => 'Grüßen',
|
|
||||||
'callback_data' => 'greet'
|
|
||||||
},
|
|
||||||
{
|
|
||||||
'text' => 'Statistik',
|
|
||||||
'callback_data' => 'statistics'
|
|
||||||
},
|
|
||||||
],
|
|
||||||
],
|
|
||||||
'resize' => 1,
|
|
||||||
'single_use' => 1,
|
|
||||||
'placeholder' => 'test',
|
|
||||||
};
|
|
||||||
$KeyboardMessage = "Hallo $Param{Message}->{chat}->{first_name}, über die folgenden Fragen kannst du auswählen, welche Interaktion du ausführen möchtest. Was möchtest du tun?";
|
|
||||||
}
|
|
||||||
my $EncodedKeyboard = JSON::encode_json(
|
|
||||||
$KeyboardData,
|
|
||||||
);
|
|
||||||
my $ResponseResult = plain POST(
|
|
||||||
join( '/', ( $Self->{URL}{Telegram}, $Self->{Token}, 'sendMessage' ) ),
|
|
||||||
{
|
|
||||||
'chat_id' => $Param{Message}->{chat}->{id},
|
|
||||||
'reply_to_message_id' => $Param{Message}->{id},
|
|
||||||
'text' => $KeyboardMessage,
|
|
||||||
'reply_markup' => $EncodedKeyboard,
|
|
||||||
}
|
|
||||||
);
|
|
||||||
$Self->{LogObject}->info( 'build: Sending result is ' . $ResponseResult );
|
|
||||||
|
|
||||||
return {};
|
|
||||||
|
|
||||||
}
|
|
||||||
|
|
||||||
=head1 processMessage
|
|
||||||
|
|
||||||
Function which receives a single message and decides what to to based on message content and attributes.
|
|
||||||
|
|
||||||
=cut
|
|
||||||
|
|
||||||
sub processMessage {
|
|
||||||
|
|
||||||
my ( $Self, %Param ) = @_;
|
|
||||||
use Data::Dumper;
|
|
||||||
use LWP::Simple::REST qw(POST plain json);
|
|
||||||
|
|
||||||
if ( !defined $Param{Message} ) {
|
|
||||||
$Self->{LogObject}->error('processMessage: Message not defined!');
|
|
||||||
return;
|
|
||||||
}
|
|
||||||
|
|
||||||
$Self->{LogObject}->info('processMessage: Starting to process message');
|
|
||||||
$Self->{LogObject}
|
|
||||||
->info( 'processMessage: Message is ' . Dumper( $Param{Message} ) );
|
|
||||||
|
|
||||||
|
|
||||||
my $ResponseData = {};
|
|
||||||
if ( defined $Param{Message}->{message} && $Param{Message}->{message}->{text} =~
|
|
||||||
/\/(?<command>greet|statistics|build)\s?(?<arguments>.*)?/ )
|
|
||||||
{
|
|
||||||
my $Message = $Param{Message}->{message};
|
|
||||||
my $Command = $+{command};
|
|
||||||
my $ArgumentsString = $+{arguments};
|
|
||||||
$ResponseData = $Self->$Command(
|
|
||||||
Message => $Message,
|
|
||||||
Arguments => $ArgumentsString,
|
|
||||||
);
|
|
||||||
if ( !keys $ResponseData->%* ) {
|
|
||||||
return;
|
|
||||||
}
|
|
||||||
}
|
|
||||||
elsif ( defined $Param{Message}->{callback_query} ) {
|
|
||||||
$Self->build(
|
|
||||||
Message => $Param{Message},
|
|
||||||
QueryStep => $Param{Message}->{callback_query}->{data},
|
|
||||||
);
|
|
||||||
}
|
|
||||||
else {
|
|
||||||
$Self->{LogObject}
|
|
||||||
->debug( 'Command not recognized. Data: ' . $Param{Message}->{message}->{text} );
|
|
||||||
if ( $Self->{Whitelist}->{$Param{Message}->{message}->{from}->{id}} eq 'Sarah'
|
|
||||||
|| $Self->{Whitelist}->{$Param{Message}->{message}->{from}->{id}} eq 'Stefan' ) {
|
|
||||||
$ResponseData = $Self->replyLoveQuote( Message => $Param{Message}->{message} );
|
|
||||||
}
|
|
||||||
else {
|
|
||||||
$ResponseData->{text} =
|
|
||||||
"I'm sorry, "
|
|
||||||
. ( $Param{Message}->{message}->{chat}->{first_name}
|
|
||||||
? $Param{Message}->{message}->{chat}->{first_name}
|
|
||||||
: $Param{Message}->{message}->{chat}->{username} )
|
|
||||||
. ", I couldn't understand your request. Currently I can process the commands:\n\n\t\/greet\n\t\/statistics driver standings\n\t\/statistics constructor standings";
|
|
||||||
}
|
|
||||||
|
|
||||||
}
|
|
||||||
|
|
||||||
my $ResponseResult = plain POST(
|
|
||||||
join( '/', ( $Self->{URL}{Telegram}, $Self->{Token}, 'sendMessage' ) ),
|
|
||||||
{
|
|
||||||
chat_id => $Param{Message}->{message}->{chat}->{id},
|
|
||||||
$ResponseData->%*,
|
|
||||||
}
|
|
||||||
);
|
|
||||||
my $Response = JSON::decode_json($ResponseResult);
|
|
||||||
$Self->{LogObject}
|
|
||||||
->info( 'processMessage: Answering result is ' . Dumper($Response) );
|
|
||||||
|
|
||||||
# mark message as read
|
|
||||||
my $SeenResult = plain POST(
|
|
||||||
join( '/', ( $Self->{URL}{Telegram}, $Self->{Token}, 'readMessageContents' ) ),
|
|
||||||
{
|
|
||||||
id => $Param{Message}->{message}->{id},
|
|
||||||
}
|
|
||||||
);
|
|
||||||
|
|
||||||
}
|
|
||||||
|
|
||||||
=head1 fetchMessages
|
|
||||||
|
|
||||||
Requesting messages from Telegram API and passing them one by one to processMessage.
|
|
||||||
|
|
||||||
=cut
|
|
||||||
|
|
||||||
sub fetchMessages {
|
|
||||||
|
|
||||||
my ( $Self, %Param ) = @_;
|
|
||||||
use Data::Dumper;
|
|
||||||
use LWP::Simple::REST qw(GET json);
|
|
||||||
|
|
||||||
my $Method = 'getUpdates';
|
|
||||||
$Self->{LogObject}->info('fetchMessages: Initiating getUpdates');
|
|
||||||
|
|
||||||
my $MessageDataRaw =
|
|
||||||
json GET( join( '/', ( $Self->{URL}{Telegram}, $Self->{Token}, $Method ) ), {} );
|
|
||||||
$Self->{LogObject}
|
|
||||||
->info( 'fetchMessages: Messages raw are ' . Dumper($MessageDataRaw) );
|
|
||||||
my @Messages = $MessageDataRaw->{result}->@*;
|
|
||||||
$Self->{LogObject}
|
|
||||||
->info( 'fetchMessages: Messages returned are ' . Dumper( \@Messages ) );
|
|
||||||
|
|
||||||
MESSAGE:
|
|
||||||
for my $Message (@Messages) {
|
|
||||||
if ( !$Self->{Whitelist}{$Message->{message}{from}{id}} ) {
|
|
||||||
$Self->{LogObject}
|
|
||||||
->info( 'fetchMessages: User not whitelisted, skipping message ' . Dumper($MessageDataRaw) );
|
|
||||||
|
|
||||||
$Self->{MessageIDs}{$Message->{message}{message_id}} = 1;
|
|
||||||
next MESSAGE;
|
|
||||||
}
|
|
||||||
if ($Self->{MessageIDs}{$Message->{message}{message_id}}) {
|
|
||||||
$Self->{LogObject}->info('fetchMessages: Skipping known message_id');
|
|
||||||
next MESSAGE;
|
|
||||||
}
|
|
||||||
else {
|
|
||||||
$Self->{LogObject}->info('fetchMessages: Calling processMessage');
|
|
||||||
$Self->{MessageIDs}{$Message->{message}{message_id}} = 1;
|
|
||||||
$Self->processMessage( Message => $Message, );
|
|
||||||
}
|
|
||||||
}
|
|
||||||
YAML::DumpFile("$FindBin::Bin/message_ids.yml", $Self->{MessageIDs});
|
|
||||||
}
|
|
||||||
|
|
||||||
1;
|
|
||||||
@ -1,26 +0,0 @@
|
|||||||
#/usr/bin/perl
|
|
||||||
|
|
||||||
use v5.32;
|
|
||||||
|
|
||||||
use strict;
|
|
||||||
use warnings;
|
|
||||||
|
|
||||||
use FindBin;
|
|
||||||
use YAML;
|
|
||||||
|
|
||||||
my $Conf;
|
|
||||||
BEGIN { $Conf = YAML::LoadFile("$FindBin::Bin/.bot.cnf"); }
|
|
||||||
|
|
||||||
if ( !$Conf->%* ) {
|
|
||||||
print STDERR "No valid config was found. Exiting...\n";
|
|
||||||
exit;
|
|
||||||
}
|
|
||||||
|
|
||||||
use lib $Conf->{Lib};
|
|
||||||
|
|
||||||
use TelegramBot;
|
|
||||||
|
|
||||||
my $BotObject = TelegramBot->new($Conf->%*);
|
|
||||||
$BotObject->fetchMessages();
|
|
||||||
|
|
||||||
exit;
|
|
||||||
9
log.conf
9
log.conf
@ -1,9 +0,0 @@
|
|||||||
# Config file for Log4perl
|
|
||||||
log4perl.rootLogger=DEBUG, LOGFILE
|
|
||||||
|
|
||||||
log4perl.appender.LOGFILE=Log::Log4perl::Appender::File
|
|
||||||
log4perl.appender.LOGFILE.filename=log4perl.log
|
|
||||||
log4perl.appender.LOGFILE.mode=append
|
|
||||||
|
|
||||||
log4perl.appender.LOGFILE.layout=PatternLayout
|
|
||||||
log4perl.appender.LOGFILE.layout.ConversionPattern=[%r] %F %L %c - %m%n
|
|
||||||
Loading…
Reference in New Issue
Block a user