XML-Hash-LX
view release on metacpan or search on metacpan
TODO: make hash2xml faster
0.0603 2011-08-19
- Fix tests
0.0602 2011-08-18
- Merge encoding patch from ~gugu
0.06_01 2011-06-16
- Fix when attribute/cdata/comment value is empty/undef
- Cleanup tests (move qualitee tests to xt/*)
- add bt/* - benchmark testing draft
0.06 2009-09-15
Fix dist: remove cpants.pl from install
0.05 2009-09-03
Fix: work with earlier versions of XML::LibXML (for ex 1.58)
Remove Catalyst stuff from distribution, make it separate
xml2hash( '<item>Test1<sub />Test2</item>' )
: { item => { sub => '', '~' => 'Test1+Test2' } };
# argument
xml2hash( '<item>Test1<sub />Test2</item>', join => '+' )
: { item => { sub => '', '~' => 'Test1+Test2' } };
trim [ = 1 ]
Trim leading and trailing whitespace from text nodes
cdata [ = undef ]
When defined, CDATA sections will be stored under this key
# cdata = undef
<node><![CDATA[ test ]]></node> => { node => 'test' }
# cdata = '#'
<node><![CDATA[ test ]]></node> => { node => { '#' => 'test' } }
comm [ = undef ]
When defined, comments sections will be stored under this key
When undef, comments will be ignored
# comm = undef
<node><!-- comm --><sub/></node> => { node => { sub => '' } }
Trim leading and trailing whitespace from text nodes
# trim = 1
{ node => { sub => [ ' ', 'test' ], '#text' => "test" } }
<node>test<sub>test</sub></node>
# trim = 0
{ node => { sub => [ ' ', 'test' ], '#text' => "test" } }
<node>test<sub> test</sub></node>
cdata [ = undef ]
When defined, such key elements will be saved as CDATA sections
# cdata = undef
{ node => { '#' => 'test' } } => <node><#>test</#></node> # it's bad ;)
# cdata = '#'
{ node => { '#' => 'test' } } => <node><![CDATA[test]]></node>
comm [ = undef ]
When defined, such key elements will be saved as comment sections
# comm = undef
{ node => { '/' => 'test' } } => <node></>test<//></node> # it's very bad! ;)
# comm = '/'
{ node => { '/' => 'test' } } => <node><!-- test --></node>
use Data::Dumper;
$Data::Dumper::Indent = 1;
$Data::Dumper::Useqq = 1;
# xml to hash options
$XML::Hash::LX::X2H{trim} = 0; # don't trim whitespace
$XML::Hash::LX::X2H{attr} = '+'; # make attributes as keys with prefix '+';
$XML::Hash::LX::X2H{text} = '~'; # make text node as key '~';
#$XML::Hash::LX::X2H{join} = ' '; # join all whitespaces with ' ';
#$XML::Hash::LX::X2H{join} = undef;# don't join text nodes
$XML::Hash::LX::X2H{cdata} = '#'; # separate cdata sections from common values and save it under key '#';
$XML::Hash::LX::X2H{comm} = '//'; # keep comments and store under key '//';
# array cast
$XML::Hash::LX::X2A{nest} = 1; # node with name 'nest' should be always stored as array
#$XML::Hash::LX::X2A = 1; # all nodes should be always stored as array
#$XML::Hash::LX::X2H{order} = 1; # keep order strictly
my $hash = xml2hash
q{<root at="key">
<nest>
<!-- something commented -->
first
<v>a</v>
mid
<!-- something commented -->
<v at="a">b</v>
<vv><![CDATA[ cdata <<>> content ]]></vv>
last
</nest>
</root>},
attr => '.', # locally override attr to be prefixed with '.'
;
print +Dumper $hash;
# hash to xml options
$XML::Hash::LX::H2X{trim} = 1; # ignore whitespace
$XML::Hash::LX::H2X{attr} = '+'; # keys, starting from '+' are attributes
$XML::Hash::LX::H2X{text} = '~'; # key '~' is text node
$XML::Hash::LX::H2X{cdata} = '#'; # key '#' is CDATA node
$XML::Hash::LX::H2X{comm} = '//'; # key '//' is comment node
# scalarref is treated as raw xml
$hash->{root}{inject} = \('<rawnode attr="zzz" />');
# refref is treated as XML::LibXML elements, and will be cloned and inserted
$hash->{root}{add} = \( XML::LibXML::Element->new('test') );
print hash2xml
$hash,
attr => '.', # locally override attr to be prefixed with '.'
lib/XML/Hash/LX.pm view on Meta::CPAN
: { item => { sub => '', '~' => 'Test1+Test2' } };
# argument
xml2hash( '<item>Test1<sub />Test2</item>', join => '+' )
: { item => { sub => '', '~' => 'Test1+Test2' } };
=item trim [ = 1 ]
Trim leading and trailing whitespace from text nodes
=item cdata [ = undef ]
When defined, CDATA sections will be stored under this key
# cdata = undef
<node><![CDATA[ test ]]></node> => { node => 'test' }
# cdata = '#'
<node><![CDATA[ test ]]></node> => { node => { '#' => 'test' } }
=item comm [ = undef ]
When defined, comments sections will be stored under this key
When undef, comments will be ignored
# comm = undef
<node><!-- comm --><sub/></node> => { node => { sub => '' } }
lib/XML/Hash/LX.pm view on Meta::CPAN
our $X2A = 0;
our %X2A = ();
our %X2H;
%X2H = (
order => 0,
attr => '-',
text => '#text',
join => '',
trim => 1,
cdata => undef,
comm => undef,
#cdata => '#',
#comm => '//',
%X2H, # also inject previously user-defined options
);
sub _x2h {
my $doc = shift;
my $res;
if ($doc->hasChildNodes or $doc->hasAttributes) {
if ($X2H{order}) {
$res = [];
lib/XML/Hash/LX.pm view on Meta::CPAN
$res->{ $X2H{attr} . $_->nodeName } = $_->getValue;
}
}
for ($doc->childNodes) {
my $ref = ref $_;
my $nn;
if ($ref eq 'XML::LibXML::Text') {
$nn = $X2H{text}
}
elsif ($ref eq 'XML::LibXML::CDATASection') {
$nn = defined $X2H{cdata} ? $X2H{cdata} : $X2H{text};
}
elsif ($ref eq 'XML::LibXML::Comment') {
$nn = defined $X2H{comm} ? $X2H{comm} : next;
}
else {
$nn = $_->nodeName;
}
my $chld = _x2h($_);
if ($X2H{order}) {
if ($nn eq $X2H{text}) {
lib/XML/Hash/LX.pm view on Meta::CPAN
Trim leading and trailing whitespace from text nodes
# trim = 1
{ node => { sub => [ ' ', 'test' ], '#text' => "test" } }
<node>test<sub>test</sub></node>
# trim = 0
{ node => { sub => [ ' ', 'test' ], '#text' => "test" } }
<node>test<sub> test</sub></node>
=item cdata [ = undef ]
When defined, such key elements will be saved as CDATA sections
# cdata = undef
{ node => { '#' => 'test' } } => <node><#>test</#></node> # it's bad ;)
# cdata = '#'
{ node => { '#' => 'test' } } => <node><![CDATA[test]]></node>
=item comm [ = undef ]
When defined, such key elements will be saved as comment sections
# comm = undef
{ node => { '/' => 'test' } } => <node></>test<//></node> # it's very bad! ;)
# comm = '/'
lib/XML/Hash/LX.pm view on Meta::CPAN
}
elsif (ref $data eq 'HASH') {
for (keys %$data) {
#warn "$_ $data->{$_}";
#next if !defined $data->{$_} or ( !ref $data->{$_} and !length $data->{$_} );
# What may be empty ?
# - attribute
# - node
# - comment
# Skip empty: text, cdata
my $cdata_or_text;
if ($_ eq $H2X{text}) {
$cdata_or_text = 'XML::LibXML::Text';
}
elsif (defined $H2X{cdata} and $_ eq $H2X{cdata}) {
$cdata_or_text = 'XML::LibXML::CDATASection';
}
if (0) {}
elsif($cdata_or_text) {
push @rv, map {
defined($_) ? do {
$H2X{trim} and s/(?:^\s+|\s+$)//sg;
$H2X{trim} && !length($_) ? () :
$cdata_or_text->new( $_ )
} : (),
} ref $data->{$_} ? @{ $data->{$_} } : $data->{$_};
}
elsif (defined $H2X{comm} and $_ eq $H2X{comm}) {
push @rv, map XML::LibXML::Comment->new(defined $_ ? $_ : ''), ref $data->{$_} ? @{ $data->{$_} } : $data->{$_};
}
elsif (substr($_,0,$AL) eq $H2X{attr} ) {
if ($parent) {
$parent->setAttribute( substr($_,1),defined $data->{$_} ? $data->{$_} : '' );
t/01-conv.t view on Meta::CPAN
our $data;
{
is_deeply
$data = xml2hash($xml1),
{root => {'-at' => 'key',nest => {'#text' => 'firstmidlast',vv => '',v => ['a',{'-at' => 'a','#text' => 'b'}]}}},
'default (1)'
or diag dd($data),"\n";
}
{
is_deeply
$data = xml2hash($xml1, cdata => '#cdata'),
{root => {'-at' => 'key',nest => {'#cdata' => 'first','#text' => 'midlast',vv => '',v => ['a',{'-at' => 'a','#text' => 'b'}]}}},
'default (1)'
or diag dd($data),"\n";
}
{
is_deeply
$data = xml2hash($xml2),
{root => {'-at' => 'key',nest => 'first & mid & last'}},
'default (2)'
or diag dd($data),"\n";
}
t/01-conv.t view on Meta::CPAN
}
{
is_deeply
$data = xml2hash(q{<root x="1">test</root>}, text => '#textnode'),
{root => { -x => 1, '#textnode' => 'test' }},
'text node'
or diag dd($data),"\n";
}
{
is_deeply
$data = xml2hash(q{<root x="1"><![CDATA[test]]></root>}, cdata => '#cdata'),
{root => { -x => 1, '#cdata' => 'test' }},
'cdata node'
or diag dd($data),"\n";
}
# Composing
# Due to unpredictable order of hash keys
# { node => { a => 1, b => 2 } }
# could be one of:
# <node><a>1</a><b>2</b></node>
# <node><b>2</b><a>1</a></node>
t/01-conv.t view on Meta::CPAN
'trim 0',
;
is
$data = hash2xml( { node => { sub => [ " \t\n", 'test' ] } }, trim => 0 ),
qq{$xml<node><sub> \t\ntest</sub></node>\n},
'trim 1',
;
}
{
is
$data = hash2xml( { node => { sub => { '@' => 'test' } } }, cdata => '@' ),
qq{$xml<node><sub><![CDATA[test]]></sub></node>\n},
'cdata @',
;
}
{
is
$data = hash2xml( { node => { sub => { '/' => 'test' } } },comm => '/' ),
qq{$xml<node><sub><!--test--></sub></node>\n},
'comm /',
;
}
{
is
$data = hash2xml( { node => { -attr => undef, '#cdata' => undef, '/' => undef, x=>undef } }, cdata => '#cdata', comm => '/' ),
qq{$xml<node attr=""><!----><x/></node>\n},
'empty attr',
;
}
{
is
$data = hash2xml( { node => { test => "ТеÑÑ‚" } }, encoding => 'cp1251' ),
qq{<?xml version="1.0" encoding="cp1251"?>\n<node><test>\322\345\361\362</test></node>\n},
'encoding support',
;
( run in 0.664 second using v1.01-cache-2.11-cpan-454fe037f31 )