Some tidying and a bit of necessary reworking.
This commit is contained in:
		
							
								
								
									
										105
									
								
								TelegramBot.pm
									
									
									
									
									
								
							
							
						
						
									
										105
									
								
								TelegramBot.pm
									
									
									
									
									
								
							@@ -47,18 +47,27 @@ sub new {
 | 
			
		||||
    # whitelist
 | 
			
		||||
    $Self->{Whitelist} = $Param{Whitelist};
 | 
			
		||||
 | 
			
		||||
    # default command list
 | 
			
		||||
    $Self->{CommandList} = {
 | 
			
		||||
        'greet' => \&greet,
 | 
			
		||||
    };
 | 
			
		||||
 | 
			
		||||
    # include plugins
 | 
			
		||||
    # 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 ) {
 | 
			
		||||
@@ -74,6 +83,15 @@ sub new {
 | 
			
		||||
 | 
			
		||||
                $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};
 | 
			
		||||
            }
 | 
			
		||||
        }
 | 
			
		||||
    }
 | 
			
		||||
 | 
			
		||||
@@ -102,9 +120,9 @@ sub greet {
 | 
			
		||||
    $Self->{LogObject}->debug( 'Random Greet is ' . $Greet );
 | 
			
		||||
    my $ReturnContent =
 | 
			
		||||
      $Greet . ', '
 | 
			
		||||
      . ( $Param{Message}->{chat}->{first_name}
 | 
			
		||||
        ? $Param{Message}->{chat}->{first_name}
 | 
			
		||||
        : $Param{Message}->{chat}->{username} )
 | 
			
		||||
      . ( $Param{Message}{chat}{first_name}
 | 
			
		||||
        ? $Param{Message}{chat}{first_name}
 | 
			
		||||
        : $Param{Message}{chat}{username} )
 | 
			
		||||
      . '!';
 | 
			
		||||
    $Self->{LogObject}->debug( 'ReturnContent is ' . $ReturnContent );
 | 
			
		||||
    return { text => $ReturnContent, };
 | 
			
		||||
@@ -118,8 +136,8 @@ sub greet {
 | 
			
		||||
 | 
			
		||||
# 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);
 | 
			
		||||
@@ -135,8 +153,8 @@ sub build {
 | 
			
		||||
            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},
 | 
			
		||||
                    'chat_id'             => $Param{Message}{callback_query}{from}{id},
 | 
			
		||||
                    'reply_to_message_id' => $Param{Message}{callback_query}{message}{message_id},
 | 
			
		||||
                    'text'                => "Kommando $Param{QueryStep} erkannt",
 | 
			
		||||
                }
 | 
			
		||||
            );
 | 
			
		||||
@@ -146,17 +164,16 @@ sub build {
 | 
			
		||||
 | 
			
		||||
    }
 | 
			
		||||
    else {
 | 
			
		||||
        # TODO load list of commands from core and plugins
 | 
			
		||||
        $KeyboardData = {
 | 
			
		||||
            'inline_keyboard' => [
 | 
			
		||||
                [
 | 
			
		||||
                    {
 | 
			
		||||
                        'text'          => 'Grüßen',
 | 
			
		||||
                        'callback_data' => 'greet'
 | 
			
		||||
                        'callback_data' => 'greet',
 | 
			
		||||
                    },
 | 
			
		||||
                    {
 | 
			
		||||
                        'text'          => 'Statistik',
 | 
			
		||||
                        'callback_data' => 'statistics'
 | 
			
		||||
                        'callback_data' => 'statistics',
 | 
			
		||||
                    },
 | 
			
		||||
                ],
 | 
			
		||||
            ],
 | 
			
		||||
@@ -164,16 +181,18 @@ sub build {
 | 
			
		||||
            '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?";
 | 
			
		||||
        $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?";
 | 
			
		||||
    }
 | 
			
		||||
    my $EncodedKeyboard = JSON::encode_json(
 | 
			
		||||
 | 
			
		||||
    # keyboard encoding
 | 
			
		||||
    my $EncodedKeyboard = JSON::to_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},
 | 
			
		||||
            'chat_id'             => $Param{Message}{message}{chat}{id},
 | 
			
		||||
            'reply_to_message_id' => $Param{Message}{message}{message_id},
 | 
			
		||||
            'text'                => $KeyboardMessage,
 | 
			
		||||
            'reply_markup'        => $EncodedKeyboard,
 | 
			
		||||
        }
 | 
			
		||||
@@ -191,8 +210,8 @@ sub build {
 | 
			
		||||
=cut
 | 
			
		||||
 | 
			
		||||
sub processMessage {
 | 
			
		||||
 | 
			
		||||
    my ( $Self, %Param ) = @_;
 | 
			
		||||
 | 
			
		||||
    use Data::Dumper;
 | 
			
		||||
    use LWP::Simple::REST qw(POST plain json);
 | 
			
		||||
 | 
			
		||||
@@ -205,13 +224,15 @@ sub processMessage {
 | 
			
		||||
    $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} =~
 | 
			
		||||
    my $QueryTriggerList  = join('|', keys $Self->{QueryTrigger}->%*);
 | 
			
		||||
 | 
			
		||||
    # command branch
 | 
			
		||||
    if ( defined $Param{Message}{message} && $Param{Message}{message}{text} && $Param{Message}{message}{text} =~
 | 
			
		||||
        /\/(?<command>$CommandList)\s?(?<arguments>.*)?/ )
 | 
			
		||||
    {
 | 
			
		||||
        my $Message = $Param{Message}->{message};
 | 
			
		||||
        my $Message = $Param{Message}{message};
 | 
			
		||||
        my $Command         = $+{command};
 | 
			
		||||
        my $ArgumentsString = $+{arguments};
 | 
			
		||||
        $ResponseData = $Self->{CommandList}{$Command}(
 | 
			
		||||
@@ -223,25 +244,40 @@ sub processMessage {
 | 
			
		||||
            return;
 | 
			
		||||
        }
 | 
			
		||||
    }
 | 
			
		||||
    elsif ( defined $Param{Message}->{callback_query} ) {
 | 
			
		||||
 | 
			
		||||
    # query trigger branch
 | 
			
		||||
    elsif ( defined $Param{Message}{message} && $Param{Message}{message}{text} && $Param{Message}{message}{text} =~ /\/(?<trigger>$QueryTriggerList)/ ) {
 | 
			
		||||
        $Self->build(
 | 
			
		||||
            Message   => $Param{Message},
 | 
			
		||||
            QueryStep => $Param{Message}->{callback_query}->{data},
 | 
			
		||||
            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} );
 | 
			
		||||
          ->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} )
 | 
			
		||||
              . ( $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";
 | 
			
		||||
        }
 | 
			
		||||
 | 
			
		||||
@@ -250,7 +286,7 @@ sub processMessage {
 | 
			
		||||
    my $ResponseResult = plain POST(
 | 
			
		||||
        join( '/', ( $Self->{TelegramURL}, $Self->{Token}, 'sendMessage' ) ),
 | 
			
		||||
        {
 | 
			
		||||
            chat_id => $Param{Message}->{message}->{chat}->{id},
 | 
			
		||||
            chat_id => $Param{Message}{message}{chat}{id} || $Param{Message}{callback_query}{message}{chat}{id},
 | 
			
		||||
            $ResponseData->%*,
 | 
			
		||||
        }
 | 
			
		||||
    );
 | 
			
		||||
@@ -262,7 +298,7 @@ sub processMessage {
 | 
			
		||||
    my $SeenResult = plain POST(
 | 
			
		||||
        join( '/', ( $Self->{TelegramURL}, $Self->{Token}, 'readMessageContents' ) ),
 | 
			
		||||
        {
 | 
			
		||||
            id => $Param{Message}->{message}->{id},
 | 
			
		||||
            id => $Param{Message}{message}{id},
 | 
			
		||||
        }
 | 
			
		||||
    );
 | 
			
		||||
 | 
			
		||||
@@ -275,7 +311,6 @@ sub processMessage {
 | 
			
		||||
=cut
 | 
			
		||||
 | 
			
		||||
sub fetchMessages {
 | 
			
		||||
 | 
			
		||||
    my ( $Self, %Param ) = @_;
 | 
			
		||||
    use Data::Dumper;
 | 
			
		||||
    use LWP::Simple::REST qw(GET json);
 | 
			
		||||
@@ -293,20 +328,22 @@ sub fetchMessages {
 | 
			
		||||
 | 
			
		||||
    MESSAGE:
 | 
			
		||||
    for my $Message (@Messages) {
 | 
			
		||||
        if ( !$Self->{Whitelist}{$Message->{message}{from}{id}} ) {
 | 
			
		||||
        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}{$Message->{message}{message_id}} = 1;
 | 
			
		||||
            $Self->{MessageIDs}{$MessageID} = 1;
 | 
			
		||||
            next MESSAGE;
 | 
			
		||||
        }
 | 
			
		||||
        if ($Self->{MessageIDs}{$Message->{message}{message_id}}) {
 | 
			
		||||
        if ($Self->{MessageIDs}{$MessageID}) {
 | 
			
		||||
            $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->{MessageIDs}{$MessageID} = 1;
 | 
			
		||||
            $Self->processMessage( Message => $Message, );
 | 
			
		||||
        }
 | 
			
		||||
    }
 | 
			
		||||
 
 | 
			
		||||
		Reference in New Issue
	
	Block a user