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.
21 our $state; # FIXME check this!
29 foreach my $n ( keys %$tree ) {
30 next unless ref($tree->{$n}) eq 'ARRAY';
31 @out = map { $_->{value} } @{ $tree->{$n} };
35 die "no array in ",dump($tree) unless @out;
43 foreach my $n ( keys %$tree ) {
44 next unless ref($tree->{$n}) eq 'HASH';
45 $hash->{$n} = $tree->{$n}->{value};
47 die "no hash value in ",dump($hash) unless $hash;
54 foreach my $node ( keys %$tree ) {
55 next if $node =~ m/^_/;
59 if ( $node =~ m/GetRPCMethodsResponse/ ) {
61 $state->{MethodList} = [ _get_array( $tree->{$node}->{MethodList} ) ];
64 } elsif ( $node =~ m/(ID|MaxEnvelopes|CurrentTime|RetryCount)/ ) {
66 $state->{$1} = $tree->{$node}->{value};
70 } elsif ( $node =~ m/(DeviceId)/ ) {
72 $state->{$1} = _hash_value $tree->{$node};
75 } elsif ( $node =~ m/(Fault)/ && ! defined $tree->{$node}->{detail} ) {
77 $state->{$1} = _hash_value $tree->{$node};
80 } elsif ( $node =~ m/(EventStruct|ParameterValueStruct|ParameterInfoStruct)/ ) {
88 if ( ref $tree->{$node} eq 'HASH' ) {
89 @struct = ( $tree->{$node} );
90 } elsif ( ref $tree->{$node} eq 'ARRAY' ) {
91 @struct = @{ $tree->{$node} };
93 die "don't know how to handle $node in ",dump($tree);
96 foreach my $e ( @struct ) {
97 my $hash = _hash_value $e;
99 if ( my $n = delete $hash->{Name} ) {
100 my @keys = keys %$hash;
102 $state->{$name}->{$n} = $hash;
104 $state->{$name}->{$n} = $hash->{ $keys[0] };
105 # warn "using $keys[0] as value for $name.$n\n";
108 push @{ $state->{$name} }, $hash;
114 } elsif ( ref($tree->{$node}) eq 'HASH' ) {
116 $state->{_dispatch} = 'InformResponse' if $node =~ m/Inform/;
118 warn "## recurse $node\n" if $debug;
119 _walk( $tree->{$node} );
124 # warn "XXX tree ",dump( $tree->{$node} );
125 warn "## state ",dump( $state ) if $debug;
133 my $xml = shift || confess "no xml?";
137 my $bare = XML::Bare->new( text => $xml );
138 my $hash = $bare->parse();
141 #warn "# parsed to ",dump($hash);