view release on metacpan or  search on metacpan

lib/EV/Telegram/TDLib/Bots.pm  view on Meta::CPAN

package EV::Telegram::TDLib::Bots;

use strict;
use warnings;
use Carp qw(croak);
use MIME::Base64 ();

our $VERSION = '0.04';

=head1 NAME

EV::Telegram::TDLib::Bots - bot methods for EV::Telegram::TDLib

=head1 DESCRIPTION

One of the mixins L<EV::Telegram::TDLib> inherits from. It has no
interface of its own and is not meant to be used directly: loading the
main module loads this one, and its methods are called on a client.

They are documented together with the rest of the API, under
L<EV::Telegram::TDLib/"Bots mixin">.

=cut

sub CLONE_SKIP { 1 }


our %UPDATES = (
    updateNewCallbackQuery         => \&update_callback_query,
    updateNewInlineCallbackQuery   => \&update_callback_query,
    updateNewBusinessCallbackQuery => \&update_callback_query,
    updateNewInlineQuery           => \&update_inline_query,
);

# TL `bytes` travels base64-encoded over the JSON interface, so callback
# payloads are decoded on the way in and encoded on the way out; a caller
# that never sees the encoding cannot get it wrong
# the query is decoded before the on_callback_query guard, so a bot that only
# registers on_callback_data still receives one
sub update_callback_query {
    my ($self, $obj) = @_;
    my $payload = $obj->{payload} // {};
    my %q = (
        id             => $obj->{id},
        sender_user_id => $obj->{sender_user_id},
        chat_id        => $obj->{chat_id},
        message_id     => $obj->{message_id},
        type           => $payload->{'@type'},
    );
    # a press on a message sent through inline mode has no chat: it names
    # the message by inline_message_id instead
    $q{inline_message_id} = $obj->{inline_message_id}
        if defined $obj->{inline_message_id};
    # one on a business message carries the message itself, and the
    # connection it came through
    if (ref $obj->{message} eq 'HASH' && ref $obj->{message}{message} eq 'HASH') {
        @q{qw(chat_id message_id)} = @{ $obj->{message}{message} }{qw(chat_id id)};
        $q{connection_id} = $obj->{connection_id};
    }
    $q{data} = MIME::Base64::decode_base64($payload->{data})
        if defined $payload->{data};
    $q{game_short_name} = $payload->{game_short_name}
        if defined $payload->{game_short_name};
    $self->route_callback_data(\%q);
    my $cb = $self->{on_callback_query} or return;
    $self->guarded($cb, \%q);
}

sub on_callback_query {
    my ($self, $cb) = @_;
    $self->{on_callback_query} = $cb if @_ > 1;
    return $self->{on_callback_query};
}

sub answer_callback_query {
    my ($self, @args) = @_;
    my $cb = ref $args[-1] eq 'CODE' ? pop @args : sub {};
    my ($id, @rest) = @args;
    my %opt = opts(@rest);
    need('callback_query_id', $id);
    # int64 crosses the JSON interface as a string; a number would lose
    # precision on ids above 2^53
    $self->send({
        '@type'           => 'answerCallbackQuery',
        callback_query_id => plain_text('a callback query id', $id),
        text              => plain_text('an answer text', $opt{text}),
        show_alert        => json_bool($opt{show_alert}),
        url               => plain_text('a url', $opt{url}),
        cache_time        => num('cache_time', $opt{cache_time} // 0),
    }, $cb);
    return;
}

# rows: [ [ { text => 'Yes', data => 'yes' }, { text => 'Docs', url => '...' } ] ]
sub inline_keyboard {
    my ($self, $rows) = @_;
    croak 'inline_keyboard needs an arrayref of rows'
        unless ref $rows eq 'ARRAY';
    my @out;
    for my $row (@$rows) {

lib/EV/Telegram/TDLib/Bots.pm  view on Meta::CPAN

    croak 'set_bot_name needs a name; pass the empty string to clear it'
        unless @args;
    my ($name, @rest) = @args;
    my %opt = opts(@rest);
    $self->send({
        '@type'        => 'setBotName',
        bot_user_id    => $self->bot_id(\%opt),
        language_code  => plain_text('a language code', $opt{language_code}),
        name           => plain_text('a bot name', $name),
    }, $cb);
    return;
}

sub set_bot_description {
    my ($self, @args) = @_;
    my $cb = ref $args[-1] eq 'CODE' ? pop @args : sub {};
    croak 'set_bot_description needs a description; pass the empty string '
        . 'to clear it' unless @args;
    my ($text, @rest) = @args;
    my %opt = opts(@rest);
    # the long text, shown on the bot's empty chat screen
    $self->send({
        '@type'        => 'setBotInfoDescription',
        bot_user_id    => $self->bot_id(\%opt),
        language_code  => plain_text('a language code', $opt{language_code}),
        description    => plain_text('a description', $text),
    }, $cb);
    return;
}

sub set_bot_short_description {
    my ($self, @args) = @_;
    my $cb = ref $args[-1] eq 'CODE' ? pop @args : sub {};
    croak 'set_bot_short_description needs a description; pass the empty '
        . 'string to clear it' unless @args;
    my ($text, @rest) = @args;
    my %opt = opts(@rest);
    # the one-liner shown in the bot's profile and in search results
    $self->send({
        '@type'            => 'setBotInfoShortDescription',
        bot_user_id        => $self->bot_id(\%opt),
        language_code      => plain_text('a language code', $opt{language_code}),
        short_description  => plain_text('a description', $text),
    }, $cb);
    return;
}

sub set_bot_photo {
    my ($self, @args) = @_;
    my $cb = ref $args[-1] eq 'CODE' ? pop @args : sub {};
    my ($path, @rest) = @args;
    my %opt = opts(@rest);
    $self->send({
        '@type'      => 'setBotProfilePhoto',
        bot_user_id  => $self->bot_id(\%opt),
        photo        => $self->input_chat_photo($path, \%opt),
    }, $cb);
    return;
}

sub update_inline_query {
    my ($self, $obj) = @_;
    my $cb = $self->{on_inline_query} or return;
    $self->guarded($cb, {
        id             => $obj->{id},
        sender_user_id => $obj->{sender_user_id},
        query          => $obj->{query},
        offset         => $obj->{offset},
        chat_type      => ($obj->{chat_type} || {})->{'@type'},
        user_location  => $obj->{user_location},
    });
}

sub on_inline_query {
    my ($self, $cb) = @_;
    $self->{on_inline_query} = $cb if @_ > 1;
    return $self->{on_inline_query};
}

# results: [ { id => '1', title => 'A', message => 'sent when picked' }, ... ]
sub answer_inline_query {
    my ($self, @args) = @_;
    my $cb = ref $args[-1] eq 'CODE' ? pop @args : sub {};
    my ($id, $results, @rest) = @args;
    my %opt = opts(@rest);
    need('inline_query_id', $id);
    croak 'answer_inline_query needs an arrayref of results'
        unless ref $results eq 'ARRAY';
    my $n = 0;
    my @out;
    my $bad;
    for my $r (@$results) {
        croak 'each inline result must be a hashref' unless ref $r eq 'HASH';
        croak 'each result needs a title' unless defined $r->{title};
        my $text = defined $r->{message} ? $r->{message} : $r->{title};
        push @out, {
            '@type'      => 'inputInlineQueryResultArticle',
            id           => defined $r->{id}
                                ? plain_text('a result id', $r->{id})
                                : "" . ++$n,
            title        => plain_text('a result title', $r->{title}),
            description  => plain_text('a result description', $r->{description}),
            url          => plain_text('a url', $r->{url}),
            thumbnail_url    => defined $r->{thumbnail_url}
                                  ? plain_text('a thumbnail url',
                                               $r->{thumbnail_url}) : '',
            thumbnail_width  => num('thumbnail_width', $r->{thumbnail_width} // 0),
            thumbnail_height => num('thumbnail_height', $r->{thumbnail_height} // 0),
            input_message_content => {
                '@type' => 'inputMessageText',
                text    => do {
                    my $t = $self->format_text($text,
                        $r->{parse_mode} // $opt{parse_mode});
                    # a parse failure must reach the caller, not TDLib
                    $bad ||= $t if ($t->{'@type'} // '') eq 'error';
                    $t;
                },
            },
            ($r->{reply_markup} ? (reply_markup => $r->{reply_markup}) : ()),
        };
    }