package XML::Struct::Simple;
use strict;
use Moo;
use List::Util qw(first);
use Scalar::Util qw(reftype blessed);
use Carp qw(carp);
our $VERSION = '0.27';
has root => (
is => 'rw',
default => sub { 0 },
);
has attributes => (
is => 'rw',
default => sub { 1 },
coerce => sub { !defined $_[0] or ($_[0] and $_[0] ne 'remove') },
);
has content => (
is => 'rw',
default => sub { 'content' },
);
has depth => (
is => 'rw',
coerce => sub { (defined $_[0] and $_[0] >= 0) ? $_[0] : undef },
);
sub transform {
my ($self, $element) = @_;
my $simple = $self->transform_content($element,0);
# enforce root for special case text
if ($self->root or !ref $simple) {
my $root = $self->root !~ /^[+-]?[0-9]+$/ ? $self->root : $element->[0];
return { $root => $simple };
} else {
return $simple;
}
}
# returns a (possibly empty) hash or a scalar
sub transform_content {
my ($self, $element, $depth) = @_;
$depth = 0 if !defined $depth;
if (defined $self->depth and $depth >= $self->depth) {
return $element;
} elsif ( @$element == 1 ) { # empty tag
return { };
}
my $attributes = {};
my $children;
if ( reftype $element->[1] eq 'HASH' ) { # [ $tag, \%attributes, \@children ]
$attributes = $element->[1] if $self->attributes;
$children = $element->[2];
} else { # [ $tag, \@children ]
$children = $element->[1];
}
# no element children
unless ( first { ref $_ } @$children ) {
my $content = join "", @$children;
if ($content eq '') {
return { %$attributes };
} elsif (!%$attributes) {
return $content;
} else {
return { %$attributes, $self->content => $content };
}
}
my $simple = { map {$_ => [$attributes->{$_}] } keys %$attributes };
foreach my $child ( @$children ) {
next unless ref $child; # skip mixed content text
my $name = $child->[0];
my $content = $self->transform_content($child, $depth+1);
if ( $simple->{$name} ) {
push @{$simple->{$name}}, $content;
} else {
$simple->{$name} = [$content];
}
}
foreach my $name (keys %$simple) {
next if @{$simple->{$name}} != 1;
my $c = $simple->{$name}->[0];
if (!ref $c or (!blessed $c and reftype $c eq 'HASH')) {
$simple->{$name} = $c;
}
}
return $simple;
}
sub removeXMLAttr {
my $node = shift;
carp "removeXMLAttr is deprecated"
if 'XML::Struct::Simple::removeXMLAttr' ne (caller(1))[3];
ref $node
? ( $node->[2]
? [ $node->[0], [ map { removeXMLAttr($_,1) } @{$node->[2]} ] ]
: [ $node->[0] ] ) # empty element
: $node; # text node
}
1;
__END__
=encoding UTF-8
=head1 NAME
XML::Struct::Simple - Transform MicroXML data structures into simple (unordered) form
=head1 SYNOPSIS
my $micro = [
root => { xmlns => 'http://example.org/' },
[ '!', [ x => {}, [42] ] ]
];
my $converter = XML::Struct::Simple->new( root => 'record' );
my $simple = $converter->transform( $micro );
# { record => { xmlns => 'http://example.org/', x => 42 } }
=head1 DESCRIPTION
This module implements a transformation from structured XML (MicroXML) to
simple key-value format (SimpleXML) as known from L: Attributes
and child elements are treated as hash keys with their content as value. Text
elements without attributes are converted to text and empty elements without
attributes are converted to empty hashes.
L can export the function C for easy use. Function
C and L apply transformation to SimpleXML with
option C.
=head1 METHODS
=head2 transform( $element )
Transform XML given as array reference (MicroXML) to XML as hash reference
(SimpleXML) as configured.
=head2 transform_content( $element [, $depth ] )
Transform child nodes and attributes of an XML element given as array reference
at a given depth (C<0> by default). Returns a hash reference, a scalar, or the
element unmodified.
=head1 CONFIGURATION
=over
=item root
Keep the root element instead of removing. This corresponds to option
C in L. In addition a non-numeric value can be used to
override the name of the root element. Disabled by default.
=item attributes
Include XML attributes. Enabled by default. The special value C is
equivalent to false. Corresponds to option C in L.
=item content
Name of a field to put text content in. Set to "C by default.
Corresponds to option C in L.
=item depth
Only transform up to a given depth. Set to a negative value by default for
unlimited depth. Elements below depth are not cloned but copied by reference.
Depth 0 will return the element unmodified.
=back
Option C, C, and other fetures of L not
supported. Options C and C supported in
L are not supported yet.
=cut