#!/usr/bin/perl use strict; #use Devel::Profiler; use lib '../lib'; use lib '../t/lib'; require 'djabberd-test.pl'; my $server = Test::DJabberd::Server->new(clientport => 5222, hostname => "example.com", id => 1); my $pa = Test::DJabberd::Client->new(server => $server, name => "partya"); my $pb = Test::DJabberd::Client->new(server => $server, name => "partyb"); $pa->login; $pb->login; for (1..333) { print "$_\n" if $_ % 50 == 0; # PA to PB $pa->send_xml("Hello. I am $pa."); like($pb->recv_xml, qr/type=.chat.*Hello.*I am \Q$pa\E/, "pb got pa's message"); # PB to PA $pb->send_xml("Hello back! xxxxxxxxxxxxxx xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx"); like($pa->recv_xml, qr/Hello back/, "pa got pb's message"); # PA to self $pa->send_xml(qq{ Hello self xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx x x x x ! Hello self OMGxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx x x x x x x! }); like($pa->recv_xml, qr/Hello self/, "pa got own message"); } sub like { my ($val, $regexp, $msg) = @_; $val =~ /$regexp/ or die "Failed: $msg"; }