AnyEvent-XMPP
view release on metacpan or search on metacpan
lib/AnyEvent/XMPP/Ext/Receipts.pm view on Meta::CPAN
=item B<disco>
An C<AnyEvent::XMPP::Ext::Disco> object so that it can be figured out whether
the recipient supports message receipts (via service discovery).
This is required.
=item B<debug>
If you pass a value that evaluates to true, debug messages will be printed to
STDOUT.
=item B<auto_resend>
Amount of time in seconds after which messages will be re-sent when no receipt
was received. Of course messages will only be re-sent if the recipient is known
to support message receipts.
Defaults to 30 (seconds).
Set to 0 to disable automatic re-sending.
=back
Here is an example with all keys set:
my $receipts = AnyEvent::XMPP::Ext::Receipts->new(
disco => $disco,
auto_resend => 30,
debug => 1,
);
=cut
sub new {
my $this = shift;
my $class = ref($this) || $this;
my $self = bless { @_ }, $class;
die "You did not pass an AnyEvent::XMPP::Ext::Disco object as 'disco', see SYNOPSIS"
unless defined($self->{disco});
$self->{debug} //= 0;
# Re-send messages after unacknowledged for 30 seconds.
$self->{auto_resend} //= 30;
$self->init;
$self
}
sub init {
my ($self) = @_;
set_xmpp_ns_alias(receipts => 'urn:xmpp:receipts');
$self->reg_cb(
ext_before_message_xml => sub {
my ($self, $con, $node) = @_;
# Figure out if this is a receive receipt (XEP-0184), such a message
# looks like this:
# <message from="recipient@jabber.ccc.de/androidDc9226M8"
# id="CA597-36"
# to="me@jabber.ccc.de/18327446281349735808246801">
# <received id="foobar23" xmlns="urn:xmpp:receipts"/>
# </message>
my ($receipt) = $node->find_all ([qw/receipts received/]);
if (defined($receipt)) {
my $id = $receipt->attr('id');
print "(xep0184) message $id acknowledged\n" if $self->{debug};
delete $timers{$id};
# If the recipient acknowledged our message, he *obviously*
# supports receipts.
$supports_receipts{$node->attr('from')} = 1;
$self->stop_event;
}
# Figure out if this is a message which requests a receipt, such as
# <message from="me@jabber.ccc.de/Psi+" id="aae0a" to="recipient@jabber.ccc.de/presence" type="chat" xml:lang="en">
# <body>Did you get this?</body>
# <request xmlns="urn:xmpp:receipts"/>
# </message>
my ($request) = $node->find_all ([qw/receipts request/]);
if (defined($request)) {
my $id = $node->attr('id');
print "(xep0184) sending receipt for $id\n" if $self->{debug};
# A receipt looks like this:
# <message from="recipient@jabber.ccc.de/presence" to="me@jabber.ccc.de/Psi+">
# <received xmlns="urn:xmpp:receipts" id="aae0a"/>
# </message>
$con->send_message(
$node->attr('from'),
$node->attr('type'),
# Add a receipt request tag to the message, like this:
# <received xmlns='urn:xmpp:receipts' id="aae0a"/>
sub {
my $w = shift;
$w->addPrefix('urn:xmpp:receipts', '');
$w->startTag(['urn:xmpp:receipts', 'received'],
id => $id);
$w->endTag;
},
_is_receipt => 1);
}
},
ext_before_send_message_hook => sub {
my ($self, $con, $id, $to, $type, $attrs, $create_cb) = @_;
# We can only handle full jids as per XEP-0184 5.1:
# "If the sender knows only the recipient's bare JID, it cannot
# cannot determine [...] whether the intended recipient supports
# the Message Delivery Receipts protoocl. [...] the sender MUST NOT
# depend on receiving an ack message in reply."
# If we canât rely on ack messages, receipts are useless.
return if is_bare_jid($to);
# If we have already figured out that the recipient does not
# support message receipts, sending them (and especially waiting
# for acknowledge) is pointless.
return if exists($supports_receipts{$to}) && !$supports_receipts{$to};
# If this is a message receipt (sent by us), do not add a receipt
( run in 1.751 second using v1.01-cache-2.11-cpan-39bf76dae61 )