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
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
|
use lib "t/lib";
use Test::More tests=>5;
BEGIN{ use_ok( "Net::XMPP" ); }
my $Client;
my $connected = 0;
my $server = "obelisk.net";
my $port = 5225;
my $username = "test-netjabber";
my $password = "test";
my $resource = $$.time.qx(hostname);
chomp($resource);
###############################################################################
#
# Make sure you can ever connect to the server. If we cannot then we should
# skip the rest of the tests because they will fail.
#
###############################################################################
SKIP:
{
my $sock = IO::Socket::INET->new(PeerAddr=>"$server:$port");
skip "Cannot open connection (maybe a firewall?)",4 unless defined($sock);
$sock->close();
$Client = Net::XMPP::Client->new();
$Client->SetCallBacks(onconnect => \&onConnect,
onauth => \&onAuth,
message => \&onMessage,
);
$Client->Execute(username=>$username,
password=>$password,
resource=>$resource,
hostname=>$server,
port=>$port,
register=>1,
connectsleep=>0,
connectattempts=>1,
);
#--------------------------------------------------------------------------
# If all went well, we should never get here.
#--------------------------------------------------------------------------
ok(0,"Connected") unless $connected;
ok(0,"Authenticated");
ok(0,"Subject");
ok(0,"Body");
}
###############################################################################
#
# onConnect - when we establish an initial connection to the server run the
# following
#
###############################################################################
sub onConnect
{
$connected = 1;
ok(1, "Connected");
}
###############################################################################
#
# onAuth - when we have successfully authenticated with the server send a
# test message to ourselves.
#
###############################################################################
sub onAuth
{
$Client->MessageSend(to=>$username."@".$server."/".$resource,
subject=>"test",
body=>"This is a test.");
ok(1, "Authenticated");
}
###############################################################################
#
# onMessage - when we get a message, check that the contents match what we sent
# above.
#
###############################################################################
sub onMessage
{
my $sid = shift;
my $message = shift;
is( $message->GetSubject(), "test", "Subject" );
is( $message->GetBody(), "This is a test.", "Body" );
$Client->Disconnect();
exit(0);
}
|
