#!/usr/bin/perl
use Event;
use Net::XMPP2::Connection;
use XML::CompileX::Transport::SOAPXMPP;
use Test::More tests => 18;
my %connections;
my $last_set_callback;
my $expecting = '';
# Let's override some methods to have a sane testing environment.
{ package Event;
no warnings;
sub loop {
return;
}
};
{ package main;
no warnings;
sub loop {
return;
}
};
{ package Net::XMPP2::Connection;
no warnings;
sub new {
my $class = shift;
my %data = @_;
my $res = $data{resource};
$connections{$res} = bless \%data, 'Test::XMPP2';
return $connections{$res};
}
};
{ package Test::XMPP2;
sub connect {
return 1;
}
sub reg_cb {
my $self = shift;
my %callbacks = @_;
$self->{callbacks} = \%callbacks;
}
sub send_iq {
my ($self, $type, $cb, $rb) = @_;
our $iq_id ||= 0;
$iq_id++;
return unless $expecting eq 'iq';
$last_set_callback = $cb;
$rb->(Test::Node->new(id => $iq_id));
return $iq_id;
}
sub send_message {
my ($self, $jid, $type, $cb, %attr) = @_;
return unless $expecting eq 'message';
$last_set_callback = $cb;
}
};
{ package Test::Writer;
sub new {
return bless {}, 'Test::Writer';
}
sub raw {
my ($self, $data) = @_;
$self->{data} = $data;
}
}
{ package Test::Node;
sub new {
my $self = shift;
my %args = @_;
return bless \%args, 'Test::Node';
}
sub attr {
return $_[0]->{$_[1]};
}
sub nodes { () };
sub text { 'node' };
}
my $conct = Net::XMPP2::Connection->new(resource => 'test');
my $trans = XML::CompileX::Transport::SOAPXMPP->new
(connection => $conct,
address => 'foo@jabber.org');
my $writer = Test::Writer->new();
my $send_iq = $trans->compileClient(kind => 'request-response');
my $send_message = $trans->compileClient(kind => 'one-way');
{
$expecting = 'iq';
$last_set_callback = undef;
my ($output, $trace) = $send_iq->('FooBar', {});
ok($last_set_callback, 'Message sent.');
$last_set_callback->($writer) if $last_set_callback;
is($writer->{data}, 'FooBar', 'Message content set.');
like($output->toString, '/node<\/node>/', 'Message response set.');
}
{
$expecting = 'message';
$last_set_callback = undef;
my ($output, $trace) = $send_message->('BarBaz', {});
ok($last_set_callback, 'Message sent.');
$last_set_callback->($writer) if $last_set_callback;
is($writer->{data}, 'BarBaz', 'Message content set.');
ok(!$output, 'Message response empty.');
}
{
$expecting = 'message';
$last_set_callback = undef;
$trans->force_stanza_types('message');
my ($output, $trace) = $send_iq->('BuzBuz', {});
ok($last_set_callback, 'Message sent.');
$last_set_callback->($writer) if $last_set_callback;
is($writer->{data}, 'BuzBuz', 'Message content set.');
ok(!$output, 'Message response empty.');
}
{
$expecting = 'iq';
$last_set_callback = undef;
$trans->force_stanza_types('iq');
my ($output, $trace) = $send_message->('BzzBzz', {});
ok($last_set_callback, 'Message sent.');
$last_set_callback->($writer) if $last_set_callback;
is($writer->{data}, 'BzzBzz', 'IQ content set.');
ok(!$output, 'IQ response is undef when its forced.');
}
{
$expecting = 'iq';
$last_set_callback = undef;
$trans->force_stanza_types('iq');
$trans->wait_iq_reply(0);
my ($output, $trace) = $send_message->('BzztBzzt', {});
ok($last_set_callback, 'Message sent.');
$last_set_callback->($writer) if $last_set_callback;
is($writer->{data}, 'BzztBzzt', 'IQ content set.');
ok(!$output, 'IQ response empty.');
my $id = $trans->last_sent_iq_id;
ok($id, 'Last message sent has an id.');
my $node = $trans->consume_iq_reply($id);
ok($node, 'Have reply content set.');
my $text = undef;
$text = $node->text if $node;
is($text, 'node', 'Consumed reply is sane.');
}