conf/mungle/xml.pl

# special mungle file which prepare data_structure from XML

my $ds = get_ds;
warn "## ds = ",dump( $ds );

my @a = ( 'foo' );
my @s = ( 'bar' );

# check if tag is scalar or array and add it
foreach my $tag ( qw/number array/ ) {
        if ( ref($xml->{$tag}) eq 'ARRAY' ) {
                push @a, $tag;
        } else {
                push @s, $tag;
        }
}

warn '## collect data from @a = ',dump( @a ), ' @s = ',dump( @s );

# unroll content from arrays
foreach my $tag ( @a ) {
        next unless defined $ds->{xml}->{$tag};
        set_ds( $tag => [
                map { $_->{content} } @{ $ds->{xml}->{$tag} }
        ] );
}

# and just copy scalars
foreach my $tag ( @s ) {
        next unless defined $ds->{xml}->{$tag};
        set_ds( $tag => $ds->{xml}->{$tag} );
}

1	# special mungle file which prepare data_structure from XML
2
3	my $ds = get_ds;
4	warn "## ds = ",dump( $ds );
5
6	my @a = ( 'foo' );
7	my @s = ( 'bar' );
8
9	# check if tag is scalar or array and add it
10	foreach my $tag ( qw/number array/ ) {
11	if ( ref($xml->{$tag}) eq 'ARRAY' ) {
12	push @a, $tag;
13	} else {
14	push @s, $tag;
15	}
16	}
17
18	warn '## collect data from @a = ',dump( @a ), ' @s = ',dump( @s );
19
20	# unroll content from arrays
21	foreach my $tag ( @a ) {
22	next unless defined $ds->{xml}->{$tag};
23	set_ds( $tag => [
24	map { $_->{content} } @{ $ds->{xml}->{$tag} }
25	] );
26	}
27
28	# and just copy scalars
29	foreach my $tag ( @s ) {
30	next unless defined $ds->{xml}->{$tag};
31	set_ds( $tag => $ds->{xml}->{$tag} );
32	}
33