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 ]]&lt; ]]><el>more text</el></doc>';
345my $t5= new XML::Twig;
346$t5->parse( $st5);
347sttest( $t5->root, $st5, "CDATA Section with ]]&lt;");
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