7 use Data::Dump qw/dump/;
8 use Carp qw/confess cluck/;
12 CWMP::Parser - parse SOAP request XML
16 Design is based on my expirience with L<XML::Rules>, but show-stopper
17 was it's inability to parse invalid XML returned by some devices, so
18 in this version we depend on L<XML::Bare>
22 our $state; # FIXME check this!
30 foreach my $n ( keys %$tree ) {
31 next unless ref($tree->{$n}) eq 'ARRAY';
32 @out = map { $_->{value} } @{ $tree->{$n} };
36 die "no array in ",dump($tree) unless @out;
44 foreach my $n ( keys %$tree ) {
45 next unless ref($tree->{$n}) eq 'HASH';
46 $hash->{$n} = $tree->{$n}->{value};
48 die "no hash value in ",dump($hash) unless $hash;
55 foreach my $node ( keys %$tree ) {
56 next if $node =~ m/^_/;
60 if ( $node =~ m/GetRPCMethodsResponse/ ) {
62 $state->{MethodList} = [ _get_array( $tree->{$node}->{MethodList} ) ];
65 } elsif ( $node =~ m/(ID|MaxEnvelopes|CurrentTime|RetryCount)/ ) {
67 $state->{$1} = $tree->{$node}->{value};
71 } elsif ( $node =~ m/(DeviceId)/ ) {
73 $state->{$1} = _hash_value $tree->{$node};
76 } elsif ( $node =~ m/(Fault)/ && ! defined $tree->{$node}->{detail} ) {
78 $state->{$1} = _hash_value $tree->{$node};
81 } elsif ( $node =~ m/(EventStruct|ParameterValueStruct|ParameterInfoStruct)/ ) {
89 if ( ref $tree->{$node} eq 'HASH' ) {
90 @struct = ( $tree->{$node} );
91 } elsif ( ref $tree->{$node} eq 'ARRAY' ) {
92 @struct = @{ $tree->{$node} };
94 die "don't know how to handle $node in ",dump($tree);
97 foreach my $e ( @struct ) {
98 my $hash = _hash_value $e;
100 if ( my $n = delete $hash->{Name} ) {
101 my @keys = keys %$hash;
103 $state->{$name}->{$n} = $hash;
105 $state->{$name}->{$n} = $hash->{ $keys[0] };
106 # warn "using $keys[0] as value for $name.$n\n";
109 push @{ $state->{$name} }, $hash;
115 } elsif ( ref($tree->{$node}) eq 'HASH' ) {
117 $state->{_dispatch} = 'InformResponse' if $node =~ m/Inform/;
119 warn "## recurse $node\n" if $debug;
120 _walk( $tree->{$node} );
125 # warn "XXX tree ",dump( $tree->{$node} );
126 warn "## state ",dump( $state ) if $debug;
134 my $xml = shift || confess "no xml?";
138 my $bare = XML::Bare->new( text => $xml );
139 my $hash = $bare->parse();
142 #warn "# parsed to ",dump($hash);