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