view release on metacpan or  search on metacpan

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

package EV::Telegram::TDLib::Messages;

use strict;
use warnings;
use Carp qw(croak);
use EV;
use Encode ();
use overload ();

our $VERSION = '0.04';

=head1 NAME

EV::Telegram::TDLib::Messages - message 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/"Messages mixin">.

=cut

sub CLONE_SKIP { 1 }

my %PARSE_MODE = (
    markdown => { '@type' => 'textParseModeMarkdown', version => 2 },
    html     => { '@type' => 'textParseModeHTML' },
);

our %UPDATES = (
    updateNewMessage            => \&update_new_message,
    updateMessageSendSucceeded  => \&update_send_succeeded,
    updateMessageSendFailed     => \&update_send_failed,
    updateDeleteMessages        => \&update_delete_messages,
);

sub sending { $_[0]{cache}{sending} ||= {} }


sub update_new_message {
    my ($self, $obj) = @_;
    my $msg = $obj->{message} or return;
    # an answer to a pending ask is not offered to the command router: a reply
    # that happens to start with a slash would otherwise run two code paths
    my $answered = $self->answer_ask($msg);
    $self->route_command($msg) unless $answered;
    if (my $cb = $self->{on_message}) { $cb->($msg) }
    # Mini App data arrives as a message content, not as its own update
    my $c = $msg->{content};
    return unless ref $c eq 'HASH'
        && ($c->{'@type'} // '') eq 'messageWebAppDataReceived';
    if (my $cb = $self->{on_web_app_data}) {
        $cb->($msg, $c->{data}, $c->{button_text});
    }
}

# A yet-unsent message id is assigned from a per-chat counter, so the Nth send
# to one chat and the Nth to another share it. Keying on the id alone dropped
# one callback and handed the other the wrong chat's message.
sub sending_key {
    my ($chat_id, $message_id) = @_;
    return unless defined $chat_id && defined $message_id;
    return (0 + $chat_id) . ':' . (0 + $message_id);
}

sub update_send_succeeded {
    my ($self, $obj) = @_;
    my $key = sending_key($obj->{message}{chat_id}, $obj->{old_message_id})
        or return;
    my $cb = delete $self->sending->{$key} or return;
    $cb->($obj->{message}, undef);
}

sub update_send_failed {
    my ($self, $obj) = @_;
    my $key = sending_key($obj->{message}{chat_id}, $obj->{old_message_id})
        or return;
    my $cb = delete $self->sending->{$key} or return;
    $cb->(undef, $obj->{error} // { '@type' => 'error', code => -1,
                                    message => 'message send failed' });
}

# The schema says it outright: a message being sent that is irrecoverably
# deleted yields this instead of updateMessageSendFailed. Without it a caller
# waiting for delivery is owed an answer that never comes, and only close()
# ever resolves it.
sub update_delete_messages {
    my ($self, $obj) = @_;
    # a cache eviction is not a deletion: the schema says such a message can
    # be retrieved again, so the send is still outstanding
    return if $obj->{from_cache};
    my $sending = $self->sending;
    return unless %$sending;
    for my $id (@{ $obj->{message_ids} || [] }) {
        my $key = sending_key($obj->{chat_id}, $id) or next;
        my $cb = delete $sending->{$key} or next;
        # guarded: one update can carry many ids, and a die in an earlier
        # callback would strand the rest
        $self->guarded($cb, undef,
                        { '@type' => 'error', code => -1,
                          message => 'message deleted before it was sent' });
    }
}

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

# Stringified here rather than at each caller: an SV that has ever been used
# as a number carries IOK, the encoder then emits a JSON Number, and TDLib
# refuses a Number in a text field. A bare numeric comparison is enough to
# set it, so the same string can send once and fail afterwards.
sub format_text {
    my ($self, $text, $parse_mode) = @_;
    # translate() and parse_markdown() answer with a formattedText, and
    # stringifying one sent HASH(0x...) to the chat: already-formatted text
    # passes straight through, and parse_mode has nothing left to do. An
    # object that stringifies, a URI say, is text like any other
    if (ref $text && !overload::Method($text, '""')) {
        return $text if ref $text eq 'HASH'
                     && ($text->{'@type'} // '') eq 'formattedText';
        croak 'text must be a string or a formattedText';
    }
    $text = defined $text ? "$text" : '';
    return { '@type' => 'formattedText', text => $text, entities => [] }
        unless $parse_mode;
    my $mode = $PARSE_MODE{$parse_mode}
        or croak "unknown parse_mode '$parse_mode'";
    return $self->execute({
        '@type' => 'parseTextEntities', text => $text, parse_mode => $mode,
    });
}

sub input_text {
    my ($self, $text, $opt, $cb) = @_;
    my $formatted = $self->format_text($text, $opt->{parse_mode});
    if (($formatted->{'@type'} // '') eq 'error') {
        $cb->(undef, $formatted);
        return;
    }
    my %content = ('@type' => 'inputMessageText', text => $formatted);
    $content{link_preview_options} = { '@type' => 'linkPreviewOptions',
                                       is_disabled => json_bool(1) }
        if $opt->{disable_preview};
    return \%content;