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 )