#!/bin/perl -w # $Id: /xmltwig/trunk/t/test1.t 4 2007-03-16T12:16:25.259192Z mrodrigu $ use strict; use Carp; use File::Spec; use lib File::Spec->catdir(File::Spec->curdir,'t'); use tools; # This just tests a complete twig, no callbacks $|=1; use XML::Twig; my $doc=' ]>
S1 I1 S1 I2 S1 Title S1 P1 S2 P2 Note P1 S1 para 3
S2 intro S2 Title S2 P1 S2 P2 S2 P3
Annex Title Annex P1 Annex P2
'; my $TMAX=97; # don't forget to update! print "1..$TMAX\n"; # test twig creation my $t= new XML::Twig(); ok( $t, 'twig creation'); # test parse $t->parse( $doc, ErrorContext=>2); ok( $t, 'parse'); # test the root my $root= $t->root; etest( $t->root, 'doc', 'doc1', 'root'); # print in a file open( TMP, '>tmp'); select TMP; $t->print(); $root->print(); select STDOUT; $t->print( \*TMP); $root->print( \*TMP); ok( 'ok', "print"); # test the element root and twig functions on the root ok( $root->twig, 'root->twig'); etest( $root->root, 'doc', 'doc1', 'root->root'); # navigation my $section1= etest( $root->first_child, 'section', 'section1', 'first_child'); my $annex= etest( $root->first_child( 'annex'), 'annex', 'annex1', 'first_child( annex)'); etest( $root->last_child, 'annex', 'annex1', 'last_child'); my $section2= etest( $root->last_child( 'section'), 'section', 'section2', 'last_child( section)'); etest( $section2->prev_sibling, 'section', 'section1', 'prev_sibling'); etest( $section1->next_sibling, 'section', 'section2', 'next_sibling'); my $note= etest( $root->next_elt( 'note'), 'note', 'note1', 'next_elt( note)'); etest( $note->root, 'doc', 'doc1', 'root'); ok( $note->twig, 'twig'); etest( $note->twig->root, 'doc', 'doc1', 'twig->root'); # playing with next_elt and prev_elt my $para2= etest( $note->prev_sibling, 'para', 'para2', 'prev_sibling'); etest( $note->prev_elt( 'para'), 'para', 'para2', 'prev_elt( para)'); my $para3= etest( $note->next_sibling, 'para', 'para3', 'next_sibling'); my $paranote1= etest( $note->next_elt( 'para'), 'para', 'paranote1', 'next_elt( para)'); etest( $paranote1->next_elt( 'para'), 'para', 'para3', 'next_elt( para)'); # difference between next_sibling and next_sibling( gi) etest( $para2->next_sibling, 'note', 'note1', 'next_sibling'); etest( $para2->next_sibling( 'para'), 'para', 'para3', 'next_sibling( para)'); # testing in/parent/in_context ok( $paranote1->in( $note), 'in'); ok( $paranote1->in( $section1), 'in'); ok( !$paranote1->in( $section2), 'not in'); ok( $paranote1->in_context( 'note'), 'in_context'); ok( $paranote1->in_context( 'section'), 'in_context'); ok( !$paranote1->in_context( 'intro'), 'not in_context'); etest( $paranote1->parent, 'note', 'note1', 'parent'); # testing list methods (ancestors/children) stest( (join ":", map { $_->id} $paranote1->ancestors), 'note1:section1:doc1', 'ancestors'); stest( (join ":", map { $_->id} $paranote1->ancestors('section')), 'section1', 'ancestors( section)'); stest( (join ":", map { $_->id} $section1->children), 'intro1:title1:para1:para2:note1:para3', 'children'); stest( (join ":", map { $_->id} $section1->children( 'para')), 'para1:para2:para3', 'children( para)'); stest( $paranote1->level, 3, 'level'); # testing attributes my $title1= etest( $root->next_elt( 'title'), 'title', 'title1', 'next_elt( title)'); stest( $title1->id, 'title1', 'id'); stest( $title1->att('id'), 'title1', 'att( id)'); stest( $title1->att('no'), '1', 'att( no)'); $title1->set_att('no', 'Auto'); stest( $title1->att('no'), 'Auto', 'set att( no)'); $title1->set_att('no', '1'); $title1->set_att('newatt', 'newval'); stest( $title1->att('newatt'), 'newval', 'set att( newval)'); $title1->del_att('newatt'); stest( stringifyh( %{$title1->atts}), 'id:title1:no:1', 'del_att'); $title1->set_att('id', 'newid'); stest( $title1->id, 'newid', 'set_att(id)'); stest( $title1->att( 'id'), 'newid', 'set_att(id)'); $title1->set_id( 'title1'); stest( $title1->id, 'title1', 'set_id'); stest( $title1->att( 'id'), 'title1', 'set_id'); stest( stringifyh( %{$title1->atts}), 'id:title1:no:1', 'atts'); $title1->del_atts; stest( $title1->att( 'id'), '', 'del_atts'); $title1->set_atts( { 'no' => '1', 'id' => 'newtitleid'}); stest( stringifyh( %{$title1->atts}), 'id:newtitleid:no:1', 'set_atts'); stest( $title1->id, 'newtitleid', 'id'); stest( $title1->att('id'), 'newtitleid', 'att( id)'); $title1->set_id( 'title1'); # now let's cut and paste $title1->cut; stest( (join ":", map { $_->id} $section1->children), 'intro1:para1:para2:note1:para3', 'cut (1)'); my $intro1= $section1->first_child( 'intro'); $intro1->cut; stest( (join ":", map { $_->id} $section1->children), 'para1:para2:note1:para3', 'cut (2)'); $intro1->paste( $section1); stest( (join ":", map { $_->id} $section1->children), 'intro1:para1:para2:note1:para3', 'paste'); $title1->paste( 'first_child', $section2, ); stest( (join ":", map { $_->id} $section2->children), 'title1:intro2:title2:para4:para5:para6', 'paste( first_child)'); $title1->cut; stest( (join ":", map { $_->id} $section2->children), 'intro2:title2:para4:para5:para6', 'paste'); $title1->paste( $section2); stest( (join ":", map { $_->id} $section2->children), 'title1:intro2:title2:para4:para5:para6', 'paste'); $title1->cut; stest( (join ":", map { $_->id} $section2->children), 'intro2:title2:para4:para5:para6', 'cut (3)'); $title1->paste( 'last_child', $section2); stest( (join ":", map { $_->id} $section2->children), 'intro2:title2:para4:para5:para6:title1', 'paste( last_child)'); $title1->cut; stest( (join ":", map { $_->id} $section2->children), 'intro2:title2:para4:para5:para6', 'cut(4)'); my $intro2= etest( $section2->first_child( 'intro'), 'intro', 'intro2', 'first_sibling( intro)'); $title1->paste( 'after', $intro2); stest( (join ":", map { $_->id} $section2->children), 'intro2:title1:title2:para4:para5:para6', 'paste( after)'); $title1->cut; stest( (join ":", map { $_->id} $section2->children), 'intro2:title2:para4:para5:para6', 'cut (5)'); $title1->paste( 'before', $intro2); stest( (join ":", map { $_->id} $section2->children), 'title1:intro2:title2:para4:para5:para6', 'paste( before)'); $title1->cut; stest( (join ":", map { $_->id} $section2->children), 'intro2:title2:para4:para5:para6', 'cut (6)'); my $para4= etest( $t->elt_id( 'para4'), 'para', 'para4', 'elt_id'); $title1->paste( 'after', $para4); stest( (join ":", map { $_->id} $section2->children), 'intro2:title2:para4:title1:para5:para6', 'paste( after)'); $title1->cut; stest( (join ":", map { $_->id} $section2->children), 'intro2:title2:para4:para5:para6', 'cut (7)'); $title1->paste( 'before', $para4); stest( (join ":", map { $_->id} $section2->children), 'intro2:title2:title1:para4:para5:para6', 'paste( before)'); $title1->cut; stest( (join ":", map { $_->id} $section2->children), 'intro2:title2:para4:para5:para6', 'cut (8)'); # now let's mess up the document # let's erase that pesky intro $intro2->erase; stest( (join ":", map { $_->id} $section2->children), 'paraintro3:title2:para4:para5:para6', 'erase'); $para4->delete; stest( (join ":", map { $_->id} $section2->children), 'paraintro3:title2:para5:para6', 'delete'); $t->change_gi( 'paraintro', 'para'); stest( (join ":", map { $_->gi} $section2->children), 'para:title:para:para', 'change_gi'); $para3= etest( $t->elt_id( 'para3'), 'para', 'para3', 'elt_id'); $para3->cut; stest( $section1->text, 'S1 I1S1 I2S1 P1S2 P2Note P1', 'text'); stest( $section1->sprint, '
S1 I1S1 I2S1 P1S2 P2Note P1
', 'sprint'); # let's have a look at those entities # first their names stest( join( ':', $t->entity_names), 'e1:e2:e3', 'entity_list'); # let's look at their content my $e1= $t->entity( 'e1'); stest( $e1->text, '', 'e1 text'); my $e2= $t->entity( 'e2'); stest( $e2->text, '', 'e2 text'); my $e3= $t->entity( 'e3'); stest( $e3->text, '', 'e3 text'); # additionnal erase test $section1= $root->first_child; stest( (join ":", map { $_->id} $section1->children), 'intro1:para1:para2:note1', 'erase (2)'); $intro1= $section1->first_child( 'intro'); $intro1->erase; stest( (join ":", map { $_->id} $section1->children), 'paraintro1:paraintro2:para1:para2:note1', 'erase (3)'); # new elt test my $new_elt= new XML::Twig::Elt; stest( ref $new_elt, 'XML::Twig::Elt', "new"); my $new_elt1= new XML::Twig::Elt( 'subclass'); stest( ref $new_elt, 'XML::Twig::Elt', "new subclass"); my $new_elt2= new XML::Twig::Elt; stest( ref $new_elt2, 'XML::Twig::Elt', "create no gi"); my $new_elt3= new XML::Twig::Elt( 'elt3'); $new_elt3->set_id( 'elt3'); etest( $new_elt3, 'elt3', 'elt3', "create with gi"); my $new_elt4= new XML::Twig::Elt( 'elt4', 'text of elt4'); ttest( $new_elt4, 'text of elt4', "create with gi and text"); my $new_elt5= new XML::Twig::Elt( 'elt5', 'text of elt5 ', $new_elt4); ttest( $new_elt5, 'text of elt5 text of elt4', "create with gi and content"); my $new_elt6= new XML::Twig::Elt( PCDATA, 'text of elt6'); ttest( $new_elt6, 'text of elt6', "create PCDATA"); # test CDATA my $st1='bold]]>'; my $t1= new XML::Twig; $t1->parse( $st1); sttest( $t1->root, $st1, "CDATA Section"); my $st2='text bold]]> more text'; my $t2= new XML::Twig; $t2->parse( $st2); sttest( $t2->root, $st2, "CDATA Section"); my $st3='bold]]> text'; my $t3= new XML::Twig; $t3->parse( $st3); sttest( $t3->root, $st3, "CDATA Section"); my $st4='textbold]]>more text'; my $t4= new XML::Twig; $t4->parse( $st4); sttest( $t4->root, $st4, "CDATA Section"); my $st5='text more text'; my $t5= new XML::Twig; $t5->parse( $st5); sttest( $t5->root, $st5, "CDATA Section with ]]<"); # test prefix my $st6='textmore text'; my $t6= new XML::Twig; $t6->parse( $st6); $doc= $t6->root; $doc->prefix( 'p1:'); sttest( $t6->root,'p1:textmore text', "prefix doc"); my $el1= $doc->first_child( 'el1'); $el1->prefix( 'p2:'); sttest( $t6->root,'p1:p2:textmore text', "prefix el1"); my $el2= $doc->first_child( 'el2'); my $pcdata= $el2->first_child( PCDATA); $pcdata->prefix( 'p3:'); sttest( $t6->root,'p1:p2:textp3:more text', "prefix pcdata"); exit 0; __END__