XML-TreePP
view release on metacpan or search on metacpan
* supports UTF-8 with BOM when parsing XML
http://www.kawa.net/works/perl/feedpp/feedpp.html#com-2008-01-03T15:02:56Z
2007/11/11 (0.32)
* supports invalid xml decl quoted with single quote (thanks to xatrix)
ex. <?xml version='1.0' encoding='windows-1250'?>
http://rt.cpan.org/Public/Bug/Display.html?id=30187
2007/09/22 (0.31)
* "]]>" in CDATA must be separated into "<![CDATA[]]]]><![CDATA[>]]>"
http://www.w3.org/TR/REC-xml/#sec-cdata-sect
* utf8_flag option requires Perl 5.8.1
* avoid "Wide character in print at" in writefile()
2007/08/27 (0.29)
* 34_utf8_flag.t skips all tests on Perl 5.8.0
utf8::is_utf8() wasn't there in 5.8.0.
http://www.nntp.perl.org/group/perl.perl5.changes/2003/08/msg8628.html
* 34_utf8_flag.t passes all tests on Perl 5.8.1-2
http://rt.perl.org/rt3/Public/Bug/Display.html?id=24846
* avoid "Use of uninitialized value in substitution" in xml_escape
* new tests: 00_pod.t 13_encoding_en.t 14_encoding_zh.t
15_encoding_ja.t 16_encoding_ko.t 17_output_encoding.t
2006/04/30 (0.10)
* attr_prefix parameter added to emulate E4X, ECMAScript for XML.
* user_agent parameter and its default value added.
* source code passed perltidy. (thanks to Nadim)
2006/04/08 (0.08)
* set() and get() method added.
* cdata_scalar_ref option added. CDATASection's round trip supported.
* some error checkes added. (thanks to Nadim)
2006/03/09 (0.07)
* Correct POD about parsehttp() method
2006/03/02 (0.06)
* parsehttp() method now supports the HTTP::Lite pure Perl module as well.
* Bug fix: xml_escape() call in hash_to_xml() method. (thanks to suVene)
2006/02/26 (0.04)
README.md
example/envxml.cgi
lib/XML/TreePP.pm
make-dist.sh
t/00_pod.t
t/01_parse.t
t/02_write.t
t/03_parsefile.t
t/04_escape.t
t/05_empty.t
t/06_cdata.t
t/07_attr_prefix.t
t/08_force_array.t
t/09_http-lite.t
t/10_http-lwp.t
t/11_escape_cdata.t
t/12_escape_charref.t
t/13_encoding_en.t
t/14_encoding_zh.t
t/15_encoding_ja.t
t/16_encoding_ko.t
t/17_output_encoding.t
t/18_escape_amp.t
t/19_multi_text.t
t/20_http-lite-cached.t
t/21_http-lwp-cached.t
t/28_http-lwp-force.t
t/29_http-lwp-withcache.t
t/30_first_out.t
t/31_tie_ixhash.t
t/32_base_class.t
t/33_indent.t
t/34_utf8_flag.t
t/35_force_hash.t
t/36_elem_class.t
t/37_undef.t
t/38_cdata_cdsect.t
t/39_writefile.t
t/40_writefile_jcode.t
t/41_writefile_encode.t
t/42_cdata_comment.t
t/43_encoding_quote.t
t/44_utf8_bom.t
t/45_attr_space.t
t/46_xml_deref.t
t/47_xml_deref_utf8.t
t/48_blobref.t
t/49_invalid_encoding.t
t/50_invalid_tree.t
t/51_RT_42441.t
t/52_require_xml_decl.t
This option allows you to specify a list of element names which should
always be forced into an hash representation.
$tpp->set( force_hash => [ 'item', 'image' ] );
The default value is null, it means that context of the elements will
determine to make hash or to keep it scalar as a text node. See also
"text_node_key" option below. Note that the special wildcard name '*'
means all elements.
cdata_scalar_ref
This option allows you to convert a cdata section into a reference for
scalar on parsing an XML document.
$tpp->set( cdata_scalar_ref => 1 );
The default value is false, it means that each cdata section is
converted into a scalar.
user_agent
This option allows you to specify a HTTP_USER_AGENT string which is used
by parsehttp() method.
$tpp->set( user_agent => 'Mozilla/4.0 (compatible; ...)' );
The default string is 'XML-TreePP/#.##', where '#.##' is substituted
with the version number of this library.
This option allows you to specify a list of element names which
should always be forced into an hash representation.
$tpp->set( force_hash => [ 'item', 'image' ] );
The default value is null, it means that context of the elements
will determine to make hash or to keep it scalar as a text node.
See also ["text\_node\_key"](#text_node_key) option below.
Note that the special wildcard name `'*'` means all elements.
## cdata\_scalar\_ref
This option allows you to convert a cdata section into a reference
for scalar on parsing an XML document.
$tpp->set( cdata_scalar_ref => 1 );
The default value is false, it means that each cdata section is converted into a scalar.
## user\_agent
This option allows you to specify a HTTP\_USER\_AGENT string which
is used by parsehttp() method.
$tpp->set( user_agent => 'Mozilla/4.0 (compatible; ...)' );
The default string is `'XML-TreePP/#.##'`, where `'#.##'` is
substituted with the version number of this library.
lib/XML/TreePP.pm view on Meta::CPAN
This option allows you to specify a list of element names which
should always be forced into an hash representation.
$tpp->set( force_hash => [ 'item', 'image' ] );
The default value is null, it means that context of the elements
will determine to make hash or to keep it scalar as a text node.
See also L</text_node_key> option below.
Note that the special wildcard name C<'*'> means all elements.
=head2 cdata_scalar_ref
This option allows you to convert a cdata section into a reference
for scalar on parsing an XML document.
$tpp->set( cdata_scalar_ref => 1 );
The default value is false, it means that each cdata section is converted into a scalar.
=head2 user_agent
This option allows you to specify a HTTP_USER_AGENT string which
is used by parsehttp() method.
$tpp->set( user_agent => 'Mozilla/4.0 (compatible; ...)' );
The default string is C<'XML-TreePP/#.##'>, where C<'#.##'> is
substituted with the version number of this library.
lib/XML/TreePP.pm view on Meta::CPAN
$attr = {};
tie( %$attr, 'Tie::IxHash' ) if $ixhash;
}
$attr->{$prefix.$key} = $val;
}
$node->{attributes} = $attr if ref $attr;
}
push( @$flat, $node );
}
elsif ($typeCDATA) { ## CDATASection
if ( exists $self->{cdata_scalar_ref} && $self->{cdata_scalar_ref} ) {
push( @$flat, \$contCDATA ); # as reference for scalar
}
else {
push( @$flat, $contCDATA ); # as scalar like text node
}
}
elsif ($typeCmnt) { # Comment (ignore)
}
elsif ($typeDocT) { # DocumentType (ignore)
}
lib/XML/TreePP.pm view on Meta::CPAN
my $tree = {};
my $text = [];
if ( exists $self->{use_ixhash} && $self->{use_ixhash} ) {
tie( %$tree, 'Tie::IxHash' );
}
while ( scalar @$source ) {
my $node = shift @$source;
if ( !ref $node || UNIVERSAL::isa( $node, "SCALAR" ) ) {
push( @$text, $node ); # cdata or text node
next;
}
my $name = $node->{tagName};
if ( $node->{endTag} ) {
last if ( $parent eq $name );
return $self->die( "Invalid tag sequence: <$parent></$name>" );
}
my $elem = $node->{attributes};
my $forcehash = $self->{__force_hash_all} || $self->{__force_hash}->{$name};
my $subclass;
lib/XML/TreePP.pm view on Meta::CPAN
if ( scalar @$text ) {
if ( scalar @$text == 1 ) {
# one text node (normal)
$text = shift @$text;
}
elsif ( ! scalar grep {ref $_} @$text ) {
# some text node splitted
$text = join( '', @$text );
}
else {
# some cdata node
my $join = join( '', map {ref $_ ? $$_ : $_} @$text );
$text = \$join;
}
if ( $haschild ) {
# some child nodes and also text node
$tree->{$self->{text_node_key}} = $text;
}
else {
# only text node without child nodes
$tree = $text;
lib/XML/TreePP.pm view on Meta::CPAN
}
elsif ( UNIVERSAL::isa( $val, 'HASH' ) ) {
my $child = $self->hash_to_xml( $key, $val );
push( @$out, $child );
}
elsif ( UNIVERSAL::isa( $val, 'ARRAY' ) ) {
my $child = $self->array_to_xml( $key, $val );
push( @$out, $child );
}
elsif ( UNIVERSAL::isa( $val, 'SCALAR' ) ) {
my $child = $self->scalaref_to_cdata( $key, $val );
push( @$out, $child );
}
else {
my $ref = ref $val;
$self->warn( "Unsupported reference type: $ref in $key" ) if $ref;
my $child = $self->scalar_to_xml( $key, $val );
push( @$out, $child );
}
}
lib/XML/TreePP.pm view on Meta::CPAN
}
elsif ( UNIVERSAL::isa( $val, 'HASH' ) ) {
my $child = $self->hash_to_xml( $name, $val );
push( @$out, $child );
}
elsif ( UNIVERSAL::isa( $val, 'ARRAY' ) ) {
my $child = $self->array_to_xml( $name, $val );
push( @$out, $child );
}
elsif ( UNIVERSAL::isa( $val, 'SCALAR' ) ) {
my $child = $self->scalaref_to_cdata( $name, $val );
push( @$out, $child );
}
else {
my $ref = ref $val;
$self->warn( "Unsupported reference type: $ref in $name" ) if $ref;
my $child = $self->scalar_to_xml( $name, $val );
push( @$out, $child );
}
}
my $text = join( '', @$out );
$text;
}
sub scalaref_to_cdata {
my $self = shift;
my $name = shift;
my $ref = shift;
my $data = defined $$ref ? $$ref : '';
$data =~ s#(]])(>)#$1]]><![CDATA[$2#g;
my $text = '<![CDATA[' . $data . ']]>';
$text = "<$name>$text</$name>\n" if ( $name ne $self->{text_node_key} );
$text;
}
t/04_escape.t view on Meta::CPAN
# ----------------------------------------------------------------
use strict;
use Test::More tests => 9;
BEGIN { use_ok('XML::TreePP') };
# ----------------------------------------------------------------
my $tpp = XML::TreePP->new();
my $source = '<root><text><>&"'&gt;&lt;</text><cdata><![CDATA[<>&"'&gt;&lt;]]></cdata><attr key="<>&"'&gt;&lt;">BBB</attr></root>';
my $tree = $tpp->parse( $source );
is( $tree->{root}->{text}, '<>&"\'><', "parse text node" );
is( $tree->{root}->{cdata}, '<>&"'&gt;&lt;', "parse cdata node" );
is( $tree->{root}->{attr}->{'-key'}, '<>&"\'><', "parse attribute" );
$tree->{root}->{text_add} = '<>&"'&gt;&lt;';
my $cdata_raw = $tree->{root}->{cdata};
$tree->{root}->{cdata_ref} = \$cdata_raw;
my $back = $tpp->write( $tree );
my $text = ( $back =~ m#<text>(.*)</text># )[0];
is( $text, '<>&"'&gt;&lt;', "write text node" );
my $cdata = ( $back =~ m#<cdata>(.*)</cdata># )[0];
is( $cdata, '&lt;&gt;&amp;&quot;&apos;&amp;gt;&amp;lt;', "write cdata node (as text node)" );
my $attr = ( $back =~ m#<attr\s+key="(.*?)"\s*># )[0];
is( $attr, '<>&"'&gt;&lt;', "write attribute" );
my $tadd = ( $back =~ m#<text_add>(.*)</text_add># )[0];
is( $tadd, '&lt;&gt;&amp;&quot;&apos;&amp;gt;&amp;lt;', "write new var" );
my $cref = ( $back =~ m#<cdata_ref>(.*)</cdata_ref># )[0];
is( $cref, '<![CDATA[<>&"'&gt;&lt;]]>', "write cdata node (as cdata)" );
# ----------------------------------------------------------------
;1;
# ----------------------------------------------------------------
t/06_cdata.t view on Meta::CPAN
# ----------------------------------------------------------------
use strict;
use Test::More tests => 13;
BEGIN { use_ok('XML::TreePP') };
# ----------------------------------------------------------------
{
my $cdatal = '<cdata><![CDATA[';
my $test = 'bar &lt; <&> &gt; <span><br/></span> bar';
my $cdatar = ']]></cdata>';
my $tpp = XML::TreePP->new();
my $xml1 = join( "", $cdatal, $test, $cdatar );
$tpp->set( cdata_scalar_ref => 1 );
my $tree1 = $tpp->parse( $xml1 );
my $cdata1 = $tree1->{cdata};
ok( ref $cdata1, "cdata as reference" );
is( $$cdata1, $test, "cdata escaping" );
my $xml2 = $tpp->write( $tree1 );
ok( $xml2 =~ /\Q$cdatal$test$cdatar\E/, "round trip: source" );
$tpp->set( cdata_scalar_ref => undef );
my $tree2 = $tpp->parse( $xml2 );
my $cdata2 = $tree2->{cdata};
ok( ! ref $cdata2, "round trip: cdata as scalar" );
is( $cdata2, $test, "round trip: text node escaping" );
$tree2->{cdata} = \$cdata2;
my $xml3 = $tpp->write( $tree2 );
ok( $xml2 =~ /\Q$cdatal$test$cdatar\E/, "round trip: again" );
}
# ----------------------------------------------------------------
{
my $root1 = '<cdata attr="foo">';
my $root2 = '<bar/>';
my $cdatal = '<![CDATA[';
my $test = 'bar &lt; <&> &gt; <span><br/></span> bar';
my $cdatar = ']]>';
my $root3 = '</cdata>';
my $tpp = XML::TreePP->new();
my $xml1 = join( '', $root1, $root2, $cdatal, $test, $cdatar, $root3 );
$tpp->set( cdata_scalar_ref => 1 );
my $tree1 = $tpp->parse( $xml1 );
my $cdata1 = $tree1->{cdata}{'#text'};
ok( ref $cdata1, 'cdata as reference B' );
is( $$cdata1, $test, 'cdata escaping B' );
my $xml2 = $tpp->write( $tree1 );
ok( $xml2 =~ /\Q$cdatal$test$cdatar\E/, 'round trip: source B' );
$tpp->set( cdata_scalar_ref => undef );
my $tree2 = $tpp->parse( $xml2 );
my $cdata2 = $tree2->{cdata}{'#text'};
ok( ! ref $cdata2, 'round trip: cdata as scalar B' );
is( $cdata2, $test, 'round trip: text node escaping B' );
$tree2->{cdata} = \$cdata2;
my $xml3 = $tpp->write( $tree2 );
ok( $xml2 =~ /\Q$cdatal$test$cdatar\E/, 'round trip: again B' );
}
# ----------------------------------------------------------------
;1;
# ----------------------------------------------------------------
t/11_escape_cdata.t view on Meta::CPAN
# ----------------------------------------------------------------
use strict;
use Test::More tests => 7;
BEGIN { use_ok('XML::TreePP') };
# ----------------------------------------------------------------
my $tpp = XML::TreePP->new();
$tpp->set( cdata_scalar_ref => 1 );
my $source = '<root><text><>&><</text><cdata><![CDATA[<>&><]]></cdata><attr key="<>&><">BBB</attr></root>';
my $tree = $tpp->parse( $source );
is( $tree->{root}->{text}, '<>&><', "parse text node" );
my $cdata = $tree->{root}->{cdata};
is( $$cdata, '<>&><', "parse cdata node" );
is( $tree->{root}->{attr}->{'-key'}, '<>&><', "parse attribute" );
my $back = $tpp->write( $tree );
like( $back, qr{ <text>\s* <>&>< \s*</text> }sx, "write text node" );
like( $back, qr{ <cdata><!\[CDATA\[<>&><\]\]></cdata> }sx, "write cdata node (as cdata)" );
like( $back, qr{ <attr\s+key="<>&><" }sx, "write attribute" );
# ----------------------------------------------------------------
;1;
# ----------------------------------------------------------------
t/19_multi_text.t view on Meta::CPAN
# ----------------------------------------------------------------
my $xml1 = '<root><text>aaa<child attr="bar"/>bbb</text></root>';
my $xml2 = '<root><text attr="foo">ccc<child attr="bar"/>ddd</text></root>';
my $xml3 = '<root><text><![CDATA[eee]]><child attr="bar"/><![CDATA[fff]]></text></root>';
my $xml4 = '<root><text attr="foo"><![CDATA[ggg]]><child attr="bar"/><![CDATA[hhh]]></text></root>';
my $xml5 = '<root><text><![CDATA[iii]]>jjj<![CDATA[kkk]]></text></root>';
my $xml6 = '<root><text>lll<![CDATA[mmm]]>nnn</text></root>';
my $tpp = XML::TreePP->new();
foreach my $cdata ( 1, 0 ) {
$tpp->set( cdata_scalar_ref => $cdata );
$tpp->set( multi_text_nodes => 0 );
my $tree1 = $tpp->parse( $xml1 );
my $tree2 = $tpp->parse( $xml2 );
my $tree3 = $tpp->parse( $xml3 );
my $tree4 = $tpp->parse( $xml4 );
my $tree5 = $tpp->parse( $xml5 );
my $tree6 = $tpp->parse( $xml6 );
ok( ! ref $tree1->{root}{text}{'#text'}, '1 parse' );
ok( ! ref $tree2->{root}{text}{'#text'}, '2 parse' );
if ( $cdata ) {
is( ref $tree3->{root}{text}{'#text'}, 'SCALAR', '3 parse cdata' );
is( ref $tree4->{root}{text}{'#text'}, 'SCALAR', '4 parse cdata' );
is( ref $tree5->{root}{text}, 'SCALAR', '5 parse cdata' );
is( ref $tree6->{root}{text}, 'SCALAR', '6 parse cdata' );
}
else {
ok( ! ref $tree3->{root}{text}{'#text'}, '3 parse' );
ok( ! ref $tree4->{root}{text}{'#text'}, '4 parse' );
ok( ! ref $tree5->{root}{text}, '5 parse' );
ok( ! ref $tree6->{root}{text}, '6 parse' );
}
is( $tree1->{root}{text}{'#text'}, 'aaabbb', '1 aaa-bbb' );
is( $tree2->{root}{text}{'#text'}, 'cccddd', '2 ccc-ddd' );
if ( $cdata ) {
is( ref $tree3->{root}{text}{'#text'}, 'SCALAR', '3 eee-fff ref' );
is( ref $tree4->{root}{text}{'#text'}, 'SCALAR', '4 ggg-hhh ref' );
is( ref $tree5->{root}{text}, 'SCALAR', '5 iii-jjj-kkk ref' );
is( ref $tree6->{root}{text}, 'SCALAR', '6 lll-mmm-nnn ref' );
is( ${$tree3->{root}{text}{'#text'}}, 'eeefff', '3 eee-fff cdata' );
is( ${$tree4->{root}{text}{'#text'}}, 'ggghhh', '4 ggg-hhh cdata' );
is( ${$tree5->{root}{text}}, 'iiijjjkkk', '5 iii-jjj-kkk cdata' );
is( ${$tree6->{root}{text}}, 'lllmmmnnn', '6 lll-mmm-nnn cdata' );
}
else {
is( $tree3->{root}{text}{'#text'}, 'eeefff', '3 eee-fff' );
is( $tree4->{root}{text}{'#text'}, 'ggghhh', '4 ggg-hhh' );
is( $tree5->{root}{text}, 'iiijjjkkk', '5 iii-jjj-kkk' );
is( $tree6->{root}{text}, 'lllmmmnnn', '6 lll-mmm-nnn' );
}
my $write1 = $tpp->write( $tree1 );
my $write2 = $tpp->write( $tree2 );
my $write3 = $tpp->write( $tree3 );
my $write4 = $tpp->write( $tree4 );
my $write5 = $tpp->write( $tree5 );
my $write6 = $tpp->write( $tree6 );
like( $write1, qr/>aaabbb</s, '1 back' );
like( $write2, qr/>cccddd</s, '2 back' );
if ( $cdata ) {
like( $write3, qr/<!\[CDATA\[eeefff\]\]>/s, '3 write cdata' );
like( $write4, qr/<!\[CDATA\[ggghhh\]\]>/s, '4 write cdata' );
like( $write5, qr/<!\[CDATA\[iiijjjkkk\]\]>/s, '5 write cdata' );
like( $write6, qr/<!\[CDATA\[lllmmmnnn\]\]>/s, '6 write cdata' );
}
else {
like( $write3, qr/>eeefff</s, '3 write' );
like( $write4, qr/>ggghhh</s, '4 write' );
like( $write5, qr/>iiijjjkkk</s, '5 write' );
like( $write6, qr/>lllmmmnnn</s, '6 write' );
}
}
# ----------------------------------------------------------------
;1;
t/25_text_node_key.t view on Meta::CPAN
# 25_text_noe_key.t
use strict;
use Test::More tests => 13;
BEGIN { use_ok('XML::TreePP') };
my $tpp = XML::TreePP->new();
$tpp->set( cdata_scalar_ref => 1 );
my $hello = 'Hello, World!';
my $tnode_keys = [ '#text', '_content', '0' ];
foreach my $tkey ( @$tnode_keys ) {
my $rand = int(rand() * 9000 + 1000);
my $text = "$hello $rand $tkey";
my $tree = {
root => {
text => {
-attr => $text,
$tkey => $text,
},
cdata => {
-attr => $text,
$tkey => \$text,
},
}
};
$tpp->set( text_node_key => $tkey );
my $write = $tpp->write( $tree );
# print STDERR $write;
my $back = $tpp->parse( $write );
is( $back->{root}->{text}->{-attr}, $text, "attribute1 for $tkey" );
is( $back->{root}->{text}->{$tkey}, $text, "text node for $tkey" );
is( $back->{root}->{cdata}->{-attr}, $text, "attribute2 for $tkey" );
my $ref = $back->{root}->{cdata}->{$tkey};
is( $$ref, $text, "cdata node for $tkey (content)" ) if ref $ref;
is( $text, 'SCALAR(0x...)', "cdata node for $tkey (ref)" ) unless ref $ref;
}
1;
t/33_indent.t view on Meta::CPAN
my $xml = $tpp->write( $tree );
my $space = $indent ? '\040' x $indent : '';
$indent ||= 0;
like( $xml, qr{ <one>1</one> }x, "[$indent] text node" );
like( $xml, qr{ <two><three }x, "[$indent] child node" );
like( $xml, qr{ />2</two> }x, "[$indent] text node after empty node" );
like( $xml, qr{ <six>6</six> }x, "[$indent] explicit text node" );
like( $xml, qr{ >7</seven> }x, "[$indent] text node after attribute" );
like( $xml, qr{ <nine><!\[CDATA\[9\]\]></nine> }x, "[$indent] cdata node" );
like( $xml, qr{ ^<root> }mx, "[$indent] no-indent root" );
like( $xml, qr{ ^$space<one> }mx, "[$indent] indent one" );
like( $xml, qr{ ^$space<two> }mx, "[$indent] indent two" );
like( $xml, qr{ ^$space<four> }mx, "[$indent] indent four" );
like( $xml, qr{ ^$space</four> }mx, "[$indent] indent four end" );
like( $xml, qr{ ^$space$space<five> }mx, "[$indent] indent five" );
like( $xml, qr{ ^$space$space<six> }mx, "[$indent] indent six" );
like( $xml, qr{ ^$space$space<seven }mx, "[$indent] indent seven" );
like( $xml, qr{ ^$space<nine> }mx, "[$indent] indent nine" );
t/37_undef.t view on Meta::CPAN
list => [ '', undef ],
empty => \$empty,
undef => \$undef,
}
};
my $xml = $tpp->write( $tree );
like( $xml, qr{<attr one="" two=""}, 'attr one two' );
like( $xml, qr{ <hash>\s*<three }xs, 'hash three' );
like( $xml, qr{ </three>\s*<four }xs, 'hash four' );
like( $xml, qr{ <empty><!\[CDATA\[ }xs, 'empty cdata' );
like( $xml, qr{ <undef><!\[CDATA\[ }xs, 'undef cdata' );
}
# ----------------------------------------------------------------
;1;
# ----------------------------------------------------------------
t/38_cdata_cdsect.t view on Meta::CPAN
# ----------------------------------------------------------------
use strict;
use Test::More tests => 161;
BEGIN { use_ok('XML::TreePP') };
# ----------------------------------------------------------------
{
my $test = {
'<cdata><![CDATA[]]></cdata>' => '',
'<cdata><![CDATA[]]]></cdata>' => ']',
'<cdata><![CDATA[>]]></cdata>' => '>',
'<cdata><![CDATA[]]]]></cdata>' => ']]',
'<cdata><![CDATA[]]]><![CDATA[]]]></cdata>' => ']]',
'<cdata><![CDATA[]>]]></cdata>' => ']>',
'<cdata><![CDATA[]]]><![CDATA[>]]></cdata>' => ']>',
'<cdata>]<![CDATA[]]]>></cdata>' => ']]>',
'<cdata>]<![CDATA[]>]]></cdata>' => ']]>',
'<cdata><![CDATA[]]]]>></cdata>' => ']]>',
'<cdata><![CDATA[]]]]><![CDATA[>]]></cdata>' => ']]>',
'<cdata><![CDATA[]]]><![CDATA[]>]]></cdata>' => ']]>',
'<cdata>]<![CDATA[]]]><![CDATA[>]]></cdata>' => ']]>',
'<cdata><![CDATA[]]]><![CDATA[]]]>></cdata>' => ']]>',
'<cdata><![CDATA[]]]>]<![CDATA[>]]></cdata>' => ']]>',
'<cdata><![CDATA[]]]><![CDATA[]]]><![CDATA[>]]></cdata>' => ']]>',
'<cdata><![CDATA[]]]><![CDATA[]>]]]]><![CDATA[>]]></cdata>' => ']]>]]>',
'<cdata><![CDATA[]]]><![CDATA[]>]]]><![CDATA[]>]]></cdata>' => ']]>]]>',
'<cdata><![CDATA[]]]><![CDATA[]>]]><![CDATA[]]]]><![CDATA[>]]></cdata>' => ']]>]]>',
'<cdata><![CDATA[]]]]><![CDATA[>]]><![CDATA[]]]><![CDATA[]>]]></cdata>' => ']]>]]>',
};
&cdata_cdsect( $test );
&cdata_cdsect( $test, { cdata_scalar_ref=>1 } );
}
# ----------------------------------------------------------------
sub cdata_cdsect {
my $list = shift;
my $opt = shift;
my $tpp = XML::TreePP->new( %$opt );
foreach my $src ( keys %$list ) {
my $val = $list->{$src};
my $tree = $tpp->parse( $src );
ok( exists $tree->{cdata}, 'exists' );
my $cdata = $tree->{cdata};
$cdata = $$cdata if ( ref $cdata eq 'SCALAR' );
ok( ! ref $cdata, 'invalid ref' );
is( $cdata, $val, $val );
my $xml = $tpp->write( $tree );
my $again = $tpp->parse( $xml );
my $cdat2 = $again->{cdata};
$cdat2 = $$cdat2 if ( ref $cdat2 eq 'SCALAR' );
is( $cdat2, $cdata, 'round trip' );
}
}
# ----------------------------------------------------------------
;1;
# ----------------------------------------------------------------
t/42_cdata_comment.t view on Meta::CPAN
'<xml><!-- AAA -->BBB<![CDATA[CCC]]>DDD<!-- EEE --></xml>' => 'BBBCCCDDD',
'<xml><![CDATA[AAA]]>BBB<!-- CCC -->DDD<![CDATA[EEE]]></xml>' => 'AAABBBDDDEEE',
'<xml><![CDATA[<!-- AAA -->]]></xml>' => '<!-- AAA -->',
'<xml><!-- <![CDATA[AAA]]> --></xml>' => '',
'<xml><![CDATA[<!-- AAA -->]]><!-- <![CDATA[BBB]]> --></xml>' => '<!-- AAA -->',
'<xml><!-- <![CDATA[AAA]]> --><![CDATA[<!-- BBB -->]]></xml>' => '<!-- BBB -->',
};
&cdata_cdsect( $test );
&cdata_cdsect( $test, { cdata_scalar_ref=>1 } );
}
# ----------------------------------------------------------------
sub cdata_cdsect {
my $list = shift;
my $opt = shift;
my $tpp = XML::TreePP->new( %$opt );
my $memo = exists $opt->{cdata_scalar_ref} ? 'cdata_scalar_ref ' : 'default ';
foreach my $src ( keys %$list ) {
my $val = $list->{$src};
my $tree = $tpp->parse( $src );
ok( exists $tree->{xml}, $memo.'exists' );
my $cdata = $tree->{xml};
$cdata = $$cdata if ( ref $cdata eq 'SCALAR' );
ok( ! ref $cdata, $memo.'invalid ref' );
is( $cdata, $val, $memo.$val );
my $xml = $tpp->write( $tree );
my $again = $tpp->parse( $xml );
my $cdat2 = $again->{xml};
$cdat2 = $$cdat2 if ( ref $cdat2 eq 'SCALAR' );
is( $cdat2, $cdata, $memo.'round trip' );
}
}
# ----------------------------------------------------------------
;1;
# ----------------------------------------------------------------
t/48_blobref.t view on Meta::CPAN
local $SIG{__WARN__} = sub {}; # ignore warn messages
my $xml1 = $tpp->write( $tree1 );
like( $xml1, qr#<elem>value</elem>#, 'no1: HASHREF - child node' );
my $xml2 = $tpp->write( $tree2 );
like( $xml2, qr#<elem>first</elem>\s*<elem>last</elem>#s, 'no2: ARRAYREF - multiple nodes' );
my $xml3 = $tpp->write( $tree3 );
my $exp3 = '<scalarref><![CDATA[value]]></scalarref>';
like( $xml3, qr#\Q$exp3\E#, 'no3: SCALARREF - cdata node' );
my $xml4 = $tpp->write( $tree4 );
like( $xml4, qr#xml#, 'no4: CODEREF - undefined behavior rather than die' );
my $xml5 = $tpp->write( $tree5 );
like( $xml5, qr#<elem>value</elem>#, 'no5: OBJECT - as a normal child node' );
my $xml6 = $tpp->write( $tree6 );
like( $xml6, qr#xml#, 'no6: BLOB - undefined behavior rather than die' );
( run in 0.375 second using v1.01-cache-2.11-cpan-ec4f86ec37b )