Net-Jabber

 view release on metacpan or  search on metacpan

t/parse_x_data.t  view on Meta::CPAN

use lib "t/lib";
use Test::More tests=>28;

BEGIN{ use_ok( "Net::Jabber" ); }

require "t/mytestlib.pl";

my $message_node = new XML::Stream::Node("message");
ok( defined($message_node), "new()" );
isa_ok( $message_node, "XML::Stream::Node" );

$message_node->put_attrib(to=>"jer\@jabber.org",
                          from=>"reatmon\@jabber.org");
my $body_node = $message_node->add_child("body");
$body_node->add_cdata("body");
my $subject_node = $message_node->add_child("subject");
$subject_node->add_cdata("subject");

my $xdata = $message_node->add_child("x");
$xdata->put_attrib(xmlns=>"jabber:x:data");
$xdata->add_child("instructions","fill this out");
my $field1 = $xdata->add_child("field");
$field1->put_attrib(type=>"hidden",
                    var=>"formnum");
$field1->add_child("value","value1");

my $field2 = $xdata->add_child("field");
$field2->put_attrib(type=>"list-single",
                    var=>"mylist");
$field2->add_child("value","male");
$field2->add_child("value","test");
$field2->add_child("required");
my $option1 = $field2->add_child("option");
$option1->put_attrib(label=>"Male");
$option1->add_child("value","male");
my $option2 = $field2->add_child("option");
$option2->put_attrib(label=>"Female");
$option2->add_child("value","female");

is( $message_node->GetXML(), "<message from='reatmon\@jabber.org' to='jer\@jabber.org'><body>body</body><subject>subject</subject><x xmlns='jabber:x:data'><instructions>fill this out</instructions><field type='hidden' var='formnum'><value>value1</val...

my $message = new Net::Jabber::Message($message_node);
ok( defined($message), "new()" );
isa_ok( $message, "Net::Jabber::Message" );
isa_ok( $message, "Net::XMPP::Message" );

is( $message->GetTo(), "jer\@jabber.org", "GetTo");
is( $message->GetFrom(), "reatmon\@jabber.org", "GetFrom");
is( $message->GetSubject(), "subject", "GetSubject");
is( $message->GetBody(), "body", "GetBody");

my @xdatas = $message->GetChild("jabber:x:data");
is( $#xdatas, 0, "one data packet" );

my $xdata1 = $xdatas[0];
ok( defined($xdata1), "defined data" );
isa_ok( $xdata1, "Net::Jabber::Stanza" );
isa_ok( $xdata1, "Net::XMPP::Stanza" );

is( $xdata1->GetInstructions(), "fill this out", "GetInsructions" );

my @fields = $xdata1->GetFields();
is( $#fields, 1, "two fields");

my $listField = $fields[1];
is( $listField->GetVar(), "mylist", "GetVar");
is( $listField->GetType(), "list-single", "GetType");

my @values = $listField->GetValue();
is( $#values, 1, "two values");
is( $values[0], "male", "value == male");
is( $values[1], "test", "value == test");

ok( $listField->GetRequired(), "GetRequired");

my @options = $listField->GetOptions();
is( $#options, 1, "two options");



( run in 0.741 second using v1.01-cache-2.11-cpan-39bf76dae61 )