1use lib "t/lib"; 2use Test::More tests=>155; 3 4BEGIN{ use_ok( "Net::Jabber" ); } 5 6require "t/mytestlib.pl"; 7 8my $x = new Net::Jabber::Stanza("x"); 9ok( defined($x), "new()" ); 10isa_ok( $x, "Net::Jabber::Stanza" ); 11isa_ok( $x, "Net::XMPP::Stanza" ); 12 13testScalar($x, "XMLNS", "jabber:x:data"); 14 15testScalar($x, "Instructions", "do this"); 16testScalar($x, "Title", "title"); 17testScalar($x, "Type", "type"); 18 19my $field = $x->AddField(); 20ok( defined($field), "AddField()" ); 21isa_ok( $field, "Net::Jabber::Stanza" ); 22isa_ok( $field, "Net::XMPP::Stanza" ); 23 24testScalar($field, "Desc", "desc"); 25testScalar($field, "Label", "label"); 26 27testFlag($field, "Required"); 28 29testScalar($field, "Type", "type"); 30testScalar($field, "Value", "value"); 31testScalar($field, "Var", "var"); 32 33$field->SetValue("value2"); 34my @values = $field->GetValue(); 35is( $values[0], "value", "check value 1" ); 36is( $values[1], "value2", "check value 2" ); 37 38my $option = $field->AddOption(); 39ok( defined($option), "AddOption()" ); 40isa_ok( $option, "Net::Jabber::Stanza" ); 41isa_ok( $option, "Net::XMPP::Stanza" ); 42 43testScalar($option, "Label", "label"); 44testScalar($option, "Value", "value"); 45 46my $field2 = $x->AddField(); 47ok( defined($field2), "AddField()" ); 48isa_ok( $field2, "Net::Jabber::Stanza" ); 49isa_ok( $field2, "Net::XMPP::Stanza" ); 50 51my $option2 = $field2->AddOption(); 52ok( defined($option2), "AddOption()" ); 53isa_ok( $option2, "Net::Jabber::Stanza" ); 54isa_ok( $option2, "Net::XMPP::Stanza" ); 55 56my @testFields = $x->GetFields(); 57is( $#testFields, 1, "Only two fields..."); 58 59my $testField = $testFields[0]; 60 61testPostScalar($testField, "Desc", "desc"); 62testPostScalar($testField, "Label", "label"); 63 64is( $testField->DefinedRequired(), 1, "required defined" ); 65ok( $testField->GetRequired(), "required" ); 66 67testPostScalar($testField, "Type", "type"); 68testPostScalar($testField, "Var", "var"); 69 70my @testOptions = $testField->GetOptions(); 71is( $#testOptions, 0, "Only two options..."); 72 73my $testOption = $testOptions[0]; 74 75testPostScalar($testOption, "Label", "label"); 76testPostScalar($testOption, "Value", "value"); 77 78is( $x->GetXML(), "<x type='type' xmlns='jabber:x:data'><instructions>do this</instructions><title>title</title><field label='label' type='type' var='var'><desc>desc</desc><required/><value>value</value><value>value2</value><option label='label'><value>value</value></option></field><field><option/></field></x>", "GetXML()" ); 79 80 81 82my $x2 = new Net::Jabber::Stanza("x"); 83ok( defined($x2), "new()" ); 84isa_ok( $x2, "Net::Jabber::Stanza" ); 85isa_ok( $x2, "Net::XMPP::Stanza" ); 86 87testScalar($x2, "XMLNS", "jabber:x:data"); 88 89$x2->SetData(instructions=>"do this", 90 title=>"title", 91 type=>"type"); 92 93testPostScalar($x2, "Instructions", "do this"); 94testPostScalar($x2, "Title", "title"); 95testPostScalar($x2, "Type", "type"); 96 97my $field3 = $x2->AddField(); 98ok( defined($field3), "AddField()" ); 99isa_ok( $field3, "Net::Jabber::Stanza" ); 100isa_ok( $field3, "Net::XMPP::Stanza" ); 101 102testNotDefined($field3, "Desc"); 103testNotDefined($field3, "Label"); 104testNotDefined($field3, "Required"); 105testNotDefined($field3, "Type"); 106testNotDefined($field3, "Value"); 107testNotDefined($field3, "Var"); 108 109$field3->SetField(desc=>"desc", 110 label=>"label", 111 required=>1, 112 type=>"type", 113 value=>"value", 114 var=>"var"); 115 116 117testPostScalar($field3, "Desc", "desc"); 118testPostScalar($field3, "Label", "label"); 119testPostFlag($field3, "Required"); 120testPostScalar($field3, "Type", "type"); 121testPostScalar($field3, "Value", "value"); 122testPostScalar($field3, "Var", "var"); 123 124my $option3 = $field3->AddOption(); 125ok( defined($option3), "AddOption()" ); 126isa_ok( $option3, "Net::Jabber::Stanza" ); 127isa_ok( $option3, "Net::XMPP::Stanza" ); 128 129testNotDefined($option3, "Label"); 130testNotDefined($option3, "Value"); 131 132$option3->SetOption(label=>"label", 133 value=>"value"); 134 135testPostScalar($option3, "Label", "label"); 136testPostScalar($option3, "Value", "value"); 137 138is( $x2->GetXML(), "<x type='type' xmlns='jabber:x:data'><instructions>do this</instructions><title>title</title><field label='label' type='type' var='var'><desc>desc</desc><required/><value>value</value><option label='label'><value>value</value></option></field></x>", "GetXML()" ); 139 140 141my $x3 = new Net::Jabber::Stanza("x"); 142ok( defined($x3), "new()" ); 143isa_ok( $x3, "Net::Jabber::Stanza" ); 144isa_ok( $x3, "Net::XMPP::Stanza" ); 145 146testScalar($x3, "XMLNS", "jabber:x:data"); 147 148my $reported = $x3->AddReported(); 149ok( defined($reported), "new()" ); 150isa_ok( $reported, "Net::Jabber::Stanza" ); 151isa_ok( $reported, "Net::XMPP::Stanza" ); 152 153ok( defined($x3), "new()" ); 154isa_ok( $x3, "Net::Jabber::Stanza" ); 155isa_ok( $x3, "Net::XMPP::Stanza" ); 156 157$reported->AddField(var=>"var1", 158 label=>"Var1"); 159$reported->AddField(var=>"var2", 160 label=>"Var2"); 161 162is( $x3->GetXML(), "<x xmlns='jabber:x:data'><reported><field label='Var1' var='var1'/><field label='Var2' var='var2'/></reported></x>", "GetXML()"); 163 164 165my $x4 = new Net::Jabber::Stanza("x"); 166ok( defined($x4), "new()" ); 167isa_ok( $x4, "Net::Jabber::Stanza" ); 168isa_ok( $x4, "Net::XMPP::Stanza" ); 169 170testScalar($x4, "XMLNS", "jabber:x:data"); 171 172my $item = $x4->AddItem(); 173ok( defined($item), "new()" ); 174isa_ok( $item, "Net::Jabber::Stanza" ); 175isa_ok( $item, "Net::XMPP::Stanza" ); 176 177ok( defined($x4), "new()" ); 178isa_ok( $x4, "Net::Jabber::Stanza" ); 179isa_ok( $x4, "Net::XMPP::Stanza" ); 180 181$item->AddField(var=>"var1", 182 label=>"Var1"); 183$item->AddField(var=>"var2", 184 label=>"Var2"); 185 186is( $x4->GetXML(), "<x xmlns='jabber:x:data'><item><field label='Var1' var='var1'/><field label='Var2' var='var2'/></item></x>", "GetXML()"); 187 188my $item2 = $x4->AddItem(); 189ok( defined($item2), "new()" ); 190isa_ok( $item2, "Net::Jabber::Stanza" ); 191isa_ok( $item2, "Net::XMPP::Stanza" ); 192 193ok( defined($x4), "new()" ); 194isa_ok( $x4, "Net::Jabber::Stanza" ); 195isa_ok( $x4, "Net::XMPP::Stanza" ); 196 197$item2->AddField(var=>"var3", 198 label=>"Var3", 199 value=>"value3"); 200$item2->AddField(var=>"var4", 201 label=>"Var4", 202 value=>"value4"); 203 204is( $x4->GetXML(), "<x xmlns='jabber:x:data'><item><field label='Var1' var='var1'/><field label='Var2' var='var2'/></item><item><field label='Var3' var='var3'><value>value3</value></field><field label='Var4' var='var4'><value>value4</value></field></item></x>", "GetXML()"); 205 206my @items = $x4->GetItems(); 207is( $#items, 1, "are there two items?"); 208 209is( $items[0]->GetXML(), "<item><field label='Var1' var='var1'/><field label='Var2' var='var2'/></item>", "GetXML()"); 210is( $items[1]->GetXML(), "<item><field label='Var3' var='var3'><value>value3</value></field><field label='Var4' var='var4'><value>value4</value></field></item>", "GetXML()"); 211 212my @fields = $items[1]->GetFields(); 213is( $#fields, 1, "are there two fields?"); 214 215is( $fields[0]->GetXML(), "<field label='Var3' var='var3'><value>value3</value></field>", "GetXML()"); 216is( $fields[1]->GetXML(), "<field label='Var4' var='var4'><value>value4</value></field>", "GetXML()"); 217 218$fields[1]->RemoveValue(); 219 220is( $fields[1]->GetXML(), "<field label='Var4' var='var4'/>", "GetXML()"); 221 222 223