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