TelegramBot/TelegramBot.pm

# 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};

    $Self->{CommandList} = {
        'greet' => \&greet,
    };

    # include plugins
    my @Plugins = glob("$FindBin::Bin/Plugins/*");
    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};
            }
        }
    }

    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 {
        # TODO load list of commands from core and plugins
        $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 = {};
    my $CommandList  = join('|', keys $Self->{CommandList}->%*);
    if ( defined $Param{Message}->{message} && $Param{Message}->{message}->{text} =~
        /\/(?<command>$CommandList)\s?(?<arguments>.*)?/ )
    {
        my $Message = $Param{Message}->{message};
        my $Command         = $+{command};
        my $ArgumentsString = $+{arguments};
        $ResponseData = $Self->{CommandList}{$Command}(
            $Self,
            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;