1use lib "t/lib"; 2use Test::More tests=>88; 3 4BEGIN{ use_ok( "Net::Jabber" ); } 5 6require "t/mytestlib.pl"; 7 8my $debug = new Net::XMPP::Debug(setdefault=>1, 9 level=>-1, 10 file=>"stdout", 11 header=>"test", 12 ); 13 14#------------------------------------------------------------------------------ 15# iq 16#------------------------------------------------------------------------------ 17my $iq = new Net::Jabber::IQ(); 18ok( defined($iq), "new()"); 19isa_ok( $iq, "Net::Jabber::IQ"); 20isa_ok( $iq, "Net::XMPP::IQ"); 21 22testScalar($iq, "Error", "error"); 23testScalar($iq, "ErrorCode", "401"); 24testJID($iq, "From", "user1", "server1", "resource1"); 25testScalar($iq, "ID", "id"); 26testJID($iq, "To", "user2", "server2", "resource2"); 27testScalar($iq, "Type", "Type"); 28 29is( $iq->DefinedQuery("jabber:x:oob"), "", "not DefinedChild - jabber:x:oob" ); 30is( $iq->DefinedQuery("jabber:iq:roster"), "", "not DefinedChild - jabber:iq:roster" ); 31 32#------------------------------------------------------------------------------ 33# query - roster 34#------------------------------------------------------------------------------ 35my $xroster = $iq->NewQuery("jabber:iq:roster"); 36ok( defined( $xroster ), "NewChild - jabber:iq:roster" ); 37isa_ok( $xroster, "Net::XMPP::Stanza" ); 38 39#------------------------------------------------------------------------------ 40# x - oob 41#------------------------------------------------------------------------------ 42my $xoob = $iq->NewX("jabber:x:oob"); 43ok( defined( $xoob ), "NewChild - jabber:x:oob" ); 44isa_ok( $xoob, "Net::XMPP::Stanza" ); 45 46#------------------------------------------------------------------------------ 47# DefinedChild... 48#------------------------------------------------------------------------------ 49is( $iq->DefinedQuery(), 1, "DefinedChild" ); 50is( $iq->DefinedQuery("jabber:iq:roster"), 1, "DefinedChild - jabber:iq:roster" ); 51is( $iq->DefinedX("jabber:x:oob"), 1, "DefinedChild - jabber:x:oob" ); 52 53#------------------------------------------------------------------------------ 54# X 55#------------------------------------------------------------------------------ 56my @x2 = $iq->GetQuery(); 57is( $x2[0], $xroster, "Is the first the roster?"); 58is( $x2[1], $xoob, "Is the second the oob?"); 59 60#------------------------------------------------------------------------------ 61# X 62#------------------------------------------------------------------------------ 63my @x3 = $iq->GetX("jabber:x:oob"); 64is( $#x3, 0, "filter on xmlns - only one x... right?"); 65is( $x3[0], $xoob, "Is the first x the oob?"); 66 67#------------------------------------------------------------------------------ 68# X 69#------------------------------------------------------------------------------ 70my @x4 = $iq->GetQuery("jabber:iq:roster"); 71is( $#x4, 0, "filter on xmlns - only one x... right?"); 72is( $x4[0], $xroster, "Is the first x the roster?"); 73 74is( $iq->DefinedX("jabber:x:testns"), "", "not DefinedX - jabber:x:testns" ); 75 76#------------------------------------------------------------------------------ 77# iq 78#------------------------------------------------------------------------------ 79my $iq2 = new Net::Jabber::IQ(); 80ok( defined($iq2), "new()"); 81isa_ok( $iq2, "Net::Jabber::IQ"); 82 83#------------------------------------------------------------------------------ 84# defined 85#------------------------------------------------------------------------------ 86is( $iq2->DefinedError(), '', "error not defined" ); 87is( $iq2->DefinedErrorCode(), '', "errorcode not defined" ); 88is( $iq2->DefinedFrom(), '', "from not defined" ); 89is( $iq2->DefinedID(), '', "id not defined" ); 90is( $iq2->DefinedTo(), '', "to not defined" ); 91is( $iq2->DefinedType(), '', "type not defined" ); 92 93#------------------------------------------------------------------------------ 94# set it 95#------------------------------------------------------------------------------ 96$iq2->SetIQ(error=>"error", 97 errorcode=>"401", 98 from=>"user1\@server1/resource1", 99 id=>"id", 100 to=>"user2\@server2/resource2", 101 type=>"type"); 102 103testPostScalar($iq, "Error", "error"); 104testPostScalar($iq, "ErrorCode", "401"); 105testPostJID($iq, "From", "user1", "server1", "resource1"); 106testPostScalar($iq, "ID", "id"); 107testPostJID($iq, "To", "user2", "server2", "resource2"); 108testPostScalar($iq, "Type", "Type"); 109 110 111my $iq3 = new Net::Jabber::IQ(); 112ok( defined($iq3), "new()"); 113isa_ok( $iq3, "Net::Jabber::IQ"); 114 115$iq3->SetIQ(error=>"error", 116 errorcode=>"401", 117 from=>"user1\@server1/resource1", 118 id=>"id", 119 to=>"user2\@server2/resource2", 120 type=>"type"); 121 122my $query = $iq3->NewQuery("jabber:iq:auth"); 123ok( defined($query), "new()"); 124isa_ok( $query, "Net::XMPP::Stanza"); 125 126$query->SetAuth(username=>"user", 127 password=>"pass"); 128 129is( $iq3->GetXML(), "<iq from='user1\@server1/resource1' id='id' to='user2\@server2/resource2' type='type'><error code='401'>error</error><query xmlns='jabber:iq:auth'><password>pass</password><username>user</username></query></iq>", "GetXML()"); 130 131my $reply = $iq3->Reply(); 132 133is( $reply->GetXML(), "<iq from='user2\@server2/resource2' id='id' to='user1\@server1/resource1' type='result'><query xmlns='jabber:iq:auth'/></iq>", "GetXML()"); 134 135 136