EV-Telegram-TDLib
view release on metacpan or search on metacpan
lib/EV/Telegram/TDLib/Bots.pm view on Meta::CPAN
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
lib/EV/Telegram/TDLib/Bots.pm view on Meta::CPAN
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},
});
lib/EV/Telegram/TDLib/Business.pm view on Meta::CPAN
# A business_connection_id arrives only through updateBusinessConnection, so
# without these handlers every method that takes one would be unreachable.
# edited and deleted business messages, and the quick-reply updates, carry no
# hook of their own and reach on_update like any other unhandled type
our %UPDATES = (
updateBusinessConnection => \&update_connection,
updateNewBusinessMessage => \&update_new_business_message,
);
sub update_connection {
my ($self, $obj) = @_;
if (my $cb = $self->{on_business_connection}) { $cb->($obj->{connection}) }
}
sub update_new_business_message {
my ($self, $obj) = @_;
if (my $cb = $self->{on_business_message}) {
$cb->({ connection_id => $obj->{connection_id},
message => $obj->{message} });
}
}
sub on_business_connection {
my ($self, $cb) = @_;
$self->{on_business_connection} = $cb if @_ > 1;
lib/EV/Telegram/TDLib/Chats.pm view on Meta::CPAN
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) = @_;
lib/EV/Telegram/TDLib/Chats.pm view on Meta::CPAN
}
# 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 {
lib/EV/Telegram/TDLib/Chats.pm view on Meta::CPAN
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},
lib/EV/Telegram/TDLib/Connection.pm view on Meta::CPAN
sub CLONE_SKIP { 1 }
our %UPDATES = (
updateConnectionState => \&update_connection_state,
updateOption => \&update_option,
);
# TDLib pushes its options as updates, my_id among them right after login,
# so the account's own id is known without a getMe round trip
sub update_option {
my ($self, $obj) = @_;
my $name = $obj->{name};
return unless defined $name;
my $v = $obj->{value} // {};
my $type = $v->{'@type'} // '';
$self->{cache}{options}{$name} =
$type eq 'optionValueEmpty' ? undef
: $type eq 'optionValueBoolean' ? ($v->{value} ? 1 : 0)
: $v->{value};
}
lib/EV/Telegram/TDLib/Connection.pm view on Meta::CPAN
sub option {
my ($self, $name) = @_;
# same as the other cache readers: undef in, undef out, and no warning
# from inside the module for the lookup
return undef unless defined $name;
return $self->{cache}{options}{$name};
}
sub my_id { $_[0]{cache}{options}{my_id} }
sub update_connection_state {
my ($self, $obj) = @_;
my $state = $obj->{state} or return;
my $type = $state->{'@type'} // '';
return unless length $type;
$self->{cache}{connection_state} = $type;
if (my $cb = $self->{on_connection_state}) { $cb->($type) }
}
sub connection_state { $_[0]{cache}{connection_state} }
lib/EV/Telegram/TDLib/Files.pm view on Meta::CPAN
our %UPDATES = (
updateFile => \&update_file,
);
sub downloads { $_[0]{cache}{downloads} ||= {} }
sub uploads { $_[0]{cache}{uploads} ||= {} }
sub update_file {
my ($self, $obj) = @_;
my $file = $obj->{file} or return;
# an id-less file would key both registries under the empty string and
# collide with a later lookup
return unless defined $file->{id};
# TDLib re-sends updateFile for reasons unrelated to our download, so
# only registered ids are followed and a completed one is dropped at once.
# One update can reach both registries for the same id, so every callback
# is guarded: a die in an earlier one would strand the other's watcher.
if (my $dl = $self->downloads->{ $file->{id} }) {
lib/EV/Telegram/TDLib/Messages.pm view on Meta::CPAN
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'
lib/EV/Telegram/TDLib/Messages.pm view on Meta::CPAN
# 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
lib/EV/Telegram/TDLib/Payments.pm view on Meta::CPAN
our %UPDATES = (
updateNewPreCheckoutQuery => \&update_pre_checkout,
updateNewShippingQuery => \&update_shipping,
);
# The invoice payload is the seller's own order id, handed back at checkout.
# It is TL bytes in inputMessageInvoice and in updateNewPreCheckoutQuery, but a
# plain string in updateNewShippingQuery -- encoding all three alike corrupts
# the shipping one, so each is handled on its own terms.
sub update_pre_checkout {
my ($self, $obj) = @_;
my $cb = $self->{on_pre_checkout_query} or return;
$cb->({
id => $obj->{id},
sender_user_id => $obj->{sender_user_id},
currency => $obj->{currency},
total_amount => $obj->{total_amount},
payload => MIME::Base64::decode_base64($obj->{invoice_payload} // ''),
shipping_option_id => $obj->{shipping_option_id},
order_info => $obj->{order_info},
});
}
sub update_shipping {
my ($self, $obj) = @_;
my $cb = $self->{on_shipping_query} or return;
$cb->({
id => $obj->{id},
sender_user_id => $obj->{sender_user_id},
payload => $obj->{invoice_payload},
shipping_address => $obj->{shipping_address},
});
}
lib/EV/Telegram/TDLib/Stories.pm view on Meta::CPAN
our %UPDATES = (
updateStory => \&update_story,
updateStoryDeleted => \&update_story_deleted,
updateStoryPostSucceeded => \&update_post_succeeded,
updateStoryPostFailed => \&update_post_failed,
updateChatActiveStories => \&update_active_stories,
);
sub posting { $_[0]{cache}{posting} ||= {} }
sub update_story {
my ($self, $obj) = @_;
if (my $cb = $self->{on_story}) { $cb->($obj->{story}) }
}
# The schema says a canceled post yields updateStoryDeleted instead of
# updateStoryPostFailed. That comment is stale for 1.8.66: on_delete_story
# returns early unless the id is a server one (<= 1999999999), while a
# yet-unsent story is numbered from 2000000000 up, so this update never
# carries a provisional id. A cancelled post takes the 406 "Canceled" path
# into delete_pending_story, which emits updateStoryPostFailed -- already
# handled. So there is nothing to resolve here.
sub update_story_deleted {
my ($self, $obj) = @_;
if (my $cb = $self->{on_story_deleted}) {
$cb->($obj->{story_poster_chat_id}, $obj->{story_id});
}
}
# a provisional story id is unique only among one chat's stories, so two
# chats posting at once would otherwise share a key
sub posting_key {
my ($chat_id, $story_id) = @_;
return unless defined $chat_id && defined $story_id;
return (0 + $chat_id) . ':' . (0 + $story_id);
}
sub update_post_succeeded {
my ($self, $obj) = @_;
my $key = posting_key($obj->{story}{poster_chat_id}, $obj->{old_story_id})
or return;
my $cb = delete $self->posting->{$key} or return;
$cb->($obj->{story}, undef);
}
sub update_post_failed {
my ($self, $obj) = @_;
my $key = posting_key($obj->{story}{poster_chat_id}, $obj->{story}{id})
or return;
my $cb = delete $self->posting->{$key} or return;
$cb->(undef, $obj->{error} // { '@type' => 'error', code => -1,
message => 'story post failed' });
}
sub update_active_stories {
my ($self, $obj) = @_;
if (my $cb = $self->{on_active_stories}) { $cb->($obj->{active_stories}) }
}
sub on_story {
my ($self, $cb) = @_;
$self->{on_story} = $cb if @_ > 1;
return $self->{on_story};
}
lib/EV/Telegram/TDLib/Users.pm view on Meta::CPAN
sub CLONE_SKIP { 1 }
our %UPDATES = (
updateUser => \&update_user,
);
sub users { $_[0]{cache}{users} ||= {} }
sub update_user {
my ($self, $obj) = @_;
my $user = $obj->{user} or return;
$self->users->{ $user->{id} } = $user;
if (my $cb = $self->{on_user}) { $cb->($user) }
}
sub me {
my ($self, @args) = @_;
my $cb = ref $args[-1] eq 'CODE' ? pop @args : sub {};
no_extra('me', 0, \@args);
( run in 0.462 second using v1.01-cache-2.11-cpan-57ff5998125 )