# 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}; # default command list $Self->{CommandList} = { 'greet' => \&greet, }; # default query trigger $Self->{QueryTrigger} = { 'startQuery' => 1, }; # load plugins my @Plugins = glob("$FindBin::Bin/Plugins/*"); # iterate over plugins found if ( @Plugins ) { use File::Basename; PLUGIN: for my $PluginPath ( @Plugins ) { my $PluginName = basename($PluginPath); next PLUGIN unless require("$FindBin::Bin/Plugins/${PluginName}/Core.pm"); my $FullPath = "Plugins::${PluginName}::Core"; my $PluginObject = $FullPath->new; if( !$PluginObject ) { $Self->{LogObject}->error("Couldn't load plugin $PluginName"); next PLUGIN; } # import plugin command list my $PluginCommandList = $PluginObject->getCommandList(); COMMAND: for my $PluginCommand ( keys $PluginCommandList->%* ) { next COMMAND if $Self->{CommandList}{$PluginCommand}; $Self->{CommandList}{$PluginCommand} = $PluginCommandList->{$PluginCommand}; } # import plugin query trigger my $PluginQueryTriggerList = $PluginObject->getQueryTrigger(); QUERYTRIGGER: for my $PluginQueryTrigger ( keys $PluginQueryTriggerList->%* ) { next QUERYTRIGGER if $Self->{QueryTrigger}{$PluginQueryTrigger}; $Self->{QueryTrigger}{$PluginQueryTrigger} = $PluginQueryTriggerList->{$PluginQueryTrigger}; } } } 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 # TODO rebuild to take custom parameters of various kind 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}{message}{chat}{first_name}, über die folgenden Fragen kannst du auswählen, welche Interaktion du ausführen möchtest. Was möchtest du tun?"; } # keyboard encoding my $EncodedKeyboard = JSON::to_json( $KeyboardData, ); my $ResponseResult = plain POST( join( '/', ( $Self->{TelegramURL}, $Self->{Token}, 'sendMessage' ) ), { 'chat_id' => $Param{Message}{message}{chat}{id}, 'reply_to_message_id' => $Param{Message}{message}{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 = {}; my $CommandList = join('|', keys $Self->{CommandList}->%*); my $QueryTriggerList = join('|', keys $Self->{QueryTrigger}->%*); # command branch if ( defined $Param{Message}{message} && $Param{Message}{message}{text} && $Param{Message}{message}{text} =~ /\/(?$CommandList)\s?(?.*)?/ ) { my $Message = $Param{Message}{message}; my $Command = $+{command}; my $ArgumentsString = $+{arguments}; $ResponseData = $Self->{CommandList}{$Command}( $Self, Message => $Message, Arguments => $ArgumentsString, ); if ( !keys $ResponseData->%* ) { return; } } # query trigger branch elsif ( defined $Param{Message}{message} && $Param{Message}{message}{text} && $Param{Message}{message}{text} =~ /\/(?$QueryTriggerList)/ ) { $Self->build( Message => $Param{Message}, QueryStep => $Param{Message}{callback_query}{data} || '', ); } # query result branch elsif ( defined $Param{Message}{callback_query} ) { my $ArgumentsString = ''; $ResponseData = $Self->{CommandList}{$Param{Message}{callback_query}{data}}( $Self, Message => $Param{Message}{callback_query}{message}, Arguments => $ArgumentsString, ); if ( !keys $ResponseData->%* ) { return; } } 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} || $Param{Message}{callback_query}{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) { my $MessageID = $Message->{message}{message_id} || $Message->{callback_query}{message}{message_id}; my $UserID = $Message->{message}{from}{id} || $Message->{callback_query}{message}{chat}{id}; if ( !$Self->{Whitelist}{$UserID} ) { $Self->{LogObject} ->info( 'fetchMessages: User not whitelisted, skipping message ' . Dumper($MessageDataRaw) ); $Self->{MessageIDs}{$MessageID} = 1; next MESSAGE; } if ($Self->{MessageIDs}{$MessageID}) { $Self->{LogObject}->info('fetchMessages: Skipping known message_id'); next MESSAGE; } else { $Self->{LogObject}->info('fetchMessages: Calling processMessage'); $Self->{MessageIDs}{$MessageID} = 1; $Self->processMessage( Message => $Message, ); } } YAML::DumpFile("$FindBin::Bin/message_ids.yml", $Self->{MessageIDs}); } 1;