1#!/usr/bin/perl -w 2 3 4use strict; 5use Carp; 6 7use File::Spec; 8use lib File::Spec->catdir(File::Spec->curdir,"t"); 9use tools; 10use FindBin qw($Bin); BEGIN { unshift @INC, $Bin; } use xmlxpath_tools; 11 12my $DEBUG=0; 13 14print "1..114\n"; 15 16# This just tests a complete twig, no callbacks 17 18$|=1; 19 20my $doc='<?xml version="1.0" standalone="no"?> 21<!DOCTYPE doc [ 22<!NOTATION gif PUBLIC "gif"> 23<!ENTITY e1 SYSTEM "e1.gif" NDATA gif> 24<!ENTITY e2 SYSTEM "e2.gif" NDATA gif> 25<!ENTITY e3 \'internal entity\'> 26]> 27<doc id="doc1"> 28 <section id="section1"> 29 <intro id="intro1"> 30 <para id="paraintro1">S1 I1</para> 31 <para id="paraintro2">S1 I2</para> 32 </intro> 33 <title no="1" id="title1">S1 Title</title> 34 <para id="para1">S1 P1</para> 35 <para id="para2">S2 P2</para> 36 <note id="note1"> 37 <para id="paranote1">Note P1</para> 38 </note> 39 <para id="para3">S1 <xref refid="section2"/>para 3</para> 40 </section> 41 <section id="section2"> 42 <intro id="intro2"> 43 <para id="paraintro3">S2 intro</para> 44 </intro> 45 <title no="2" id="title2">S2 Title</title> 46 <para id="para4">S2 P1</para> 47 <para id="para5">S2 P2</para> 48 <para id="para6">S2 P3</para> 49 </section> 50 <annex id="annex1"> 51 <title no="A" id="titleA">Annex Title</title> 52 <para id="paraannex1">Annex P1</para> 53 <para id="paraannex2">Annex P2</para> 54 </annex> 55</doc>'; 56 57 58my $i=0; 59my $failed=0; 60 61# test twig creation 62my $t= XML::Twig::XPath->new; 63ok( $t, 'twig creation'); 64 65# test parse 66$t->parse( $doc, ErrorContext=>2); 67ok( $t, 'parse'); 68 69ok( ($t->node_cmp( $t->root) == -1), 'cmp twig to root'); 70ok( ($t->node_cmp( $t) == 0), 'cmp twig to root'); 71 72 73 74# test the root 75my $root= $t->root; 76etest( $t->root, 'doc', 'doc1', 'root'); 77 78# print in a file 79open( TMP, '>tmp'); 80select TMP; 81$t->print(); 82$root->print(); 83select STDOUT; 84$t->print( \*TMP); 85$root->print( \*TMP); 86ok( 'ok', "print"); 87 88# test the element root and twig functions on the root 89ok( $root->twig, 'root->twig'); 90etest( $root->root, 91 'doc', 'doc1', 'root->root'); 92 93 94# navigation 95my $section1= 96etest( $root->first_child, 97 'section', 'section1', 'first_child'); 98my $annex= 99etest( $root->first_child( 'annex'), 100 'annex', 'annex1', 'first_child( annex)'); 101 102etest( $root->last_child, 103 'annex', 'annex1', 'last_child'); 104my $section2= 105etest( $root->last_child( 'section'), # 10 106 'section', 'section2', 'last_child( section)'); 107 108etest( $section2->prev_sibling, 109 'section', 'section1', 'prev_sibling'); 110etest( $section1->next_sibling, 111 'section', 'section2', 'next_sibling'); 112 113my $note= 114etest( $root->next_elt( 'note'), 115 'note', 'note1', 'next_elt( note)'); 116etest( $note->root, 117 'doc', 'doc1', 'root'); 118ok( $note->twig, 'twig'); 119etest( $note->twig->root, 120 'doc', 'doc1', 'twig->root'); 121 122# playing with next_elt and prev_elt 123my $para2= 124etest( $note->prev_sibling, 125 'para', 'para2', 'prev_sibling'); 126etest( $note->prev_elt( 'para'), 127 'para', 'para2', 'prev_elt( para)'); 128my $para3= 129etest( $note->next_sibling, 130 'para', 'para3', 'next_sibling'); 131my $paranote1= 132etest( $note->next_elt( 'para'), # 20 133 'para', 'paranote1', 'next_elt( para)'); 134etest( $paranote1->next_elt( 'para'), 135 'para', 'para3', 'next_elt( para)'); 136 137# difference between next_sibling and next_sibling( gi) 138etest( $para2->next_sibling, 139 'note', 'note1', 'next_sibling'); 140etest( $para2->next_sibling( 'para'), 141 'para', 'para3', 'next_sibling( para)'); 142 143# testing in/parent/in_context 144ok( $paranote1->in( $note), 'in'); 145ok( $paranote1->in( $section1), 'in'); 146ok( !$paranote1->in( $section2), 'not in'); 147ok( $paranote1->in_context( 'note'), 'in_context'); 148ok( $paranote1->in_context( 'section'), 'in_context'); 149ok( !$paranote1->in_context( 'intro'), 'not in_context'); 150etest( $paranote1->parent, # 30 151 'note', 'note1', 'parent'); 152 153# testing list methods (ancestors/children) 154stest( (join ":", map { $_->id} $paranote1->ancestors), 155 'note1:section1:doc1', 'ancestors'); 156stest( (join ":", map { $_->id} $paranote1->ancestors('section')), 157 'section1', 'ancestors( section)'); 158stest( (join ":", map { $_->id} $section1->children), 159 'intro1:title1:para1:para2:note1:para3', 'children'); 160stest( (join ":", map { $_->id} $section1->children( 'para')), 161 'para1:para2:para3', 'children( para)'); 162 163stest( $paranote1->level, 3, 'level'); 164 165# testing attributes 166my $title1= 167 etest( $root->next_elt( 'title'), 168 'title', 'title1', 'next_elt( title)'); 169stest( $title1->id, 'title1', 'id'); 170stest( $title1->att('id'), 'title1', 'att( id)'); 171stest( $title1->att('no'), '1', 'att( no)'); 172$title1->set_att('no', 'Auto'); 173stest( $title1->att('no'), 'Auto', 'set att( no)'); 174$title1->set_att('no', '1'); 175 176$title1->set_att('newatt', 'newval'); 177stest( $title1->att('newatt'), 'newval', 'set att( newval)'); 178$title1->del_att('newatt'); 179stest( stringifyh( %{$title1->atts}), 'id:title1:no:1', 'del_att'); 180 181$title1->set_att('id', 'newid'); 182stest( $title1->id, 'newid', 'set_att(id)'); 183stest( $title1->att( 'id'), 'newid', 'set_att(id)'); 184$title1->set_id( 'title1'); 185stest( $title1->id, 'title1', 'set_id'); 186stest( $title1->att( 'id'), 'title1', 'set_id'); 187 188 189stest( stringifyh( %{$title1->atts}), 'id:title1:no:1', 'atts'); 190 191$title1->del_atts; 192stest( $title1->att( 'id'), '', 'del_atts'); 193$title1->set_atts( { 'no' => '1', 'id' => 'newtitleid'}); 194stest( stringifyh( %{$title1->atts}), 'id:newtitleid:no:1', 'set_atts'); 195stest( $title1->id, 'newtitleid', 'id'); 196stest( $title1->att('id'), 'newtitleid', 'att( id)'); 197$title1->set_id( 'title1'); 198 199 200# now cut and paste 201$title1->cut; 202stest( (join ":", map { $_->id} $section1->children), 203 'intro1:para1:para2:note1:para3', 'cut (1)'); 204my $intro1= $section1->first_child( 'intro'); 205$intro1->cut; 206stest( (join ":", map { $_->id} $section1->children), 207 'para1:para2:note1:para3', 'cut (2)'); 208$intro1->paste( $section1); 209stest( (join ":", map { $_->id} $section1->children), 210 'intro1:para1:para2:note1:para3', 'paste'); 211 212$title1->paste( 'first_child', $section2, ); 213stest( (join ":", map { $_->id} $section2->children), 214 'title1:intro2:title2:para4:para5:para6', 'paste( first_child)'); 215$title1->cut; 216stest( (join ":", map { $_->id} $section2->children), 217 'intro2:title2:para4:para5:para6', 'paste'); 218$title1->paste( $section2); 219stest( (join ":", map { $_->id} $section2->children), 220 'title1:intro2:title2:para4:para5:para6', 'paste'); 221$title1->cut; 222stest( (join ":", map { $_->id} $section2->children), 223 'intro2:title2:para4:para5:para6', 'cut (3)'); 224$title1->paste( 'last_child', $section2); 225stest( (join ":", map { $_->id} $section2->children), 226 'intro2:title2:para4:para5:para6:title1', 'paste( last_child)'); 227$title1->cut; 228stest( (join ":", map { $_->id} $section2->children), 229 'intro2:title2:para4:para5:para6', 'cut(4)'); 230 231my $intro2= 232 etest( $section2->first_child( 'intro'), 233 'intro', 'intro2', 'first_sibling( intro)'); 234 235$title1->paste( 'after', $intro2); 236stest( (join ":", map { $_->id} $section2->children), 237 'intro2:title1:title2:para4:para5:para6', 'paste( after)'); 238$title1->cut; 239stest( (join ":", map { $_->id} $section2->children), 240 'intro2:title2:para4:para5:para6', 'cut (5)'); 241 242$title1->paste( 'before', $intro2); 243stest( (join ":", map { $_->id} $section2->children), 244 'title1:intro2:title2:para4:para5:para6', 'paste( before)'); 245$title1->cut; 246stest( (join ":", map { $_->id} $section2->children), 247 'intro2:title2:para4:para5:para6', 'cut (6)'); 248 249my $para4= etest( $t->elt_id( 'para4'), 'para', 'para4', 'elt_id'); 250$title1->paste( 'after', $para4); 251stest( (join ":", map { $_->id} $section2->children), 252 'intro2:title2:para4:title1:para5:para6', 'paste( after)'); 253$title1->cut; 254stest( (join ":", map { $_->id} $section2->children), 255 'intro2:title2:para4:para5:para6', 'cut (7)'); 256 257$title1->paste( 'before', $para4); 258stest( (join ":", map { $_->id} $section2->children), 259 'intro2:title2:title1:para4:para5:para6', 'paste( before)'); 260$title1->cut; 261stest( (join ":", map { $_->id} $section2->children), 262 'intro2:title2:para4:para5:para6', 'cut (8)'); 263 264# now we mess up the document 265# erase that pesky intro 266$intro2->erase; 267stest( (join ":", map { $_->id} $section2->children), 268 'paraintro3:title2:para4:para5:para6', 'erase'); 269 270$para4->delete; 271stest( (join ":", map { $_->id} $section2->children), 272 'paraintro3:title2:para5:para6', 'delete'); 273$t->change_gi( 'paraintro', 'para'); 274stest( (join ":", map { $_->gi} $section2->children), 275 'para:title:para:para', 'change_gi'); 276 277$para3= etest( $t->elt_id( 'para3'), 'para', 'para3', 'elt_id'); 278$para3->cut; 279stest( $section1->text, 'S1 I1S1 I2S1 P1S2 P2Note P1', 'text'); 280 281stest( $section1->sprint, 282'<section id="section1"><intro id="intro1"><para id="paraintro1">S1 I1</para><para id="paraintro2">S1 I2</para></intro><para id="para1">S1 P1</para><para id="para2">S2 P2</para><note id="note1"><para id="paranote1">Note P1</para></note></section>', 283 'sprint'); 284 285# have a look at those entities 286# first their names 287stest( join( ':', $t->entity_names), 'e1:e2:e3', 'entity_list'); 288# look at their content 289my $e1= $t->entity( 'e1'); 290stest( $e1->text, '<!ENTITY e1 SYSTEM "e1.gif" NDATA gif>', 'e1 text'); 291my $e2= $t->entity( 'e2'); 292stest( $e2->text, '<!ENTITY e2 SYSTEM "e2.gif" NDATA gif>', 'e2 text'); 293my $e3= $t->entity( 'e3'); 294stest( $e3->text, '<!ENTITY e3 "internal entity">', 'e3 text'); 295 296 297# additionnal erase test 298$section1= $root->first_child; 299stest( (join ":", map { $_->id} $section1->children), 300 'intro1:para1:para2:note1', 'erase (2)'); 301$intro1= $section1->first_child( 'intro'); 302$intro1->erase; 303stest( (join ":", map { $_->id} $section1->children), 304 'paraintro1:paraintro2:para1:para2:note1', 'erase (3)'); 305 306 307# new elt test 308my $new_elt= new XML::Twig::XPath::Elt; 309stest( ref $new_elt, 'XML::Twig::XPath::Elt', "new"); 310my $new_elt1= new XML::Twig::XPath::Elt( 'subclass'); 311stest( ref $new_elt, 'XML::Twig::XPath::Elt', "new subclass"); 312 313my $new_elt2= new XML::Twig::XPath::Elt; 314stest( ref $new_elt2, 'XML::Twig::XPath::Elt', "create no gi"); 315 316my $new_elt3= new XML::Twig::XPath::Elt( 'elt3'); 317$new_elt3->set_id( 'elt3'); 318etest( $new_elt3, 'elt3', 'elt3', "create with gi"); 319 320my $new_elt4= new XML::Twig::XPath::Elt( 'elt4', 'text of elt4'); 321ttest( $new_elt4, 'text of elt4', "create with gi and text"); 322 323my $new_elt5= new XML::Twig::XPath::Elt( 'elt5', 'text of elt5 ', $new_elt4); 324ttest( $new_elt5, 'text of elt5 text of elt4', "create with gi and content"); 325 326my $new_elt6= new XML::Twig::XPath::Elt( PCDATA, 'text of elt6'); 327ttest( $new_elt6, 'text of elt6', "create PCDATA"); 328 329# test CDATA 330my $st1='<doc><![CDATA[<br><b>bold</b>]]></doc>'; 331my $t1= new XML::Twig::XPath; 332$t1->parse( $st1); 333sttest( $t1->root, $st1, "CDATA Section"); 334 335 336my $st2='<doc>text <![CDATA[<br><b>bold</b>]]> more text</doc>'; 337my $t2= new XML::Twig::XPath; 338$t2->parse( $st2); 339sttest( $t2->root, $st2, "CDATA Section"); 340 341my $st3='<doc><![CDATA[<br><b>bold</b>]]> text</doc>'; 342my $t3= new XML::Twig::XPath; 343$t3->parse( $st3); 344sttest( $t3->root, $st3, "CDATA Section"); 345 346my $st4='<doc><el>text</el><![CDATA[<br><b>bold</b>]]><el>more text</el></doc>'; 347my $t4= new XML::Twig::XPath; 348$t4->parse( $st4); 349sttest( $t4->root, $st4, "CDATA Section"); 350 351my $st5='<doc>text <![CDATA[ text ]]< ]]><el>more text</el></doc>'; 352my $t5= new XML::Twig::XPath; 353$t5->parse( $st5); 354sttest( $t5->root, $st5, "CDATA Section with ]]<"); 355 356# test prefix 357my $st6='<doc><el1>text</el1><el2>more text</el2></doc>'; 358my $t6= new XML::Twig::XPath; 359$t6->parse( $st6); 360$doc= $t6->root; 361$doc->prefix( 'p1:'); 362sttest( $t6->root,'<doc>p1:<el1>text</el1><el2>more text</el2></doc>', 363 "prefix doc"); 364my $el1= $doc->first_child( 'el1'); 365$el1->prefix( 'p2:'); 366sttest( $t6->root,'<doc>p1:<el1>p2:text</el1><el2>more text</el2></doc>', 367 "prefix el1"); 368my $el2= $doc->first_child( 'el2'); 369my $pcdata= $el2->first_child( PCDATA); 370$pcdata->prefix( 'p3:'); 371sttest( $t6->root,'<doc>p1:<el1>p2:text</el1><el2>p3:more text</el2></doc>', 372 "prefix pcdata"); 373 374is( $t6->node_cmp( 1), -1, "compare twig with scalar"); 375ok( UNIVERSAL::isa( $t->root->getParentNode, 'XML::Twig::XPath'), 'getParentNode on the root'); 376ok( UNIVERSAL::isa( $t->root->first_child->getParentNode, 'XML::Twig::XPath::Elt'), 'getParentNode on an elt'); 377eval '$t6->root->node_cmp( []);'; 378matches( $@, "^unknown node type ", "compare elt with scalar"); 379my $elt= XML::Twig::XPath::Elt->new( elt => { att1 => 1, att2 => 2 }, "99"); 380my( $att1, $att2)= $elt->getAttributes; 381is( $att1->node_cmp( $att2), -1, "attribute comparison"); 382is( $att2->node_cmp( $att1), 1, "attribute comparison (reverse order)"); 383is( $att2->node_cmp( $elt), 1, "compare attribute with elt"); 384is( $att2->node_cmp( $t6), 1, "compare attribute with elt"); 385is( $elt->node_cmp( $att1), -1, "compare elt with attribute"); 386is( $att1->node_cmp( $att1), 0, "compare attribute with itself"); 387is( $elt->node_cmp( $elt), 0, "compare elt with itself"); 388eval( '$att1->node_cmp( 1)'); 389matches( $@, "^unknown node type ", "compare att with scalar"); 390$elt->set_att( att3 => 3); 391my $att3= XML::Twig::XPath::Attribute->new( $elt => 'att3'); 392is( $att1->node_cmp( $att3), -1, "attribute comparison"); 393ok( $att2->to_number == 2, "to_number on att"); 394ok( $elt->to_number == 99, "to_number on elt"); 395 396exit 0; 397