#!perl -T
use strict;
use warnings;
use Test::More tests => 60;
use Data::Dumper;
use Encode qw(encode);
use XML::Rules;
my $xml = <<'*END*';
<data version="1.0">
<foo attr="ahoj">cau</foo>
<bar/>
<baz>xxx"xxx</baz>
<baz>yyyy</baz>
</data>
*END*
my $data_utf8 = "P\x{159}\x{ed}li\x{17e} \x{17e}lu\x{b4}tou\x{10d}k\x{fd} k\x{fa}\x{148} \x{fa}p\x{11b}l \x{161}\x{ed}len\x{e9} \x{f3}dy.";
# in case you wonder ... The crazy looking stuff above is a Czech sentence commonly used to test the encodings. It contains all accentuated characters used in Czech and still kinda makes sense.
# It translates as "Too yellow horse moaned crazy odes." I did say "kinda" ;-)
my $data_windows = encode( 'windows-1250', $data_utf8);
my $data_latin2 = encode( 'ISO-8859-2', $data_utf8);
my $parser = XML::Rules->new(
rules => [
_default => 'raw',
# data => 'as is',
],
);
my $res = $parser->parse($xml);
#print Dumper($res);
my $new_xml = $parser->ToXML(@$res) . "\n";
#print $new_xml;
#exit;
is( $new_xml, $xml, "Parse and output");
{
my $res = $parser->ToXML( 'data', 'some <important> "content"');
is( $res, '<data>some <important> "content"</data>', "Tag with content only");
}
{
my $res = $parser->ToXML( 'data', {_content => 'some <important> "content"'});
is( $res, '<data>some <important> "content"</data>', "Tag with content as attribute");
}
{
my $res = $parser->ToXML( 'data', {str => 'some <important> "content"'});
is( $res, '<data str="some <important> "content""/>', "Tag with one attribute");
}
{
my $res = $parser->ToXML( 'data', {str => 'string', _content => 'some <important> "content"'});
is( $res, '<data str="string">some <important> "content"</data>', "Tag with one attribute and content");
}
{
my $res = $parser->ToXML( 'data', {str => 'some <important> "content"', other => 156});
ok(
(
$res eq '<data str="some <important> "content"" other="156"/>'
or
$res eq '<data other="156" str="some <important> "content""/>'
),
"Tag with two attributes"
);
}
{
my $res = $parser->ToXML( 'data', '');
is( $res, '<data></data>', "Tag with empty string content");
}
{
my $res = $parser->ToXML( 'data', undef);
is( $res, '<data/>', "Tag with no content");
}
{
my $res = $parser->ToXML( 'data', {});
is( $res, '<data/>', "Tag with no content");
}
{
my $res = $parser->ToXML( 'data', {x => 5});
is( $res, '<data x="5"/>', "Tag with no content and one attribute");
}
{
my $res = $parser->ToXML( 'data', {y => 10, x => 5, z => 99});
is( $res, '<data x="5" y="10" z="99"/>', "Tag with no content and three attributes");
}
{
my $res = $parser->ToXML( 'data', {x => q{Jose "d'Artagnan" Razon}});
is( $res, q{<data x="Jose "d'Artagnan" Razon"/>}, "Tag with no content and one attribute that needs escaping");
}
{
my $res = $parser->ToXML( 'data', {x => $data_utf8});
is( $res, qq{<data x="$data_utf8"/>}, "Tag with no content and one attribute with accents");
}
{
my $res = $parser->ToXML( 'data', {foo => {}});
is( $res, '<data><foo/></data>', "Tag containg tag with no content");
}
{
my $res = $parser->ToXML( 'data', {foo => []});
is( $res, '<data><foo/></data>', "Tag containg tag with no content");
}
{
my $res = $parser->ToXML( 'data', {foo => ['']});
is( $res, '<data><foo></foo></data>', "Tag containg tag with empty string content");
}
{ # rules: windows, output: utf8
my $parser = XML::Rules->new(
rules => [ _default => 'raw', ],
encode => 'windows-1250',
output_encoding => 'utf8',
);
my $res = $parser->ToXML( 'data', {x => $data_windows});
is( $res, qq{<data x="$data_utf8"/>}, "Tag with no content and one attribute with accents (windows->utf8)");
}
{ # rules: windows, output: latin2
my $parser = XML::Rules->new(
rules => [ _default => 'raw', ],
encode => 'windows-1250',
output_encoding => 'ISO-8859-2',
);
my $res = $parser->ToXML( 'data', {x => $data_windows});
is( $res, qq{<data x="$data_latin2"/>}, "Tag with no content and one attribute with accents (windows->latin2)");
}
{ # rules: utf8, output: latin2
my $parser = XML::Rules->new(
rules => [ _default => 'raw', ],
encode => 'UTF8',
output_encoding => 'ISO-8859-2',
);
my $res = $parser->ToXML( 'data', {x => $data_utf8});
is( $res, qq{<data x="$data_latin2"/>}, "Tag with no content and one attribute with accents (utf8->latin2)");
}
{
my $res = $parser->ToXML( 'data', [qw(foo bar baz)]);
is( $res, '<data>foo</data><data>bar</data><data>baz</data>', "Tag with array of contents");
}
{
my $res = $parser->ToXML( 'data', [qw(foo)]);
is( $res, '<data>foo</data>', "Tag with array of contents with a single item");
}
{
my $res = $parser->ToXML( 'data', []);
is( $res, '', "Tag with array of contents with no items");
}
{
my $res = $parser->ToXML( ['data', {id => 1}, qw(foo bar baz)]);
is( $res, '<data id="1">foo</data><data id="1">bar</data><data id="1">baz</data>', "Tag with an attribute and array of contents");
}
{
my $res = $parser->ToXML( ['data', {id => 1}, [qw(foo bar baz)]]);
is( $res, '<data id="1">foobarbaz</data>', "Tag with an attribute and contents as array");
}
{
my $res = $parser->ToXML( 'data', [{str => 'foo'}, {str => 'bar'}, {str => 'baz'}]);
is( $res, '<data str="foo"/><data str="bar"/><data str="baz"/>', "Tag with array of attributes");
}
{
my $res = $parser->ToXML( ['data', {}, {str => 'foo'}, {str => 'bar'}, {str => 'baz'}]);
is( $res, '<data str="foo"/><data str="bar"/><data str="baz"/>', "Again as arrayref");
}
{
my $res = $parser->ToXML( ['data', {str => 'foo'}, {str => 'bar'}, {str => 'baz'}]);
is( $res, '<data str="bar"/><data str="baz"/>', "Overwrite attribute hashes");
}
{
my $res = $parser->ToXML( ['data' => {name => 'foo'}, {str => 'bar'}, {str => 'baz'}]);
is( $res, '<data name="foo" str="bar"/><data name="foo" str="baz"/>', "Merge attribute hashes");
}
{
my $res = $parser->ToXML( 'data', {bar => {_content => 'baz'}});
is( $res, '<data><bar>baz</bar></data>', "Tag with subtag");
}
{
my $res = $parser->ToXML( ['data', {bar => {_content => 'baz'}}]);
is( $res, '<data><bar>baz</bar></data>', "Tag with subtag as arrayref");
}
{
my $res = $parser->ToXML( 'data', {bar => {}});
is( $res, '<data><bar/></data>', "Tag with empty subtag");
}
{
my $res = $parser->ToXML( 'data', {attr => 5, bar => {}});
is( $res, '<data attr="5"><bar/></data>', "Tag with attribute and empty subtag");
}
{
my $res = $parser->ToXML( 'data', {attr => 5, bar => {a => 42, _content=> 'string'}});
is( $res, '<data attr="5"><bar a="42">string</bar></data>', "Tag with attribute and subtag with content and attribute");
}
{
my $res = $parser->ToXML( 'data', 'some <important> "content"', 1);
is( $res, '<data>some <important> "content"', "Tag with content only, don't close");
}
{
my $res = $parser->ToXML( 'data', {_content => 'some <important> "content"'}, "don't close");
is( $res, '<data>some <important> "content"', "Tag with content as attribute, don't close");
}
{
my $res = $parser->ToXML( 'data', {str => 'some <important> "content"'}, 1);
is( $res, '<data str="some <important> "content"">', "Tag with one attribute, don't close");
}
{
my $res = $parser->ToXML( 'data', {str => 'string', _content => 'some <important> "content"'}, 1);
is( $res, '<data str="string">some <important> "content"', "Tag with one attribute and content, don't close");
}
{
my $res = $parser->ToXML( 'data', {_content => ['start', [str => 'foo'], 'middle', [str => 'bar'], [str => 'baz'], 'end']});
is( $res, '<data>start<str>foo</str>middle<str>bar</str><str>baz</str>end</data>', "Tag with mix of text content and subtags");
}
{
my $res = $parser->ToXML( 'data', {
at => '5',
sub => {_content => 'SUBTAG'},
_content => ['start', [str => 'foo'], 'middle', [str => 'bar'], [str => 'baz'], 'end']
});
is( $res, '<data at="5"><sub>SUBTAG</sub>start<str>foo</str>middle<str>bar</str><str>baz</str>end</data>', "Tag with an attribute, subtag in attribute and mix of text content and subtags");
}
# pretty-printing
{
my $res = $parser->ToXML( 'data', '', 0, ' ', ' ');
is( $res, "<data></data>", "Tag with empty string content (pretty-print)");
}
{
my $res = $parser->ToXML( 'data', undef, 0, ' ', ' ');
is( $res, "<data/>", "Tag with no content (pretty-print)");
}
{
my $res = $parser->ToXML( 'data', {}, 0, ' ', ' ');
is( $res, "<data/>", "Tag with no content (pretty-print)");
}
{
my $res = $parser->ToXML( 'data', {x => 5}, 0, ' ', ' ');
is( $res, qq{<data x="5"/>}, "Tag with no content and one attribute (pretty-print)");
}
{
my $res = $parser->ToXML( 'data', {y => 10, x => 5, z => 99}, 0, ' ', ' ');
is( $res, qq{<data x="5" y="10" z="99"/>}, "Tag with no content and three attributes (pretty-print)");
}
{
my $res = $parser->ToXML( 'data', [qw(foo bar baz)], 0, ' ', ' ');
is( $res, qq{<data>foo</data>\n <data>bar</data>\n <data>baz</data>}, "Tag with array of contents (pretty-print)");
}
{
my $res = $parser->ToXML( 'data', [{str => 'foo'}, {str => 'bar'}, {str => 'baz'}], 0, ' ', ' ');
is( $res, qq{<data str="foo"/>\n <data str="bar"/>\n <data str="baz"/>}, "Tag with array of attributes (pretty-print)");
}
{
my $res = $parser->ToXML( 'data', {bar => {_content => 'baz'}}, 0, ' ', ' ');
is( $res, qq{<data>\n <bar>baz</bar>\n </data>}, "Tag with subtag (pretty-print)");
}
{
my $res = $parser->ToXML( 'data', {bar => {}}, 0, ' ', ' ');
is( $res, qq{<data>\n <bar/>\n </data>}, "Tag with empty subtag (pretty-print)");
}
{
my $res = $parser->ToXML( 'data', {attr => 5, bar => {}}, 0, ' ', ' ');
is( $res, qq{<data attr="5">\n <bar/>\n </data>}, "Tag with attribute and empty subtag (pretty-print)");
}
{
my $res = $parser->ToXML( 'data', {attr => 5, bar => {a => 42, _content=> 'string'}}, 0, ' ', ' ');
is( $res, qq{<data attr="5">\n <bar a="42">string</bar>\n </data>}, "Tag with attribute and subtag with content and attribute (pretty-print)");
}
# more complex examples. modeled after http://www.perlmonks.org/?node_id=787605
{
my $res = $parser->ToXML( [ family => { name => 'Kawasaki' },
[
[father => 'Yasushisa' ],
[mother => 'Chizuko' ],
[children =>
[
[girl => 'Shiori'],
[boy => 'Yasuke'],
[boy => 'Kairi']
]
]
]
]);
is( $res, qq{<family name="Kawasaki"><father>Yasushisa</father><mother>Chizuko</mother><children><girl>Shiori</girl><boy>Yasuke</boy><boy>Kairi</boy></children></family>}, "Family tree");
}
{
my $res = $parser->ToXML( [ family => { name => 'Kawasaki' },
[
[father => 'Yasushisa' ],
[mother => 'Chizuko' ],
[child =>
[[girl => 'Shiori']],
[[boy => 'Yasuke']],
[[boy => 'Kairi']]
]
]
], 0);
is( $res, qq{<family name="Kawasaki"><father>Yasushisa</father><mother>Chizuko</mother><child><girl>Shiori</girl></child><child><boy>Yasuke</boy></child><child><boy>Kairi</boy></child></family>}, "Family tree");
}
{
my $res = $parser->ToXML( [ family => { name => 'Kawasaki' },
[
[father => 'Yasushisa' ],
[mother => 'Chizuko' ],
[child =>
'Shiori',
'Yasuke',
'Kairi'
]
]
], 0);
is( $res, qq{<family name="Kawasaki"><father>Yasushisa</father><mother>Chizuko</mother><child>Shiori</child><child>Yasuke</child><child>Kairi</child></family>}, "Family tree");
}
{
my $res = $parser->ToXML( [ family => { name => 'Kawasaki' },
[
[father => 'Yasushisa' ],
[mother => 'Chizuko' ],
[child =>
{sex => 'f'}, 'Shiori',
{sex => 'm'}, 'Yasuke',
{sex => 'm'}, 'Kairi'
]
]
], 0);
is( $res, qq{<family name="Kawasaki"><father>Yasushisa</father><mother>Chizuko</mother><child sex="f">Shiori</child><child sex="m">Yasuke</child><child sex="m">Kairi</child></family>}, "Family tree");
}
{
my $res = $parser->ToXML( [ family => { name => 'Kawasaki' },
[
[father => 'Yasushisa' ],
[mother => 'Chizuko' ],
[child =>
'Shiori',
{sex => 'm'}, 'Yasuke',
{sex => 'm'}, 'Kairi'
]
]
], 0);
is( $res, qq{<family name="Kawasaki"><father>Yasushisa</father><mother>Chizuko</mother><child>Shiori</child><child sex="m">Yasuke</child><child sex="m">Kairi</child></family>}, "Family tree");
}
#formatted
{
my $res = $parser->ToXML( [ family => { name => 'Kawasaki' },
[
[father => 'Yasushisa' ],
[mother => 'Chizuko' ],
[children =>
[
[girl => 'Shiori'],
[boy => 'Yasuke'],
[boy => 'Kairi']
]
]
]
], 0, ' ', '');
is( $res, qq{<family name="Kawasaki">
<father>Yasushisa</father>
<mother>Chizuko</mother>
<children>
<girl>Shiori</girl>
<boy>Yasuke</boy>
<boy>Kairi</boy>
</children>
</family>}, "Family tree (formatted)");
}
{
my $res = $parser->ToXML( [ family => { name => 'Kawasaki' },
[
[father => 'Yasushisa' ],
[mother => 'Chizuko' ],
[child =>
[[girl => 'Shiori']],
[[boy => 'Yasuke']],
[[boy => 'Kairi']]
]
]
], 0, ' ', '');
is( $res, qq{<family name="Kawasaki">
<father>Yasushisa</father>
<mother>Chizuko</mother>
<child>
<girl>Shiori</girl>
</child>
<child>
<boy>Yasuke</boy>
</child>
<child>
<boy>Kairi</boy>
</child>
</family>}, "Family tree (formatted)");
}
{
my $res = $parser->ToXML( [ family => { name => 'Kawasaki' },
[
[father => 'Yasushisa' ],
[mother => 'Chizuko' ],
[child =>
'Shiori',
'Yasuke',
'Kairi'
]
]
], 0, ' ', '');
is( $res, qq{<family name="Kawasaki">
<father>Yasushisa</father>
<mother>Chizuko</mother>
<child>Shiori</child>
<child>Yasuke</child>
<child>Kairi</child>
</family>}, "Family tree (formatted)");
}
{
my $res = $parser->ToXML( [ family => { name => 'Kawasaki' },
[
[father => 'Yasushisa' ],
[mother => 'Chizuko' ],
[child =>
{sex => 'f'}, 'Shiori',
{sex => 'm'}, 'Yasuke',
{sex => 'm'}, 'Kairi'
]
]
], 0, ' ', '');
is( $res, qq{<family name="Kawasaki">
<father>Yasushisa</father>
<mother>Chizuko</mother>
<child sex="f">Shiori</child>
<child sex="m">Yasuke</child>
<child sex="m">Kairi</child>
</family>}, "Family tree (formatted)");
}
{
my $res = $parser->ToXML( [ family => { name => 'Kawasaki' },
[
[father => 'Yasushisa' ],
[mother => 'Chizuko' ],
[child =>
'Shiori',
{sex => 'm'}, 'Yasuke',
{sex => 'm'}, 'Kairi'
]
]
], 0, ' ', '');
is( $res, qq{<family name="Kawasaki">
<father>Yasushisa</father>
<mother>Chizuko</mother>
<child>Shiori</child>
<child sex="m">Yasuke</child>
<child sex="m">Kairi</child>
</family>}, "Family tree (formatted)");
}