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