1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
|
#!perl
use strict;
no warnings;
use Test::More;
use AnyEvent::XMPP;
use AnyEvent::XMPP::Namespaces qw/xmpp_ns/;
use AnyEvent::XMPP::TestClient;
use AnyEvent::XMPP::IM::Message;
use AnyEvent::XMPP::Util qw/bare_jid/;
my $cl =
AnyEvent::XMPP::TestClient->new_or_exit (tests => 1, finish_count => 1);
my $C = $cl->client;
my $disco = $cl->instance_ext ('AnyEvent::XMPP::Ext::Disco');
my $ping = $cl->instance_ext ('AnyEvent::XMPP::Ext::Ping');
$disco->enable_feature ($ping->disco_feature);
my $disconnect_reason = '';
my @ignore_ids;
$C->reg_cb (
session_ready => sub {
my ($C, $acc) = @_;
my $con = $acc->connection;
push @ignore_ids, $con->next_iq_id;
$ping->enable_timeout ($con, 1);
},
disconnect => sub {
my ($C, $acc, $h, $p, $reason) = @_;
$disconnect_reason = $reason;
$cl->finish;
},
before_recv_stanza_xml => sub {
my ($C, $acc, $node, $rstop) = @_;
if ($node->eq (client => 'iq')
&& ($node->attr ('type') eq 'result' || $node->attr ('type') eq 'error')
&& grep { $_ eq $node->attr ('id') } @ignore_ids)
{
$$rstop = 1;
}
}
);
$cl->wait;
ok ($disconnect_reason =~ /timeout/, "disconnected by timeout");
|
