# 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->{TelegramURL} = '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->{TelegramURL}, $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->{TelegramURL}, $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} =~ /\/(?greet|statistics|build)\s?(?.*)?/ ) { 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->{TelegramURL}, $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->{TelegramURL}, $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->{TelegramURL}, $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;