1#!/usr/bin/perl
2
3use strict;
4use warnings;
5
6use XML::Twig;
7use Test::More tests => 16;
8
9
10{
11  my $in= '<plant><flower>Rose</flower><fruit><berry>Blackberry</berry></fruit><veggie>Carrot</veggie></plant>';
12  my $expected= '<plant><flower>Rose</flower><fruit><berry>Tomato</berry><berry>Blackberry</berry></fruit><veggie>Carrot</veggie></plant>';
13
14  { my $t = XML::Twig->new( twig_handlers => { '//plant/fruit' => sub { XML::Twig::Elt->new( berry => 'Tomato')->paste( $_); }  })
15                     ->parse( $in);
16    is( $t->sprint, $expected, 'paste within handler from new element');
17  }
18
19  { my $t = XML::Twig->new( twig_handlers => { '//plant/fruit' => sub { XML::Twig->new->parse( '<berry>Tomato</berry>')->root->cut->paste( first_child => $_); }  })
20                     ->parse( $in);
21    is( $t->sprint, $expected, 'paste new element from twig within handler from parsed element (cut)');
22  }
23  { my $t = XML::Twig->new( twig_handlers => { '//plant/fruit' => sub { XML::Twig->new->parse( '<berry>Tomato</berry>')->root->paste( $_); }  })
24                     ->parse( $in);
25    is( $t->sprint, $in, 'paste new element from twig within handler from parsed element (non cut)');
26  }
27}
28
29{ my $d='<d><f/><e>foo</e></d>';
30  my $calls;
31  XML::Twig->new( twig_roots => { f => 1 },
32                  end_tag_handlers => { e     => sub { $calls .= ":e"; },
33                                        'd/e' => sub { $calls .= "d/e" },
34                                      },
35                )
36           ->parse( $d);
37   is( $calls, 'd/e:e', 'several end_tag_handlers called');
38  $calls='';
39  XML::Twig->new( twig_roots => { f => 1 },
40                  end_tag_handlers => { e     => sub { $calls .= ":e"; },
41                                        'd/e' => sub { $calls .= "d/e"; return 0; },
42                                      },
43                )
44           ->parse( $d);
45   is( $calls, 'd/e', 'end_tag_handlers chain broken by false return');
46}
47
48{ my $d='<d><f><e>foo</e><g/></f></d>';
49  my $calls;
50  XML::Twig->new( twig_roots => { f => 1 },
51                  ignore_elts => { e => 1 },
52                  end_tag_handlers => { e     => sub { $calls .= ":e"; },
53                                        'f/e' => sub { $calls .= "f/e" },
54                                      },
55                )
56           ->parse( $d);
57   is( $calls, 'f/e:e', 'several end_tag_handlers called with ignore_elts active');
58  $calls='';
59  XML::Twig->new( twig_roots => { f => 1 },
60                  ignore_elts => { e => 1 },
61                  end_tag_handlers => { e     => sub { $calls .= ":e"; },
62                                        'f/e' => sub { $calls .= "f/e"; return 0; },
63                                      },
64                )
65           ->parse( $d);
66   is( $calls, 'f/e', 'end_tag_handlers chain with ignore_elts active broken by false return');
67}
68
69is( XML::Twig->parse( '<d/>')->encoding, undef, 'encoding, no xml declaration');
70is( XML::Twig->parse( '<?xml version="1.0"?><d/>')->encoding, undef, 'encoding, xml declaration but no encoding given');
71is( XML::Twig->parse( '<?xml version="1.0" encoding="utf-8"?><d/>')->encoding, 'utf-8', 'encoding, encoding given');
72
73is( XML::Twig->parse( '<d/>')->standalone, undef, 'standalone, no xml declaration');
74is( XML::Twig->parse( '<?xml version="1.0"?><d/>')->standalone, undef, 'standalone, xml declaration but no standalone bit');
75ok( XML::Twig->parse( '<?xml version="1.0" standalone="yes"?><d/>')->standalone, 'standalone, yes');
76ok( ! XML::Twig->parse( '<?xml version="1.0" standalone="no"?><d/>')->standalone, 'standalone, no');
77
78{
79  XML::Twig::_set_weakrefs(0);
80  my $t= XML::Twig->parse( '<d><e/><e><f/><f/></e><e/></d>');
81  $t->root->first_child( 'e')->next_sibling( 'e')->erase;
82  is( $t->sprint, '<d><e/><f/><f/><e/></d>', 'erase without weakrefs');
83  XML::Twig::_set_weakrefs(1)
84}
85
86{
87my $doc='<ns1:list xmlns:ns1="http://namespace/CommandService" xmlns:ns2="http://namespace/ShelfService" xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance">
88  <commands>
89    <commandId>1</commandId>
90    <command xsi:type="ns2:find">
91      <equipmentFilter>...</equipmentFilter>
92    </command>
93  </commands>
94  <commands>
95    <commandId>2</commandId>
96    <command xsi:type="ns2:getByName">
97      <name>...</name>
98    </command>
99  </commands>
100</ns1:list>
101';
102
103my $expected= $doc;
104$expected=~ s{ns1}{cmdsvc}g;
105$expected=~ s{ns2}{shlsvc}g;
106
107my %map= reverse ( cmdsvc => "http://namespace/CommandService",
108                   shlsvc => "http://namespace/ShelfService",
109                   xsi    => "http://www.w3.org/2001/XMLSchema-instance",
110                 );
111
112my $x = XML::Twig->new( map_xmlns => { %map },
113                        twig_handlers => { '*[@xsi:type]' => sub { upd_xsi_type( @_, \%map) } },
114                        pretty_print => "indented"
115                      );
116$x->parse($doc);
117
118is( $x->sprint, $expected, 'original_uri');
119
120sub upd_xsi_type
121  { my( $t, $elt, $map)= @_;
122    my $type= $elt->att( 'xsi:type');
123    my( $old_prefix)= $type=~ m{^([^:]*):};
124    if( my $new_prefix=  $map->{$t->original_uri( $old_prefix)})
125      { $type=~ s{^$old_prefix}{$new_prefix};
126        $elt->set_att( 'xsi:type' => $type);
127      }
128    return 1; # to make sure other handlers are called
129  }
130
131}
132