F1DataTelegramBot/F1DataBot.pm

405 lines
14 KiB
Perl
Raw Normal View History

2023-05-08 17:00:34 +02:00
# Important for switch feature
use v5.32;
2023-05-08 17:00:34 +02:00
use utf8;
2023-05-08 17:00:34 +02:00
use strict;
use warnings;
no warnings qw(experimental);
# core packages
use Encode;
2023-05-08 17:00:34 +02:00
# CPAN packages
use JSON;
2023-05-08 17:00:34 +02:00
use Log::Log4perl;
use YAML;
2023-05-08 17:00:34 +02:00
# Package name
package F1DataBot;
# Constants and initalisations
Log::Log4perl->init('log.conf');
sub new {
my ( $Type, %Param ) = @_;
# allocate new hash for object
my $Self = {};
bless( $Self, $Type );
2023-05-22 18:42:56 +02:00
# TODO Use LogLevel Param for Logger Initialisation.
$Self->{LogLevel} = $Param{LogLevel} || 'info';
$Self->{LogObject} = Log::Log4perl->get_logger('F1DataBot');
$Self->{Token} = 'bot5868933096:AAE8Oe-AxU6m_yCWfpqTqwwjERqnRpBGJtE';
$Self->{URL} = {
Ergast => 'http://ergast.com/api/f1',
Telegram => 'https://api.telegram.org',
};
# load remembered update ids
2023-07-07 19:12:57 +02:00
$Self->{MessageIDs} = YAML::LoadFile('message_ids.yml');
return $Self;
}
2023-05-08 17:00:34 +02:00
2023-05-22 18:42:56 +02:00
=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
2023-05-08 17:00:34 +02:00
sub greet {
my ( $Self, %Param ) = @_;
$Self->{LogObject}->info('greet: Initiating greet routine');
2023-05-08 17:00:34 +02:00
if ( !defined $Param{Message} ) {
$Self->{LogObject}->error('greet: Message not defined!');
return;
}
2023-05-08 17:00:34 +02:00
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, };
}
2023-05-08 17:00:34 +02:00
2023-05-22 18:42:56 +02:00
=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 {};
2023-05-08 17:00:34 +02:00
}
2023-05-22 18:42:56 +02:00
=head1 statistics
Starting point for executing F1 statistic queries.
=cut
2023-05-08 17:00:34 +02:00
sub statistics {
my ( $Self, %Param ) = @_;
use Data::Dumper;
use LWP::Simple::REST qw(GET json);
$Self->{LogObject}->info('statistics: Initiating statistics routine');
if ( !defined $Param{Message} ) {
$Self->{LogObject}->error('statistics: Message not defined!');
return;
}
# Parse arguments
# Expected format: driver | constructor | circuit
# Circuit: [name] [statistics identifier] [individual parameters]
$Param{Message}->{text} =~
/^(\/statistics)\s(?<statclass>driver|constructor|circuit)/;
my $StatClass = $+{statclass};
my %ReturnData;
given ($StatClass) {
when ('driver') {
$Self->{LogObject}->info('statistics: Recognizing driver command');
$Param{Message}->{text} =~
/^(\/statistics)\s$StatClass\s(?<statidentifier>\w+)/;
my $StatIdentifier = $+{statidentifier};
given ($StatIdentifier) {
when ('standings') {
my $Standings = json POST(
join( '/',
( $Self->{URL}{Ergast}, 'current', 'driverStandings.json' )
),
{}
);
my %DriverStandings;
my $DriverStandingsFormatted = sprintf( "%-3s%-4s%-5s%7s\n",
"#", "No.", "Code", "Points" );
for my $Driver ( $Standings->{MRData}->{StandingsTable}
->{StandingsLists}->[0]->{DriverStandings}->@* )
{
$DriverStandingsFormatted .= sprintf(
"%-3d%-4d%-5s%7d\n",
$Driver->{positionText},
$Driver->{Driver}->{permanentNumber},
$Driver->{Driver}->{code},
$Driver->{points}
);
}
$DriverStandingsFormatted =~ s/^/<pre>/;
$DriverStandingsFormatted =~ s/$/<\/pre>/;
$Self->{LogObject}
->info( 'statistics: DriverStandingsFormatted are '
. $DriverStandingsFormatted );
$Self->{LogObject}
->info( 'statistics: DriverStandingsFormattedLength is '
. length($DriverStandingsFormatted) );
$ReturnData{text} = $DriverStandingsFormatted;
$ReturnData{parse_mode} = 'HTML';
}
default {
$ReturnData{text} =
"I'm sorry, "
. ( $Param{Message}->{chat}->{first_name}
? $Param{Message}->{chat}->{first_name}
: $Param{Message}->{chat}->{username} )
. ", I recognized you wanted to fetch a statistic about drivers, but I couldn't determine which one. Maybe you want to try again? Currently available are:\n\tstandings";
}
}
}
when ('constructor') {
$Self->{LogObject}
->info('statistics: Recognizing constructor command');
$Param{Message}->{text} =~
/^(\/statistics)\s$StatClass\s(?<statidentifier>\w+)/;
my $StatIdentifier = $+{statidentifier};
given ($StatIdentifier) {
when ('standings') {
my $Standings = json POST(
join(
'/',
(
$Self->{URL}{Ergast}, 'current',
'constructorStandings.json'
)
),
{}
);
$Self->{LogObject}
->info( 'statistics: Fetched standings are '
. Dumper($Standings) );
my %ConstructorStandings;
my $ConstructorStandingsFormatted = '';
for my $Constructor ( $Standings->{MRData}->{StandingsTable}
->{StandingsLists}->[0]->{ConstructorStandings}->@* )
{
$ConstructorStandingsFormatted .=
"Position: $Constructor->{positionText}, Name: $Constructor->{Constructor}->{name} - Points: $Constructor->{points}\n";
}
$ConstructorStandingsFormatted =~ s/^/<pre>/;
$ConstructorStandingsFormatted =~ s/$/<\/pre>/;
2023-07-07 19:19:36 +02:00
$ReturnData{text} = $ConstructorStandingsFormatted;
}
default {
$ReturnData{text} =
"I'm sorry, "
. ( $Param{Message}->{chat}->{first_name}
? $Param{Message}->{chat}->{first_name}
: $Param{Message}->{chat}->{username} )
. ", I recognized you wanted to fetch a statistic about constructors, but I couldn't determine which one. Maybe you want to try again? Currently available are:\n\tstandings";
}
}
}
when ('circuit') {
$Self->{LogObject}->info('statistics: Recognizing circuit command');
}
# Statistics class not recognized
default {
$ReturnData{text} =
"I'm sorry, "
. ( $Param{Message}->{chat}->{first_name}
? $Param{Message}->{chat}->{first_name}
: $Param{Message}->{chat}->{username} )
. ", I recognized you wanted to fetch a statistic, but I couldn't determine which one. Maybe you want to try again? Currently available are:\n\tdriver\n\tconstructor\n\tcircuit";
}
}
return \%ReturnData;
# Use system to call the python script (big shame, but nothing to do about it)
2023-05-08 17:00:34 +02:00
}
2023-05-22 18:42:56 +02:00
=head1 processMessage
Function which receives a single message and decides what to to based on message content and attributes.
=cut
2023-05-08 17:00:34 +02:00
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} );
$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},
}
);
2023-05-08 17:00:34 +02:00
}
2023-05-22 18:42:56 +02:00
=head1 fetchMessages
Requesting messages from Telegram API and passing them one by one to processMessage.
=cut
2023-05-08 17:00:34 +02:00
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) {
2023-07-07 19:12:57 +02:00
if ($Self->{MessageIDs}{$Message->{message}{message_id}}) {
$Self->{LogObject}->info('fetchMessages: Skipping known message_id');
next MESSAGE;
}
else {
2023-07-07 19:12:57 +02:00
$Self->{LogObject}->info('fetchMessages: Calling processMessage');
$Self->{MessageIDs}{$Message->{message}{message_id}} = 1;
$Self->processMessage( Message => $Message, );
}
}
2023-07-07 19:12:57 +02:00
YAML::DumpFile('message_ids.yml', $Self->{MessageIDs});
2023-05-08 17:00:34 +02:00
}
1;