view release on metacpan or  search on metacpan

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

package EV::Telegram::TDLib::Chats;

use strict;
use warnings;
use Carp qw(croak);

our $VERSION = '0.04';

=head1 NAME

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

=cut

sub CLONE_SKIP { 1 }


# updates whose payload fields overwrite the same-named cached chat fields;
# two of them also carry the chat's complete position set, which replaces it
my %CHAT_FIELDS = (
    updateChatTitle                      => ['title'],
    updateChatPhoto                      => ['photo'],
    updateChatPermissions                => ['permissions'],
    updateChatLastMessage                => ['last_message'],
    updateChatDraftMessage               => ['draft_message'],
    updateChatReadInbox                  => ['last_read_inbox_message_id', 'unread_count'],
    updateChatReadOutbox                 => ['last_read_outbox_message_id'],
    updateChatUnreadMentionCount         => ['unread_mention_count'],
    updateChatNotificationSettings       => ['notification_settings'],
    updateChatIsMarkedAsUnread           => ['is_marked_as_unread'],
    updateChatBlockList                  => ['block_list'],
    updateChatHasScheduledMessages       => ['has_scheduled_messages'],
    updateChatDefaultDisableNotification => ['default_disable_notification'],
    updateChatActionBar                  => ['action_bar'],
    updateChatTheme                      => ['theme'],
    updateChatAvailableReactions         => ['available_reactions'],
    updateChatPendingJoinRequests        => ['pending_join_requests'],
    updateChatMessageAutoDeleteTime      => ['message_auto_delete_time'],
);

our %UPDATES = (
    updateNewChatJoinRequest    => \&update_join_request,
    updateNewChat      => \&update_new_chat,
    updateChatPosition => \&update_chat_position,
    updateChatAddedToList     => \&update_chat_list,
    updateChatRemovedFromList => \&update_chat_list,
    (map { $_ => \&update_chat_fields } keys %CHAT_FIELDS),
);

sub _chats { $_[0]{cache}{chats} ||= {} }

sub update_new_chat {
    my ($self, $obj) = @_;
    my $chat = $obj->{chat} or return;
    $self->_chats->{ $chat->{id} } = $chat;
    if (my $cb = $self->{on_chat}) { $cb->($chat) }
}

# a chat list is its type plus, for a folder, the folder's id: every folder is
# a chatListFolder, so keying on the type alone let folders overwrite each other
sub position_key {
    my ($list) = @_;
    my $type = $list->{'@type'} // '';
    return $type eq 'chatListFolder'
        ? "$type:" . ($list->{chat_folder_id} // '') : $type;
}

# updateChatPosition carries the one position that changed; order 0 means the
# chat left that list
sub merge_position {
    my ($chat, $pos) = @_;
    my $key = position_key($pos->{list});
    my $positions = $chat->{positions} ||= [];
    @$positions = grep { position_key($_->{list}) ne $key } @$positions;
    push @$positions, $pos unless ($pos->{order} // 0) eq '0';
}

# payload fields the schema marks nullable: TDLib omits a null object
# field from the JSON entirely, so for these an absent key means
# "now null", not "unchanged"
my %NULLABLE = map { $_ => 1 } qw(
    last_message draft_message photo action_bar theme block_list
    pending_join_requests
);

sub update_chat_fields {
    my ($self, $obj) = @_;
    my $fields = $CHAT_FIELDS{ $obj->{'@type'} } or return;
    return unless defined $obj->{chat_id};
    my $chat = $self->_chats->{ $obj->{chat_id} } or return;
    for my $f (@$fields) {
        $chat->{$f} = $obj->{$f} if $NULLABLE{$f} || exists $obj->{$f};
    }
    # updateChatLastMessage and updateChatDraftMessage carry the chat's
    # complete set of positions and are sent instead of updateChatPosition,
    # so a list the chat has left is signalled only by its absence: replace
    $chat->{positions} = [ grep { ($_->{order} // 0) ne '0' } @{ $obj->{positions} } ]
        if ref $obj->{positions} eq 'ARRAY';
}

sub update_chat_position {
    my ($self, $obj) = @_;
    return unless defined $obj->{chat_id};
    my $chat = $self->_chats->{ $obj->{chat_id} } or return;
    merge_position($chat, $obj->{position}) if $obj->{position};
}

# chat_lists is membership, which the schema keeps apart from positions:
# updateNewChat carries it as it stood, usually empty, and these two keep it
# current
sub update_chat_list {
    my ($self, $obj) = @_;
    return unless defined $obj->{chat_id} && $obj->{chat_list};
    my $chat = $self->_chats->{ $obj->{chat_id} } or return;
    my $key = position_key($obj->{chat_list});
    my $lists = $chat->{chat_lists} ||= [];
    @$lists = grep { position_key($_) ne $key } @$lists;
    push @$lists, $obj->{chat_list} if $obj->{'@type'} eq 'updateChatAddedToList';
}

sub chat {
    my ($self, $id) = @_;
    # documented to answer undef for a chat this client has not seen, and
    # `my $c = $td->chat($id) or return` is the idiomatic call, so an undef id
    # answers the same way rather than croaking. Returning early only to keep
    # the lookup from warning from inside the module.
    return undef unless defined $id;
    # keyed as TDLib sends ids, so a padded or signed one -- accepted
    # everywhere else -- is normalised to find the same entry
    $id = 0 + $id if !ref $id && $id =~ /\A\s*[+-]?[0-9]+\s*\z/;
    return $self->_chats->{$id};
}

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

sub load_chats {
    my ($self, @args) = @_;
    my $cb = ref $args[-1] eq 'CODE' ? pop @args : sub {};
    my ($limit, @rest) = @args;
    my %opt = opts(@rest);
    need('limit', $limit);
    # loadChats is what makes TDLib fetch more of a list, so without this the
    # archive and the folders could never be paged past whatever was cached
    $self->send({ '@type' => 'loadChats', limit => 0 + $limit,
                  chat_list => chat_list($opt{list}) }, sub {
        my ($res, $err) = @_;
        # TDLib answers 404 once the chat list is exhausted; that is the
        # normal end of a load, not a failure
        $err = undef if $err && ($err->{code} // 0) == 404;
        $cb->($res, $err);
    });
    return;
}

sub chat_by_username {
    my ($self, @args) = @_;
    my $cb = ref $args[-1] eq 'CODE' ? pop @args : sub {};
    no_extra('chat_by_username', 1, \@args);
    my ($name) = @args;
    need('username', $name);
    $name = plain_text('a username', $name);
    $name =~ s/^\@//;
    $self->send({ '@type' => 'searchPublicChat', username => $name }, sub {
        my ($chat, $err) = @_;
        $self->_chats->{ $chat->{id} } = $chat if $chat;
        $cb->($chat, $err);
    });

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

    my %opt = opts(@rest);
    $self->send({
        '@type'      => 'getBlockedMessageSenders',
        block_list   => { '@type' => ($opt{stories} ? 'blockListStories'
                                                    : 'blockListMain') },
        offset       => num('offset', $opt{offset} // 0),
        limit        => num('limit', $opt{limit} // 100),
    }, $cb);
    return;
}

sub join_requests {
    my ($self, @args) = @_;
    my $cb = ref $args[-1] eq 'CODE' ? pop @args : sub {};
    my ($chat_id, @rest) = @args;
    my %opt = opts(@rest);
    need('chat_id', $chat_id);
    $self->send({
        '@type'          => 'getChatJoinRequests',
        chat_id          => 0 + $chat_id,
        invite_link      => plain_text('an invite link', $opt{link}),
        query            => plain_text('a query', $opt{query}),
        (defined $opt{offset_request}
            ? (offset_request => $opt{offset_request}) : ()),
        limit            => num('limit', $opt{limit} // 100),
    }, $cb);
    return;
}

sub process_join_request {
    my ($self, @args) = @_;
    my $cb = ref $args[-1] eq 'CODE' ? pop @args : sub {};
    my ($chat_id, $user_id, $approve, @rest) = @args;
    no_opts('process_join_request', @rest);
    need('chat_id, user_id', $chat_id, $user_id);
    $self->send({ '@type' => 'processChatJoinRequest', chat_id => 0 + $chat_id,
                  user_id => 0 + $user_id,
                  approve => json_bool(defined $approve ? $approve : 1) }, $cb);
    return;
}

# approves or declines everyone at once, optionally only those from one link
sub process_join_requests {
    my ($self, @args) = @_;
    my $cb = ref $args[-1] eq 'CODE' ? pop @args : sub {};
    my ($chat_id, $approve, @rest) = @args;
    my %opt = opts(@rest);
    need('chat_id', $chat_id);
    $self->send({ '@type' => 'processChatJoinRequests', chat_id => 0 + $chat_id,
                  invite_link => plain_text('an invite link', $opt{link}),
                  approve => json_bool(defined $approve ? $approve : 1) }, $cb);
    return;
}

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

sub update_join_request {
    my ($self, $obj) = @_;
    my $cb = $self->{on_join_request} or return;
    my $r = $obj->{request} || {};
    $cb->({
        chat_id       => $obj->{chat_id},
        user_id       => $r->{user_id},
        date          => $r->{date},
        bio           => $r->{bio},
        invite_link   => $obj->{invite_link},
        user_chat_id  => $obj->{user_chat_id},
    });
}

# A supergroup's chat id is -1000000000000 minus its supergroup id, and the
# supergroup_* methods want the latter. Everything else in this module takes a
# chat id, so accept either and convert rather than let the mismatch surface as
# an unhelpful server error.
sub supergroup_id {
    my ($id) = @_;
    return 0 + $id unless $id < 0;
    return -1000000000000 - $id;
}

# A basic group's chat id is its group id negated, with no offset: DialogId
# builds one as -chat_id and reads it back as ChatId(-id). Same reasoning as
# supergroup_id -- take either rather than send a negative id TDLib rejects.
sub basic_group_id {
    my ($id) = @_;
    return $id < 0 ? -$id : 0 + $id;
}

sub add_members {
    my ($self, @args) = @_;
    my $cb = ref $args[-1] eq 'CODE' ? pop @args : sub {};
    no_extra('add_members', 2, \@args);
    my ($chat_id, $user_ids) = @args;
    need('chat_id, user_ids', $chat_id, $user_ids);
    croak 'add_members needs an arrayref of user ids' unless ref $user_ids eq 'ARRAY';
    $self->send({ '@type' => 'addChatMembers', chat_id => 0 + $chat_id,
                  user_ids => num_list('user_ids', $user_ids) }, $cb);
    return;
}

# revoke also deletes what they already sent, which set_member_status does
# not; TDLib passes it on for a basic group only
sub ban_member {
    my ($self, @args) = @_;
    my $cb = ref $args[-1] eq 'CODE' ? pop @args : sub {};
    my ($chat_id, $user_id, @rest) = @args;
    my %opt = opts(@rest);
    need('chat_id, user_id', $chat_id, $user_id);
    $self->send({ '@type' => 'banChatMember', chat_id => 0 + $chat_id,
                  member_id => sender($user_id),
                  banned_until_date => unix_time('until', $opt{until} // 0),
                  revoke_messages => json_bool($opt{revoke}) }, $cb);
    return;
}

sub transfer_ownership {
    my ($self, @args) = @_;