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