1package Net::XMPP2::TestClient; 2use strict; 3no warnings; 4use AnyEvent; 5use Net::XMPP2::Client; 6use Net::XMPP2::Util qw/stringprep_jid prep_bare_jid dump_twig_xml/; 7use Net::XMPP2::Namespaces qw/xmpp_ns/; 8use Test::More; 9 10=head1 NAME 11 12Net::XMPP2::TestClient - XMPP Test Client for tests 13 14=head1 SYNOPSIS 15 16=head1 DESCRIPTION 17 18This module is a helper module to ease the task of testing. 19If you want to run the developer test suite you have to set the environment 20variable C<NET_XMPP2_TEST> to something like this: 21 22 NET_XMPP2_TEST="test_me@your_xmpp_server.tld:secret_password" 23 24Most tests will try to connect two accounts, so please take a server 25that allows two connections from the same IP. 26 27If you also want to run the MUC tests (see L<Net::XMPP2::Ext::MUC>) 28you also need to setup the environment variable C<NET_XMPP2_TEST_MUC> 29to contain the domain of a MUC service: 30 31 NET_XMPP2_TEST_MUC="conference.your_xmpp_server.tld" 32 33If you see some tests fail and want to know more about the protocol flow 34you can enable the protocol debugging output by setting C<NET_XMPP2_TEST_DEBUG> 35to '1': 36 37 NET_XMPP2_TEST_DEBUG=1 38 39(NOTE: You will only see the output of this by running a single test) 40 41If one of the tests takes longer than the preconfigured 20 seconds default 42timeout in your setup you can set C<NET_XMPP2_TEST_TIMEOUT>: 43 44 NET_XMPP2_TEST_TIMEOUT=60 # for a 1 minute timeout 45 46=head1 CLEANING UP 47 48If the tests went wrong somewhere or you interrupted the tests you might 49want to delete the accounts from the server manually, then run: 50 51 perl t/z_*_unregister.t 52 53=head1 MANUAL TESTING 54 55If you just want to run a single test yourself, just execute the register 56test before doing so: 57 58 perl t/z_00_register.t 59 60And then you could eg. run: 61 62 perl t/z_03_iq_auth.t 63 64=head1 METHODS 65 66=head2 new (%args) 67 68Following arguments can be passed in C<%args>: 69 70=over 4 71 72=back 73 74=cut 75 76sub new_or_exit { 77 my $this = shift; 78 my $class = ref($this) || $this; 79 my $self = { 80 timeout => 20, 81 finish_count => 1, 82 @_ 83 }; 84 85 if ($ENV{NET_XMPP2_TEST_DEBUG}) { 86 $self->{debug} = 1; 87 } 88 89 if ($ENV{NET_XMPP2_TEST_TIMEOUT}) { 90 $self->{timeout} = $ENV{NET_XMPP2_TEST_TIMEOUT}; 91 } 92 93 $self->{tests}; 94 95 if ($self->{muc_test} && not $ENV{NET_XMPP2_TEST_MUC}) { 96 plan skip_all => "environment var NET_XMPP2_TEST_MUC not set! Set it to a conference!"; 97 exit; 98 } 99 100 if ($ENV{NET_XMPP2_TEST}) { 101 plan tests => $self->{tests} + 1 102 } else { 103 plan skip_all => "environment var NET_XMPP2_TEST not set! (see also Net::XMPP2::TestClient)!"; 104 exit; 105 } 106 107 bless $self, $class; 108 $self->init; 109 $self 110} 111 112sub init { 113 my ($self) = @_; 114 $self->{condvar} = AnyEvent->condvar; 115 $self->{timeout} = 116 AnyEvent->timer ( 117 after => $self->{timeout}, cb => sub { 118 $self->{error} .= "Error: Test Timeout\n"; 119 $self->{condvar}->broadcast; 120 } 121 ); 122 123 my $cl = $self->{client} = Net::XMPP2::Client->new (debug => $self->{debug} || 0); 124 my ($jid, $password) = split /:/, $ENV{NET_XMPP2_TEST}, 2; 125 126 $self->{jid} = $jid; 127 $self->{password} = $password; 128 $cl->add_account ($jid, $password, undef, undef, $self->{connection_args}); 129 130 if ($self->{two_accounts}) { 131 $self->{connected_accounts} = {}; 132 133 $cl->reg_cb (session_ready => sub { 134 my ($cl, $acc) = @_; 135 $self->{connected_accounts}->{$acc->bare_jid} = $acc->jid; 136 my (@jids) = values %{$self->{connected_accounts}}; 137 my $cnt = scalar @jids; 138 if ($cnt > 1) { 139 $cl->event (two_accounts_ready => $acc, @jids); 140 } 141 }); 142 143 $cl->add_account ("2nd_".$jid, $password, undef, undef, $self->{connection_args}); 144 } 145 146 147 if ($self->{muc_test} && $ENV{NET_XMPP2_TEST_MUC}) { 148 $self->{muc_room} = "test_nxmpp2@" . $ENV{NET_XMPP2_TEST_MUC}; 149 150 my $disco = $self->instance_ext ('Net::XMPP2::Ext::Disco'); 151 $self->{disco} = $disco; 152 153 $cl->reg_cb ( 154 before_session_ready => sub { 155 my ($cl, $acc) = @_; 156 my $con = $acc->connection; 157 $con->add_extension ( 158 $self->{mucs}->{$acc->bare_jid} 159 = Net::XMPP2::Ext::MUC->new (disco => $disco, connection => $con) 160 ); 161 }, 162 two_accounts_ready => sub { 163 my ($cl, $acc, $jid1, $jid2) = @_; 164 my $cnt = 0; 165 my ($room1, $room2); 166 my $muc = $self->{muc1} = $self->{mucs}->{prep_bare_jid $jid1}; 167 168 $muc->join_room ($self->{muc_room}, "test1", sub { 169 my ($room, $user, $error) = @_; 170 $room1 = $room; 171 if ($error) { 172 $self->{error} .= "Error: Couldn't join $self->{muc_room} as 'test1': ".$error->string."\n"; 173 $self->{condvar}->broadcast; 174 } else { 175 my $muc = $self->{muc2} = $self->{mucs}->{prep_bare_jid $jid2}; 176 $muc->join_room ($self->{muc_room}, "test2", sub { 177 my ($room, $user, $error) = @_; 178 my $room2 = $room; 179 if ($error) { 180 $self->{error} .= "Error: Couldn't join $self->{muc_room} as 'test2'".$error->string."\n"; 181 $self->{condvar}->broadcast; 182 } else { 183 $cl->event (two_rooms_joined => $acc, $jid1, $jid2, $room1, $room2) 184 } 185 }); 186 } 187 }); 188 189 190 } 191 ); 192 } 193 194 195 $cl->reg_cb (error => sub { 196 my ($cl, $acc, $error) = @_; 197 $self->{error} .= "Error: " . $error->string . "\n"; 198 $self->finish unless $self->{continue_on_error}; 199 }); 200 201 $cl->start; 202} 203 204sub checkpoint { 205 my ($self, $name, $cnt, $cb) = @_; 206 $self->{checkpoints}->{$name} = [$cnt, $cb]; 207} 208 209sub reached_checkpoint { 210 my ($self, $name) = @_; 211 my $chp = $self->{checkpoints}->{$name} 212 or die "no such checkpoint defined: $name"; 213 $chp->[0]--; 214 if ($chp->[0] <= 0) { 215 $chp->[1]->(); 216 delete $self->{checkpoints}->{$name}; 217 } 218} 219 220sub main_account { ($_[0]->{jid}, $_[0]->{password}) } 221 222sub client { $_[0]->{client} } 223 224sub tests { $_[0]->{tests} } 225 226sub instance_ext { 227 my ($self, $ext, @args) = @_; 228 eval "require $ext; 1"; 229 if ($@) { die "Couldn't load '$ext': $@" } 230 my $eo = $ext->new (@args); 231 $self->{client}->add_extension ($eo); 232 $eo 233} 234 235sub finish { 236 my ($self) = @_; 237 $self->{_cur_finish_cnt}++; 238 if ($self->{finish_count} <= $self->{_cur_finish_cnt}) { 239 $self->{condvar}->broadcast; 240 } 241} 242 243sub wait { 244 my ($self) = @_; 245 $self->{condvar}->wait; 246 247 if ($self->error) { 248 fail ("error free"); 249 diag ($self->error); 250 } else { 251 pass ("error free"); 252 } 253} 254 255sub error { $_[0]->{error} } 256 257=head1 AUTHOR 258 259Robin Redeker, C<< <elmex at ta-sa.org> >>, JID: C<< <elmex at jabber.org> >> 260 261=head1 COPYRIGHT & LICENSE 262 263Copyright 2007 Robin Redeker, all rights reserved. 264 265This program is free software; you can redistribute it and/or modify it 266under the same terms as Perl itself. 267 268=cut 269 2701; # End of Net::XMPP2::TestClient 271